/[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 561 by dpavlin, Sat Jul 1 10:19:29 2006 UTC revision 562 by dpavlin, Sun Jul 2 16:14:41 2006 UTC
# Line 7  use Exporter 'import'; Line 7  use Exporter 'import';
7    
8          tag search display          tag search display
9          marc marc_indicators marc_repeatable_subfield          marc marc_indicators marc_repeatable_subfield
10            marc_compose
11    
12          rec1 rec2 rec          rec1 rec2 rec
13          regex prefix suffix surround          regex prefix suffix surround
14          first lookup join_with          first lookup join_with
15    
16            split_rec_on
17  /;  /;
18    
19  use warnings;  use warnings;
# Line 30  WebPAC::Normalize - describe normalisato Line 33  WebPAC::Normalize - describe normalisato
33    
34  =head1 VERSION  =head1 VERSION
35    
36  Version 0.07  Version 0.08
37    
38  =cut  =cut
39    
40  our $VERSION = '0.07';  our $VERSION = '0.08';
41    
42  =head1 SYNOPSIS  =head1 SYNOPSIS
43    
# Line 193  sub _get_marc_fields { Line 196  sub _get_marc_fields {
196                  $a->[0] . $a->[3] cmp $b->[0] . $b->[3]                  $a->[0] . $a->[3] cmp $b->[0] . $b->[3]
197          } @{ $marc_record };          } @{ $marc_record };
198    
199            @sorted_marc_record = @{ $marc_record };        ### FIXME disable sorting
200            
201          # output marc fields          # output marc fields
202          my @m;          my @m;
203    
# Line 294  Change level of debug warnings Line 299  Change level of debug warnings
299  sub _debug {  sub _debug {
300          my $l = shift;          my $l = shift;
301          return $debug unless defined($l);          return $debug unless defined($l);
302            warn "debug level $l" if ($l > 0);
303          $debug = $l;          $debug = $l;
304  }  }
305    
# Line 410  sub marc_indicators { Line 416  sub marc_indicators {
416          @{ $marc_indicators->{$f} } = ($i1,$i2);          @{ $marc_indicators->{$f} } = ($i1,$i2);
417  }  }
418    
419    =head2 marc_compose
420    
421    Save values for each MARC subfield explicitly
422    
423      marc_compose('900',
424            'a', rec('200','a')
425            'b', rec('201','a')
426            'a', rec('200','b')
427            'c', rec('200','c')
428      );
429    
430    =cut
431    
432    sub marc_compose {
433            my $f = shift or die "marc_compose needs field";
434            die "marc_compose field must be numer" unless ($f =~ /^\d+$/);
435    
436            my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');
437            my $m = [ $f, $i1, $i2 ];
438    
439            while (@_) {
440                    my $sf = shift or die "marc_compose $f needs subfield";
441                    my $v = shift or die "marc_compose $f needs value for subfield $sf";
442    
443                    next unless (defined($v) && $v !~ /^\s*$/);
444                    from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
445                    push @$m, ( $sf, $v );
446                    warn "## ++ marc_compose($f,$sf,$v) ", dump( $m ) if ($debug > 1);
447            }
448    
449            warn "## marc_compose(d) ", dump( $m ) if ($debug > 1);
450    
451            push @{ $marc_record }, $m;
452    }
453    
454    
455  =head1 Functions to extract data from input  =head1 Functions to extract data from input
456    
# Line 579  sub join_with { Line 620  sub join_with {
620          return join($d, grep { defined($_) && $_ ne '' } @_);          return join($d, grep { defined($_) && $_ ne '' } @_);
621  }  }
622    
623    =head2 split_rec_on
624    
625    Split record subfield on some regex and take one of parts out
626    
627      $a_before_semi_column =
628            split_rec_on('200','a', /\s*;\s*/, $part);
629    
630    C<$part> is optional number of element. First element is
631    B<1>, not 0!
632    
633    If there is no C<$part> parameter or C<$part> is 0, this function will
634    return all values produced by splitting.
635    
636    =cut
637    
638    sub split_rec_on {
639            die "split_rec_on need (fld,sf,regex[,part]" if ($#_ < 2);
640    
641            my ($fld, $sf, $regex, $part) = @_;
642            warn "### regex ", ref($regex), $regex if ($debug > 2);
643    
644            my @r = rec( $fld, $sf );
645            my $v = shift @r;
646            warn "### first rec($fld,$sf) = ",dump($v) if ($debug > 2);
647    
648            my @s = split( $regex, $v );
649            warn "## split_rec_on($fld,$sf,$regex,$part) = ",dump(@s) if ($debug > 1);
650            if ($part > 0) {
651                    return $s[ $part - 1 ];
652            } else {
653                    return @s;
654            }
655    }
656    
657  # END  # END
658  1;  1;
Legend:
Removed from v.561  
changed lines
  Added in v.562
  ViewVC Help
Powered by ViewVC 1.1.26