/[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 215 by dpavlin, Mon Dec 5 17:47:39 2005 UTC revision 715 by dpavlin, Tue Sep 26 14:03:12 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::Dump qw/dump/;
10    
11  =head1 NAME  =head1 NAME
12    
13  WebPAC::Store - Store normalized data on disk  WebPAC::Store - Store WebPAC data on disk
14    
15  =head1 VERSION  =head1 VERSION
16    
17  Version 0.04  Version 0.12
18    
19  =cut  =cut
20    
21  our $VERSION = '0.04';  our $VERSION = '0.12';
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
25  This module provides disk storage for normalised data.  This module provides disk storage for normalised data and lookups.
26    
27  It is newest component of WebPAC, so it will change quite often or be in  It is one of newer components of WebPAC, so it will change from time to
28  flux. However, I will try to keep backward compatiblity by providing  time.
29  multiple back-ends.  
30    I will try to keep backward compatiblity by providing multiple back-ends,
31    but this can't be garanteed. In other words, don't delete your input
32    databases just yet :-)
33    
34  This has additional advantage. I can create single place to plugin other  This has additional advantage. I can create single place to plugin other
35  file formats which provide better performance for particular type of data.  file formats which provide better performance for particular type of data.
# Line 45  Create new normalised database object Line 49  Create new normalised database object
49    
50    my $db = new WebPAC::Store(    my $db = new WebPAC::Store(
51          path => '/path/to/cache/ds/',          path => '/path/to/cache/ds/',
52            database => 'name',
53          read_only => 1,          read_only => 1,
54    );    );
55    
# Line 54  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    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    
67  sub new {  sub new {
68          my $class = shift;          my $class = shift;
69          my $self = {@_};          my $self = {@_};
70          bless($self, $class);          bless($self, $class);
71    
72            my $log = $self->_get_logger();
73    
74            foreach my $p (qw/path/) {
75                    $log->logconfess("need $p") unless ($self->{$p});
76            }
77    
78          $self->path( $self->{'path'} );          $self->path( $self->{'path'} );
79    
# Line 75  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 83  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 116  sub path { Line 134  sub path {
134    
135  =head2 load_ds  =head2 load_ds
136    
137  Retrive from disk one data_structure records using field 000 as key  Retrive from disk one data_structure records usually using field 000 as key
   
   my $ds = $db->load_ds( 42 );  
   
 There is also a more verbose form, similar to C<save_ds>  
138    
139    my $ds = $db->load_ds( id => 42 );    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<input> is used to differenciate different source input databases
150    which are indexed in same database.
151    
152    C<database> if B<optional> argument which will override database name used when creating
153    C<WebPAC::Store> object (for simple retrival from multiple databases).
154    
155  Returns hash or undef if cacheing is disabled or unavailable.  Returns hash or undef if cacheing is disabled or unavailable.
156    
157  =cut  =cut
# Line 135  Returns hash or undef if cacheing is dis Line 159  Returns hash or undef if cacheing is dis
159  sub load_ds {  sub load_ds {
160          my $self = shift;          my $self = shift;
161    
         return unless $self->{'path'};  
   
162          my $log = $self->_get_logger;          my $log = $self->_get_logger;
163    
164          my $cache_path = $self->{'path'};          my $cache_path = $self->{'path'};
165    
166          my $id = shift;          if (! $cache_path) {
167          if (lc($id) eq 'id') {                  $log->warn("path not set, ignoring load_ds");
168                  $id = shift;                  return;
                 $log->logconfess("got hash, but without key id") unless (defined($id));  
                 $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);  
169          }          }
170    
171          if (! defined($id)) {          $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
172                  $log->warn("called without id");  
173                  return undef;          my $args = {@_};
174          } else {          my $id = $args->{id};
175                  my $cache_file = "$cache_path/$id";  
176                  if (-r $cache_file) {          $log->logconfess("got hash, but without id") unless (defined($id));
177                          my $ds_ref = retrieve($cache_file);          $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
178                          if ($ds_ref) {  
179                                  $log->debug("cache hit: $cache_file");          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
180                                  my $ok = 1;  
181  #                               foreach my $f (qw(current_filename headline)) {          my $input = $args->{input} || '';
182  #                                       if ($ds_ref->{$f}) {  
183  #                                               $self->{$f} = $ds_ref->{$f};          my $cache_file = "$cache_path/$database/$input/$id";
184  #                                       } else {          $cache_file =~ s#//#/#go;
185  #                                               $ok = 0;  
186  #                                       }          $log->debug("using cache_file $cache_file");
187  #                               };  
188                                  if ($ok && $ds_ref->{'ds'}) {          if (-r $cache_file) {
189                                          return $ds_ref->{'ds'};                  my $ds_ref = retrieve($cache_file);
190                                  } else {                  if ($ds_ref) {
191                                          $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");                          $log->debug("cache hit: $cache_file");
192                                          undef $self->{'path'};                          if ($ds_ref->{'ds'}) {
193                                  }                                  return $ds_ref->{'ds'};
194                            } else {
195                                    $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
196                                    undef $self->{'path'};
197                          }                          }
                 } else {  
                         #$log->warn("cache entry $cache_file doesn't exist");  
                         return undef;  
198                  }                  }
199            } else {
200                    #$log->warn("cache entry $cache_file doesn't exist");
201                    return undef;
202          }          }
203    
204          return undef;          return undef;
# Line 186  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],
215          ds => $ds,          ds => $ds,
216    );    );
# Line 203  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 $cache_file = $self->{path} . '/' . $arg->{id};          my $database = $args->{database} || $self->{database};
241            $log->logconfess("can't find database name") unless (defined($database));
242    
243            my $input = $args->{input} || '';
244    
245            my $cache_file = $self->{path} . "/$database/$input/";
246            $cache_file =~ s#//#/#go;
247    
248            mkpath($cache_file) unless (-d $cache_file);
249    
250            $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 load_lookup
262    
263      $data = $db->load_lookup(
264            database => $database,
265            input => $input,
266            key => $key,
267      );
268    
269    =cut
270    
271    sub load_lookup {
272            my $self = shift;
273            my $args = {@_};
274    
275            my $log = $self->_get_logger;
276    
277            foreach my $r (qw/input key/) {
278                    $log->logconfess("need '$r'") unless defined($args->{$r});
279            }
280    
281            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
282    
283            my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key};
284    
285            if (! -e $path) {
286                    $log->warn("lookup $path doesn't exist, skipping");
287                    return;
288            }
289    
290            if (my $data = retrieve($path)) {
291                    $log->info("loaded lookup $path");
292                    return $data;
293            } else {
294                    $log->logwarn("can't load lookup $database/", $args->{input}, "/", $args->{key}, " from $path: $!");
295                    return undef;
296            }
297    }
298    
299    =head2 save_lookup
300    
301      $db->save_lookup(
302            database => $database,
303            input => $input,
304            key => $key,
305            data => $lookup,
306      );
307    
308    =cut
309    
310    sub save_lookup {
311            my $self = shift;
312            my $args = {@_};
313    
314            my $log = $self->_get_logger;
315    
316            foreach my $r (qw/input key data/) {
317                    $log->logconfess("need '$r'") unless defined($args->{$r});
318            }
319    
320            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
321    
322            my $path = $self->{path} . "/lookup/$database/" . $args->{input};
323    
324            mkpath($path) unless (-d $path);
325    
326            $path .= "/" . $args->{key};
327    
328            if (store $args->{data}, $path) {
329                    $log->info("saved lookup $path");
330                    return 1;
331            } else {
332                    $log->logwarn("can't save lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!");
333                    return undef;
334            }
335    }
336    
337    
338  =head1 AUTHOR  =head1 AUTHOR
339    
340  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.215  
changed lines
  Added in v.715
  ViewVC Help
Powered by ViewVC 1.1.26