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

 finish dbf input

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@870 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/conf/log.conf b/conf/log.conf
index a386072..a51161c 100644 (file)
--- a/conf/log.conf
+++ b/conf/log.conf
@@ -38,6 +38,7 @@ log4perl.rootLogger=INFO, LOG, SCREEN
 #log4perl.logger.WebPAC.Input.ISIS.fetch=DEBUG
 #log4perl.logger.WebPAC.Input.ISIS.open=DEBUG
 #log4perl.logger.WebPAC.Input.Gutenberg=DEBUG
+#log4perl.logger.WebPAC.Input.DBF=DEBUG
 
 #log4perl.logger.WebPAC.Normalize.=DEBUG
 #log4perl.logger.WebPAC.Normalize.new=DEBUG

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

diff --git a/t/2-input-dbf.t b/t/2-input-dbf.t
index 25728de..4ae1597 100755 (executable)
--- a/t/2-input-dbf.t
+++ b/t/2-input-dbf.t
@@ -15,7 +15,7 @@ use_ok( 'WebPAC::Input' );
 }
 
 ok(my $abs_path = abs_path($0), "abs_path");
-$abs_path =~ s#/[^/]*$#/#;
+$abs_path =~ s#/[^/]*$#/#;     #fix-vim        
 
 my $module = 'WebPAC::Input::DBF';
 diag "testing with $module", $debug ? ' with debug' : '';
@@ -30,9 +30,7 @@ ok(my $input = new WebPAC::Input(
 ok(my $db = $input->open(
        path => "$abs_path/data/cas2000.dbf",
        input_config => {
-               xmapping => [
-                       { 'foobar' => [ '200', 'a' ] },
-               ],
+               mapping_path => "$abs_path/conf/input/dbf/cas2000.yml",
        },
 ), "open");
 ok(my $size = $input->size, "size");