/[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 764 by dpavlin, Wed Oct 25 20:53:48 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.14
18    
19  =cut  =cut
20    
21  our $VERSION = '0.10';  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 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 83  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 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 = $store->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 = $store->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/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 200  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',
213            input => 'name',
214          id => $ds->{000}->[0],          id => $ds->{000}->[0],
         prefix => 'name',  
215          ds => $ds,          ds => $ds,
216    );    );
217    
218  B<Totally broken, but fast.>  C<database> and C<input> are optional.
   
 Depends on filename generated by C<load_ds>.  
219    
220  =cut  =cut
221    
# Line 219  sub save_ds { Line 226  sub save_ds {
226    
227          return unless($self->{'path'});          return unless($self->{'path'});
228    
229          my $arg = {@_};          my $args = {@_};
230    
231          my $log = $self->_get_logger;          my $log = $self->_get_logger;
232            $log->debug("save_ds arguments:", dump( \@_ ));
233    
234          foreach my $f (qw/id ds/) {          foreach my $f (qw/id ds/) {
235                  $log->logconfess("need $f") unless ($arg->{$f});                  $log->logconfess("need $f") unless (defined($args->{$f}));
236          }          }
237    
238          my $database = $self->{database};          my $database = $args->{database} || $self->{database};
239          $log->logconfess("can't find database name") unless ($database);          $log->logconfess("can't find database name") unless (defined($database));
240    
241          my $prefix = $arg->{prefix} || '';          my $input = $args->{input} || '';
242    
243          my $cache_file = $self->{path} . '/' . $prefix . '/';          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);
247    
248          $cache_file .= $arg->{id};          $cache_file .= $args->{id};
249    
250          $log->debug("creating storable cache file $cache_file");          $log->debug("creating storable cache file $cache_file");
251    
252          return store {          return store {
253                  ds => $arg->{ds},                  ds => $args->{ds},
254                  id => $arg->{id},                  id => $args->{id},
255          }, $cache_file;          }, $cache_file;
256    
257  }  }
258    
259    =head2 load_lookup
260    
261    Loads lookup hash from file
262    
263      $data = $store->load_lookup(
264            database => $database,
265            input => $input,
266            key => $key,
267      );
268    
269    C<database> is optional.
270    
271    =cut
272    
273    sub load_lookup {
274            my $self = shift;
275            my $args = {@_};
276    
277            my $log = $self->_get_logger;
278    
279            foreach my $r (qw/input key/) {
280                    $log->logconfess("need '$r'") unless defined($args->{$r});
281            }
282    
283            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
284    
285            my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key};
286    
287            if (! -e $path) {
288                    $log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input});
289                    return;
290            }
291    
292            if (my $data = retrieve($path)) {
293                    $log->info("loaded lookup $path");
294                    return $data;
295            } else {
296                    $log->logwarn("can't load lookup $database/", $args->{input}, "/", $args->{key}, " from $path: $!");
297                    return undef;
298            }
299    }
300    
301  =head2 save_lookup  =head2 save_lookup
302    
303    $db->save_lookup( $database, $input, $key, $lookup );  Save lookup data to file.
304    
305      $store->save_lookup(
306            database => $database,
307            input => $input,
308            key => $key,
309            data => $lookup,
310      );
311    
312    C<database> is optional.
313    
314  =cut  =cut
315    
316  sub save_lookup {  sub save_lookup {
317          my $self = shift;          my $self = shift;
318          my ($database, $input, $key, $lookup) = @_;          my $args = {@_};
319    
320          my $log = $self->_get_logger;          my $log = $self->_get_logger;
321    
322          my $path = $self->{'path'} . "/lookup/$input";          foreach my $r (qw/input key data/) {
323                    $log->logconfess("need '$r'") unless defined($args->{$r});
324            }
325    
326            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
327    
328            my $path = $self->{path} . "/lookup/$database/" . $args->{input};
329    
330          mkpath($path) unless (-d $path);          mkpath($path) unless (-d $path);
331    
332          $path .= "/$key";          $path .= "/" . $args->{key};
333    
334            my $t = time();
335    
336          if (store $lookup, $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 {          } else {
340                  $log->logwarn("can't store lookup $database/$input/$key in $path: $!");                  $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;
423            } else {
424                    $log->logwarn("can't save row to $path: $!");
425                    return undef;
426            }
427  }  }
428    
429    
# Line 282  Dobrica Pavlinusic, C<< <dpavlin@rot13.o Line 433  Dobrica Pavlinusic, C<< <dpavlin@rot13.o
433    
434  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
435    
436  Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.  Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved.
437    
438  This program is free software; you can redistribute it and/or modify it  This program is free software; you can redistribute it and/or modify it
439  under the same terms as Perl itself.  under the same terms as Perl itself.
Legend:
Removed from v.710  
changed lines
  Added in v.764
  ViewVC Help
Powered by ViewVC 1.1.26