/[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 6 by dpavlin, Sun Dec 18 23:12:26 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.02;
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 59  sub new { Line 59  sub new {
59          print STDERR "# opening ",$self->{marcdb},"\n" if ($self->{debug});          print STDERR "# opening ",$self->{marcdb},"\n" if ($self->{debug});
60    
61          open($self->{fh}, $self->{marcdb}) || croak "can't open ",$self->{marcdb},": $!";          open($self->{fh}, $self->{marcdb}) || croak "can't open ",$self->{marcdb},": $!";
62            binmode($self->{fh});
63    
64          $self->{count} = 0;          $self->{count} = 0;
65    
# Line 69  sub new { Line 70  sub new {
70                  push @{$self->{fh_offset}}, tell($self->{fh});                  push @{$self->{fh_offset}}, tell($self->{fh});
71    
72                  my $leader;                  my $leader;
73                  read($self->{fh}, $leader, 24);                  my $len = read($self->{fh}, $leader, 24);
74    
75                    if ($len < 24) {
76                            carp "short read of leader, aborting\n";
77                            last;
78                    }
79    
80                  # Byte        Name                  # Byte        Name
81                  # ----        ----                  # ----        ----
# Line 103  sub new { Line 109  sub new {
109                  push @{$self->{leaders}}, $leader;                  push @{$self->{leaders}}, $leader;
110    
111                  # skip to next record                  # skip to next record
112                  seek($self->{fh},substr($leader,0,5)-24,1);                  my $o = substr($leader,0,5);
113                    if ($o > 24) {
114                            seek($self->{fh},$o-24,1) if ($o);
115                    } else {
116                            last;
117                    }
118    
119          }          }
120    
# Line 196  sub fetch { Line 207  sub fetch {
207                  my $f = substr($fields,$addr,$len);                  my $f = substr($fields,$addr,$len);
208                  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});
209    
210                  $row->{$tag} = $f;                  push @{ $row->{$tag} }, $f;
211    
212                  my $del = substr($fields,$addr+$len-1,1);                  my $del = substr($fields,$addr+$len-1,1);
213    
# Line 217  sub fetch { Line 228  sub fetch {
228          return $row;          return $row;
229  }  }
230    
231    
232    =head2 to_hash
233    
234    Read record with specified MFN and convert it to hash
235    
236      my $hash = $marc->to_hash($mfn);
237    
238    It has ability to convert characters (using C<hash_filter>) from MARC
239    database before creating structures enabling character re-mapping or quick
240    fix-up of data.
241    
242    This function returns hash which is like this:
243    
244      '200' => [
245                 {
246                   'i1' => '1',
247                   'i2' => ' '
248                   'a' => 'Goa',
249                   'f' => 'Valdo D\'Arienzo',
250                   'e' => 'tipografie e tipografi nel XVI secolo',
251                 }
252               ],
253    
254    This method will also create additional field C<000> with MFN.
255    
256    =cut
257    
258    sub to_hash {
259            my $self = shift;
260    
261            my $mfn = shift || confess "need mfn!";
262    
263            # init record to include MFN as field 000
264            my $rec = { '000' => [ $mfn ] };
265    
266            my $row = $self->fetch($mfn) || return;
267    
268            foreach my $k (keys %{$row}) {
269                    foreach my $l (@{$row->{$k}}) {
270    
271                            # remove end marker
272                            $l =~ s/\x1E$//;
273    
274                            # filter output
275                            $l = $self->{'hash_filter'}->($l) if ($self->{'hash_filter'});
276    
277                            my $val;
278    
279                            # has identifiers?
280                            ($val->{'i1'},$val->{'i2'}) = ($1,$2) if ($l =~ s/^([01 #])([01 #])\x1F/\x1F/);
281    
282                            # has subfields?
283                            if ($l =~ m/\x1F/) {
284                                    foreach my $t (split(/\x1F/,$l)) {
285                                            next if (! $t);
286                                            $val->{substr($t,0,1)} = substr($t,1);
287                                    }
288                            } else {
289                                    $val = $l;
290                            }
291    
292                            push @{$rec->{$k}}, $val;
293                    }
294            }
295    
296            return $rec;
297    }
298    
299    
300  1;  1;
301  __END__  __END__
302    

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

  ViewVC Help
Powered by ViewVC 1.1.26