--- trunk/lib/WebPAC/Normalize.pm	2007/04/01 21:47:47	813
+++ trunk/lib/WebPAC/Normalize.pm	2007/10/30 20:27:20	915
@@ -7,9 +7,10 @@
 	_debug
 	_pack_subfields_hash
 
-	tag search display
+	search_display search display
+
 	marc marc_indicators marc_repeatable_subfield
-	marc_compose marc_leader
+	marc_compose marc_leader marc_fixed
 	marc_duplicate marc_remove marc_count
 	marc_original_order
 
@@ -42,11 +43,11 @@
 
 =head1 VERSION
 
-Version 0.27
+Version 0.30
 
 =cut
 
-our $VERSION = '0.27';
+our $VERSION = '0.30';
 
 =head1 SYNOPSIS
 
@@ -59,7 +60,7 @@
 C<perl -c normalize.pl>.
 
 Normalisation can generate multiple output normalized data. For now, supported output
-types (on the left side of definition) are: C<tag>, C<display>, C<search> and
+types (on the left side of definition) are: C<search_display>, C<display>, C<search> and
 C<marc>.
 
 =head1 FUNCTIONS
@@ -442,27 +443,36 @@
 
 Those functions generally have to first in your normalization file.
 
-=head2 tag
+=head2 search_display
 
-Define new tag for I<search> and I<display>.
+Define output for L<search> and L<display> at the same time
 
-  tag('Title', rec('200','a') );
+  search_display('Title', rec('200','a') );
 
 
 =cut
 
-sub tag {
-	my $name = shift or die "tag needs name as first argument";
+sub search_display {
+	my $name = shift or die "search_display needs name as first argument";
 	my @o = grep { defined($_) && $_ ne '' } @_;
 	return unless (@o);
-	$out->{$name}->{tag} = $name;
 	$out->{$name}->{search} = \@o;
 	$out->{$name}->{display} = \@o;
 }
 
+=head2 tag
+
+Old name for L<search_display>, but supported
+
+=cut
+
+sub tag {
+	search_display( @_ );
+}
+
 =head2 display
 
-Define tag just for I<display>
+Define output just for I<display>
 
   @v = display('Title', rec('200','a') );
 
@@ -472,7 +482,6 @@
 	my $name = shift or die "display needs name as first argument";
 	my @o = grep { defined($_) && $_ ne '' } @_;
 	return unless (@o);
-	$out->{$name}->{tag} = $name;
 	$out->{$name}->{display} = \@o;
 }
 
@@ -488,7 +497,6 @@
 	my $name = shift or die "search needs name as first argument";
 	my @o = grep { defined($_) && $_ ne '' } @_;
 	return unless (@o);
-	$out->{$name}->{tag} = $name;
 	$out->{$name}->{search} = \@o;
 }
 
@@ -517,6 +525,49 @@
 	}
 }
 
+=head2 marc_fixed
+
+Create control/indentifier fields with values in fixed positions
+
+  marc_fixed('008', 00, '070402');
+  marc_fixed('008', 39, '|');
+
+Positions not specified will be filled with spaces (C<0x20>).
+
+There will be no effort to extend last specified value to full length of
+field in standard.
+
+=cut
+
+sub marc_fixed {
+	my ($f, $pos, $val) = @_;
+	die "need marc(field, position, value)" unless defined($f) && defined($pos);
+
+	confess "need val" unless defined $val;
+
+	my $update = 0;
+
+	map {
+		if ($_->[0] eq $f) {
+			my $old = $_->[1];
+			if (length($old) <= $pos) {
+				$_->[1] .= ' ' x ( $pos - length($old) ) . $val;
+				warn "## marc_fixed($f,$pos,'$val') append '$old' -> '$_->[1]'\n" if ($debug > 1);
+			} else {
+				$_->[1] = substr($old, 0, $pos) . $val . substr($old, $pos + length($val));
+				warn "## marc_fixed($f,$pos,'$val') update '$old' -> '$_->[1]'\n" if ($debug > 1);
+			}
+			$update++;
+		}
+	} @{ $marc_record->[ $marc_record_offset ] };
+
+	if (! $update) {
+		my $v = ' ' x $pos . $val;
+		push @{ $marc_record->[ $marc_record_offset ] }, [ $f, $v ];
+		warn "## marc_fixed($f,$pos,'val') created '$v'\n" if ($debug > 1);
+	}
+}
+
 =head2 marc
 
 Save value for MARC field
@@ -831,6 +882,9 @@
 
 	my ($h,$include_subfields) = @_;
 
+	# sanity and ease of use
+	return $h if (ref($h) ne 'HASH');
+
 	if ( defined($h->{subfields}) ) {
 		my $sfs = delete $h->{subfields} || die "no subfields?";
 		my @out;
@@ -980,7 +1034,8 @@
 =cut
 
 sub prefix {
-	my $p = shift or return;
+	my $p = shift;
+	return @_ unless defined( $p );
 	return map { $p . $_ } grep { defined($_) } @_;
 }
 
@@ -993,7 +1048,8 @@
 =cut
 
 sub suffix {
-	my $s = shift or die "suffix needs string as first argument";
+	my $s = shift;
+	return @_ unless defined( $s );
 	return map { $_ . $s } grep { defined($_) } @_;
 }
 
@@ -1006,8 +1062,10 @@
 =cut
 
 sub surround {
-	my $p = shift or die "surround need prefix as first argument";
-	my $s = shift or die "surround needs suffix as second argument";
+	my $p = shift;
+	my $s = shift;
+	$p = '' unless defined( $p );
+	$s = '' unless defined( $s );
 	return map { $p . $_ . $s } grep { defined($_) } @_;
 }
 
@@ -1182,7 +1240,6 @@
   $database_code = config();	# use _ from hash
   $database_name = config('name');
   $database_input_name = config('input name');
-  $tag = config('input normalize tag');
 
 Up to three levels are supported.