--- trunk/lib/WebPAC/Normalize.pm 2006/07/30 14:19:54 604 +++ trunk/lib/WebPAC/Normalize.pm 2006/08/25 12:31:01 618 @@ -36,11 +36,11 @@ =head1 VERSION -Version 0.15 +Version 0.16 =cut -our $VERSION = '0.15'; +our $VERSION = '0.16'; =head1 SYNOPSIS @@ -646,38 +646,50 @@ 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($to,$from): field $from doesn't have subfields specification\n"; + next; + } + my @sfs = @{ $d->{subfields} }; - die "field $from doesn't have subfields specification\n" unless(@sfs); 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); @@ -698,8 +710,6 @@ } warn "## marc_record = ", dump( $marc_record ),$/ if ($debug > 1); - - warn "# marc_original_order is partly implemented"; }