/[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

revision 6 by dpavlin, Sun Dec 18 23:12:26 2005 UTC revision 23 by dpavlin, Sun Nov 4 22:44:42 2007 UTC
# Line 1  Line 1 
   
1  package MARC::Fast;  package MARC::Fast;
2    
3  use strict;  use strict;
4  use Carp;  use Carp;
5  use Data::Dumper;  use Data::Dumper;
# Line 7  use Data::Dumper; Line 7  use Data::Dumper;
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.02;          $VERSION     = 0.09;
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 42  Read MARC database Line 51  Read MARC database
51          quiet => 0,          quiet => 0,
52          debug => 0,          debug => 0,
53          assert => 0,          assert => 0,
54            hash_filter => sub {
55                    my ($t, $record_number) = @_;
56                    $t =~ s/foo/bar/;
57                    return $t;
58            },
59    );    );
60    
61  =cut  =cut
# Line 106  sub new { Line 120  sub new {
120                  print STDERR "REC ",$self->{count},": $leader\n" if ($self->{debug});                  print STDERR "REC ",$self->{count},": $leader\n" if ($self->{debug});
121    
122                  # store leader for later                  # store leader for later
123                  push @{$self->{leaders}}, $leader;                  push @{$self->{leader}}, $leader;
124    
125                  # skip to next record                  # skip to next record
126                  my $o = substr($leader,0,5);                  my $o = substr($leader,0,5);
# Line 140  Fetch record from database Line 154  Fetch record from database
154    
155    my $hash = $marc->fetch(42);    my $hash = $marc->fetch(42);
156    
157    First record number is C<1>
158    
159  =cut  =cut
160    
161  sub fetch {  sub fetch {
162          my $self = shift;          my $self = shift;
163    
164          my $rec_nr = shift || return;          my $rec_nr = shift;
165    
166          my $leader = $self->{leaders}->[$rec_nr - 1];          if ( ! $rec_nr ) {
167                    $self->{last_leader} = undef;
168                    return;
169            }
170    
171            my $leader = $self->{leader}->[$rec_nr - 1];
172            $self->{last_leader} = $leader;
173          unless ($leader) {          unless ($leader) {
174                  carp "can't find record $rec_nr";                  carp "can't find record $rec_nr";
175                  return;                  return;
# Line 229  sub fetch { Line 251  sub fetch {
251  }  }
252    
253    
254    =head2 last_leader
255    
256    Returns leader of last record L<fetch>ed
257    
258      print $marc->last_leader;
259    
260    Added in version 0.08 of this module, so if you need it use:
261    
262      use MARC::Fast 0.08;
263    
264    to be sure that it's supported.
265    
266    =cut
267    
268    sub last_leader {
269            my $self = shift;
270            return $self->{last_leader};
271    }
272    
273    
274  =head2 to_hash  =head2 to_hash
275    
276  Read record with specified MFN and convert it to hash  Read record with specified MFN and convert it to hash
277    
278    my $hash = $marc->to_hash($mfn);    my $hash = $marc->to_hash( $mfn, include_subfields => 1, );
279    
280  It has ability to convert characters (using C<hash_filter>) from MARC  It has ability to convert characters (using C<hash_filter>) from MARC
281  database before creating structures enabling character re-mapping or quick  database before creating structures enabling character re-mapping or quick
# Line 260  sub to_hash { Line 302  sub to_hash {
302    
303          my $mfn = shift || confess "need mfn!";          my $mfn = shift || confess "need mfn!";
304    
305            my $args = {@_};
306    
307          # init record to include MFN as field 000          # init record to include MFN as field 000
308          my $rec = { '000' => [ $mfn ] };          my $rec = { '000' => [ $mfn ] };
309    
310          my $row = $self->fetch($mfn) || return;          my $row = $self->fetch($mfn) || return;
311    
312          foreach my $k (keys %{$row}) {          foreach my $rec_nr (keys %{$row}) {
313                  foreach my $l (@{$row->{$k}}) {                  foreach my $l (@{$row->{$rec_nr}}) {
314    
315                          # remove end marker                          # remove end marker
316                          $l =~ s/\x1E$//;                          $l =~ s/\x1E$//;
317    
318                          # filter output                          # filter output
319                          $l = $self->{'hash_filter'}->($l) if ($self->{'hash_filter'});                          $l = $self->{'hash_filter'}->($l, $rec_nr) if ($self->{'hash_filter'});
320    
321                          my $val;                          my $val;
322    
323                          # has identifiers?                          # has identifiers?
324                          ($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/);
325    
326                            my $sf_usage;
327                            my @subfields;
328    
329                          # has subfields?                          # has subfields?
330                          if ($l =~ m/\x1F/) {                          if ($l =~ m/\x1F/) {
331                                  foreach my $t (split(/\x1F/,$l)) {                                  foreach my $t (split(/\x1F/,$l)) {
332                                          next if (! $t);                                          next if (! $t);
333                                            my $f = substr($t,0,1);
334    
335                                            push @subfields, ( $f, $sf_usage->{$f}++ || 0 );
336    
337                                            # repeatable subfiled -- convert it to array
338                                            if ($val->{$f}) {
339                                                    if ( $sf_usage->{$f} == 2 ) {
340                                                            $val->{$f} = [ $val->{$f}, $val ];
341                                                    } else {
342                                                            push @{$val->{$f}}, $val;
343                                                    }
344                                            }
345                                          $val->{substr($t,0,1)} = substr($t,1);                                          $val->{substr($t,0,1)} = substr($t,1);
346                                  }                                  }
347                                    $val->{subfields} = [ @subfields ] if $args->{include_subfields};
348                          } else {                          } else {
349                                  $val = $l;                                  $val = $l;
350                          }                          }
351    
352                          push @{$rec->{$k}}, $val;                          push @{$rec->{$rec_nr}}, $val;
353                  }                  }
354          }          }
355    
356          return $rec;          return $rec;
357  }  }
358    
359    =head2 to_ascii
360    
361  1;    print $marc->to_ascii( 42 );
 __END__  
362    
363  =head1 BUGS  =cut
364    
365    sub to_ascii {
366            my $self = shift;
367    
368            my $mfn = shift || confess "need mfn";
369            my $row = $self->fetch($mfn) || return;
370    
371  =head1 SUPPORT          my $out;
372    
373            foreach my $f (sort keys %{$row}) {
374                    my $dump = join('', @{ $row->{$f} });
375                    $dump =~ s/\x1e$//;
376                    $dump =~ s/\x1f/\$/g;
377                    $out .= "$f\t$dump\n";
378            }
379    
380            return $out;
381    }
382    
383    1;
384    __END__
385    
386  =head1 AUTHOR  =head1 AUTHOR
387    
# Line 326  LICENSE file included with this module. Line 401  LICENSE file included with this module.
401    
402  =head1 SEE ALSO  =head1 SEE ALSO
403    
404  perl(1).  L<Biblio::Isis>, perl(1).
405    
406  =cut  =cut

Legend:
Removed from v.6  
changed lines
  Added in v.23

  ViewVC Help
Powered by ViewVC 1.1.26