--- trunk/lib/WebPAC/Normalize.pm	2006/09/06 20:54:47	641
+++ trunk/lib/WebPAC/Normalize.pm	2006/09/26 10:05:25	711
@@ -15,6 +15,7 @@
 	rec1 rec2 rec
 	regex prefix suffix surround
 	first lookup join_with
+	save_into_lookup
 
 	split_rec_on
 /;
@@ -24,7 +25,6 @@
 
 #use base qw/WebPAC::Common/;
 use Data::Dump qw/dump/;
-use Encode qw/from_to/;
 use Storable qw/dclone/;
 
 # debugging warn(s)
@@ -37,11 +37,11 @@
 
 =head1 VERSION
 
-Version 0.17
+Version 0.20
 
 =cut
 
-our $VERSION = '0.17';
+our $VERSION = '0.20';
 
 =head1 SYNOPSIS
 
@@ -67,14 +67,14 @@
 Return data structure
 
   my $ds = WebPAC::Normalize::data_structure(
-  	lookup => $lookup->lookup_hash,
+  	lookup => $lookup_variable,
 	row => $row,
 	rules => $normalize_pl_config,
 	marc_encoding => 'utf-8',
 	config => $config,
   );
 
-Options C<lookup>, C<row>, C<rules> and C<log> are mandatory while all
+Options C<row>, C<rules> and C<log> are mandatory while all
 other are optional.
 
 This function will B<die> if normalizastion can't be evaled.
@@ -91,9 +91,9 @@
 	die "need normalisation argument" unless ($arg->{rules});
 
 	no strict 'subs';
-	_set_lookup( $arg->{lookup} );
+	_set_lookup( $arg->{lookup} ) if (defined( $arg->{lookup} ));
 	_set_rec( $arg->{row} );
-	_set_config( $arg->{config} );
+	_set_config( $arg->{config} ) if (defined( $arg->{config} ));
 	_clean_ds( %{ $arg } );
 	eval "$arg->{rules}";
 	die "error evaling $arg->{rules}: $@\n" if ($@);
@@ -187,6 +187,18 @@
 	$lookup = shift;
 }
 
+=head2 _get_lookup
+
+Get current lookup hash
+
+  my $lookup = _get_lookup();
+
+=cut
+
+sub _get_lookup {
+	return $lookup;
+}
+
 =head2 _get_marc_fields
 
 Get all fields defined by calls to C<marc>
@@ -470,7 +482,6 @@
 	foreach (@_) {
 		my $v = $_;		# make var read-write for Encode
 		next unless (defined($v) && $v !~ /^\s*$/);
-		from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
 		my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');
 		if (defined $sf) {
 			push @{ $marc_record->[ $marc_record_offset ] }, [ $f, $i1, $i2, $sf => $v ];
@@ -550,7 +561,6 @@
 		my $v = shift;
 
 		next unless (defined($v) && $v !~ /^\s*$/);
-		from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
 		warn "## ++ marc_compose($f,$sf,$v) ", dump( $m ),$/ if ($debug > 1);
 		if ($sf ne '+') {
 			push @$m, ( $sf, $v );
@@ -725,17 +735,20 @@
 
 =head2 _pack_subfields_hash
 
- @values = _pack_subfields_hash( $h, $include_subfields )
+ @subfields = _pack_subfields_hash( $h );
+ $subfields = _pack_subfields_hash( $h, 1 );
+
+Return each subfield value in array or pack them all together and return scalar
+with subfields (denoted by C<^>) and values.
 
 =cut
 
 sub _pack_subfields_hash {
 
-	warn "## _pack_subfields_hash( ",dump(@_), " )\n";
+	warn "## _pack_subfields_hash( ",dump(@_), " )\n" if ($debug > 1);
 
 	my ($h,$include_subfields) = @_;
 
-
 	if ( defined($h->{subfields}) ) {
 		my $sfs = delete $h->{subfields} || die "no subfields?";
 		my @out;
@@ -745,16 +758,34 @@
 			my $o = shift @$sfs;
 			if ($o == 0 && ref( $h->{$sf} ) ne 'ARRAY' ) {
 				# single element subfields are not arrays
+#warn "====> $sf $o / $#$sfs ", dump( $sfs, $h->{$sf} ), "\n";
+
 				push @out, $h->{$sf};
 			} else {
-#warn "====> $f $sf $o $#$sfs ", dump( $sfs ), "\n";
+#warn "====> $sf $o / $#$sfs ", dump( $sfs, $h->{$sf} ), "\n";
 				push @out, $h->{$sf}->[$o];
 			}
 		}
-		return @out;
+		if ($include_subfields) {
+			return join('', @out);
+		} else {
+			return @out;
+		}
 	} else {
-		# FIXME this should probably be in alphabetical order instead of hash order
-		values %{$h};
+		if ($include_subfields) {
+			my $out = '';
+			foreach my $sf (sort keys %$h) {
+				if (ref($h->{$sf}) eq 'ARRAY') {
+					$out .= '^' . $sf . join('^' . $sf, @{ $h->{$sf} });
+				} else {
+					$out .= '^' . $sf . $h->{$sf};
+				}
+			}
+			return $out;
+		} else {
+			# FIXME this should probably be in alphabetical order instead of hash order
+			values %{$h};
+		}
 	}
 }
 
@@ -777,7 +808,6 @@
 		my @out;
 		foreach my $h ( @{ $rec->{$f} } ) {
 			if (ref($h) eq 'HASH') {
-warn "rec1 hash: ",dump($h),"\n";
 				push @out, ( _pack_subfields_hash( $h ) );
 			} else {
 				push @out, $h;
@@ -914,6 +944,8 @@
   @v = lookup( $v );
   @v = lookup( @v );
 
+FIXME B<currently this one is broken!>
+
 =cut
 
 sub lookup {
@@ -926,6 +958,29 @@
 	}
 }
 
+=head2 save_into_lookup
+
+Save value into lookup.
+
+  save_into_lookup($key,sub {
+ 	# code which produce one or more values 
+  });
+
+This function shouldn't be called directly, it's called from code created by L<WebPAC::Parser>.
+
+=cut
+
+sub save_into_lookup {
+	my ($k,$coderef) = @_;
+	die "save_into_lookup needs key" unless defined($k);
+	die "save_into_lookup needs CODE" unless ( defined($coderef) && ref($coderef) eq 'CODE' );
+	my $mfn = $rec->{'000'}->[0] || die "mfn not defined or zero";
+	foreach my $v ( $coderef->() ) {
+		$lookup->{$k}->{$v}->{$mfn}++;
+		warn "# lookup $k $v $mfn saved\n" if ($debug > 1);
+	}
+}
+
 =head2 config
 
 Consult config values stored in C<config.yml>