/[webpac2]/trunk/lib/WebPAC/Store.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Store.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 710 by dpavlin, Mon Sep 25 18:58:43 2006 UTC revision 714 by dpavlin, Tue Sep 26 12:47:52 2006 UTC
# Line 6  use strict; Line 6  use strict;
6  use base 'WebPAC::Common';  use base 'WebPAC::Common';
7  use Storable;  use Storable;
8  use File::Path;  use File::Path;
9  use Data::Dumper;  use Data::Dump qw/dump/;
10    
11  =head1 NAME  =head1 NAME
12    
# Line 14  WebPAC::Store - Store WebPAC data on dis Line 14  WebPAC::Store - Store WebPAC data on dis
14    
15  =head1 VERSION  =head1 VERSION
16    
17  Version 0.10  Version 0.11
18    
19  =cut  =cut
20    
21  our $VERSION = '0.10';  our $VERSION = '0.11';
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
# Line 59  in which cache file for C<data_structure Line 59  in which cache file for C<data_structure
59  If called with C<read_only> it will not disable caching if  If called with C<read_only> it will not disable caching if
60  called without write permission (but will die on C<save_ds>).  called without write permission (but will die on C<save_ds>).
61    
62  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
63    database in specified when calling other functions.
64    
65  =cut  =cut
66    
# Line 70  sub new { Line 71  sub new {
71    
72          my $log = $self->_get_logger();          my $log = $self->_get_logger();
73    
74          foreach my $p (qw/path database/) {          foreach my $p (qw/path/) {
75                  $log->logconfess("need $p") unless ($self->{$p});                  $log->logconfess("need $p") unless ($self->{$p});
76          }          }
77    
# Line 88  Check if specified cache directory exist Line 89  Check if specified cache directory exist
89  If you pass false or zero value to this function, it will disable  If you pass false or zero value to this function, it will disable
90  cacheing.  cacheing.
91    
92  You can also example C<< $db->{path} >> to get current cache path.  You can also call this function to get current cache path.
93    
94     my $cache_path = $db->path;
95    
96  =cut  =cut
97    
# Line 96  sub path { Line 99  sub path {
99          my $self = shift;          my $self = shift;
100    
101          my $dir = shift;          my $dir = shift;
102            
103            return $self->{path} unless defined($dir);
104    
105          my $log = $self->_get_logger();          my $log = $self->_get_logger();
106    
# Line 131  sub path { Line 136  sub path {
136    
137  Retrive from disk one data_structure records usually using field 000 as key  Retrive from disk one data_structure records usually using field 000 as key
138    
139    my $ds = $db->load_ds( id => 42, prefix => 'name', database => 'ps' );    my $ds = $db->load_ds(
140                    database => 'ps',
141                    input => 'name',
142                    id => 42,
143      );
144    
145  This function will also perform basic sanity checking on returned  This function will also perform basic sanity checking on returned
146  data and disable caching if data is corrupted (or changed since last  data and disable caching if data is corrupted (or changed since last
147  update).  update).
148    
149  C<prefix> is used to differenciate different source input databases  C<input> is used to differenciate different source input databases
150  which are indexed in same database.  which are indexed in same database.
151    
152  C<database> if B<optional> argument which will override database name used when creating  C<database> if B<optional> argument which will override database name used when creating
# Line 167  sub load_ds { Line 176  sub load_ds {
176          $log->logconfess("got hash, but without id") unless (defined($id));          $log->logconfess("got hash, but without id") unless (defined($id));
177          $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);          $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
178    
179          my $database = $args->{database} || $self->{database};          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
         my $prefix = $args->{prefix} || '';  
180    
181          $log->logconfess("can't find database name") unless ($database);          my $input = $args->{input} || '';
182    
183          my $cache_file = "$cache_path/$database/$prefix/$id";          my $cache_file = "$cache_path/$database/$input/$id";
184          $cache_file =~ s#//#/#go;          $cache_file =~ s#//#/#go;
185    
186          $log->debug("using cache_file $cache_file");          $log->debug("using cache_file $cache_file");
# Line 201  sub load_ds { Line 209  sub load_ds {
209  Store data_structure on disk.  Store data_structure on disk.
210    
211    $db->save_ds(    $db->save_ds(
212            database => 'name',
213            input => 'name',
214          id => $ds->{000}->[0],          id => $ds->{000}->[0],
         prefix => 'name',  
215          ds => $ds,          ds => $ds,
216    );    );
217    
# Line 219  sub save_ds { Line 228  sub save_ds {
228    
229          return unless($self->{'path'});          return unless($self->{'path'});
230    
231          my $arg = {@_};          my $args = {@_};
232    
233          my $log = $self->_get_logger;          my $log = $self->_get_logger;
234            $log->debug("save_ds arguments:", dump( \@_ ));
235    
236          foreach my $f (qw/id ds/) {          foreach my $f (qw/id ds/) {
237                  $log->logconfess("need $f") unless ($arg->{$f});                  $log->logconfess("need $f") unless (defined($args->{$f}));
238          }          }
239    
240          my $database = $self->{database};          my $database = $args->{database} || $self->{database};
241          $log->logconfess("can't find database name") unless ($database);          $log->logconfess("can't find database name") unless (defined($database));
242    
243          my $prefix = $arg->{prefix} || '';          my $input = $args->{input} || '';
244    
245          my $cache_file = $self->{path} . '/' . $prefix . '/';          my $cache_file = $self->{path} . "/$database/$input/";
246          $cache_file =~ s#//#/#go;          $cache_file =~ s#//#/#go;
247    
248          mkpath($cache_file) unless (-d $cache_file);          mkpath($cache_file) unless (-d $cache_file);
249    
250          $cache_file .= $arg->{id};          $cache_file .= $args->{id};
251    
252          $log->debug("creating storable cache file $cache_file");          $log->debug("creating storable cache file $cache_file");
253    
254          return store {          return store {
255                  ds => $arg->{ds},                  ds => $args->{ds},
256                  id => $arg->{id},                  id => $args->{id},
257          }, $cache_file;          }, $cache_file;
258    
259  }  }
260    
261  =head2 save_lookup  =head2 save_lookup
262    
263    $db->save_lookup( $database, $input, $key, $lookup );    $db->save_lookup(
264            database => $database,
265            input => $input,
266            key => $key,
267            data => $lookup,
268      );
269    
270  =cut  =cut
271    
272  sub save_lookup {  sub save_lookup {
273          my $self = shift;          my $self = shift;
274          my ($database, $input, $key, $lookup) = @_;          my $args = {@_};
275    
276          my $log = $self->_get_logger;          my $log = $self->_get_logger;
277    
278          my $path = $self->{'path'} . "/lookup/$input";          foreach my $r (qw/input key data/) {
279                    $log->logconfess("need '$r'") unless defined($args->{$r});
280            }
281    
282            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
283    
284            my $path = $self->{path} . "/lookup/$database/" . $args->{input};
285    
286          mkpath($path) unless (-d $path);          mkpath($path) unless (-d $path);
287    
288          $path .= "/$key";          $path .= "/" . $args->{key};
289    
290          if (store $lookup, $path) {          if (store $args->{data}, $path) {
291                  $log->info("saved lookup $path");                  $log->info("saved lookup $path");
292                    return 1;
293          } else {          } else {
294                  $log->logwarn("can't store lookup $database/$input/$key in $path: $!");                  $log->logwarn("can't store lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!");
295                    return undef;
296          }          }
   
           
297  }  }
298    
299    
Legend:
Removed from v.710  
changed lines
  Added in v.714
  ViewVC Help
Powered by ViewVC 1.1.26