/[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 752 by dpavlin, Sun Oct 8 18:21:26 2006 UTC revision 788 by dpavlin, Sun Dec 10 12:56:59 2006 UTC
# Line 19  use Exporter 'import'; Line 19  use Exporter 'import';
19          save_into_lookup          save_into_lookup
20    
21          split_rec_on          split_rec_on
22    
23            get set
24  /;  /;
25    
26  use warnings;  use warnings;
# Line 39  WebPAC::Normalize - describe normalisato Line 41  WebPAC::Normalize - describe normalisato
41    
42  =head1 VERSION  =head1 VERSION
43    
44  Version 0.23  Version 0.25
45    
46  =cut  =cut
47    
48  our $VERSION = '0.23';  our $VERSION = '0.25';
49    
50  =head1 SYNOPSIS  =head1 SYNOPSIS
51    
# Line 635  Remove some field or subfield from MARC Line 637  Remove some field or subfield from MARC
637    
638  This will erase field C<200> or C<200^a> from current MARC record.  This will erase field C<200> or C<200^a> from current MARC record.
639    
640      marc_remove('*');
641    
642    Will remove all fields in current MARC record.
643    
644  This is useful after calling C<marc_duplicate> or on it's own (but, you  This is useful after calling C<marc_duplicate> or on it's own (but, you
645  should probably just remove that subfield definition if you are not  should probably just remove that subfield definition if you are not
646  using C<marc_duplicate>).  using C<marc_duplicate>).
# Line 652  sub marc_remove { Line 658  sub marc_remove {
658    
659          warn "### marc_remove before = ", dump( $marc ), $/ if ($debug > 2);          warn "### marc_remove before = ", dump( $marc ), $/ if ($debug > 2);
660    
661          my $i = 0;          if ($f eq '*') {
662          foreach ( 0 .. $#{ $marc } ) {  
663                  last unless (defined $marc->[$i]);                  delete( $marc_record->[ $marc_record_offset ] );
664                  warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3);                  warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1);
665                  if ($marc->[$i]->[0] eq $f) {  
666                          if (! defined $sf) {          } else {
667                                  # remove whole field  
668                                  splice @$marc, $i, 1;                  my $i = 0;
669                                  warn "#### slice \@\$marc, $i, 1 = ",dump( @{ $marc }), $/ if ($debug > 3);                  foreach ( 0 .. $#{ $marc } ) {
670                                  $i--;                          last unless (defined $marc->[$i]);
671                          } else {                          warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3);
672                                  foreach my $j ( 0 .. (( $#{ $marc->[$i] } - 3 ) / 2) ) {                          if ($marc->[$i]->[0] eq $f) {
673                                          my $o = ($j * 2) + 3;                                  if (! defined $sf) {
674                                          if ($marc->[$i]->[$o] eq $sf) {                                          # remove whole field
675                                                  # remove subfield                                          splice @$marc, $i, 1;
676                                                  splice @{$marc->[$i]}, $o, 2;                                          warn "#### slice \@\$marc, $i, 1 = ",dump( @{ $marc }), $/ if ($debug > 3);
677                                                  warn "#### slice \@{\$marc->[$i]}, $o, 2 = ", dump( @{ $marc }), $/ if ($debug > 3);                                          $i--;
678                                                  # is record now empty?                                  } else {
679                                                  if ($#{ $marc->[$i] } == 2) {                                          foreach my $j ( 0 .. (( $#{ $marc->[$i] } - 3 ) / 2) ) {
680                                                          splice @$marc, $i, 1;                                                  my $o = ($j * 2) + 3;
681                                                          warn "#### slice \@\$marc, $i, 1 = ", dump( @{ $marc }), $/ if ($debug > 3);                                                  if ($marc->[$i]->[$o] eq $sf) {
682                                                          $i--;                                                          # remove subfield
683                                                  };                                                          splice @{$marc->[$i]}, $o, 2;
684                                                            warn "#### slice \@{\$marc->[$i]}, $o, 2 = ", dump( @{ $marc }), $/ if ($debug > 3);
685                                                            # is record now empty?
686                                                            if ($#{ $marc->[$i] } == 2) {
687                                                                    splice @$marc, $i, 1;
688                                                                    warn "#### slice \@\$marc, $i, 1 = ", dump( @{ $marc }), $/ if ($debug > 3);
689                                                                    $i--;
690                                                            };
691                                                    }
692                                          }                                          }
693                                  }                                  }
694                          }                          }
695                            $i++;
696                  }                  }
                 $i++;  
         }  
697    
698          warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2);                  warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2);
699    
700          $marc_record->[ $marc_record_offset ] = $marc;                  $marc_record->[ $marc_record_offset ] = $marc;
701            }
702    
703          warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1);          warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1);
704  }  }
# Line 1022  Easy as pie, right? Line 1036  Easy as pie, right?
1036  sub lookup {  sub lookup {
1037          my ($what, $database, $input, $key, $having) = @_;          my ($what, $database, $input, $key, $having) = @_;
1038    
1039          confess "lookup needs 5 arguments: what, database, input, key, having" unless ($#_ == 4);          confess "lookup needs 5 arguments: what, database, input, key, having\n" unless ($#_ == 4);
1040    
1041          warn "## lookup ($database, $input, $key)", $/ if ($debug > 1);          warn "## lookup ($database, $input, $key)", $/ if ($debug > 1);
1042          return unless (defined($lookup->{$database}->{$input}->{$key}));          return unless (defined($lookup->{$database}->{$input}->{$key}));
# Line 1248  sub split_rec_on { Line 1262  sub split_rec_on {
1262          }          }
1263  }  }
1264    
1265    my $hash;
1266    
1267    =head2 set
1268    
1269      set( key => 'value' );
1270    
1271    =cut
1272    
1273    sub set {
1274            my ($k,$v) = @_;
1275            warn "## set ( $k => ", dump($v), " )", $/;
1276            $hash->{$k} = $v;
1277    };
1278    
1279    =head2 get
1280    
1281      get( 'key' );
1282    
1283    =cut
1284    
1285    sub get {
1286            my $k = shift || return;
1287            my $v = $hash->{$k};
1288            warn "## get $k = ", dump( $v ), $/;
1289            return $v;
1290    }
1291    
1292    
1293  # END  # END
1294  1;  1;

Legend:
Removed from v.752  
changed lines
  Added in v.788

  ViewVC Help
Powered by ViewVC 1.1.26