r1293@llin: dpavlin | 2007-06-22 01:46:20 +0200

[webpac2] / lib / WebPAC / Input / DBF.pm

diff --git a/lib/WebPAC/Input/DBF.pm b/lib/WebPAC/Input/DBF.pm
index 6563370..ecd5098 100644 (file)
--- a/lib/WebPAC/Input/DBF.pm
+++ b/lib/WebPAC/Input/DBF.pm
@@ -8,8 +8,7 @@ use base qw/WebPAC::Common/;
 use XBase;
 use Data::Dump qw/dump/;
 use Encode qw/encode_utf8/;
-use YAML;
-use File::Slurp;
+use YAML qw/LoadFile DumpFile/;
 
 =head1 NAME
 
@@ -40,6 +39,7 @@ Returns new low-level input API object
 
   my $ll_db = new WebPAC::Input::DBF(
        path => '/path/to/database.dbf'
+       mapping_path => '/path/to/input/dbf/mapping.yml',
        filter => sub {
                my ($l,$field_nr) = @_;
                # do something with $l which is line of input file
@@ -55,6 +55,10 @@ Options:
 
 path to DBF file
 
+=item mapping_path
+
+path to mapping YAML which will be created on first run
+
 =back
 
 =cut
@@ -68,16 +72,19 @@ sub new {
 
        my $log = $self->_get_logger();
 
+       $log->logconfess("this module requires input_config") unless ( $arg->{input_config} );
+
        my $db = XBase->new( $arg->{path} ) || $log->logdie("can't open ", $arg->{path}, ": $!");
 
        my $size = $db->last_record;
 
        $log->info("opening DBF database '$arg->{path}' with $size records");
 
-       my $mapping = $arg->{input_config}->{mapping};
+       my $mapping_path = $arg->{input_config}->{mapping_path};
+       my $mapping;
 
-       if ( ! $mapping ) {
-               $log->debug("didn't found any mapping file in configuration", sub { dump( $arg->{input_config} ) });
+       if ( ! $mapping_path ) {
+               $log->debug("didn't found any mapping_path in configuration", sub { dump( $arg->{input_config} ) });
 
                foreach my $field ( $db->field_names ) {
                        push @$mapping, { $field => { '900' => 'x' } };
@@ -88,13 +95,16 @@ sub new {
 
                $log->logdie("mapping file $mapping_path allready exists, aborting.") if ( -e $mapping_path );
 
-               write_file( $mapping_path, Dump( { mapping => $mapping } ) ) ||
+               DumpFile( $mapping_path, Dump( { mapping => $mapping } ) ) ||
                        $log->logdie("can't write template file for mapping_path $mapping_path: $!");
 
                $log->logdie("template file for mapping_path created as $mapping_path");
 
        } else {
-               $log->debug("using mapping ", sub { dump($mapping) });
+               $mapping = LoadFile( $mapping_path ) || $log->logdie("can't open $mapping_path: $!");
+               $log->logdie("missing top-level mapping key in $mapping_path") unless ( $mapping->{mapping} );
+               $mapping = $mapping->{mapping};
+               $log->debug("using mapping from $mapping_path = ", sub { dump($mapping) });
        }
 
        foreach my $mfn ( 1 .. $size ) {
@@ -107,6 +117,13 @@ sub new {
                        '001' => [ $mfn ],
                };
 
+               # fixme -- this *will* break given wrong structure!
+               foreach my $m ( @$mapping ) {
+                       my $db_field = (keys %$m)[0];
+                       my ( $f, $sf ) = %{ $m->{$db_field} };
+                       push @{ $record->{$f} }, '^' . $sf . $row->{$db_field} if ( defined( $row->{$db_field} ) && $row->{$db_field} ne '' );
+               }
+
                $self->{_rows}->{ $mfn } = $record;
                $log->debug("created row $mfn ", dump( $record ));
        }
@@ -159,8 +176,8 @@ sub size {
 Return hash from row. Taken from L<Biblio::Isis>
 
   my $rec = $ll_db->_to_hash(
-       mfn => $mfn;
-       $row
+       mfn => $mfn,
+       row => $row,
   );
 
 =cut