/[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 5 by dpavlin, Sat Oct 8 16:33:09 2005 UTC revision 18 by dpavlin, Mon Oct 29 22:33:35 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.08;
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 59  sub new { Line 73  sub new {
73          print STDERR "# opening ",$self->{marcdb},"\n" if ($self->{debug});          print STDERR "# opening ",$self->{marcdb},"\n" if ($self->{debug});
74    
75          open($self->{fh}, $self->{marcdb}) || croak "can't open ",$self->{marcdb},": $!";          open($self->{fh}, $self->{marcdb}) || croak "can't open ",$self->{marcdb},": $!";
76            binmode($self->{fh});
77    
78          $self->{count} = 0;          $self->{count} = 0;
79    
# Line 69  sub new { Line 84  sub new {
84                  push @{$self->{fh_offset}}, tell($self->{fh});                  push @{$self->{fh_offset}}, tell($self->{fh});
85    
86                  my $leader;                  my $leader;
87                  read($self->{fh}, $leader, 24);                  my $len = read($self->{fh}, $leader, 24);
88    
89                    if ($len < 24) {
90                            carp "short read of leader, aborting\n";
91                            last;
92                    }
93    
94                  # Byte        Name                  # Byte        Name
95                  # ----        ----                  # ----        ----
# Line 100  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                  seek($self->{fh},substr($leader,0,5)-24,1);                  my $o = substr($leader,0,5);
127                    if ($o > 24) {
128                            seek($self->{fh},$o-24,1) if ($o);
129                    } else {
130                            last;
131                    }
132    
133          }          }
134    
# Line 129  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            if ( ! $rec_nr ) {
167                    $self->{last_leader} = undef;
168                    return;
169            }
170    
171          my $leader = $self->{leaders}->[$rec_nr - 1];          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 196  sub fetch { Line 229  sub fetch {
229                  my $f = substr($fields,$addr,$len);                  my $f = substr($fields,$addr,$len);
230                  print STDERR "tag/len/addr $tag [$len] $addr: '$f'\n" if ($self->{debug});                  print STDERR "tag/len/addr $tag [$len] $addr: '$f'\n" if ($self->{debug});
231    
232                  if ($row->{$tag}) {                  push @{ $row->{$tag} }, $f;
                         $row->{$tag} .= $f;  
                 } else {  
                         $row->{$tag} = $f;  
                 }  
233    
234                  my $del = substr($fields,$addr+$len-1,1);                  my $del = substr($fields,$addr+$len-1,1);
235    
# Line 221  sub fetch { Line 250  sub fetch {
250          return $row;          return $row;
251  }  }
252    
 1;  
 __END__  
253    
254  =head1 BUGS  =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
275    
276    Read record with specified MFN and convert it to hash
277    
278  =head1 SUPPORT    my $hash = $marc->to_hash($mfn);
279    
280    It has ability to convert characters (using C<hash_filter>) from MARC
281    database before creating structures enabling character re-mapping or quick
282    fix-up of data.
283    
284    This function returns hash which is like this:
285    
286      '200' => [
287                 {
288                   'i1' => '1',
289                   'i2' => ' '
290                   'a' => 'Goa',
291                   'f' => 'Valdo D\'Arienzo',
292                   'e' => 'tipografie e tipografi nel XVI secolo',
293                 }
294               ],
295    
296    This method will also create additional field C<000> with MFN.
297    
298    =cut
299    
300    sub to_hash {
301            my $self = shift;
302    
303            my $mfn = shift || confess "need mfn!";
304    
305            # init record to include MFN as field 000
306            my $rec = { '000' => [ $mfn ] };
307    
308            my $row = $self->fetch($mfn) || return;
309    
310            foreach my $rec_nr (keys %{$row}) {
311                    foreach my $l (@{$row->{$rec_nr}}) {
312    
313                            # remove end marker
314                            $l =~ s/\x1E$//;
315    
316                            # filter output
317                            $l = $self->{'hash_filter'}->($l, $rec_nr) if ($self->{'hash_filter'});
318    
319                            my $val;
320    
321                            # has identifiers?
322                            ($val->{'i1'},$val->{'i2'}) = ($1,$2) if ($l =~ s/^([01 #])([01 #])\x1F/\x1F/);
323    
324                            # has subfields?
325                            if ($l =~ m/\x1F/) {
326                                    foreach my $t (split(/\x1F/,$l)) {
327                                            next if (! $t);
328                                            my $f = substr($t,0,1);
329                                            # repeatable subfileds. When we hit first one,
330                                            # store CURRENT (up to that) in first repetition
331                                            # of this record. Then, new record with same
332                                            # identifiers will be created.
333                                            if ($val->{$f}) {
334                                                    push @{$rec->{$rec_nr}}, $val;
335                                                    $val = {
336                                                            i1 => $val->{i1},
337                                                            i2 => $val->{i2},
338                                                    };
339                                            }
340                                            $val->{substr($t,0,1)} = substr($t,1);
341                                    }
342                            } else {
343                                    $val = $l;
344                            }
345    
346                            push @{$rec->{$rec_nr}}, $val;
347                    }
348            }
349    
350            return $rec;
351    }
352    
353    =head2 to_ascii
354    
355      print $marc->to_ascii( 42 );
356    
357    =cut
358    
359    sub to_ascii {
360            my $self = shift;
361    
362            my $mfn = shift || confess "need mfn";
363            my $row = $self->fetch($mfn) || return;
364    
365            my $out;
366    
367            foreach my $f (sort keys %{$row}) {
368                    my $dump = join('', @{ $row->{$f} });
369                    $dump =~ s/\x1e$//;
370                    $dump =~ s/\x1f/\$/g;
371                    $out .= "$f\t$dump\n";
372            }
373    
374            return $out;
375    }
376    
377    1;
378    __END__
379    
380  =head1 AUTHOR  =head1 AUTHOR
381    
# Line 250  LICENSE file included with this module. Line 395  LICENSE file included with this module.
395    
396  =head1 SEE ALSO  =head1 SEE ALSO
397    
398  perl(1).  L<Biblio::Isis>, perl(1).
399    
400  =cut  =cut
Legend:
Removed from v.5  
changed lines
  Added in v.18
  ViewVC Help
Powered by ViewVC 1.1.26