/[webpac2]/trunk/lib/WebPAC/Normalize.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Normalize.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 603 by dpavlin, Sun Jul 23 20:19:56 2006 UTC revision 605 by dpavlin, Sun Jul 30 14:23:23 2006 UTC
# Line 9  use Exporter 'import'; Line 9  use Exporter 'import';
9          marc marc_indicators marc_repeatable_subfield          marc marc_indicators marc_repeatable_subfield
10          marc_compose marc_leader          marc_compose marc_leader
11          marc_duplicate marc_remove          marc_duplicate marc_remove
12            marc_original_order
13    
14          rec1 rec2 rec          rec1 rec2 rec
15          regex prefix suffix surround          regex prefix suffix surround
# Line 641  sub marc_remove { Line 642  sub marc_remove {
642          warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1);          warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1);
643  }  }
644    
645    =head2 marc_original_order
646    
647    Copy all subfields preserving original order to marc field.
648    
649      marc_original_order(210, 260);
650    
651    You might want to use this command if you are just renaming subfields or
652    using pre-processing modify_record in C<config.yml> and don't need any
653    post-processing or want to preserve order of original subfields.
654    
655    =cut
656    
657    sub marc_original_order {
658    
659            my ($from, $to) = @_;
660            die "marc_original_order needs from and to fields\n" unless ($from && $to);
661    
662            my $r = $rec->{$from} || return;
663            die "record field $from isn't array\n" unless (ref($r) eq 'ARRAY');
664    
665            my ($i1,$i2) = defined($marc_indicators->{$to}) ? @{ $marc_indicators->{$to} } : (' ',' ');
666            warn "## marc_original_order($from,$to) source = ", dump( $r ),$/ if ($debug > 1);
667    
668            foreach my $d (@$r) {
669    
670                    if (! defined($d->{subfields}) && ref($d->{subfields}) ne 'ARRAY') {
671                            warn "# marc_original_order($from,$to): field $from doesn't have subfields specification\n";
672                            next;
673                    }
674            
675                    my @sfs = @{ $d->{subfields} };
676    
677                    die "field $from doesn't have even number of subfields specifications\n" unless($#sfs % 2 == 1);
678    
679    warn "#--> d: ",dump($d), "\n#--> sfs: ",dump(@sfs),$/;
680    
681                    my $m = [ $to, $i1, $i2 ];
682    
683                    while (my $sf = shift @sfs) {
684    warn "#--> sf: ",dump($sf), $/;
685                            my $offset = shift @sfs;
686                            die "corrupted sufields specification for field $from\n" unless defined($offset);
687    
688                            my $v;
689                            if (ref($d->{$sf}) eq 'ARRAY') {
690                                    $v = $d->{$sf}->[$offset] if (defined($d->{$sf}->[$offset]));
691                            } elsif ($offset == 0) {
692                                    $v = $d->{$sf};
693                            } else {
694                                    die "field $from subfield '$sf' need occurence $offset which doesn't exist", dump($d->{$sf});
695                            }
696                            push @$m, ( $sf, $v ) if (defined($v));
697                    }
698    
699                    if ($#{$m} > 2) {
700                            push @{ $marc_record->[ $marc_record_offset ] }, $m;
701                    }
702            }
703    
704            warn "## marc_record = ", dump( $marc_record ),$/ if ($debug > 1);
705    
706            warn "# marc_original_order is partly implemented";
707    }
708    
709    
710  =head1 Functions to extract data from input  =head1 Functions to extract data from input
711    
712  This function should be used inside functions to create C<data_structure> described  This function should be used inside functions to create C<data_structure> described
# Line 924  sub split_rec_on { Line 990  sub split_rec_on {
990          my $v = shift @r;          my $v = shift @r;
991          warn "### first rec($fld,$sf) = ",dump($v),$/ if ($debug > 2);          warn "### first rec($fld,$sf) = ",dump($v),$/ if ($debug > 2);
992    
993          return '' if( ! defined($v) || $v =~ /^\s*$/);          return '' if ( ! defined($v) || $v =~ /^\s*$/);
994    
995          my @s = split( $regex, $v );          my @s = split( $regex, $v );
996          warn "## split_rec_on($fld,$sf,$regex,$part) = ",dump(@s),$/ if ($debug > 1);          warn "## split_rec_on($fld,$sf,$regex,$part) = ",dump(@s),$/ if ($debug > 1);

Legend:
Removed from v.603  
changed lines
  Added in v.605

  ViewVC Help
Powered by ViewVC 1.1.26