/[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 817 by dpavlin, Thu Apr 5 21:50:14 2007 UTC revision 889 by dpavlin, Thu Sep 6 19:12:15 2007 UTC
# Line 42  WebPAC::Normalize - describe normalisato Line 42  WebPAC::Normalize - describe normalisato
42    
43  =head1 VERSION  =head1 VERSION
44    
45  Version 0.28  Version 0.29
46    
47  =cut  =cut
48    
49  our $VERSION = '0.28';  our $VERSION = '0.29';
50    
51  =head1 SYNOPSIS  =head1 SYNOPSIS
52    
# Line 535  sub marc_fixed { Line 535  sub marc_fixed {
535          my ($f, $pos, $val) = @_;          my ($f, $pos, $val) = @_;
536          die "need marc(field, position, value)" unless defined($f) && defined($pos);          die "need marc(field, position, value)" unless defined($f) && defined($pos);
537    
538            confess "need val" unless defined $val;
539    
540          my $update = 0;          my $update = 0;
541    
542          map {          map {
543                  if ($_->[0] eq $f) {                  if ($_->[0] eq $f) {
544                          my $old = $_->[1];                          my $old = $_->[1];
545                          if (length($old) < $pos) {                          if (length($old) <= $pos) {
546                                  $_->[1] .= ' ' x ( $pos - length($old) ) . $val;                                  $_->[1] .= ' ' x ( $pos - length($old) ) . $val;
547                                  warn "## marc_fixed($f,$pos,'$val') append '$old' -> '$_->[1]'\n" if ($debug > 1);                                  warn "## marc_fixed($f,$pos,'$val') append '$old' -> '$_->[1]'\n" if ($debug > 1);
548                          } else {                          } else {
# Line 872  sub _pack_subfields_hash { Line 874  sub _pack_subfields_hash {
874    
875          my ($h,$include_subfields) = @_;          my ($h,$include_subfields) = @_;
876    
877            # sanity and ease of use
878            return $h if (ref($h) ne 'HASH');
879    
880          if ( defined($h->{subfields}) ) {          if ( defined($h->{subfields}) ) {
881                  my $sfs = delete $h->{subfields} || die "no subfields?";                  my $sfs = delete $h->{subfields} || die "no subfields?";
882                  my @out;                  my @out;
# Line 1021  Prefix all values with a string Line 1026  Prefix all values with a string
1026  =cut  =cut
1027    
1028  sub prefix {  sub prefix {
1029          my $p = shift or return;          my $p = shift;
1030            return @_ unless defined( $p );
1031          return map { $p . $_ } grep { defined($_) } @_;          return map { $p . $_ } grep { defined($_) } @_;
1032  }  }
1033    
# Line 1034  suffix all values with a string Line 1040  suffix all values with a string
1040  =cut  =cut
1041    
1042  sub suffix {  sub suffix {
1043          my $s = shift or die "suffix needs string as first argument";          my $s = shift;
1044            return @_ unless defined( $s );
1045          return map { $_ . $s } grep { defined($_) } @_;          return map { $_ . $s } grep { defined($_) } @_;
1046  }  }
1047    
# Line 1047  surround all values with a two strings Line 1054  surround all values with a two strings
1054  =cut  =cut
1055    
1056  sub surround {  sub surround {
1057          my $p = shift or die "surround need prefix as first argument";          my $p = shift;
1058          my $s = shift or die "surround needs suffix as second argument";          my $s = shift;
1059            $p = '' unless defined( $p );
1060            $s = '' unless defined( $s );
1061          return map { $p . $_ . $s } grep { defined($_) } @_;          return map { $p . $_ . $s } grep { defined($_) } @_;
1062  }  }
1063    

Legend:
Removed from v.817  
changed lines
  Added in v.889

  ViewVC Help
Powered by ViewVC 1.1.26