--- trunk/lib/WebPAC/Normalize.pm 2006/07/30 14:23:23 605 +++ trunk/lib/WebPAC/Normalize.pm 2006/08/25 12:31:06 619 @@ -36,11 +36,11 @@ =head1 VERSION -Version 0.15 +Version 0.16 =cut -our $VERSION = '0.15'; +our $VERSION = '0.16'; =head1 SYNOPSIS @@ -540,8 +540,12 @@ warn "### marc_compose input subfields = ", dump(@_),$/ if ($debug > 2); + if ($#_ % 2 != 1) { + die "ERROR: marc_compose",dump($f,@_)," not valid (must be even).\nDo you need to add first() or join() around some argument?\n"; + } + while (@_) { - my $sf = shift or die "marc_compose $f needs subfield"; + my $sf = shift; my $v = shift; next unless (defined($v) && $v !~ /^\s*$/); @@ -646,29 +650,36 @@ Copy all subfields preserving original order to marc field. - marc_original_order(210, 260); + marc_original_order( marc_field_number, original_input_field_number ); + +Please note that field numbers are consistent with other commands (marc +field number first), but somewhat counter-intuitive (destination and then +source). You might want to use this command if you are just renaming subfields or using pre-processing modify_record in C and don't need any post-processing or want to preserve order of original subfields. + =cut sub marc_original_order { - my ($from, $to) = @_; + my ($to, $from) = @_; die "marc_original_order needs from and to fields\n" unless ($from && $to); - my $r = $rec->{$from} || return; + return unless defined($rec->{$from}); + + my $r = $rec->{$from}; die "record field $from isn't array\n" unless (ref($r) eq 'ARRAY'); my ($i1,$i2) = defined($marc_indicators->{$to}) ? @{ $marc_indicators->{$to} } : (' ',' '); - warn "## marc_original_order($from,$to) source = ", dump( $r ),$/ if ($debug > 1); + warn "## marc_original_order($to,$from) source = ", dump( $r ),$/ if ($debug > 1); foreach my $d (@$r) { if (! defined($d->{subfields}) && ref($d->{subfields}) ne 'ARRAY') { - warn "# marc_original_order($from,$to): field $from doesn't have subfields specification\n"; + warn "# marc_original_order($to,$from): field $from doesn't have subfields specification\n"; next; } @@ -676,12 +687,13 @@ die "field $from doesn't have even number of subfields specifications\n" unless($#sfs % 2 == 1); -warn "#--> d: ",dump($d), "\n#--> sfs: ",dump(@sfs),$/; + warn "#--> d: ",dump($d), "\n#--> sfs: ",dump(@sfs),$/ if ($debug > 2); my $m = [ $to, $i1, $i2 ]; while (my $sf = shift @sfs) { -warn "#--> sf: ",dump($sf), $/; + + warn "#--> sf: ",dump($sf), $/ if ($debug > 2); my $offset = shift @sfs; die "corrupted sufields specification for field $from\n" unless defined($offset); @@ -702,8 +714,6 @@ } warn "## marc_record = ", dump( $marc_record ),$/ if ($debug > 1); - - warn "# marc_original_order is partly implemented"; }