/[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 710 by dpavlin, Mon Sep 25 18:58:43 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;
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.10
18    
19  =cut  =cut
20    
21  our $VERSION = '0.04';  our $VERSION = '0.10';
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    Mandatory parametar C<database> is used as subdirectory in database directory.
63    
64  =cut  =cut
65    
66  sub new {  sub new {
67          my $class = shift;          my $class = shift;
68          my $self = {@_};          my $self = {@_};
69          bless($self, $class);          bless($self, $class);
70    
71            my $log = $self->_get_logger();
72    
73            foreach my $p (qw/path database/) {
74                    $log->logconfess("need $p") unless ($self->{$p});
75            }
76    
77          $self->path( $self->{'path'} );          $self->path( $self->{'path'} );
78    
# Line 116  sub path { Line 129  sub path {
129    
130  =head2 load_ds  =head2 load_ds
131    
132  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
133    
134    my $ds = $db->load_ds( 42 );    my $ds = $db->load_ds( id => 42, prefix => 'name', database => 'ps' );
   
 There is also a more verbose form, similar to C<save_ds>  
   
   my $ds = $db->load_ds( id => 42 );  
135    
136  This function will also perform basic sanity checking on returned  This function will also perform basic sanity checking on returned
137  data and disable caching if data is corrupted (or changed since last  data and disable caching if data is corrupted (or changed since last
138  update).  update).
139    
140    C<prefix> is used to differenciate different source input databases
141    which are indexed in same database.
142    
143    C<database> if B<optional> argument which will override database name used when creating
144    C<WebPAC::Store> object (for simple retrival from multiple databases).
145    
146  Returns hash or undef if cacheing is disabled or unavailable.  Returns hash or undef if cacheing is disabled or unavailable.
147    
148  =cut  =cut
# Line 135  Returns hash or undef if cacheing is dis Line 150  Returns hash or undef if cacheing is dis
150  sub load_ds {  sub load_ds {
151          my $self = shift;          my $self = shift;
152    
         return unless $self->{'path'};  
   
153          my $log = $self->_get_logger;          my $log = $self->_get_logger;
154    
155          my $cache_path = $self->{'path'};          my $cache_path = $self->{'path'};
156    
157          my $id = shift;          if (! $cache_path) {
158          if (lc($id) eq 'id') {                  $log->warn("path not set, ignoring load_ds");
159                  $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+$/);  
160          }          }
161    
162          if (! defined($id)) {          $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
163                  $log->warn("called without id");  
164                  return undef;          my $args = {@_};
165          } else {          my $id = $args->{id};
166                  my $cache_file = "$cache_path/$id";  
167                  if (-r $cache_file) {          $log->logconfess("got hash, but without id") unless (defined($id));
168                          my $ds_ref = retrieve($cache_file);          $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
169                          if ($ds_ref) {  
170                                  $log->debug("cache hit: $cache_file");          my $database = $args->{database} || $self->{database};
171                                  my $ok = 1;          my $prefix = $args->{prefix} || '';
172  #                               foreach my $f (qw(current_filename headline)) {  
173  #                                       if ($ds_ref->{$f}) {          $log->logconfess("can't find database name") unless ($database);
174  #                                               $self->{$f} = $ds_ref->{$f};  
175  #                                       } else {          my $cache_file = "$cache_path/$database/$prefix/$id";
176  #                                               $ok = 0;          $cache_file =~ s#//#/#go;
177  #                                       }  
178  #                               };          $log->debug("using cache_file $cache_file");
179                                  if ($ok && $ds_ref->{'ds'}) {  
180                                          return $ds_ref->{'ds'};          if (-r $cache_file) {
181                                  } else {                  my $ds_ref = retrieve($cache_file);
182                                          $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");                  if ($ds_ref) {
183                                          undef $self->{'path'};                          $log->debug("cache hit: $cache_file");
184                                  }                          if ($ds_ref->{'ds'}) {
185                                    return $ds_ref->{'ds'};
186                            } else {
187                                    $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
188                                    undef $self->{'path'};
189                          }                          }
                 } else {  
                         #$log->warn("cache entry $cache_file doesn't exist");  
                         return undef;  
190                  }                  }
191            } else {
192                    #$log->warn("cache entry $cache_file doesn't exist");
193                    return undef;
194          }          }
195    
196          return undef;          return undef;
# Line 187  Store data_structure on disk. Line 202  Store data_structure on disk.
202    
203    $db->save_ds(    $db->save_ds(
204          id => $ds->{000}->[0],          id => $ds->{000}->[0],
205            prefix => 'name',
206          ds => $ds,          ds => $ds,
207    );    );
208    
# Line 211  sub save_ds { Line 227  sub save_ds {
227                  $log->logconfess("need $f") unless ($arg->{$f});                  $log->logconfess("need $f") unless ($arg->{$f});
228          }          }
229    
230          my $cache_file = $self->{path} . '/' . $arg->{id};          my $database = $self->{database};
231            $log->logconfess("can't find database name") unless ($database);
232    
233            my $prefix = $arg->{prefix} || '';
234    
235            my $cache_file = $self->{path} . '/' . $prefix . '/';
236            $cache_file =~ s#//#/#go;
237    
238            mkpath($cache_file) unless (-d $cache_file);
239    
240            $cache_file .= $arg->{id};
241    
242          $log->debug("creating storable cache file $cache_file");          $log->debug("creating storable cache file $cache_file");
243    
# Line 222  sub save_ds { Line 248  sub save_ds {
248    
249  }  }
250    
251    =head2 save_lookup
252    
253      $db->save_lookup( $database, $input, $key, $lookup );
254    
255    =cut
256    
257    sub save_lookup {
258            my $self = shift;
259            my ($database, $input, $key, $lookup) = @_;
260    
261            my $log = $self->_get_logger;
262    
263            my $path = $self->{'path'} . "/lookup/$input";
264    
265            mkpath($path) unless (-d $path);
266    
267            $path .= "/$key";
268    
269            if (store $lookup, $path) {
270                    $log->info("saved lookup $path");
271            } else {
272                    $log->logwarn("can't store lookup $database/$input/$key in $path: $!");
273            }
274    
275            
276    }
277    
278    
279  =head1 AUTHOR  =head1 AUTHOR
280    
281  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.215  
changed lines
  Added in v.710
  ViewVC Help
Powered by ViewVC 1.1.26