--- trunk/lib/WebPAC/Normalize.pm	2006/06/29 23:29:02	548
+++ trunk/lib/WebPAC/Normalize.pm	2006/06/30 18:48:33	550
@@ -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
@@ -125,7 +129,7 @@
 
 sub _clean_ds {
 	my $a = {@_};
-	($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators) = (undef);
+	($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators) = ();
 	$marc_encoding = $a->{marc_encoding};
 }
 
@@ -163,28 +167,100 @@
 =cut
 
 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;
-	my $last;
-	foreach my $row (@{ $marc_record }) {
-		if ($last &&
-			$last->[0] eq $row->[0] &&		# check if field is same
-			$last->[1] eq $row->[1] &&		# check for i1
-			$last->[2] eq $row->[2]	&&		# and for i2
-				( $last->[3] ne $row->[3] ||				# and subfield is different
-				$last->[3] eq $row->[3] &&					# or subfield is same,
-				$marc_repeatable_subfield->{ $row->[3] }	# but is repeatable
-			)
-		) {
-			push @$last, ( $row->[3] , $row->[4] );
-			next;
-		} elsif ($last) {
-			push @m, $last;
+
+	# 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;
 		}
 
-		$last = $row;
+		if (! $marc_repeatable_subfield->{ $fsf }) {
+			# make step to next subfield
+			$i = ($i + $u->{ $fsf } ) % ($len + 1);
+		}
 	}
 
-	push @m, $last if ($last);
+	if ($#$field >= 0) {
+		push @m, $field;
+		warn "## saved/3 ", dump( $field ),$/ if ($debug);
+	}
 
 	return @m;
 }
@@ -275,8 +351,9 @@
 =cut
 
 sub marc_repeatable_subfield {
-	die "marc_repeatable_subfield need subfield!\n" unless (defined($_[1]));
-	$marc_repeatable_subfield->{ $_[1] }++;
+	my ($f,$sf) = @_;
+	die "marc_repeatable_subfield need field and subfield!\n" unless ($f && $sf);
+	$marc_repeatable_subfield->{ $f . $sf }++;
 	marc(@_);
 }
 
@@ -376,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";