/[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 1 by dpavlin, Tue Jan 4 10:26:07 2005 UTC revision 8 by dpavlin, Wed Dec 28 22:16:39 2005 UTC
# 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.01;          $VERSION     = 0.03;
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 42  Read MARC database Line 42  Read MARC database
42          quiet => 0,          quiet => 0,
43          debug => 0,          debug => 0,
44          assert => 0,          assert => 0,
45            hash_filter => sub {
46                    my $t = shift;
47                    $t =~ s/foo/bar/;
48                    return $t;
49            },
50    );    );
51    
52  =cut  =cut
# Line 59  sub new { Line 64  sub new {
64          print STDERR "# opening ",$self->{marcdb},"\n" if ($self->{debug});          print STDERR "# opening ",$self->{marcdb},"\n" if ($self->{debug});
65    
66          open($self->{fh}, $self->{marcdb}) || croak "can't open ",$self->{marcdb},": $!";          open($self->{fh}, $self->{marcdb}) || croak "can't open ",$self->{marcdb},": $!";
67            binmode($self->{fh});
68    
69          $self->{count} = 0;          $self->{count} = 0;
70    
# Line 69  sub new { Line 75  sub new {
75                  push @{$self->{fh_offset}}, tell($self->{fh});                  push @{$self->{fh_offset}}, tell($self->{fh});
76    
77                  my $leader;                  my $leader;
78                  read($self->{fh}, $leader, 24);                  my $len = read($self->{fh}, $leader, 24);
79    
80                    if ($len < 24) {
81                            carp "short read of leader, aborting\n";
82                            last;
83                    }
84    
85                  # Byte        Name                  # Byte        Name
86                  # ----        ----                  # ----        ----
# Line 103  sub new { Line 114  sub new {
114                  push @{$self->{leaders}}, $leader;                  push @{$self->{leaders}}, $leader;
115    
116                  # skip to next record                  # skip to next record
117                  seek($self->{fh},substr($leader,0,5)-24,1);                  my $o = substr($leader,0,5);
118                    if ($o > 24) {
119                            seek($self->{fh},$o-24,1) if ($o);
120                    } else {
121                            last;
122                    }
123    
124          }          }
125    
# Line 196  sub fetch { Line 212  sub fetch {
212                  my $f = substr($fields,$addr,$len);                  my $f = substr($fields,$addr,$len);
213                  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});
214    
215                  $row->{$tag} = $f;                  push @{ $row->{$tag} }, $f;
216    
217                  my $del = substr($fields,$addr+$len-1,1);                  my $del = substr($fields,$addr+$len-1,1);
218    
# Line 217  sub fetch { Line 233  sub fetch {
233          return $row;          return $row;
234  }  }
235    
236    
237    =head2 to_hash
238    
239    Read record with specified MFN and convert it to hash
240    
241      my $hash = $marc->to_hash($mfn);
242    
243    It has ability to convert characters (using C<hash_filter>) from MARC
244    database before creating structures enabling character re-mapping or quick
245    fix-up of data.
246    
247    This function returns hash which is like this:
248    
249      '200' => [
250                 {
251                   'i1' => '1',
252                   'i2' => ' '
253                   'a' => 'Goa',
254                   'f' => 'Valdo D\'Arienzo',
255                   'e' => 'tipografie e tipografi nel XVI secolo',
256                 }
257               ],
258    
259    This method will also create additional field C<000> with MFN.
260    
261    =cut
262    
263    sub to_hash {
264            my $self = shift;
265    
266            my $mfn = shift || confess "need mfn!";
267    
268            # init record to include MFN as field 000
269            my $rec = { '000' => [ $mfn ] };
270    
271            my $row = $self->fetch($mfn) || return;
272    
273            foreach my $k (keys %{$row}) {
274                    foreach my $l (@{$row->{$k}}) {
275    
276                            # remove end marker
277                            $l =~ s/\x1E$//;
278    
279                            # filter output
280                            $l = $self->{'hash_filter'}->($l) if ($self->{'hash_filter'});
281    
282                            my $val;
283    
284                            # has identifiers?
285                            ($val->{'i1'},$val->{'i2'}) = ($1,$2) if ($l =~ s/^([01 #])([01 #])\x1F/\x1F/);
286    
287                            # has subfields?
288                            if ($l =~ m/\x1F/) {
289                                    foreach my $t (split(/\x1F/,$l)) {
290                                            next if (! $t);
291                                            my $f = substr($t,0,1);
292                                            # repeatable subfileds. When we hit first one,
293                                            # store CURRENT (up to that) in first repetition
294                                            # of this record. Then, new record with same
295                                            # identifiers will be created.
296                                            if ($val->{$f}) {
297                                                    push @{$rec->{$k}}, $val;
298                                                    $val = {
299                                                            i1 => $val->{i1},
300                                                            i2 => $val->{i2},
301                                                    };
302                                            }
303                                            $val->{substr($t,0,1)} = substr($t,1);
304                                    }
305                            } else {
306                                    $val = $l;
307                            }
308    
309                            push @{$rec->{$k}}, $val;
310                    }
311            }
312    
313            return $rec;
314    }
315    
316    
317  1;  1;
318  __END__  __END__
319    

Legend:
Removed from v.1  
changed lines
  Added in v.8

  ViewVC Help
Powered by ViewVC 1.1.26