--- trunk/lib/WebPAC/Normalize.pm	2006/06/29 21:18:50	541
+++ trunk/lib/WebPAC/Normalize.pm	2006/06/30 18:48:33	550
@@ -5,7 +5,7 @@
 	_get_ds _clean_ds
 
 	tag search display
-	marc21
+	marc marc_indicators marc_repeatable_subfield
 
 	rec1 rec2 rec
 	regex prefix suffix surround
@@ -16,9 +16,13 @@
 use strict;
 
 #use base qw/WebPAC::Common/;
-use Data::Dumper;
+use Data::Dump qw/dump/;
 use Encode qw/from_to/;
 
+# debugging warn(s)
+my $debug = 0;
+
+
 =head1 NAME
 
 WebPAC::Normalize - describe normalisaton rules using sets
@@ -43,7 +47,7 @@
 
 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
-C<marc21>.
+C<marc>.
 
 =head1 FUNCTIONS
 
@@ -109,9 +113,7 @@
 
 =cut
 
-my $out;
-my $marc21;
-my $marc_encoding;
+my ($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators);
 
 sub _get_ds {
 	return $out;
@@ -127,8 +129,7 @@
 
 sub _clean_ds {
 	my $a = {@_};
-	$out = undef;
-	$marc21 = undef;
+	($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators) = ();
 	$marc_encoding = $a->{marc_encoding};
 }
 
@@ -146,16 +147,122 @@
 	$lookup = shift;
 }
 
-=head2 _get_marc21_fields
+=head2 _get_marc_fields
+
+Get all fields defined by calls to C<marc>
+
+	$marc->add_fields( WebPAC::Normalize:_get_marc_fields() );
+
 
-Get all fields defined by calls to C<marc21>
 
-	$marc->add_fields( WebPAC::Normalize:_get_marc21_fields() );
+We are using I<magic> which detect repeatable fields only from
+sequence of field/subfield data generated by normalization.
+
+Repeatable field is created if there is second occurence of same subfield or
+if any of indicators are different. This is sane for most cases except for
+non-repeatable fields with repeatable subfields.
+
+You can change behaviour of that using C<marc_repeatable_subfield>.
 
 =cut
 
-sub _get_marc21_fields {
-	return @{$marc21};
+sub _get_marc_fields {
+
+
+	# first, sort all existing fields 
+	# XXX might not be needed, but modern perl might randomize elements in hash
+	my @sorted_marc_record = sort {
+		$a->[0] . $a->[3] cmp $b->[0] . $b->[3]	
+	} @{ $marc_record };
+
+	# output marc fields
+	my @m;
+
+	# count unique field-subfields (used for offset when walking to next subfield)
+	my $u;
+	map { $u->{ $_->[0] . $_->[3]  }++ } @sorted_marc_record;
+
+	if ($debug) {
+		warn "## marc_repeatable_subfield ", dump( $marc_repeatable_subfield ), $/;
+		warn "## marc_record ", dump( $marc_record ), $/;
+		warn "## sorted_marc_record ", dump( \@sorted_marc_record ), $/;
+		warn "## subfield count ", dump( $u ), $/;
+	}
+
+	my $len = $#sorted_marc_record;
+	my $visited;
+	my $i = 0;
+	my $field;
+
+	foreach ( 0 .. $len ) {
+
+		# find next element which isn't visited
+		while ($visited->{$i}) {
+			$i = ($i + 1) % ($len + 1);
+		}
+
+		# mark it visited
+		$visited->{$i}++;
+
+		my $row = $sorted_marc_record[$i];
+
+		# field and subfield which is key for
+		# marc_repeatable_subfield and u
+		my $fsf = $row->[0] . $row->[3];
+
+		if ($debug > 1) {
+
+			print "### field so far [", $#$field, "] : ", dump( $field ), " ", $field ? 'T' : 'F', $/;
+			print "### this [$i]: ", dump( $row ),$/;
+			print "### sf: ", $row->[3], " vs ", $field->[3],
+				$marc_repeatable_subfield->{ $row->[0] . $row->[3] } ? ' (repeatable)' : '', $/,
+				if ($#$field >= 0);
+
+		}
+
+		# if field exists
+		if ( $#$field >= 0 ) {
+			if (
+				$row->[0] ne $field->[0] ||		# field
+				$row->[1] ne $field->[1] ||		# i1
+				$row->[2] ne $field->[2]		# i2
+			) {
+				push @m, $field;
+				warn "## saved/1 ", dump( $field ),$/ if ($debug);
+				$field = $row;
+
+			} elsif (
+				( $row->[3] lt $field->[-2] )		# subfield which is not next (e.g. a after c)
+				||
+				( $row->[3] eq $field->[-2] &&		# same subfield, but not repeatable
+					! $marc_repeatable_subfield->{ $fsf }
+				)
+			) {
+				push @m, $field;
+				warn "## saved/2 ", dump( $field ),$/ if ($debug);
+				$field = $row;
+
+			} else {
+				# append new subfields to existing field
+				push @$field, ( $row->[3], $row->[4] );
+			}
+		} else {
+			# insert first field
+			$field = $row;
+		}
+
+		if (! $marc_repeatable_subfield->{ $fsf }) {
+			# make step to next subfield
+			$i = ($i + $u->{ $fsf } ) % ($len + 1);
+		}
+	}
+
+	if ($#$field >= 0) {
+		push @m, $field;
+		warn "## saved/3 ", dump( $field ),$/ if ($debug);
+	}
+
+	return @m;
 }
 
 =head1 Functions to create C<data_structure>
@@ -212,28 +319,66 @@
 	$out->{$name}->{search} = \@o;
 }
 
-=head2 marc21
+=head2 marc
 
 Save value for MARC field
 
-  marc21('900','a', rec('200','a') );
+  marc('900','a', rec('200','a') );
 
 =cut
 
-sub marc21 {
-	my $f = shift or die "marc21 needs field";
-	die "marc21 field must be numer" unless ($f =~ /^\d+$/);
+sub marc {
+	my $f = shift or die "marc needs field";
+	die "marc field must be numer" unless ($f =~ /^\d+$/);
 
-	my $sf = shift or die "marc21 needs subfield";
+	my $sf = shift or die "marc needs subfield";
 
 	foreach (@_) {
 		my $v = $_;		# make var read-write for Encode
-		next unless (defined($v) && $v !~ /^\s+$/);
+		next unless (defined($v) && $v !~ /^\s*$/);
 		from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
-		push @{ $marc21 }, [ $f, ' ', ' ', $sf => $v ];
+		my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');
+		push @{ $marc_record }, [ $f, $i1, $i2, $sf => $v ];
 	}
 }
 
+=head2 marc_repeatable_subfield
+
+Save values for MARC repetable subfield
+
+  marc_repeatable_subfield('910', 'z', rec('909') );
+
+=cut
+
+sub marc_repeatable_subfield {
+	my ($f,$sf) = @_;
+	die "marc_repeatable_subfield need field and subfield!\n" unless ($f && $sf);
+	$marc_repeatable_subfield->{ $f . $sf }++;
+	marc(@_);
+}
+
+=head2 marc_indicators
+
+Set both indicators for MARC field
+
+  marc_indicators('900', ' ', 1);
+
+Any indicator value other than C<0-9> will be treated as undefined.
+
+=cut
+
+sub marc_indicators {
+	my $f = shift || die "marc_indicators need field!\n";
+	my ($i1,$i2) = @_;
+	die "marc_indicators($f, ...) need i1!\n" unless(defined($i1));
+	die "marc_indicators($f, $i1, ...) need i2!\n" unless(defined($i2));
+
+	$i1 = ' ' if ($i1 !~ /^\d$/);
+	$i2 = ' ' if ($i2 !~ /^\d$/);
+	@{ $marc_indicators->{$f} } = ($i1,$i2);
+}
+
+
 =head1 Functions to extract data from input
 
 This function should be used inside functions to create C<data_structure> described
@@ -308,7 +453,7 @@
 sub regex {
 	my $r = shift;
 	my @out;
-	#warn "r: $r\n",Dumper(\@_);
+	#warn "r: $r\n", dump(\@_);
 	foreach my $t (@_) {
 		next unless ($t);
 		eval "\$t =~ $r";