/[MARC-Fast]/trunk/lib/MARC/Fast.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/MARC/Fast.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/Fast.pm revision 18 by dpavlin, Mon Oct 29 22:33:35 2007 UTC trunk/lib/MARC/Fast.pm revision 47 by dpavlin, Thu Aug 22 11:24:36 2013 UTC
# Line 2  package MARC::Fast; Line 2  package MARC::Fast;
2    
3  use strict;  use strict;
4  use Carp;  use Carp;
5  use Data::Dumper;  use Data::Dump qw/dump/;
6    
7  BEGIN {  BEGIN {
8          use Exporter ();          use Exporter ();
9          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);          use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
10          $VERSION     = 0.08;          $VERSION     = 0.12;
11          @ISA         = qw (Exporter);          @ISA         = qw (Exporter);
12          #Give a hoot don't pollute, do not export more than needed by default          #Give a hoot don't pollute, do not export more than needed by default
13          @EXPORT      = qw ();          @EXPORT      = qw ();
# Line 87  sub new { Line 87  sub new {
87                  my $len = read($self->{fh}, $leader, 24);                  my $len = read($self->{fh}, $leader, 24);
88    
89                  if ($len < 24) {                  if ($len < 24) {
90                          carp "short read of leader, aborting\n";                          warn "short read of leader, aborting\n";
91                            $self->{count}--;
92                          last;                          last;
93                  }                  }
94    
# Line 124  sub new { Line 125  sub new {
125    
126                  # skip to next record                  # skip to next record
127                  my $o = substr($leader,0,5);                  my $o = substr($leader,0,5);
128                    warn "# in record ", $self->{count}," record length isn't number but: ",dump($o),"\n" unless $o =~ m/^\d+$/;
129                  if ($o > 24) {                  if ($o > 24) {
130                          seek($self->{fh},$o-24,1) if ($o);                          seek($self->{fh},$o-24,1) if ($o);
131                  } else {                  } else {
# Line 275  sub last_leader { Line 277  sub last_leader {
277    
278  Read record with specified MFN and convert it to hash  Read record with specified MFN and convert it to hash
279    
280    my $hash = $marc->to_hash($mfn);    my $hash = $marc->to_hash( $mfn, include_subfields => 1,
281            hash_filter => sub { my ($l,$tag) = @_; return $l; }
282      );
283    
284  It has ability to convert characters (using C<hash_filter>) from MARC  It has ability to convert characters (using C<hash_filter>) from MARC
285  database before creating structures enabling character re-mapping or quick  database before creating structures enabling character re-mapping or quick
286  fix-up of data.  fix-up of data. If you specified C<hash_filter> both in C<new> and C<to_hash>
287    only the one from C<to_hash> will be used.
288    
289  This function returns hash which is like this:  This function returns hash which is like this:
290    
# Line 302  sub to_hash { Line 307  sub to_hash {
307    
308          my $mfn = shift || confess "need mfn!";          my $mfn = shift || confess "need mfn!";
309    
310            my $args = {@_};
311            my $filter_coderef = $args->{'hash_filter'} || $self->{'hash_filter'};
312    
313          # init record to include MFN as field 000          # init record to include MFN as field 000
314          my $rec = { '000' => [ $mfn ] };          my $rec = { '000' => [ $mfn ] };
315    
316          my $row = $self->fetch($mfn) || return;          my $row = $self->fetch($mfn) || return;
317    
318          foreach my $rec_nr (keys %{$row}) {          foreach my $tag (keys %{$row}) {
319                  foreach my $l (@{$row->{$rec_nr}}) {                  foreach my $l (@{$row->{$tag}}) {
320    
321                          # remove end marker                          # remove end marker
322                          $l =~ s/\x1E$//;                          $l =~ s/\x1E$//;
323    
324                          # filter output                          # filter output
325                          $l = $self->{'hash_filter'}->($l, $rec_nr) if ($self->{'hash_filter'});                          $l = $filter_coderef->($l, $tag) if $filter_coderef;
326    
327                          my $val;                          my $val;
328    
329                          # has identifiers?                          # has identifiers?
330                          ($val->{'i1'},$val->{'i2'}) = ($1,$2) if ($l =~ s/^([01 #])([01 #])\x1F/\x1F/);                          ($val->{'i1'},$val->{'i2'}) = ($1,$2) if ($l =~ s/^([01 #])([01 #])\x1F/\x1F/);
331    
332                            my $sf_usage;
333                            my @subfields;
334    
335                          # has subfields?                          # has subfields?
336                          if ($l =~ m/\x1F/) {                          if ($l =~ m/\x1F/) {
337                                  foreach my $t (split(/\x1F/,$l)) {                                  foreach my $t (split(/\x1F/,$l)) {
338                                          next if (! $t);                                          next if (! $t);
339                                          my $f = substr($t,0,1);                                          my $f = substr($t,0,1);
340                                          # repeatable subfileds. When we hit first one,                                          my $v = substr($t,1);
341                                          # store CURRENT (up to that) in first repetition  
342                                          # of this record. Then, new record with same                                          push @subfields, ( $f, $sf_usage->{$f}++ || 0 );
343                                          # identifiers will be created.  
344                                          if ($val->{$f}) {                                          # repeatable subfiled -- convert it to array
345                                                  push @{$rec->{$rec_nr}}, $val;                                          if ( defined $val->{$f} ) {
346                                                  $val = {                                                  if ( ref($val->{$f}) ne 'ARRAY' ) {
347                                                          i1 => $val->{i1},                                                          $val->{$f} = [ $val->{$f}, $v ];
348                                                          i2 => $val->{i2},                                                  } else {
349                                                  };                                                          push @{$val->{$f}}, $v;
350                                                    }
351                                            } else {
352                                                    $val->{$f} = $v;
353                                          }                                          }
                                         $val->{substr($t,0,1)} = substr($t,1);  
354                                  }                                  }
355                                    $val->{subfields} = [ @subfields ] if $args->{include_subfields};
356                          } else {                          } else {
357                                  $val = $l;                                  $val = $l;
358                          }                          }
359    
360                          push @{$rec->{$rec_nr}}, $val;                          push @{$rec->{$tag}}, $val;
361                  }                  }
362          }          }
363    
# Line 377  sub to_ascii { Line 391  sub to_ascii {
391  1;  1;
392  __END__  __END__
393    
394    =head1 UTF-8 ENCODING
395    
396    This module does nothing with encoding. But, since MARC format is byte
397    oriented even when using UTF-8 which has variable number of bytes for each
398    character, file is opened in binary mode.
399    
400    As a result, all scalars recturned to perl don't have utf-8 flag. Solution is
401    to use C<hash_filter> and L<Encode> to decode utf-8 encoding like this:
402    
403      use Encode;
404    
405      my $marc = new MARC::Fast(
406            marcdb => 'utf8.marc',
407            hash_filter => sub {
408                    Encode::decode( 'utf-8', $_[0] );
409            },
410      );
411    
412    This will affect C<to_hash>, but C<fetch> will still return binary representation
413    since it doesn't support C<hash_filter>.
414    
415  =head1 AUTHOR  =head1 AUTHOR
416    
417          Dobrica Pavlinusic          Dobrica Pavlinusic

Legend:
Removed from v.18  
changed lines
  Added in v.47

  ViewVC Help
Powered by ViewVC 1.1.26