r1020@llin: dpavlin | 2006-09-26 14:40:34 +0200

 refactored WebPAC::Store

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

diff --git a/conf/log.conf b/conf/log.conf
index 69c0c83..023bd03 100644 (file)
--- a/conf/log.conf
+++ b/conf/log.conf
@@ -13,8 +13,8 @@ log4perl.logger.main=DEBUG
 
 #log4perl.logger.WebPAC.Store=DEBUG
 #log4perl.logger.WebPAC.Store.new=DEBUG
-#log4perl.logger.WebPAC.Store.save_ds=DEBUG
-#log4perl.logger.WebPAC.Store.load_ds=DEBUG
+log4perl.logger.WebPAC.Store.save_ds=DEBUG
+log4perl.logger.WebPAC.Store.load_ds=DEBUG
 
 #log4perl.logger.WebPAC.Lookup=DEBUG
 #log4perl.logger.WebPAC.Lookup.lookup=DEBUG

diff --git a/lib/WebPAC/Store.pm b/lib/WebPAC/Store.pm
index 46fc419..1acfa55 100644 (file)
--- a/lib/WebPAC/Store.pm
+++ b/lib/WebPAC/Store.pm
@@ -6,7 +6,7 @@ use strict;
 use base 'WebPAC::Common';
 use Storable;
 use File::Path;
-use Data::Dumper;
+use Data::Dump qw/dump/;
 
 =head1 NAME
 
@@ -14,11 +14,11 @@ WebPAC::Store - Store WebPAC data on disk
 
 =head1 VERSION
 
-Version 0.10
+Version 0.11
 
 =cut
 
-our $VERSION = '0.10';
+our $VERSION = '0.11';
 
 =head1 SYNOPSIS
 
@@ -59,7 +59,8 @@ in which cache file for C<data_structure> call will be created.
 If called with C<read_only> it will not disable caching if
 called without write permission (but will die on C<save_ds>).
 
-Mandatory parametar C<database> is used as subdirectory in database directory.
+Optional parametar C<database> will be used used as subdirectory in path if no
+database in specified when calling other functions.
 
 =cut
 
@@ -88,7 +89,9 @@ Check if specified cache directory exist, and if not, disable caching.
 If you pass false or zero value to this function, it will disable
 cacheing.
 
-You can also example C<< $db->{path} >> to get current cache path.
+You can also call this function to get current cache path.
+
+ my $cache_path = $db->path;
 
 =cut
 
@@ -96,6 +99,8 @@ sub path {
        my $self = shift;
 
        my $dir = shift;
+       
+       return $self->{path} unless defined($dir);
 
        my $log = $self->_get_logger();
 
@@ -131,13 +136,17 @@ sub path {
 
 Retrive from disk one data_structure records usually using field 000 as key
 
-  my $ds = $db->load_ds( id => 42, prefix => 'name', database => 'ps' );
+  my $ds = $db->load_ds(
+               database => 'ps',
+               input => 'name',
+               id => 42,
+  );
 
 This function will also perform basic sanity checking on returned
 data and disable caching if data is corrupted (or changed since last
 update).
 
-C<prefix> is used to differenciate different source input databases
+C<input> is used to differenciate different source input databases
 which are indexed in same database.
 
 C<database> if B<optional> argument which will override database name used when creating
@@ -168,11 +177,11 @@ sub load_ds {
        $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
 
        my $database = $args->{database} || $self->{database};
-       my $prefix = $args->{prefix} || '';
+       my $input = $args->{input} || '';
 
        $log->logconfess("can't find database name") unless ($database);
 
-       my $cache_file = "$cache_path/$database/$prefix/$id";
+       my $cache_file = "$cache_path/$database/$input/$id";
        $cache_file =~ s#//#/#go;
 
        $log->debug("using cache_file $cache_file");
@@ -201,8 +210,9 @@ sub load_ds {
 Store data_structure on disk.
 
   $db->save_ds(
+       database => 'name',
+       input => 'name',
        id => $ds->{000}->[0],
-       prefix => 'name',
        ds => $ds,
   );
 
@@ -219,60 +229,72 @@ sub save_ds {
 
        return unless($self->{'path'});
 
-       my $arg = {@_};
+       my $args = {@_};
 
        my $log = $self->_get_logger;
+       $log->debug("save_ds arguments:", dump( \@_ ));
 
        foreach my $f (qw/id ds/) {
-               $log->logconfess("need $f") unless ($arg->{$f});
+               $log->logconfess("need $f") unless (defined($args->{$f}));
        }
 
-       my $database = $self->{database};
+       my $database = $args->{database} || $self->{database};
        $log->logconfess("can't find database name") unless ($database);
 
-       my $prefix = $arg->{prefix} || '';
+       my $input = $args->{input} || '';
 
-       my $cache_file = $self->{path} . '/' . $prefix . '/';
+       my $cache_file = $self->{path} . "/$database/$input/";
        $cache_file =~ s#//#/#go;
 
        mkpath($cache_file) unless (-d $cache_file);
 
-       $cache_file .= $arg->{id};
+       $cache_file .= $args->{id};
 
        $log->debug("creating storable cache file $cache_file");
 
        return store {
-               ds => $arg->{ds},
-               id => $arg->{id},
+               ds => $args->{ds},
+               id => $args->{id},
        }, $cache_file;
 
 }
 
 =head2 save_lookup
 
-  $db->save_lookup( $database, $input, $key, $lookup );
+  $db->save_lookup(
+       database => $database,
+       input => $input,
+       key => $key,
+       data => $lookup,
+  );
 
 =cut
 
 sub save_lookup {
        my $self = shift;
-       my ($database, $input, $key, $lookup) = @_;
+       my $args = {@_};
 
        my $log = $self->_get_logger;
 
-       my $path = $self->{'path'} . "/lookup/$input";
+       foreach my $r (qw/input key data/) {
+               $log->logconfess("need '$r'") unless defined($args->{$r});
+       }
+
+       my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
+
+       my $path = $self->{path} . "/lookup/$database/" . $args->{input};
 
        mkpath($path) unless (-d $path);
 
-       $path .= "/$key";
+       $path .= "/" . $args->{key};
 
-       if (store $lookup, $path) {
+       if (store $args->{data}, $path) {
                $log->info("saved lookup $path");
+               return 1;
        } else {
-               $log->logwarn("can't store lookup $database/$input/$key in $path: $!");
+               $log->logwarn("can't store lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!");
+               return undef;
        }
-
-       
 }
 
 

diff --git a/run.pl b/run.pl
index 6b7311f..3b01e3f 100755 (executable)
--- a/run.pl
+++ b/run.pl
@@ -9,7 +9,7 @@ use lib './lib';
 use WebPAC::Common 0.02;
 use WebPAC::Parser 0.04;
 use WebPAC::Input 0.13;
-use WebPAC::Store 0.10;
+use WebPAC::Store 0.11;
 use WebPAC::Normalize 0.11;
 use WebPAC::Output::TT;
 use WebPAC::Validate 0.06;
@@ -285,7 +285,7 @@ while (my ($database, $db_config) = each %{ $config->databases }) {
        my $abs_path = abs_path($0);
        $abs_path =~ s#/[^/]*$#/#;
 
-       my $db_path = $config->get('webpac')->{db_path} . '/' . $database;
+       my $db_path = $config->webpac('db_path');
 
        if ($clean) {
                $log->info("creating new database '$database' in $db_path");
@@ -296,7 +296,6 @@ while (my ($database, $db_config) = each %{ $config->databases }) {
 
        my $store = new WebPAC::Store(
                path => $db_path,
-               database => $database,
                debug => $debug,
        );
 
@@ -395,7 +394,12 @@ while (my ($database, $db_config) = each %{ $config->databases }) {
                        $log->debug("created following lookups: ", dump( $lookup_data ));
 
                        foreach my $key (keys %{ $lookup_data->{$database}->{$input_name} }) {
-                               $store->save_lookup( $database, $input_name, $key, $lookup_data->{$database}->{$input_name}->{$key} );
+                               $store->save_lookup(
+                                       database => $database,
+                                       input => $input_name,
+                                       key => $key,
+                                       data => $lookup_data->{$database}->{$input_name}->{$key},
+                               );
                        }
                }
 
@@ -472,9 +476,10 @@ while (my ($database, $db_config) = each %{ $config->databases }) {
                                );
 
                                $store->save_ds(
+                                       database => $database,
+                                       input => $input_name,
                                        id => $mfn,
                                        ds => $ds,
-                                       prefix => $input_name,
                                ) if ($ds && !$stats);
 
                                $indexer->add(

diff --git a/t/4-store.t b/t/4-store.t
index 23d36a2..59450c6 100755 (executable)
--- a/t/4-store.t
+++ b/t/4-store.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 31;
+use Test::More tests => 37;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
@@ -17,8 +17,9 @@ $abs_path =~ s#/[^/]*$#/#;
 diag "abs_path: $abs_path";
 
 my $db;
-my $debug = 1;
+my $debug = shift @ARGV;
 my $no_log = 1;        # force no log output
+$no_log = 0 if ($debug);
 
 diag "NULL Store";
 
@@ -26,15 +27,15 @@ throws_ok { new WebPAC::Store() } qr/path/, 'new without path';
 
 throws_ok { new WebPAC::Store( path => '/tmp' ) } qr/database/, 'new without database';
 
-ok($db = new WebPAC::Store( path => '/tmp', database => '.', debug => $debug ), "new");
+ok($db = new WebPAC::Store( path => '/tmp', database => 'foobar', debug => $debug ), "new");
 
-ok(! $db->path, "path");
+cmp_ok($db->path, 'eq', '/tmp', "path");
 
-ok(! $db->load_ds(), 'load_ds');
+throws_ok { $db->load_ds() } qr/id/, 'load_ds without id';
 ok(! $db->load_ds( id => 000 ), 'load_ds');
 
-ok(! $db->save_ds(), "save_ds");
-ok(! $db->save_ds( id => 000 ), 'save_ds');
+throws_ok { $db->save_ds() } qr/id/, "save_ds without id";
+throws_ok { $db->save_ds( id => 000 ) } qr/ds/, 'save_ds without ds';
 
 undef $db;
 
@@ -42,9 +43,10 @@ ok(my $path = tempdir( CLEANUP => 1 ), "path");
 
 diag "Store path: $path";
 
-ok($db = new WebPAC::Store( path => $path, database => '.', debug => $debug, no_log => $no_log ), "new");
+ok($db = new WebPAC::Store( path => $path, database => 'webpac-test', debug => $debug, no_log => $no_log ), "new");
 
 cmp_ok($db->{'path'}, 'eq', $path, "path");
+cmp_ok($db->path, 'eq', $path, "path");
 
 ok(! $db->path(''), "path - disable caching");
 
@@ -89,11 +91,25 @@ is_deeply($ds, $ds2, "loaded data");
 
 ok(! $db->load_ds( id => 42 ), "load_ds non-existing");
 
-ok($db = new WebPAC::Store( path => $path, database => '.', debug => $debug, no_log => $no_log ), "new");
+ok($db = new WebPAC::Store( path => $path, database => 'webpac-test', debug => $debug, no_log => $no_log ), "new");
 
-ok(! $db->load_ds( id => 1, prefix => 'foobar' ), "load_ds with invalid prefix");
+ok(! $db->load_ds( id => 1, input => 'foobar' ), "load_ds with invalid input");
 
-ok($ds2 = $db->load_ds( id => 1, database => '.' ), "load_ds");
+ok(! $db->load_ds( id => 1, database => 'non-existant', ), "load_ds with unknown database");
+
+ok($ds2 = $db->load_ds( id => 1, database => 'webpac-test' ), "load_ds");
+
+my $l = {
+       foo => { 42 => 1 },
+};
+
+ok($db->save_lookup( input => 'foo', key => 'bar', data => $l ), "save_lookup");
+
+ok(-e $db->path . '/lookup/webpac-test/foo/bar', "exists");
+
+ok($db->save_lookup( database => 'baz', input => 'foo', key => 'bar', data => $l ), "save_lookup with database");
+
+ok(-e $db->path . '/lookup/baz/foo/bar', "exists");
 
 undef $db;