/[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 218 by dpavlin, Mon Dec 5 17:48:00 2005 UTC revision 713 by dpavlin, Tue Sep 26 12:42:49 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    
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.06  Version 0.11
18    
19  =cut  =cut
20    
21  our $VERSION = '0.06';  our $VERSION = '0.11';
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 56  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    
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();          my $log = $self->_get_logger();
73    
# Line 85  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 93  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 128  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' );    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
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 161  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 = $self->{database};          my $database = $args->{database} || $self->{database};
180          my $prefix = $args->{prefix} || '';          my $input = $args->{input} || '';
181    
182          $log->logconfess("can't find database name") unless ($database);          $log->logconfess("can't find database name") unless ($database);
183    
184          my $cache_file = "$cache_path/$prefix/$database#$id";          my $cache_file = "$cache_path/$database/$input/$id";
185          $cache_file =~ s#//#/#go;          $cache_file =~ s#//#/#go;
186    
 open(my $fh, '>>', '/tmp/foo');  
 print $fh "$cache_file\n";  
 close($fh);  
   
187          $log->debug("using cache_file $cache_file");          $log->debug("using cache_file $cache_file");
188    
189          if (-r $cache_file) {          if (-r $cache_file) {
# Line 199  close($fh); Line 210  close($fh);
210  Store data_structure on disk.  Store data_structure on disk.
211    
212    $db->save_ds(    $db->save_ds(
213            database => 'name',
214            input => 'name',
215          id => $ds->{000}->[0],          id => $ds->{000}->[0],
         prefix => 'name',  
216          ds => $ds,          ds => $ds,
217    );    );
218    
# Line 217  sub save_ds { Line 229  sub save_ds {
229    
230          return unless($self->{'path'});          return unless($self->{'path'});
231    
232          my $arg = {@_};          my $args = {@_};
233    
234          my $log = $self->_get_logger;          my $log = $self->_get_logger;
235            $log->debug("save_ds arguments:", dump( \@_ ));
236    
237          foreach my $f (qw/id ds/) {          foreach my $f (qw/id ds/) {
238                  $log->logconfess("need $f") unless ($arg->{$f});                  $log->logconfess("need $f") unless (defined($args->{$f}));
239          }          }
240    
241          my $database = $self->{database};          my $database = $args->{database} || $self->{database};
242          $log->logconfess("can't find database name") unless ($database);          $log->logconfess("can't find database name") unless ($database);
243    
244          my $prefix = $arg->{prefix} || '';          my $input = $args->{input} || '';
245    
246          my $cache_file = $self->{path} . "/$prefix/$database#" . $arg->{id};          my $cache_file = $self->{path} . "/$database/$input/";
247          $cache_file =~ s#//#/#go;          $cache_file =~ s#//#/#go;
248    
249            mkpath($cache_file) unless (-d $cache_file);
250    
251            $cache_file .= $args->{id};
252    
253          $log->debug("creating storable cache file $cache_file");          $log->debug("creating storable cache file $cache_file");
254    
255          return store {          return store {
256                  ds => $arg->{ds},                  ds => $args->{ds},
257                  id => $arg->{id},                  id => $args->{id},
258          }, $cache_file;          }, $cache_file;
259    
260  }  }
261    
262    =head2 save_lookup
263    
264      $db->save_lookup(
265            database => $database,
266            input => $input,
267            key => $key,
268            data => $lookup,
269      );
270    
271    =cut
272    
273    sub save_lookup {
274            my $self = shift;
275            my $args = {@_};
276    
277            my $log = $self->_get_logger;
278    
279            foreach my $r (qw/input key data/) {
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};
286    
287            mkpath($path) unless (-d $path);
288    
289            $path .= "/" . $args->{key};
290    
291            if (store $args->{data}, $path) {
292                    $log->info("saved lookup $path");
293                    return 1;
294            } else {
295                    $log->logwarn("can't store lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!");
296                    return undef;
297            }
298    }
299    
300    
301  =head1 AUTHOR  =head1 AUTHOR
302    
303  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.218  
changed lines
  Added in v.713
  ViewVC Help
Powered by ViewVC 1.1.26