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

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

revision 869 by dpavlin, Thu Jun 21 21:26:19 2007 UTC revision 870 by dpavlin, Thu Jun 21 23:54:41 2007 UTC
# Line 8  use base qw/WebPAC::Common/; Line 8  use base qw/WebPAC::Common/;
8  use XBase;  use XBase;
9  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
10  use Encode qw/encode_utf8/;  use Encode qw/encode_utf8/;
11  use YAML;  use YAML qw/LoadFile DumpFile/;
 use File::Slurp;  
12    
13  =head1 NAME  =head1 NAME
14    
# Line 40  Returns new low-level input API object Line 39  Returns new low-level input API object
39    
40    my $ll_db = new WebPAC::Input::DBF(    my $ll_db = new WebPAC::Input::DBF(
41          path => '/path/to/database.dbf'          path => '/path/to/database.dbf'
42            mapping_path => '/path/to/input/dbf/mapping.yml',
43          filter => sub {          filter => sub {
44                  my ($l,$field_nr) = @_;                  my ($l,$field_nr) = @_;
45                  # do something with $l which is line of input file                  # do something with $l which is line of input file
# Line 55  Options: Line 55  Options:
55    
56  path to DBF file  path to DBF file
57    
58    =item mapping_path
59    
60    path to mapping YAML which will be created on first run
61    
62  =back  =back
63    
64  =cut  =cut
# Line 68  sub new { Line 72  sub new {
72    
73          my $log = $self->_get_logger();          my $log = $self->_get_logger();
74    
75            $log->logconfess("this module requires input_config") unless ( $arg->{input_config} );
76    
77          my $db = XBase->new( $arg->{path} ) || $log->logdie("can't open ", $arg->{path}, ": $!");          my $db = XBase->new( $arg->{path} ) || $log->logdie("can't open ", $arg->{path}, ": $!");
78    
79          my $size = $db->last_record;          my $size = $db->last_record;
80    
81          $log->info("opening DBF database '$arg->{path}' with $size records");          $log->info("opening DBF database '$arg->{path}' with $size records");
82    
83          my $mapping = $arg->{input_config}->{mapping};          my $mapping_path = $arg->{input_config}->{mapping_path};
84            my $mapping;
85    
86          if ( ! $mapping ) {          if ( ! $mapping_path ) {
87                  $log->debug("didn't found any mapping file in configuration", sub { dump( $arg->{input_config} ) });                  $log->debug("didn't found any mapping_path in configuration", sub { dump( $arg->{input_config} ) });
88    
89                  foreach my $field ( $db->field_names ) {                  foreach my $field ( $db->field_names ) {
90                          push @$mapping, { $field => { '900' => 'x' } };                          push @$mapping, { $field => { '900' => 'x' } };
# Line 88  sub new { Line 95  sub new {
95    
96                  $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 );
97    
98                  write_file( $mapping_path, Dump( { mapping => $mapping } ) ) ||                  DumpFile( $mapping_path, Dump( { mapping => $mapping } ) ) ||
99                          $log->logdie("can't write template file for mapping_path $mapping_path: $!");                          $log->logdie("can't write template file for mapping_path $mapping_path: $!");
100    
101                  $log->logdie("template file for mapping_path created as $mapping_path");                  $log->logdie("template file for mapping_path created as $mapping_path");
102    
103          } else {          } else {
104                  $log->debug("using mapping ", sub { dump($mapping) });                  $mapping = LoadFile( $mapping_path ) || $log->logdie("can't open $mapping_path: $!");
105                    $log->logdie("missing top-level mapping key in $mapping_path") unless ( $mapping->{mapping} );
106                    $mapping = $mapping->{mapping};
107                    $log->debug("using mapping from $mapping_path = ", sub { dump($mapping) });
108          }          }
109    
110          foreach my $mfn ( 1 .. $size ) {          foreach my $mfn ( 1 .. $size ) {
# Line 107  sub new { Line 117  sub new {
117                          '001' => [ $mfn ],                          '001' => [ $mfn ],
118                  };                  };
119    
120                    # fixme -- this *will* break given wrong structure!
121                    foreach my $m ( @$mapping ) {
122                            my $db_field = (keys %$m)[0];
123                            my ( $f, $sf ) = %{ $m->{$db_field} };
124                            push @{ $record->{$f} }, '^' . $sf . $row->{$db_field} if ( defined( $row->{$db_field} ) && $row->{$db_field} ne '' );
125                    }
126    
127                  $self->{_rows}->{ $mfn } = $record;                  $self->{_rows}->{ $mfn } = $record;
128                  $log->debug("created row $mfn ", dump( $record ));                  $log->debug("created row $mfn ", dump( $record ));
129          }          }
# Line 159  sub size { Line 176  sub size {
176  Return hash from row. Taken from L<Biblio::Isis>  Return hash from row. Taken from L<Biblio::Isis>
177    
178    my $rec = $ll_db->_to_hash(    my $rec = $ll_db->_to_hash(
179          mfn => $mfn;          mfn => $mfn,
180          $row          row => $row,
181    );    );
182    
183  =cut  =cut
Legend:
Removed from v.869  
changed lines
  Added in v.870
  ViewVC Help
Powered by ViewVC 1.1.26