/[webpac2]/branches/Sack/lib/WebPAC/Input/DBF.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 /branches/Sack/lib/WebPAC/Input/DBF.pm

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

revision 870 by dpavlin, Thu Jun 21 23:54:41 2007 UTC revision 873 by dpavlin, Fri Jun 22 00:03:46 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 XBase;  use XBase;
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
11  use Encode qw/encode_utf8/;  use Encode qw/encode_utf8/;
# Line 80  sub new { Line 81  sub new {
81    
82          $log->info("opening DBF database '$arg->{path}' with $size records");          $log->info("opening DBF database '$arg->{path}' with $size records");
83    
84          my $mapping_path = $arg->{input_config}->{mapping_path};          my $mapping_path = $arg->{input_config}->{mapping_path} || $self->{input_config}->{mapping_path};
85          my $mapping;          my $mapping;
86    
87          if ( ! $mapping_path ) {          if ( ! $mapping_path || ! -e $mapping_path ) {
88                  $log->debug("didn't found any mapping_path in configuration", sub { dump( $arg->{input_config} ) });                  $log->debug("didn't found any mapping_path in configuration", sub { dump( $arg->{input_config} ) });
89    
90                  foreach my $field ( $db->field_names ) {                  foreach my $field ( $db->field_names ) {
# Line 95  sub new { Line 96  sub new {
96    
97                  $log->logdie("mapping file $mapping_path allready exists, aborting.") if ( -e $mapping_path );                  $log->logdie("mapping file $mapping_path allready exists, aborting.") if ( -e $mapping_path );
98    
99                  DumpFile( $mapping_path, Dump( { mapping => $mapping } ) ) ||                  DumpFile( $mapping_path, { mapping => $mapping } ) ||
100                          $log->logdie("can't write template file for mapping_path $mapping_path: $!");                          $log->logdie("can't write template file for mapping_path $mapping_path: $!");
101    
102                  $log->logdie("template file for mapping_path created as $mapping_path");                  $log->logdie("template file for mapping_path created as $mapping_path");
# Line 171  sub size { Line 172  sub size {
172          return $self->{size};          return $self->{size};
173  }  }
174    
 =head2 _to_hash  
   
 Return hash from row. Taken from L<Biblio::Isis>  
   
   my $rec = $ll_db->_to_hash(  
         mfn => $mfn,  
         row => $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;  
 }  
   
175  =head1 AUTHOR  =head1 AUTHOR
176    
177  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.870  
changed lines
  Added in v.873
  ViewVC Help
Powered by ViewVC 1.1.26