/[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 1040 by dpavlin, Mon Nov 12 12:18:55 2007 UTC revision 1108 by dpavlin, Sun Aug 31 09:14:18 2008 UTC
# Line 6  our @EXPORT = qw/ Line 6  our @EXPORT = qw/
6          marc_duplicate marc_remove marc_count          marc_duplicate marc_remove marc_count
7          marc_original_order          marc_original_order
8          marc_template          marc_template
9            marc_clone
10  /;  /;
11    
12  use strict;  use strict;
# Line 132  sub marc_template { Line 133  sub marc_template {
133    
134          my $m;          my $m;
135    
136          foreach my $r ( @{ $rec->{ $args->{from} } } ) {          our $from_rec = $rec->{ $args->{from} };
137    
138            foreach my $r ( @$from_rec ) {
139    
                 my $i1 = $r->{i1} || ' ';  
                 my $i2 = $r->{i2} || ' ';  
140                  my $to = $args->{to};                  my $to = $args->{to};
141                    my ($i1,$i2) = _get_marc_indicators( $to );
142                  $m = [ $to, $i1, $i2 ];                  $m = [ $to, $i1, $i2 ];
143    
144                  $created_with_marc_template->{ $to }++;                  $created_with_marc_template->{ $to }++;
145    
146                  warn "### r = ",dump( $r ),$/ if $debug;                  warn "### r = ",dump( $r ),$/ if $debug;
147    
148                  my ( $from_mapping, $to_mapping, $from_count, $to_count );                  my ( $from_mapping, $from_count, $to_count );
149                    our $to_mapping;
150                  foreach my $from_sf ( keys %{$r} ) {                  foreach my $from_sf ( keys %{$r} ) {
151                          # skip everything which isn't one char subfield (e.g. 'subfields')                          # skip everything which isn't one char subfield (e.g. 'subfields')
152                          next unless $from_sf =~ m/^\w$/;                          next unless $from_sf =~ m/^\w$/;
# Line 194  sub marc_template { Line 197  sub marc_template {
197                                          warn "#### fill_in( $name, r, '$pre', $sf, $nr, '$post' )\n" if $debug;                                          warn "#### fill_in( $name, r, '$pre', $sf, $nr, '$post' )\n" if $debug;
198                                          my ( $from_sf, $from_nr );                                          my ( $from_sf, $from_nr );
199                                          if ( $name eq 'marc' ) {                                          if ( $name eq 'marc' ) {
200                                                  die "no $sf/$nr in to_mapping: ",dump( $to_mapping ), " form record ",dump( $r ) unless defined $to_mapping->{$sf}->[$nr];                                                  die "no $sf/$nr in to_mapping: ",dump( $to_mapping ), "\n>>>> from record ",dump( $r ), "\n>>>> full record = ",dump( $from_rec ) unless defined $to_mapping->{$sf}->[$nr];
201                                                  ( $from_sf, $from_nr ) = @{ $to_mapping->{$sf}->[$nr] };                                                  ( $from_sf, $from_nr ) = @{ $to_mapping->{$sf}->[$nr] };
202                                          } else {                                          } else {
203                                                  ( $from_sf, $from_nr ) = ( $sf, $nr );                                                  ( $from_sf, $from_nr ) = ( $sf, $nr );
# Line 221  sub marc_template { Line 224  sub marc_template {
224    
225                          foreach my $sf ( @{ $_template->{$name}->{order}->{$template} } ) {                          foreach my $sf ( @{ $_template->{$name}->{order}->{$template} } ) {
226                                  my ( $sf, $nr ) = @$sf;                                  my ( $sf, $nr ) = @$sf;
227                                  my $v = $fill_in->{$sf}->[$nr] || die "can't find fill_in $sf/$nr";                                  my $v = $fill_in->{$sf}->[$nr];
228                                    die "can't find fill_in $sf/$nr" unless defined $v;
229                                  if ( $name eq 'isis') {                                  if ( $name eq 'isis') {
230                                          ( $sf, $nr ) = @{ $from_mapping->{$sf}->[$nr] };                                          ( $sf, $nr ) = @{ $from_mapping->{$sf}->[$nr] };
231                                  }                                  }
# Line 343  sub marc { Line 347  sub marc {
347          foreach (@_) {          foreach (@_) {
348                  my $v = $_;             # make var read-write for Encode                  my $v = $_;             # make var read-write for Encode
349                  next unless (defined($v) && $v !~ /^\s*$/);                  next unless (defined($v) && $v !~ /^\s*$/);
350                  my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');                  my ($i1,$i2) = _get_marc_indicators( $f );
351                  if (defined $sf) {                  if (defined $sf) {
352                          push @{ $marc_record->[ $marc_record_offset ] }, [ $f, $i1, $i2, $sf => $v ];                          push @{ $marc_record->[ $marc_record_offset ] }, [ $f, $i1, $i2, $sf => $v ];
353                  } else {                  } else {
# Line 388  sub marc_indicators { Line 392  sub marc_indicators {
392          @{ $marc_indicators->{$f} } = ($i1,$i2);          @{ $marc_indicators->{$f} } = ($i1,$i2);
393  }  }
394    
395    sub _get_marc_indicators {
396            my $f = shift || confess "need field!\n";
397            return defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');
398    }
399    
400  =head2 marc_compose  =head2 marc_compose
401    
402  Save values for each MARC subfield explicitly  Save values for each MARC subfield explicitly
# Line 408  sub marc_compose { Line 417  sub marc_compose {
417          my $f = shift or die "marc_compose needs field";          my $f = shift or die "marc_compose needs field";
418          die "marc_compose field must be numer" unless ($f =~ /^\d+$/);          die "marc_compose field must be numer" unless ($f =~ /^\d+$/);
419    
420          my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');          my ($i1,$i2) = _get_marc_indicators( $f );
421          my $m = [ $f, $i1, $i2 ];          my $m = [ $f, $i1, $i2 ];
422    
423          warn "### marc_compose input subfields = ", dump(@_),$/ if ($debug > 2);          warn "### marc_compose input subfields = ", dump(@_),$/ if ($debug > 2);
# Line 559  sub marc_original_order { Line 568  sub marc_original_order {
568          my $r = $rec->{$from};          my $r = $rec->{$from};
569          die "record field $from isn't array ",dump( $rec ) unless (ref($r) eq 'ARRAY');          die "record field $from isn't array ",dump( $rec ) unless (ref($r) eq 'ARRAY');
570    
571          my ($i1,$i2) = defined($marc_indicators->{$to}) ? @{ $marc_indicators->{$to} } : (' ',' ');          my ($i1,$i2) = _get_marc_indicators( $to );
572          warn "## marc_original_order($to,$from) source = ", dump( $r ),$/ if ($debug > 1);          warn "## marc_original_order($to,$from) source = ", dump( $r ),$/ if ($debug > 1);
573    
574          foreach my $d (@$r) {          foreach my $d (@$r) {
# Line 615  sub marc_count { Line 624  sub marc_count {
624          return $#{ $marc_record };          return $#{ $marc_record };
625  }  }
626    
627    =head2 marc_clone
628    
629    Clone marc records from input file, whole or just some fields/indicators
630    
631      marc_clone;   # whole record
632    
633    =cut
634    
635    sub marc_clone {
636            foreach my $f ( keys %$rec ) {
637                    warn "## clone $f";
638                    marc_original_order( $f, $f );
639            }
640    }
641    
642  =head1 PRIVATE FUNCTIONS  =head1 PRIVATE FUNCTIONS
643    
644  =head2 _marc_push  =head2 _marc_push
Legend:
Removed from v.1040  
changed lines
  Added in v.1108
  ViewVC Help
Powered by ViewVC 1.1.26