--- trunk/lib/WebPAC/Normalize.pm	2006/09/29 20:18:30	729
+++ trunk/lib/WebPAC/Normalize.pm	2006/12/10 12:45:11	786
@@ -2,7 +2,7 @@
 use Exporter 'import';
 @EXPORT = qw/
 	_set_rec _set_lookup
-	_set_load_ds
+	_set_load_row
 	_get_ds _clean_ds
 	_debug
 	_pack_subfields_hash
@@ -19,6 +19,8 @@
 	save_into_lookup
 
 	split_rec_on
+
+	get set
 /;
 
 use warnings;
@@ -39,11 +41,11 @@
 
 =head1 VERSION
 
-Version 0.21
+Version 0.25
 
 =cut
 
-our $VERSION = '0.21';
+our $VERSION = '0.25';
 
 =head1 SYNOPSIS
 
@@ -74,16 +76,16 @@
 	rules => $normalize_pl_config,
 	marc_encoding => 'utf-8',
 	config => $config,
-	load_ds_coderef => sub {
+	load_row_coderef => sub {
 		my ($database,$input,$mfn) = shift;
-		$store->load_ds( database => $database, input => $input, id => $mfn );
+		$store->load_row( database => $database, input => $input, id => $mfn );
 	},
   );
 
 Options C<row>, C<rules> and C<log> are mandatory while all
 other are optional.
 
-C<load_ds_coderef> is closure only used when executing lookups, so they will
+C<load_row_coderef> is closure only used when executing lookups, so they will
 die if it's not defined.
 
 This function will B<die> if normalizastion can't be evaled.
@@ -93,7 +95,7 @@
 
 =cut
 
-my $load_ds_coderef;
+my $load_row_coderef;
 
 sub data_structure {
 	my $arg = {@_};
@@ -102,11 +104,11 @@
 	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 } );
-	$load_ds_coderef = $arg->{load_ds_coderef};
+	$load_row_coderef = $arg->{load_row_coderef};
 
 	eval "$arg->{rules}";
 	die "error evaling $arg->{rules}: $@\n" if ($@);
@@ -164,7 +166,7 @@
 
 =cut
 
-my ($out, $marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators);
+my ($out, $marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $leader);
 my ($marc_record_offset, $marc_fetch_offset) = (0, 0);
 
 sub _get_ds {
@@ -181,7 +183,7 @@
 
 sub _clean_ds {
 	my $a = {@_};
-	($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators) = ();
+	($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $leader) = ();
 	($marc_record_offset, $marc_fetch_offset) = (0,0);
 	$marc_encoding = $a->{marc_encoding};
 }
@@ -212,23 +214,23 @@
 	return $lookup;
 }
 
-=head2 _set_load_ds
+=head2 _set_load_row
 
 Setup code reference which will return L<data_structure> from
 L<WebPAC::Store>
 
-  _set_load_ds(sub {
+  _set_load_row(sub {
 		my ($database,$input,$mfn) = @_;
-		$store->load_ds( database => $database, input => $input, id => $mfn );
+		$store->load_row( database => $database, input => $input, id => $mfn );
   });
 
 =cut
 
-sub _set_load_ds {
+sub _set_load_row {
 	my $coderef = shift;
 	confess "argument isn't CODE" unless ref($coderef) eq 'CODE';
 
-	$load_ds_coderef = $coderef;
+	$load_row_coderef = $coderef;
 }
 
 =head2 _get_marc_fields
@@ -487,9 +489,9 @@
 	my ($offset,$value) = @_;
 
 	if ($offset) {
-		$out->{' leader'}->{ $offset } = $value;
+		$leader->{ $offset } = $value;
 	} else {
-		return $out->{' leader'};
+		return $leader;
 	}
 }
 
@@ -635,6 +637,10 @@
 
 This will erase field C<200> or C<200^a> from current MARC record.
 
+  marc_remove('*');
+
+Will remove all fields in current MARC record.
+
 This is useful after calling C<marc_duplicate> or on it's own (but, you
 should probably just remove that subfield definition if you are not
 using C<marc_duplicate>).
@@ -652,39 +658,47 @@
 
 	warn "### marc_remove before = ", dump( $marc ), $/ if ($debug > 2);
 
-	my $i = 0;
-	foreach ( 0 .. $#{ $marc } ) {
-		last unless (defined $marc->[$i]);
-		warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3);
-		if ($marc->[$i]->[0] eq $f) {
-			if (! defined $sf) {
-				# remove whole field
-				splice @$marc, $i, 1;
-				warn "#### slice \@\$marc, $i, 1 = ",dump( @{ $marc }), $/ if ($debug > 3);
-				$i--;
-			} else {
-				foreach my $j ( 0 .. (( $#{ $marc->[$i] } - 3 ) / 2) ) {
-					my $o = ($j * 2) + 3;
-					if ($marc->[$i]->[$o] eq $sf) {
-						# remove subfield
-						splice @{$marc->[$i]}, $o, 2;
-						warn "#### slice \@{\$marc->[$i]}, $o, 2 = ", dump( @{ $marc }), $/ if ($debug > 3);
-						# is record now empty?
-						if ($#{ $marc->[$i] } == 2) {
-							splice @$marc, $i, 1;
-							warn "#### slice \@\$marc, $i, 1 = ", dump( @{ $marc }), $/ if ($debug > 3);
-							$i--;
-						};
+	if ($f eq '*') {
+
+		delete( $marc_record->[ $marc_record_offset ] );
+
+	} else {
+
+		my $i = 0;
+		foreach ( 0 .. $#{ $marc } ) {
+			last unless (defined $marc->[$i]);
+			warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3);
+			if ($marc->[$i]->[0] eq $f) {
+				if (! defined $sf) {
+					# remove whole field
+					splice @$marc, $i, 1;
+					warn "#### slice \@\$marc, $i, 1 = ",dump( @{ $marc }), $/ if ($debug > 3);
+					$i--;
+				} else {
+					foreach my $j ( 0 .. (( $#{ $marc->[$i] } - 3 ) / 2) ) {
+						my $o = ($j * 2) + 3;
+						if ($marc->[$i]->[$o] eq $sf) {
+							# remove subfield
+							splice @{$marc->[$i]}, $o, 2;
+							warn "#### slice \@{\$marc->[$i]}, $o, 2 = ", dump( @{ $marc }), $/ if ($debug > 3);
+							# is record now empty?
+							if ($#{ $marc->[$i] } == 2) {
+								splice @$marc, $i, 1;
+								warn "#### slice \@\$marc, $i, 1 = ", dump( @{ $marc }), $/ if ($debug > 3);
+								$i--;
+							};
+						}
 					}
 				}
 			}
+			$i++;
 		}
-		$i++;
-	}
 
-	warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2);
+		warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2);
+
+		$marc_record->[ $marc_record_offset ] = $marc;
+	}
 
-	$marc_record->[ $marc_record_offset ] = $marc;
 
 	warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1);
 }
@@ -880,6 +894,9 @@
   @v = rec('200')
   @v = rec('200','a')
 
+If rec() returns just single value, it will
+return scalar, not array.
+
 =cut
 
 sub rec {
@@ -889,7 +906,9 @@
 	} elsif ($#_ == 1) {
 		@out = rec2(@_);
 	}
-	if (@out) {
+	if ($#out == 0 && ! wantarray) {
+		return $out[0];
+	} elsif (@out) {
 		return @out;
 	} else {
 		return '';
@@ -1017,12 +1036,12 @@
 sub lookup {
 	my ($what, $database, $input, $key, $having) = @_;
 
-	confess "lookup needs 5 arguments: what, database, input, key, having" unless ($#_ == 4);
+	confess "lookup needs 5 arguments: what, database, input, key, having\n" unless ($#_ == 4);
 
 	warn "## lookup ($database, $input, $key)", $/ if ($debug > 1);
 	return unless (defined($lookup->{$database}->{$input}->{$key}));
 
-	confess "lookup really need load_ds_coderef added to data_structure\n" unless ($load_ds_coderef);
+	confess "lookup really need load_row_coderef added to data_structure\n" unless ($load_row_coderef);
 
 	my $mfns;
 	my @having = $having->();
@@ -1031,7 +1050,7 @@
 
 	foreach my $h ( @having ) {
 		if (defined($lookup->{$database}->{$input}->{$key}->{$h})) {
-			warn "lookup for $database/$input/$key/$h return ",dump($lookup->{$database}->{$input}->{$key}->{$h}),"\n";
+			warn "lookup for $database/$input/$key/$h return ",dump($lookup->{$database}->{$input}->{$key}->{$h}),"\n" if ($debug);
 			$mfns->{$_}++ foreach keys %{ $lookup->{$database}->{$input}->{$key}->{$h} };
 		}
 	}
@@ -1040,21 +1059,21 @@
 
 	my @mfns = sort keys %$mfns;
 
-	warn "# lookup loading $database/$input/$key mfn ", join(",",@mfns)," having ",dump(@having),"\n";
+	warn "# lookup loading $database/$input/$key mfn ", join(",",@mfns)," having ",dump(@having),"\n" if ($debug);
 
 	my $old_rec = $rec;
 	my @out;
 
 	foreach my $mfn (@mfns) {
-		$rec = $load_ds_coderef->( $database, $input, $mfn );
+		$rec = $load_row_coderef->( $database, $input, $mfn );
 
-		warn "got $database/$input/$mfn = ", dump($rec), $/;
+		warn "got $database/$input/$mfn = ", dump($rec), $/ if ($debug);
 
 		my @vals = $what->();
 
 		push @out, ( @vals );
 
-		warn "lookup for mfn $mfn returned ", dump(@vals), $/;
+		warn "lookup for mfn $mfn returned ", dump(@vals), $/ if ($debug);
 	}
 
 #	if (ref($lookup->{$k}) eq 'ARRAY') {
@@ -1065,9 +1084,13 @@
 
 	$rec = $old_rec;
 
-	warn "## lookup returns = ", dump(@out), $/;
+	warn "## lookup returns = ", dump(@out), $/ if ($debug);
 
-	return @out;
+	if ($#out == 0) {
+		return $out[0];
+	} else {
+		return @out;
+	}
 }
 
 =head2 save_into_lookup
@@ -1239,5 +1262,33 @@
 	}
 }
 
+my $hash;
+
+=head2 set
+
+  set( key => 'value' );
+
+=cut
+
+sub set {
+	my ($k,$v) = @_;
+	warn "## set ( $k => ", dump($v), " )", $/;
+	$hash->{$k} = $v;
+};
+
+=head2 get
+
+  get( 'key' );
+
+=cut
+
+sub get {
+	my $k = shift || return;
+	my $v = $hash->{$k};
+	warn "## get $k = ", dump( $v ), $/;
+	return $v;
+}
+
+
 # END
 1;