r9088@llin: dpavlin | 2005-11-24 12:20:36 +0100

 API 0.02: load_ds and save_ds now accept id => 42 as arguments

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

diff --git a/lib/WebPAC/DB.pm b/lib/WebPAC/DB.pm
index f9e58e0..d8cc0ef 100644 (file)
--- a/lib/WebPAC/DB.pm
+++ b/lib/WebPAC/DB.pm
@@ -12,11 +12,11 @@ WebPAC::DB - Store normalized data on disk
 
 =head1 VERSION
 
-Version 0.01
+Version 0.02
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 =head1 SYNOPSIS
 
@@ -74,6 +74,8 @@ 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.
+
 =cut
 
 sub path {
@@ -110,7 +112,11 @@ sub path {
 
 Retrive from disk one data_structure records using field 000 as key
 
-  my $ds = $db->load_ds($rec);
+  my $ds = $db->load_ds( 42 );
+
+There is also a more verbose form, similar to C<save_ds>
+
+  my $ds = $db->load_ds( id => 42 );
 
 This function will also perform basic sanity checking on returned
 data and disable caching if data is corrupted (or changed since last
@@ -125,42 +131,43 @@ sub load_ds {
 
        return unless $self->{'path'};
 
-       my $rec = shift || return;
-
        my $log = $self->_get_logger;
 
        my $cache_path = $self->{'path'};
 
-       my $id = $rec;
-       $id = $rec->{'000'} if (ref($id) eq 'HASH');
-       $id = $rec->{'000'}->[0] if (ref($id) eq 'ARRAY');
+       my $id = shift;
+       if (lc($id) eq 'id') {
+               $id = shift;
+               $log->logconfess("got hash, but without key id") unless (defined($id));
+               $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);
+       }
 
-       unless (defined($id)) {
-               $log->warn("Can't use cacheing on records without unique identifier in field 000");
-               undef $self->{'path'};
+       if (! defined($id)) {
+               $log->warn("called without id");
+               return undef;
        } else {
                my $cache_file = "$cache_path/$id";
-               $self->{'cache_file'} = $cache_file;
                if (-r $cache_file) {
                        my $ds_ref = retrieve($cache_file);
                        if ($ds_ref) {
                                $log->debug("cache hit: $cache_file");
                                my $ok = 1;
-                               foreach my $f (qw(current_filename headline)) {
-                                       if ($ds_ref->{$f}) {
-                                               $self->{$f} = $ds_ref->{$f};
-                                       } else {
-                                               $ok = 0;
-                                       }
-                               };
+#                              foreach my $f (qw(current_filename headline)) {
+#                                      if ($ds_ref->{$f}) {
+#                                              $self->{$f} = $ds_ref->{$f};
+#                                      } else {
+#                                              $ok = 0;
+#                                      }
+#                              };
                                if ($ok && $ds_ref->{'ds'}) {
                                        return $ds_ref->{'ds'};
                                } else {
-                                       $log->warn("cache entry $cache_path corrupt. Use rm $cache_path/* to re-create it on next run!");
+                                       $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
                                        undef $self->{'path'};
                                }
                        }
                } else {
+                       $log->warn("cache entry $cache_file doesn't exist");
                        return undef;
                }
        }
@@ -173,9 +180,8 @@ sub load_ds {
 Store data_structure on disk.
 
   $db->save_ds(
+       id => $ds->{000}->[0],
        ds => $ds,
-       current_filename => $self->{'current_filename'},
-       headline => $self->{'headline'},
   );
 
 B<Totally broken, but fast.>
@@ -190,28 +196,23 @@ sub save_ds {
        die "can't write to database in read_only mode!" if ($self->{'read_only'});
 
        return unless($self->{'path'});
-       return unless (@_);
 
        my $arg = {@_};
 
        my $log = $self->_get_logger;
 
-       $log->logdie("save_ds without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});
-
-       $log->logdie("need ds") unless ($arg->{ds});
-
-       foreach my $e (qw/current_filename headline/) {
-               my $mfn = $arg->{ds}->{000}->[0] || '?';
-               $log->warn("missing $e in record $mfn") unless $arg->{$e};
+       foreach my $f (qw/id ds/) {
+               $log->logconfess("need $f") unless ($arg->{$f});
        }
 
-       $log->debug("creating storable cache file ",$self->{'cache_file'});
+       my $cache_file = $self->{path} . '/' . $arg->{id};
+
+       $log->debug("creating storable cache file $cache_file");
 
-       store {
-               ds => $arg->{'ds'},
-               current_filename => $arg->{'current_filename'},
-               headline => $arg->{'headline'},
-       }, $self->{'cache_file'};
+       return store {
+               ds => $arg->{ds},
+               id => $arg->{id},
+       }, $cache_file;
 
 }
 

diff --git a/t/4-db.t b/t/4-db.t
index 08f662c..cdff0f8 100755 (executable)
--- a/t/4-db.t
+++ b/t/4-db.t
@@ -1,11 +1,12 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 26;
+use Test::More tests => 25;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
 use File::Temp qw/tempdir/;
 use strict;
+use Data::Dumper;
 
 BEGIN {
 use_ok( 'WebPAC::DB' );
@@ -17,18 +18,19 @@ diag "abs_path: $abs_path";
 
 my $db;
 my $debug = 1;
+my $no_log = 1;        # force no log output
 
 diag "NULL DB";
 
-ok($db = new WebPAC::DB( debug => $debug, no_log => 1, ), "new");
+ok($db = new WebPAC::DB( debug => $debug, ), "new");
 
 ok(! $db->path, "path");
 
 ok(! $db->load_ds(), 'load_ds');
-ok(! $db->load_ds({ '000' => '000' }), 'load_ds');
+ok(! $db->load_ds( id => 000 ), 'load_ds');
 
 ok(! $db->save_ds(), "save_ds");
-ok(! $db->save_ds({ '000' => '000' }), 'save_ds');
+ok(! $db->save_ds( id => 000 ), 'save_ds');
 
 undef $db;
 
@@ -36,7 +38,7 @@ ok(my $path = tempdir( CLEANUP => 1 ), "path");
 
 diag "DB path: $path";
 
-ok($db = new WebPAC::DB( path => $path, debug => $debug, no_log => 1 ), "new");
+ok($db = new WebPAC::DB( path => $path, debug => $debug, no_log => $no_log ), "new");
 
 cmp_ok($db->{'path'}, 'eq', $path, "path");
 
@@ -49,9 +51,9 @@ ok($db->path( $path ), "path($path)");
 cmp_ok($db->{'path'}, 'eq', $path, "path");
 
 ok(! $db->load_ds(), 'load_ds');
-ok(! $db->load_ds({ '000' => '000' }), 'load_ds');
+ok(! $db->load_ds( id => 000 ), 'load_ds');
 
-ok(! $db->save_ds(), "save_ds");
+throws_ok { $db->save_ds() } qr/id/, "save_ds - need id";
 
 my $ds = {
        'Source' => {
@@ -65,23 +67,21 @@ my $ds = {
                'swish' => [ 'bar' ],
                'lookup_key' => [ 'bar' ]
        },
-       'filename' => [ 'out/thes/001.html' ],
-       'name' => 'filename',
-       'tag' => 'filename'
 };
 
-ok(! $db->save_ds(), "empty save_ds");
-throws_ok { $db->save_ds( foo => 1 ) } qr/ds/, "save_ds - ds";
-throws_ok { $db->save_ds( ds => $ds ) } qr/current_filename/, "save_ds - current_filename";
-throws_ok { $db->save_ds( ds => $ds, 'current_filename' => 'foo' ) } qr/headline/, "save_ds - headline";
+throws_ok { $db->save_ds( id => 1 ) } qr/ds/, "save_ds - need ds";
+
+ok($db->save_ds( id => 1, ds => $ds ), "save_ds");
 
-ok($db->save_ds( ds => $ds, 'current_filename' => 'foo', 'headline' => 'bar' ), "save_ds");
+ok(my $ds2 = $db->load_ds( id => 1 ), "load_ds with id");
+
+is_deeply($ds, $ds2, "loaded data");
 
-ok(my $ds2 = $db->load_ds({ '000' => '000' }), "load_ds");
+ok($ds2 = $db->load_ds( 1 ), "load_ds without id");
 
 is_deeply($ds, $ds2, "loaded data");
 
-ok(! $db->load_ds({ '000' => 42 }), "load_ds non-existing");
+ok(! $db->load_ds( id => 42 ), "load_ds non-existing");
 
 undef $db;