/[webpac2]/trunk/lib/WebPAC/Normalize/MARC.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/MARC.pm

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

revision 1036 by dpavlin, Mon Nov 12 11:10:48 2007 UTC revision 1040 by dpavlin, Mon Nov 12 12:18:55 2007 UTC
# Line 17  use Carp qw/confess/; Line 17  use Carp qw/confess/;
17    
18  use WebPAC::Normalize;  use WebPAC::Normalize;
19    
20  our $debug = 42;  our $debug = 0;
21    
22  my ($marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $marc_leader);  my ($marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $marc_leader);
23  my ($marc_record_offset, $marc_fetch_offset) = (0, 0);  my ($marc_record_offset, $marc_fetch_offset) = (0, 0);
# Line 58  Returns number of records produced. Line 58  Returns number of records produced.
58    
59  =cut  =cut
60    
61    my $created_with_marc_template;
62    
63  sub marc_template {  sub marc_template {
64          my $args = {@_};          my $args = {@_};
65          warn "## marc_template(",dump($args),")",$/ if $debug;          warn "## marc_template(",dump($args),")",$/ if $debug;
# Line 134  sub marc_template { Line 136  sub marc_template {
136    
137                  my $i1 = $r->{i1} || ' ';                  my $i1 = $r->{i1} || ' ';
138                  my $i2 = $r->{i2} || ' ';                  my $i2 = $r->{i2} || ' ';
139                  $m = [ $args->{to}, $i1, $i2 ];                  my $to = $args->{to};
140                    $m = [ $to, $i1, $i2 ];
141    
142                    $created_with_marc_template->{ $to }++;
143    
144                  warn "### r = ",dump( $r ),$/ if $debug;                  warn "### r = ",dump( $r ),$/ if $debug;
145    
# Line 610  sub marc_count { Line 615  sub marc_count {
615          return $#{ $marc_record };          return $#{ $marc_record };
616  }  }
617    
618    =head1 PRIVATE FUNCTIONS
619    
620  =head2 _marc_push  =head2 _marc_push
621    
622   _marc_push( $marc );   _marc_push( $marc );
# Line 621  sub _marc_push { Line 628  sub _marc_push {
628          push @{ $marc_record->[ $marc_record_offset ] }, $marc;          push @{ $marc_record->[ $marc_record_offset ] }, $marc;
629  }  }
630    
 =head1 PRIVATE FUNCTIONS  
   
631  =head2 _clean  =head2 _clean
632    
633  Clean internal structures  Clean internal structures
# Line 630  Clean internal structures Line 635  Clean internal structures
635  =cut  =cut
636    
637  sub _clean {  sub _clean {
638          ($marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $marc_leader) = ();          ($marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $marc_leader, $created_with_marc_template) = ();
639          ($marc_record_offset, $marc_fetch_offset) = (0,0);          ($marc_record_offset, $marc_fetch_offset) = (0,0);
640  }  }
641    
# Line 644  Get all fields defined by calls to C<mar Line 649  Get all fields defined by calls to C<mar
649  We are using I<magic> which detect repeatable fields only from  We are using I<magic> which detect repeatable fields only from
650  sequence of field/subfield data generated by normalization.  sequence of field/subfield data generated by normalization.
651    
652    This magic is disabled for all records created with C<marc_template>.
653    
654  Repeatable field is created when there is second occurence of same subfield or  Repeatable field is created when there is second occurence of same subfield or
655  if any of indicators are different.  if any of indicators are different.
656    
# Line 715  sub _get_marc_fields { Line 722  sub _get_marc_fields {
722    
723          # first, sort all existing fields          # first, sort all existing fields
724          # XXX might not be needed, but modern perl might randomize elements in hash          # XXX might not be needed, but modern perl might randomize elements in hash
725          my @sorted_marc_record = sort {  #       my @sorted_marc_record = sort {
726                  $a->[0] . ( $a->[3] || '' ) cmp $b->[0] . ( $b->[3] || '')  #               $a->[0] . ( $a->[3] || '' ) cmp $b->[0] . ( $b->[3] || '')
727          } @{ $marc_rec };  #       } @{ $marc_rec };
728    
729          @sorted_marc_record = @{ $marc_rec };   ### FIXME disable sorting          my @sorted_marc_record = @{ $marc_rec };        ### FIXME disable sorting
730                    
731          # output marc fields          # output marc fields
732          my @m;          my @m;
# Line 740  sub _get_marc_fields { Line 747  sub _get_marc_fields {
747          my $i = 0;          my $i = 0;
748          my $field;          my $field;
749    
750            warn "## created_with_marc_template = ",dump( $created_with_marc_template ) if $debug;
751    
752          foreach ( 0 .. $len ) {          foreach ( 0 .. $len ) {
753    
754                  # find next element which isn't visited                  # find next element which isn't visited
# Line 752  sub _get_marc_fields { Line 761  sub _get_marc_fields {
761    
762                  my $row = dclone( $sorted_marc_record[$i] );                  my $row = dclone( $sorted_marc_record[$i] );
763    
764                    if ( $created_with_marc_template->{ $row->[0] } ) {
765                            push @m, $row;
766                            warn "## copied marc_template created ", dump( $row ),$/ if $debug;
767                            next;
768                    }
769    
770                  # field and subfield which is key for                  # field and subfield which is key for
771                  # marc_repeatable_subfield and u                  # marc_repeatable_subfield and u
772                  my $fsf = $row->[0] . ( $row->[3] || '' );                  my $fsf = $row->[0] . ( $row->[3] || '' );
Legend:
Removed from v.1036  
changed lines
  Added in v.1040
  ViewVC Help
Powered by ViewVC 1.1.26