r1263@llin: dpavlin | 2007-05-27 14:36:00 +0200

[webpac2] / lib / WebPAC / Store.pm

diff --git a/lib/WebPAC/Store.pm b/lib/WebPAC/Store.pm
index 61be62b..e9bbebc 100644 (file)
--- a/lib/WebPAC/Store.pm
+++ b/lib/WebPAC/Store.pm
@@ -14,11 +14,11 @@ WebPAC::Store - Store WebPAC data on disk
 
 =head1 VERSION
 
-Version 0.12
+Version 0.14
 
 =cut
 
-our $VERSION = '0.12';
+our $VERSION = '0.14';
 
 =head1 SYNOPSIS
 
@@ -38,7 +38,7 @@ For now, this is a prototype version.
 
     use WebPAC::Store;
 
-    my $foo = WebPAC::Store->new();
+    my $store = WebPAC::Store->new();
     ...
 
 =head1 FUNCTIONS
@@ -47,7 +47,7 @@ For now, this is a prototype version.
 
 Create new normalised database object
 
-  my $db = new WebPAC::Store(
+  my $store = new WebPAC::Store(
        path => '/path/to/cache/ds/',
        database => 'name',
        read_only => 1,
@@ -84,14 +84,14 @@ sub new {
 
 Check if specified cache directory exist, and if not, disable caching.
 
- $db->path('./cache/ds/');
+ $store->path('./cache/');
 
 If you pass false or zero value to this function, it will disable
 cacheing.
 
 You can also call this function to get current cache path.
 
- my $cache_path = $db->path;
+ my $cache_path = $store->path;
 
 =cut
 
@@ -136,7 +136,7 @@ sub path {
 
 Retrive from disk one data_structure records usually using field 000 as key
 
-  my $ds = $db->load_ds(
+  my $ds = $store->load_ds(
                database => 'ps',
                input => 'name',
                id => 42,
@@ -180,7 +180,7 @@ sub load_ds {
 
        my $input = $args->{input} || '';
 
-       my $cache_file = "$cache_path/$database/$input/$id";
+       my $cache_file = "$cache_path/ds/$database/$input/$id";
        $cache_file =~ s#//#/#go;
 
        $log->debug("using cache_file $cache_file");
@@ -208,16 +208,14 @@ sub load_ds {
 
 Store data_structure on disk.
 
-  $db->save_ds(
+  $store->save_ds(
        database => 'name',
        input => 'name',
        id => $ds->{000}->[0],
        ds => $ds,
   );
 
-B<Totally broken, but fast.>
-
-Depends on filename generated by C<load_ds>.
+C<database> and C<input> are optional.
 
 =cut
 
@@ -231,7 +229,7 @@ sub save_ds {
        my $args = {@_};
 
        my $log = $self->_get_logger;
-       $log->debug("save_ds arguments:", dump( \@_ ));
+       $log->debug("save_ds arguments:", sub { dump( \@_ ) });
 
        foreach my $f (qw/id ds/) {
                $log->logconfess("need $f") unless (defined($args->{$f}));
@@ -242,7 +240,7 @@ sub save_ds {
 
        my $input = $args->{input} || '';
 
-       my $cache_file = $self->{path} . "/$database/$input/";
+       my $cache_file = $self->{path} . "/ds/$database/$input/";
        $cache_file =~ s#//#/#go;
 
        mkpath($cache_file) unless (-d $cache_file);
@@ -260,12 +258,16 @@ sub save_ds {
 
 =head2 load_lookup
 
-  $data = $db->load_lookup(
+Loads lookup hash from file
+
+  $data = $store->load_lookup(
        database => $database,
        input => $input,
        key => $key,
   );
 
+C<database> is optional.
+
 =cut
 
 sub load_lookup {
@@ -283,7 +285,7 @@ sub load_lookup {
        my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key};
 
        if (! -e $path) {
-               $log->warn("lookup $path doesn't exist, skipping");
+               $log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input});
                return;
        }
 
@@ -298,13 +300,17 @@ sub load_lookup {
 
 =head2 save_lookup
 
-  $db->save_lookup(
+Save lookup data to file.
+
+  $store->save_lookup(
        database => $database,
        input => $input,
        key => $key,
        data => $lookup,
   );
 
+C<database> is optional.
+
 =cut
 
 sub save_lookup {
@@ -325,11 +331,97 @@ sub save_lookup {
 
        $path .= "/" . $args->{key};
 
+       my $t = time();
+
        if (store $args->{data}, $path) {
-               $log->info("saved lookup $path");
+               $log->info(sprintf("saved lookup $path in %.2fs", time() - $t));
+               return 1;
+       } else {
+               $log->logwarn("can't save lookup to $path: $!");
+               return undef;
+       }
+}
+
+=head2 load_row
+
+Loads row from input database cache (used for lookups)
+
+  $row = $store->load_row(
+       database => $database,
+       input => $input,
+       id => 42,
+  );
+
+C<database> is optional.
+
+=cut
+
+sub load_row {
+       my $self = shift;
+       my $args = {@_};
+
+       my $log = $self->_get_logger;
+
+       foreach my $r (qw/input id/) {
+               $log->logconfess("need '$r'") unless defined($args->{$r});
+       }
+
+       my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
+
+       my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id};
+
+       if (! -e $path) {
+               $log->warn("input row $path doesn't exist, skipping");
+               return;
+       }
+
+       if (my $data = retrieve($path)) {
+               $log->debug("loaded row $path");
+               return $data;
+       } else {
+               $log->logwarn("can't load row from $path: $!");
+               return undef;
+       }
+}
+
+=head2 save_row
+
+Save row data to file.
+
+  $store->save_row(
+       database => $database,
+       input => $input,
+       id => $mfn,
+       row => $lookup,
+  );
+
+C<database> is optional.
+
+=cut
+
+sub save_row {
+       my $self = shift;
+       my $args = {@_};
+
+       my $log = $self->_get_logger;
+
+       foreach my $r (qw/input id row/) {
+               $log->logconfess("need '$r'") unless defined($args->{$r});
+       }
+
+       my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
+
+       my $path = $self->{path} . "/row/$database/" . $args->{input};
+
+       mkpath($path) unless (-d $path);
+
+       $path .= "/" . $args->{id};
+
+       if (store $args->{row}, $path) {
+               $log->debug("saved row $path");
                return 1;
        } else {
-               $log->logwarn("can't save lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!");
+               $log->logwarn("can't save row to $path: $!");
                return undef;
        }
 }
@@ -341,7 +433,7 @@ Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
+Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved.
 
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.