/[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 209 by dpavlin, Mon Dec 5 17:46:57 2005 UTC revision 1083 by dpavlin, Sun Dec 23 19:41:10 2007 UTC
# Line 3  package WebPAC::Store; Line 3  package WebPAC::Store;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use base 'WebPAC::Common';  use WebPAC::Common;
7    use base qw/WebPAC::Common Class::Accessor/;
8    __PACKAGE__->mk_accessors(qw/database/);
9    
10  use Storable;  use Storable;
11    use File::Path;
12    use Data::Dump qw/dump/;
13    
14  =head1 NAME  =head1 NAME
15    
16  WebPAC::Store - Store normalized data on disk  WebPAC::Store - Store WebPAC data on disk
17    
18  =head1 VERSION  =head1 VERSION
19    
20  Version 0.03  Version 0.15
21    
22  =cut  =cut
23    
24  our $VERSION = '0.03';  our $VERSION = '0.15';
25    
26  =head1 SYNOPSIS  =head1 SYNOPSIS
27    
28  This module provides disk storage for normalised data.  This module provides disk storage for normalised data and lookups.
29    
30    It is one of newer components of WebPAC, so it will change from time to
31    time.
32    
33  It is newest component of WebPAC, so it will change quite often or be in  I will try to keep backward compatiblity by providing multiple back-ends,
34  flux. However, I will try to keep backward compatiblity by providing  but this can't be garanteed. In other words, don't delete your input
35  multiple back-ends.  databases just yet :-)
36    
37  This has additional advantage. I can create single place to plugin other  This has additional advantage. I can create single place to plugin other
38  file formats which provide better performance for particular type of data.  file formats which provide better performance for particular type of data.
39    
 For now, this is a prototype version.  
   
     use WebPAC::Store;  
   
     my $foo = WebPAC::Store->new();  
     ...  
   
40  =head1 FUNCTIONS  =head1 FUNCTIONS
41    
42  =head2 new  =head2 new
43    
44  Create new normalised database object  Create new normalised database object
45    
46    my $db = new WebPAC::Store(    my $store = new WebPAC::Store({
47          path => '/path/to/cache/ds/',          database => 'name',
48          read_only => 1,    });
   );  
49    
50  Optional parameter C<path> defines path to directory  Optional parameter C<path> defines path to directory
51  in which cache file for C<data_structure> call will be created.  in which cache file for C<data_structure> call will be created.
52    
53  If called with C<read_only> it will not disable caching if  Optional parametar C<database> will be used used as subdirectory in path if no
54  called without write permission (but will die on C<save_ds>).  database in specified when calling other functions.
55    
56  =cut  =cut
57    
58  sub new {  =head2 load_ds
         my $class = shift;  
         my $self = {@_};  
         bless($self, $class);  
   
         $self->path( $self->{'path'} );  
59    
60          $self ? return $self : return undef;  Retrive from disk one data_structure records usually using field 000 as key
 }  
61    
62  =head2 path    my $ds = $store->load_ds(
63                    database => 'ps',
64                    input => 'name',
65                    id => 42,
66      );
67    
68  Check if specified cache directory exist, and if not, disable caching.  This function will also perform basic sanity checking on returned
69    data and disable caching if data is corrupted (or changed since last
70    update).
71    
72   $db->path('./cache/ds/');  C<input> is used to differenciate different source input databases
73    which are indexed in same database.
74    
75  If you pass false or zero value to this function, it will disable  C<database> if B<optional> argument which will override database name used when creating
76  cacheing.  C<WebPAC::Store> object (for simple retrival from multiple databases).
77    
78  You can also example C<< $db->{path} >> to get current cache path.  Returns hash or undef if cacheing is disabled or unavailable.
79    
80  =cut  =cut
81    
82  sub path {  sub load_ds {
83          my $self = shift;          my $self = shift;
84    
85          my $dir = shift;          my $log = $self->_get_logger;
86    
87            $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
88    
89          my $log = $self->_get_logger();          my $args = {@_};
90            my $id = $args->{id};
91    
92          if ($dir) {          $log->logconfess("got hash, but without id") unless (defined($id));
93                  my $msg;          $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
94                  if (! -e $dir) {  
95                          $msg = "doesn't exist";          my $database = $args->{database} || $self->database || $log->logconfess("no database?");
96                  } elsif (! -d $dir) {  
97                          $msg = "is not directory";          my $input = $args->{input} || '';
                 } elsif (! -w $dir) {  
                         $msg = "not writable" unless ($self->{'read_only'});  
                 }  
98    
99                  if ($msg) {          my $cache_file = $self->var_path( 'ds', $database, $input, $id );
100                          $log->warn("cache path $dir $msg, disabling...");  
101                          undef $self->{'path'};          $log->debug("using cache_file $cache_file");
102                  } else {  
103                          $log->debug("using cache dir $dir");          if (-r $cache_file) {
104                          $self->{'path'} = $dir;                  my $ds_ref = retrieve($cache_file);
105                    if ($ds_ref) {
106                            $log->debug("cache hit: $cache_file");
107                            if ($ds_ref->{'ds'}) {
108                                    return $ds_ref->{'ds'};
109                            } else {
110                                    $log->warn("cache entry $cache_file corrupt. Use rm $cache_file to re-create it on next run!");
111                            }
112                  }                  }
113          } else {          } else {
114                  $log->debug("disabling cache");                  #$log->warn("cache entry $cache_file doesn't exist");
115                  undef $self->{'path'};                  return undef;
116          }          }
117    
118            return undef;
119  }  }
120    
121  =head2 load_ds  =head2 save_ds
122    
123    Store data_structure on disk.
124    
125      $store->save_ds(
126            database => 'name',
127            input => 'name',
128            id => $ds->{000}->[0],
129            ds => $ds,
130      );
131    
132  Retrive from disk one data_structure records using field 000 as key  C<database> and C<input> are optional.
133    
134    my $ds = $db->load_ds( 42 );  =cut
135    
136  There is also a more verbose form, similar to C<save_ds>  sub save_ds {
137            my $self = shift;
138    
139    my $ds = $db->load_ds( id => 42 );          my $args = {@_};
140    
141  This function will also perform basic sanity checking on returned          my $log = $self->_get_logger;
142  data and disable caching if data is corrupted (or changed since last          $log->debug("save_ds arguments:", sub { dump( \@_ ) });
 update).  
143    
144  Returns hash or undef if cacheing is disabled or unavailable.          foreach my $f (qw/id ds/) {
145                    $log->logconfess("need $f") unless (defined($args->{$f}));
146            }
147    
148            my $database = $args->{database} || $self->{database};
149            $log->logconfess("can't find database name") unless (defined($database));
150    
151            my $input = $args->{input} || '';
152    
153            my $cache_file = $self->var_path( 'ds', $database, $input );
154    
155            mkpath($cache_file) unless (-d $cache_file);
156    
157            $cache_file = $self->var_path( 'ds', $database, $input, $args->{id} );
158    
159            $log->debug("creating storable cache file $cache_file");
160    
161            return store {
162                    ds => $args->{ds},
163                    id => $args->{id},
164            }, $cache_file;
165    
166    }
167    
168    =head2 load_lookup
169    
170    Loads lookup hash from file
171    
172      $data = $store->load_lookup(
173            database => $database,
174            input => $input,
175            key => $key,
176      );
177    
178    C<database> is optional.
179    
180  =cut  =cut
181    
182  sub load_ds {  sub load_lookup {
183          my $self = shift;          my $self = shift;
184            my $args = {@_};
         return unless $self->{'path'};  
185    
186          my $log = $self->_get_logger;          my $log = $self->_get_logger;
187    
188          my $cache_path = $self->{'path'};          foreach my $r (qw/input key/) {
189                    $log->logconfess("need '$r'") unless defined($args->{$r});
190            }
191    
192          my $id = shift;          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
193          if (lc($id) eq 'id') {  
194                  $id = shift;          my $path = $self->var_path( 'lookup', $database, $args->{input}, $args->{key} );
195                  $log->logconfess("got hash, but without key id") unless (defined($id));  
196                  $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);          if (! -e $path) {
197                    $log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input});
198                    return;
199          }          }
200    
201          if (! defined($id)) {          if (my $data = retrieve($path)) {
202                  $log->warn("called without id");                  $log->info("loaded lookup $path ", -s $path, " bytes");
203                  return undef;                  return $data;
204          } else {          } else {
205                  my $cache_file = "$cache_path/$id";                  $log->logwarn("can't load lookup $database/", $args->{input}, "/", $args->{key}, " from $path: $!");
206                  if (-r $cache_file) {                  return undef;
                         my $ds_ref = retrieve($cache_file);  
                         if ($ds_ref) {  
                                 $log->debug("cache hit: $cache_file");  
                                 my $ok = 1;  
 #                               foreach my $f (qw(current_filename headline)) {  
 #                                       if ($ds_ref->{$f}) {  
 #                                               $self->{$f} = $ds_ref->{$f};  
 #                                       } else {  
 #                                               $ok = 0;  
 #                                       }  
 #                               };  
                                 if ($ok && $ds_ref->{'ds'}) {  
                                         return $ds_ref->{'ds'};  
                                 } else {  
                                         $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");  
                                         undef $self->{'path'};  
                                 }  
                         }  
                 } else {  
                         #$log->warn("cache entry $cache_file doesn't exist");  
                         return undef;  
                 }  
207          }          }
   
         return undef;  
208  }  }
209    
210  =head2 save_ds  =head2 save_lookup
211    
212  Store data_structure on disk.  Save lookup data to file.
213    
214    $db->save_ds(    $store->save_lookup(
215          id => $ds->{000}->[0],          database => $database,
216          ds => $ds,          input => $input,
217            key => $key,
218            data => $lookup,
219    );    );
220    
221  B<Totally broken, but fast.>  C<database> is optional.
222    
223    =cut
224    
225    sub save_lookup {
226            my $self = shift;
227            my $args = {@_};
228    
229            my $log = $self->_get_logger;
230    
231            foreach my $r (qw/input key data/) {
232                    $log->logconfess("need '$r'") unless defined($args->{$r});
233            }
234    
235            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
236    
237            my $path = $self->var_path( 'lookup', $database, $args->{input} );
238    
239            mkpath($path) unless (-d $path);
240    
241            $path .= "/" . $args->{key};
242    
243  Depends on filename generated by C<load_ds>.          my $t = time();
244    
245            if (store $args->{data}, $path) {
246                    $log->info(sprintf("saved lookup %s %d bytes in %.2fs", $path, -s $path, time() - $t));
247                    return 1;
248            } else {
249                    $log->logwarn("can't save lookup to $path: $!");
250                    return undef;
251            }
252    }
253    
254    =head2 load_row
255    
256    Loads row from input database cache (used for lookups)
257    
258      $row = $store->load_row(
259            database => $database,
260            input => $input,
261            id => 42,
262      );
263    
264    C<database> is optional.
265    
266  =cut  =cut
267    
268  sub save_ds {  sub load_row {
269          my $self = shift;          my $self = shift;
270            my $args = {@_};
271    
272            my $log = $self->_get_logger;
273    
274            foreach my $r (qw/input id/) {
275                    $log->logconfess("need '$r'") unless defined($args->{$r});
276            }
277    
278            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
279    
280          die "can't write to database in read_only mode!" if ($self->{'read_only'});          my $path = $self->var_path( 'row', $database, $args->{input}, $args->{id} );
281    
282          return unless($self->{'path'});          if (! -e $path) {
283                    $log->warn("input row $path doesn't exist, skipping");
284                    return;
285            }
286    
287            if (my $data = retrieve($path)) {
288                    $log->debug("loaded row $path");
289                    return $data;
290            } else {
291                    $log->logwarn("can't load row from $path: $!");
292                    return undef;
293            }
294    }
295    
296          my $arg = {@_};  =head2 save_row
297    
298    Save row data to file.
299    
300      $store->save_row(
301            database => $database,
302            input => $input,
303            id => $mfn,
304            row => $lookup,
305      );
306    
307    C<database> is optional.
308    
309    =cut
310    
311    sub save_row {
312            my $self = shift;
313            my $args = {@_};
314    
315          my $log = $self->_get_logger;          my $log = $self->_get_logger;
316    
317          foreach my $f (qw/id ds/) {          foreach my $r (qw/input id row/) {
318                  $log->logconfess("need $f") unless ($arg->{$f});                  $log->logconfess("need '$r'") unless defined($args->{$r});
319          }          }
320    
321          my $cache_file = $self->{path} . '/' . $arg->{id};          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
322    
323          $log->debug("creating storable cache file $cache_file");          my $path = $self->var_path( 'row', $database, $args->{input} );
324    
325          return store {          mkpath($path) unless (-d $path);
                 ds => $arg->{ds},  
                 id => $arg->{id},  
         }, $cache_file;  
326    
327            $path .= "/" . $args->{id};
328    
329            if (store $args->{row}, $path) {
330                    $log->debug("saved row $path");
331                    return 1;
332            } else {
333                    $log->logwarn("can't save row to $path: $!");
334                    return undef;
335            }
336  }  }
337    
338    
339  =head1 AUTHOR  =head1 AUTHOR
340    
341  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
342    
343  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
344    
345  Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.  Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved.
346    
347  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
348  under the same terms as Perl itself.  under the same terms as Perl itself.
Legend:
Removed from v.209  
changed lines
  Added in v.1083
  ViewVC Help
Powered by ViewVC 1.1.26