/[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 17 by dpavlin, Thu Jun 21 10:24:12 2007 UTC trunk/lib/MARC/Fast.pm revision 42 by dpavlin, Thu Sep 23 13:07:28 2010 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.07;          $VERSION     = 0.10;
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 23  MARC::Fast - Very fast implementation of Line 23  MARC::Fast - Very fast implementation of
23    
24    use MARC::Fast;    use MARC::Fast;
25    
26      my $marc = new MARC::Fast(
27            marcdb => 'unimarc.iso',
28      );
29    
30      foreach my $mfn ( 1 .. $marc->count ) {
31            print $marc->to_ascii( $mfn );
32      }
33    
34    For longer example with command line options look at L<scripts/dump_fastmarc.pl>
35    
36  =head1 DESCRIPTION  =head1 DESCRIPTION
37    
38  This is very fast alternative to C<MARC> and C<MARC::Record> modules.  This is very fast alternative to C<MARC> and C<MARC::Record> modules.
39    
40  It's is also very sutable for random access to MARC records (as opposed to  It's is also very subtable for random access to MARC records (as opposed to
41  sequential one).  sequential one).
42    
43  =head1 METHODS  =head1 METHODS
# Line 78  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 111  sub new { Line 121  sub new {
121                  print STDERR "REC ",$self->{count},": $leader\n" if ($self->{debug});                  print STDERR "REC ",$self->{count},": $leader\n" if ($self->{debug});
122    
123                  # store leader for later                  # store leader for later
124                  push @{$self->{leaders}}, $leader;                  push @{$self->{leader}}, $leader;
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 145  Fetch record from database Line 156  Fetch record from database
156    
157    my $hash = $marc->fetch(42);    my $hash = $marc->fetch(42);
158    
159    First record number is C<1>
160    
161  =cut  =cut
162    
163  sub fetch {  sub fetch {
164          my $self = shift;          my $self = shift;
165    
166          my $rec_nr = shift || return;          my $rec_nr = shift;
167    
168            if ( ! $rec_nr ) {
169                    $self->{last_leader} = undef;
170                    return;
171            }
172    
173          my $leader = $self->{leaders}->[$rec_nr - 1];          my $leader = $self->{leader}->[$rec_nr - 1];
174            $self->{last_leader} = $leader;
175          unless ($leader) {          unless ($leader) {
176                  carp "can't find record $rec_nr";                  carp "can't find record $rec_nr";
177                  return;                  return;
# Line 234  sub fetch { Line 253  sub fetch {
253  }  }
254    
255    
256    =head2 last_leader
257    
258    Returns leader of last record L<fetch>ed
259    
260      print $marc->last_leader;
261    
262    Added in version 0.08 of this module, so if you need it use:
263    
264      use MARC::Fast 0.08;
265    
266    to be sure that it's supported.
267    
268    =cut
269    
270    sub last_leader {
271            my $self = shift;
272            return $self->{last_leader};
273    }
274    
275    
276  =head2 to_hash  =head2 to_hash
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    
282  It has ability to convert characters (using C<hash_filter>) from MARC  It has ability to convert characters (using C<hash_filter>) from MARC
283  database before creating structures enabling character re-mapping or quick  database before creating structures enabling character re-mapping or quick
# Line 265  sub to_hash { Line 304  sub to_hash {
304    
305          my $mfn = shift || confess "need mfn!";          my $mfn = shift || confess "need mfn!";
306    
307            my $args = {@_};
308    
309          # init record to include MFN as field 000          # init record to include MFN as field 000
310          my $rec = { '000' => [ $mfn ] };          my $rec = { '000' => [ $mfn ] };
311    
312          my $row = $self->fetch($mfn) || return;          my $row = $self->fetch($mfn) || return;
313    
314          foreach my $rec_nr (keys %{$row}) {          foreach my $tag (keys %{$row}) {
315                  foreach my $l (@{$row->{$rec_nr}}) {                  foreach my $l (@{$row->{$tag}}) {
316    
317                          # remove end marker                          # remove end marker
318                          $l =~ s/\x1E$//;                          $l =~ s/\x1E$//;
319    
320                          # filter output                          # filter output
321                          $l = $self->{'hash_filter'}->($l, $rec_nr) if ($self->{'hash_filter'});                          $l = $self->{'hash_filter'}->($l, $tag) if ($self->{'hash_filter'});
322    
323                          my $val;                          my $val;
324    
325                          # has identifiers?                          # has identifiers?
326                          ($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/);
327    
328                            my $sf_usage;
329                            my @subfields;
330    
331                          # has subfields?                          # has subfields?
332                          if ($l =~ m/\x1F/) {                          if ($l =~ m/\x1F/) {
333                                  foreach my $t (split(/\x1F/,$l)) {                                  foreach my $t (split(/\x1F/,$l)) {
334                                          next if (! $t);                                          next if (! $t);
335                                          my $f = substr($t,0,1);                                          my $f = substr($t,0,1);
336                                          # repeatable subfileds. When we hit first one,                                          my $v = substr($t,1);
337                                          # store CURRENT (up to that) in first repetition  
338                                          # of this record. Then, new record with same                                          push @subfields, ( $f, $sf_usage->{$f}++ || 0 );
339                                          # identifiers will be created.  
340                                          if ($val->{$f}) {                                          # repeatable subfiled -- convert it to array
341                                                  push @{$rec->{$rec_nr}}, $val;                                          if ( defined $val->{$f} ) {
342                                                  $val = {                                                  if ( ref($val->{$f}) ne 'ARRAY' ) {
343                                                          i1 => $val->{i1},                                                          $val->{$f} = [ $val->{$f}, $v ];
344                                                          i2 => $val->{i2},                                                  } else {
345                                                  };                                                          push @{$val->{$f}}, $v;
346                                                    }
347                                            } else {
348                                                    $val->{$f} = $v;
349                                          }                                          }
                                         $val->{substr($t,0,1)} = substr($t,1);  
350                                  }                                  }
351                                    $val->{subfields} = [ @subfields ] if $args->{include_subfields};
352                          } else {                          } else {
353                                  $val = $l;                                  $val = $l;
354                          }                          }
355    
356                          push @{$rec->{$rec_nr}}, $val;                          push @{$rec->{$tag}}, $val;
357                  }                  }
358          }          }
359    
# Line 340  sub to_ascii { Line 387  sub to_ascii {
387  1;  1;
388  __END__  __END__
389    
390    =head1 UTF-8 ENCODING
391    
392    This module does nothing with encoding. But, since MARC format is byte
393    oriented even when using UTF-8 which has variable number of bytes for each
394    character, file is opened in binary mode.
395    
396    As a result, all scalars recturned to perl don't have utf-8 flag. Solution is
397    to use C<hash_filter> and L<Encode> to decode utf-8 encoding like this:
398    
399      use Encode;
400    
401      my $marc = new MARC::Fast(
402            marcdb => 'utf8.marc',
403            hash_filter => sub {
404                    Encode::decode( 'utf-8', $_[0] );
405            },
406      );
407    
408    This will affect C<to_hash>, but C<fetch> will still return binary representation
409    since it doesn't support C<hash_filter>.
410    
411  =head1 AUTHOR  =head1 AUTHOR
412    
413          Dobrica Pavlinusic          Dobrica Pavlinusic

Legend:
Removed from v.17  
changed lines
  Added in v.42

  ViewVC Help
Powered by ViewVC 1.1.26