/[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 547 by dpavlin, Thu Jun 29 23:19:26 2006 UTC revision 551 by dpavlin, Fri Jun 30 20:43:09 2006 UTC
# Line 16  use warnings; Line 16  use warnings;
16  use strict;  use strict;
17    
18  #use base qw/WebPAC::Common/;  #use base qw/WebPAC::Common/;
19  use Data::Dumper;  use Data::Dump qw/dump/;
20  use Encode qw/from_to/;  use Encode qw/from_to/;
21    
22    # debugging warn(s)
23    my $debug = 0;
24    
25    
26  =head1 NAME  =head1 NAME
27    
28  WebPAC::Normalize - describe normalisaton rules using sets  WebPAC::Normalize - describe normalisaton rules using sets
# Line 125  Clean data structure hash for next recor Line 129  Clean data structure hash for next recor
129    
130  sub _clean_ds {  sub _clean_ds {
131          my $a = {@_};          my $a = {@_};
132          ($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators) = (undef);          ($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators) = ();
133          $marc_encoding = $a->{marc_encoding};          $marc_encoding = $a->{marc_encoding};
134  }  }
135    
# Line 163  You can change behaviour of that using C Line 167  You can change behaviour of that using C
167  =cut  =cut
168    
169  sub _get_marc_fields {  sub _get_marc_fields {
170    
171            return if (! $marc_record || ref($marc_record) ne 'ARRAY' || $#{ $marc_record } < 0);
172    
173            # first, sort all existing fields
174            # XXX might not be needed, but modern perl might randomize elements in hash
175            my @sorted_marc_record = sort {
176                    $a->[0] . $a->[3] cmp $b->[0] . $b->[3]
177            } @{ $marc_record };
178    
179            # output marc fields
180          my @m;          my @m;
181          my $last;  
182          foreach my $row (@{ $marc_record }) {          # count unique field-subfields (used for offset when walking to next subfield)
183                  if ($last &&          my $u;
184                          $last->[0] eq $row->[0] &&              # check if field is same          map { $u->{ $_->[0] . $_->[3]  }++ } @sorted_marc_record;
185                          $last->[1] eq $row->[1] &&              # check for i1  
186                          $last->[2] eq $row->[2] &&              # and for i2          if ($debug) {
187                                  ( $last->[3] ne $row->[3] ||                            # and subfield is different                  warn "## marc_repeatable_subfield ", dump( $marc_repeatable_subfield ), $/;
188                                  $last->[3] eq $row->[3] &&                                      # or subfield is same,                  warn "## marc_record ", dump( $marc_record ), $/;
189                                  $marc_repeatable_subfield->{ $row->[3] }        # but is repeatable                  warn "## sorted_marc_record ", dump( \@sorted_marc_record ), $/;
190                          )                  warn "## subfield count ", dump( $u ), $/;
191                  ) {          }
192                          push @$last, ( $row->[3] , $row->[4] );  
193                          warn "## ++ added $row->[0] ^$row->[3] to $last->[0]\n";          my $len = $#sorted_marc_record;
194                          next;          my $visited;
195                  } elsif ($last) {          my $i = 0;
196                          push @m, $last;          my $field;
197    
198            foreach ( 0 .. $len ) {
199    
200                    # find next element which isn't visited
201                    while ($visited->{$i}) {
202                            $i = ($i + 1) % ($len + 1);
203                    }
204    
205                    # mark it visited
206                    $visited->{$i}++;
207    
208                    my $row = $sorted_marc_record[$i];
209    
210                    # field and subfield which is key for
211                    # marc_repeatable_subfield and u
212                    my $fsf = $row->[0] . $row->[3];
213    
214                    if ($debug > 1) {
215    
216                            print "### field so far [", $#$field, "] : ", dump( $field ), " ", $field ? 'T' : 'F', $/;
217                            print "### this [$i]: ", dump( $row ),$/;
218                            print "### sf: ", $row->[3], " vs ", $field->[3],
219                                    $marc_repeatable_subfield->{ $row->[0] . $row->[3] } ? ' (repeatable)' : '', $/,
220                                    if ($#$field >= 0);
221    
222                    }
223    
224                    # if field exists
225                    if ( $#$field >= 0 ) {
226                            if (
227                                    $row->[0] ne $field->[0] ||             # field
228                                    $row->[1] ne $field->[1] ||             # i1
229                                    $row->[2] ne $field->[2]                # i2
230                            ) {
231                                    push @m, $field;
232                                    warn "## saved/1 ", dump( $field ),$/ if ($debug);
233                                    $field = $row;
234    
235                            } elsif (
236                                    ( $row->[3] lt $field->[-2] )           # subfield which is not next (e.g. a after c)
237                                    ||
238                                    ( $row->[3] eq $field->[-2] &&          # same subfield, but not repeatable
239                                            ! $marc_repeatable_subfield->{ $fsf }
240                                    )
241                            ) {
242                                    push @m, $field;
243                                    warn "## saved/2 ", dump( $field ),$/ if ($debug);
244                                    $field = $row;
245    
246                            } else {
247                                    # append new subfields to existing field
248                                    push @$field, ( $row->[3], $row->[4] );
249                            }
250                    } else {
251                            # insert first field
252                            $field = $row;
253                  }                  }
254    
255                  $last = $row;                  if (! $marc_repeatable_subfield->{ $fsf }) {
256                            # make step to next subfield
257                            $i = ($i + $u->{ $fsf } ) % ($len + 1);
258                    }
259          }          }
260    
261          push @m, $last if ($last);          if ($#$field >= 0) {
262                    push @m, $field;
263                    warn "## saved/3 ", dump( $field ),$/ if ($debug);
264            }
265    
266          return @m;          return @m;
267  }  }
# Line 262  sub marc { Line 338  sub marc {
338                  my $v = $_;             # make var read-write for Encode                  my $v = $_;             # make var read-write for Encode
339                  next unless (defined($v) && $v !~ /^\s*$/);                  next unless (defined($v) && $v !~ /^\s*$/);
340                  from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);                  from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
341                  push @{ $marc_record }, [                  my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');
342                          $f,                  push @{ $marc_record }, [ $f, $i1, $i2, $sf => $v ];
                         $marc_indicators->{$f}->{i1} || ' ',  
                         $marc_indicators->{$f}->{i2} || ' ',  
                         $sf => $v  
                 ];  
343          }          }
344  }  }
345    
# Line 280  Save values for MARC repetable subfield Line 352  Save values for MARC repetable subfield
352  =cut  =cut
353    
354  sub marc_repeatable_subfield {  sub marc_repeatable_subfield {
355          die "marc_repeatable_subfield need subfield!\n" unless (defined($_[1]));          my ($f,$sf) = @_;
356          $marc_repeatable_subfield->{ $_[1] }++;          die "marc_repeatable_subfield need field and subfield!\n" unless ($f && $sf);
357            $marc_repeatable_subfield->{ $f . $sf }++;
358          marc(@_);          marc(@_);
359  }  }
360    
# Line 303  sub marc_indicators { Line 376  sub marc_indicators {
376    
377          $i1 = ' ' if ($i1 !~ /^\d$/);          $i1 = ' ' if ($i1 !~ /^\d$/);
378          $i2 = ' ' if ($i2 !~ /^\d$/);          $i2 = ' ' if ($i2 !~ /^\d$/);
379          $marc_indicators->{$f}->{i1} = $i1;          @{ $marc_indicators->{$f} } = ($i1,$i2);
         $marc_indicators->{$f}->{i2} = $i2;  
380  }  }
381    
382    
# Line 382  Apply regex to some or all values Line 454  Apply regex to some or all values
454  sub regex {  sub regex {
455          my $r = shift;          my $r = shift;
456          my @out;          my @out;
457          #warn "r: $r\n",Dumper(\@_);          #warn "r: $r\n", dump(\@_);
458          foreach my $t (@_) {          foreach my $t (@_) {
459                  next unless ($t);                  next unless ($t);
460                  eval "\$t =~ $r";                  eval "\$t =~ $r";

Legend:
Removed from v.547  
changed lines
  Added in v.551

  ViewVC Help
Powered by ViewVC 1.1.26