/[webpac2]/trunk/lib/WebPAC/Input/Gutenberg.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/WebPAC/Input/Gutenberg.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 779 by dpavlin, Sun Nov 5 14:52:04 2006 UTC revision 871 by dpavlin, Thu Jun 21 23:54:42 2007 UTC
# Line 4  use warnings; Line 4  use warnings;
4  use strict;  use strict;
5    
6  use WebPAC::Input;  use WebPAC::Input;
7  use base qw/WebPAC::Common/;  use WebPAC::Input::Helper;
8    use base qw/WebPAC::Common WebPAC::Input::Helper/;
9  use XML::LibXML;  use XML::LibXML;
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
11  use Encode qw/encode_utf8/;  use Encode qw/encode_utf8/;
# Line 15  WebPAC::Input::Gutenberg - support for R Line 16  WebPAC::Input::Gutenberg - support for R
16    
17  =head1 VERSION  =head1 VERSION
18    
19  Version 0.01  Version 0.02
20    
21  =cut  =cut
22    
23  our $VERSION = '0.01';  our $VERSION = '0.02';
24    
25    
26  =head1 SYNOPSIS  =head1 SYNOPSIS
# Line 165  sub size { Line 166  sub size {
166          return $self->{size};          return $self->{size};
167  }  }
168    
 =head2 _to_hash  
   
 Return hash from row. Taken from L<Biblio::Isis>  
   
   my $rec = $ll_db->_to_hash(  
         mfn => $mfn;  
         $row  
   );  
   
 =cut  
   
 sub _to_hash {  
         my $self = shift;  
   
         my $arg = {@_};  
   
         my $log = $self->_get_logger();  
   
         my $hash_filter = $arg->{hash_filter};  
         my $mfn = $arg->{mfn} || $log->logconfess("need mfn in arguments");  
         my $row = $arg->{row} || $log->logconfess("need row in arguments");  
   
         # init record to include MFN as field 000  
         my $rec = { '000' => [ $mfn ] };  
   
         foreach my $f_nr (keys %{$row}) {  
                 foreach my $l (@{$row->{$f_nr}}) {  
   
                         # filter output  
                         $l = $hash_filter->($l, $f_nr) if ($hash_filter);  
                         next unless defined($l);  
   
                         my $val;  
                         my $r_sf;       # repeatable subfields in this record  
   
                         # has subfields?  
                         if ($l =~ m/\^/) {  
                                 foreach my $t (split(/\^/,$l)) {  
                                         next if (! $t);  
                                         my ($sf,$v) = (substr($t,0,1), substr($t,1));  
                                         next unless (defined($v) && $v ne '');  
   
                                         if (ref( $val->{$sf} ) eq 'ARRAY') {  
   
                                                 push @{ $val->{$sf} }, $v;  
   
                                                 # record repeatable subfield it it's offset  
                                                 push @{ $val->{subfields} }, ( $sf, $#{ $val->{$sf} } );  
                                                 $r_sf->{$sf}++;  
   
                                         } elsif (defined( $val->{$sf} )) {  
   
                                                 # convert scalar field to array  
                                                 $val->{$sf} = [ $val->{$sf}, $v ];  
   
                                                 push @{ $val->{subfields} }, ( $sf, 1 );  
                                                 $r_sf->{$sf}++;  
   
                                         } else {  
                                                 $val->{$sf} = $v;  
                                                 push @{ $val->{subfields} }, ( $sf, 0 );  
                                         }  
                                 }  
                         } else {  
                                 $val = $l;  
                         }  
   
                         push @{$rec->{$f_nr}}, $val;  
                 }  
         }  
   
         return $rec;  
 }  
   
169  =head1 AUTHOR  =head1 AUTHOR
170    
171  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.779  
changed lines
  Added in v.871
  ViewVC Help
Powered by ViewVC 1.1.26