/[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 716 by dpavlin, Tue Sep 26 14:07:20 2006 UTC revision 853 by dpavlin, Sun May 27 14:09:30 2007 UTC
# 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.12  Version 0.14
18    
19  =cut  =cut
20    
21  our $VERSION = '0.12';  our $VERSION = '0.14';
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
# Line 38  For now, this is a prototype version. Line 38  For now, this is a prototype version.
38    
39      use WebPAC::Store;      use WebPAC::Store;
40    
41      my $foo = WebPAC::Store->new();      my $store = WebPAC::Store->new();
42      ...      ...
43    
44  =head1 FUNCTIONS  =head1 FUNCTIONS
# Line 47  For now, this is a prototype version. Line 47  For now, this is a prototype version.
47    
48  Create new normalised database object  Create new normalised database object
49    
50    my $db = new WebPAC::Store(    my $store = new WebPAC::Store(
51          path => '/path/to/cache/ds/',          path => '/path/to/cache/ds/',
52          database => 'name',          database => 'name',
53          read_only => 1,          read_only => 1,
# Line 84  sub new { Line 84  sub new {
84    
85  Check if specified cache directory exist, and if not, disable caching.  Check if specified cache directory exist, and if not, disable caching.
86    
87   $db->path('./cache/ds/');   $store->path('./cache/');
88    
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 call this function to get current cache path.  You can also call this function to get current cache path.
93    
94   my $cache_path = $db->path;   my $cache_path = $store->path;
95    
96  =cut  =cut
97    
# Line 136  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(    my $ds = $store->load_ds(
140                  database => 'ps',                  database => 'ps',
141                  input => 'name',                  input => 'name',
142                  id => 42,                  id => 42,
# Line 180  sub load_ds { Line 180  sub load_ds {
180    
181          my $input = $args->{input} || '';          my $input = $args->{input} || '';
182    
183          my $cache_file = "$cache_path/$database/$input/$id";          my $cache_file = "$cache_path/ds/$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 208  sub load_ds { Line 208  sub load_ds {
208    
209  Store data_structure on disk.  Store data_structure on disk.
210    
211    $db->save_ds(    $store->save_ds(
212          database => 'name',          database => 'name',
213          input => 'name',          input => 'name',
214          id => $ds->{000}->[0],          id => $ds->{000}->[0],
# Line 229  sub save_ds { Line 229  sub save_ds {
229          my $args = {@_};          my $args = {@_};
230    
231          my $log = $self->_get_logger;          my $log = $self->_get_logger;
232          $log->debug("save_ds arguments:", dump( \@_ ));          $log->debug("save_ds arguments:", sub { dump( \@_ ) });
233    
234          foreach my $f (qw/id ds/) {          foreach my $f (qw/id ds/) {
235                  $log->logconfess("need $f") unless (defined($args->{$f}));                  $log->logconfess("need $f") unless (defined($args->{$f}));
# Line 240  sub save_ds { Line 240  sub save_ds {
240    
241          my $input = $args->{input} || '';          my $input = $args->{input} || '';
242    
243          my $cache_file = $self->{path} . "/$database/$input/";          my $cache_file = $self->{path} . "/ds/$database/$input/";
244          $cache_file =~ s#//#/#go;          $cache_file =~ s#//#/#go;
245    
246          mkpath($cache_file) unless (-d $cache_file);          mkpath($cache_file) unless (-d $cache_file);
# Line 260  sub save_ds { Line 260  sub save_ds {
260    
261  Loads lookup hash from file  Loads lookup hash from file
262    
263    $data = $db->load_lookup(    $data = $store->load_lookup(
264          database => $database,          database => $database,
265          input => $input,          input => $input,
266          key => $key,          key => $key,
# Line 285  sub load_lookup { Line 285  sub load_lookup {
285          my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key};          my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key};
286    
287          if (! -e $path) {          if (! -e $path) {
288                  $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});
289                  return;                  return;
290          }          }
291    
# Line 302  sub load_lookup { Line 302  sub load_lookup {
302    
303  Save lookup data to file.  Save lookup data to file.
304    
305    $db->save_lookup(    $store->save_lookup(
306          database => $database,          database => $database,
307          input => $input,          input => $input,
308          key => $key,          key => $key,
# Line 331  sub save_lookup { Line 331  sub save_lookup {
331    
332          $path .= "/" . $args->{key};          $path .= "/" . $args->{key};
333    
334            my $t = time();
335    
336          if (store $args->{data}, $path) {          if (store $args->{data}, $path) {
337                  $log->info("saved lookup $path");                  $log->info(sprintf("saved lookup $path in %.2fs", time() - $t));
338                    return 1;
339            } else {
340                    $log->logwarn("can't save lookup to $path: $!");
341                    return undef;
342            }
343    }
344    
345    =head2 load_row
346    
347    Loads row from input database cache (used for lookups)
348    
349      $row = $store->load_row(
350            database => $database,
351            input => $input,
352            id => 42,
353      );
354    
355    C<database> is optional.
356    
357    =cut
358    
359    sub load_row {
360            my $self = shift;
361            my $args = {@_};
362    
363            my $log = $self->_get_logger;
364    
365            foreach my $r (qw/input id/) {
366                    $log->logconfess("need '$r'") unless defined($args->{$r});
367            }
368    
369            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
370    
371            my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id};
372    
373            if (! -e $path) {
374                    $log->warn("input row $path doesn't exist, skipping");
375                    return;
376            }
377    
378            if (my $data = retrieve($path)) {
379                    $log->debug("loaded row $path");
380                    return $data;
381            } else {
382                    $log->logwarn("can't load row from $path: $!");
383                    return undef;
384            }
385    }
386    
387    =head2 save_row
388    
389    Save row data to file.
390    
391      $store->save_row(
392            database => $database,
393            input => $input,
394            id => $mfn,
395            row => $lookup,
396      );
397    
398    C<database> is optional.
399    
400    =cut
401    
402    sub save_row {
403            my $self = shift;
404            my $args = {@_};
405    
406            my $log = $self->_get_logger;
407    
408            foreach my $r (qw/input id row/) {
409                    $log->logconfess("need '$r'") unless defined($args->{$r});
410            }
411    
412            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
413    
414            my $path = $self->{path} . "/row/$database/" . $args->{input};
415    
416            mkpath($path) unless (-d $path);
417    
418            $path .= "/" . $args->{id};
419    
420            if (store $args->{row}, $path) {
421                    $log->debug("saved row $path");
422                  return 1;                  return 1;
423          } else {          } else {
424                  $log->logwarn("can't save lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!");                  $log->logwarn("can't save row to $path: $!");
425                  return undef;                  return undef;
426          }          }
427  }  }
Legend:
Removed from v.716  
changed lines
  Added in v.853
  ViewVC Help
Powered by ViewVC 1.1.26