/[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 540 by dpavlin, Thu Jun 29 15:29:41 2006 UTC revision 543 by dpavlin, Thu Jun 29 21:19:08 2006 UTC
# Line 17  use strict; Line 17  use strict;
17    
18  #use base qw/WebPAC::Common/;  #use base qw/WebPAC::Common/;
19  use Data::Dumper;  use Data::Dumper;
20    use Encode qw/from_to/;
21    
22  =head1 NAME  =head1 NAME
23    
# Line 24  WebPAC::Normalize - describe normalisato Line 25  WebPAC::Normalize - describe normalisato
25    
26  =head1 VERSION  =head1 VERSION
27    
28  Version 0.05  Version 0.06
29    
30  =cut  =cut
31    
32  our $VERSION = '0.05';  our $VERSION = '0.06';
33    
34  =head1 SYNOPSIS  =head1 SYNOPSIS
35    
# Line 57  Return data structure Line 58  Return data structure
58          lookup => $lookup->lookup_hash,          lookup => $lookup->lookup_hash,
59          row => $row,          row => $row,
60          rules => $normalize_pl_config,          rules => $normalize_pl_config,
61            marc_encoding => 'utf-8',
62    );    );
63    
64  Options C<lookup>, C<row>, C<rules> and C<log> are mandatory while all  Options C<lookup>, C<row>, C<rules> and C<log> are mandatory while all
# Line 78  sub data_structure { Line 80  sub data_structure {
80          no strict 'subs';          no strict 'subs';
81          _set_lookup( $arg->{lookup} );          _set_lookup( $arg->{lookup} );
82          _set_rec( $arg->{row} );          _set_rec( $arg->{row} );
83          _clean_ds();          _clean_ds( %{ $arg } );
   
84          eval "$arg->{rules}";          eval "$arg->{rules}";
85          die "error evaling $arg->{rules}: $@\n" if ($@);          die "error evaling $arg->{rules}: $@\n" if ($@);
86    
# Line 110  Return hash formatted as data structure Line 111  Return hash formatted as data structure
111    
112  my $out;  my $out;
113  my $marc21;  my $marc21;
114    my $marc_encoding;
115    
116  sub _get_ds {  sub _get_ds {
117          return $out;          return $out;
# Line 124  Clean data structure hash for next recor Line 126  Clean data structure hash for next recor
126  =cut  =cut
127    
128  sub _clean_ds {  sub _clean_ds {
129            my $a = {@_};
130          $out = undef;          $out = undef;
131          $marc21 = undef;          $marc21 = undef;
132            $marc_encoding = $a->{marc_encoding};
133  }  }
134    
135  =head2 _set_lookup  =head2 _set_lookup
# Line 148  Get all fields defined by calls to C<mar Line 152  Get all fields defined by calls to C<mar
152    
153          $marc->add_fields( WebPAC::Normalize:_get_marc21_fields() );          $marc->add_fields( WebPAC::Normalize:_get_marc21_fields() );
154    
155    
156    
157    We are using I<magic> which detect repeatable fields only from
158    sequence of field/subfield data generated by normalization.
159    
160    Repeatable field is created if there is second occurence of same subfield or
161    if any of indicators are different. This is sane for most cases except for
162    non-repeatable fields with repeatable subfields.
163    
164    B<TODO>: implement exceptions to magic
165    
166  =cut  =cut
167    
168  sub _get_marc21_fields {  sub _get_marc21_fields {
169          return @{$marc21};          my @m;
170            my $last;
171            foreach my $row (@{ $marc21 }) {
172                    if ($last &&
173                            $last->[0] eq $row->[0] &&              # check if field is same
174                            $last->[1] eq $row->[1] &&              # check for i1
175                            $last->[2] eq $row->[2]                 # and for i2
176                    ) {
177                            push @$last, ( $row->[3] , $row->[4] );
178                            warn "## ++ added $row->[0] ^$row->[3] to $last->[0]\n";
179                            next;
180                    } elsif ($last) {
181                            push @m, $last;
182                    }
183    
184                    $last = $row;
185            }
186    
187            push @m, $last if ($last);
188    
189            return @m;
190  }  }
191    
192  =head1 Functions to create C<data_structure>  =head1 Functions to create C<data_structure>
# Line 222  sub marc21 { Line 257  sub marc21 {
257    
258          my $sf = shift or die "marc21 needs subfield";          my $sf = shift or die "marc21 needs subfield";
259    
260          foreach my $v (@_) {          foreach (@_) {
261                    my $v = $_;             # make var read-write for Encode
262                    next unless (defined($v) && $v !~ /^\s*$/);
263                    from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
264                  push @{ $marc21 }, [ $f, ' ', ' ', $sf => $v ];                  push @{ $marc21 }, [ $f, ' ', ' ', $sf => $v ];
265          }          }
266  }  }
Legend:
Removed from v.540  
changed lines
  Added in v.543
  ViewVC Help
Powered by ViewVC 1.1.26