/[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 216 by dpavlin, Mon Dec 5 17:47:39 2005 UTC revision 217 by dpavlin, Mon Dec 5 17:47:51 2005 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    
# Line 13  WebPAC::Store - Store normalized data on Line 14  WebPAC::Store - Store normalized data on
14    
15  =head1 VERSION  =head1 VERSION
16    
17  Version 0.04  Version 0.05
18    
19  =cut  =cut
20    
21  our $VERSION = '0.04';  our $VERSION = '0.05';
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
# Line 45  Create new normalised database object Line 46  Create new normalised database object
46    
47    my $db = new WebPAC::Store(    my $db = new WebPAC::Store(
48          path => '/path/to/cache/ds/',          path => '/path/to/cache/ds/',
49            database => 'name',
50          read_only => 1,          read_only => 1,
51    );    );
52    
# Line 116  sub path { Line 118  sub path {
118    
119  =head2 load_ds  =head2 load_ds
120    
121  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
122    
123    my $ds = $db->load_ds( 42 );    my $ds = $db->load_ds( id => 42, database => 'name' );
   
 There is also a more verbose form, similar to C<save_ds>  
   
   my $ds = $db->load_ds( id => 42 );  
124    
125  This function will also perform basic sanity checking on returned  This function will also perform basic sanity checking on returned
126  data and disable caching if data is corrupted (or changed since last  data and disable caching if data is corrupted (or changed since last
# Line 135  Returns hash or undef if cacheing is dis Line 133  Returns hash or undef if cacheing is dis
133  sub load_ds {  sub load_ds {
134          my $self = shift;          my $self = shift;
135    
         return unless $self->{'path'};  
   
136          my $log = $self->_get_logger;          my $log = $self->_get_logger;
137    
138          my $cache_path = $self->{'path'};          my $cache_path = $self->{'path'};
139    
140          my $id = shift;          if (! $cache_path) {
141          if (lc($id) eq 'id') {                  $log->warn("path not set, ignoring load_ds");
142                  $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+$/);  
143          }          }
144    
145          if (! defined($id)) {          $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
146                  $log->warn("called without id");  
147                  return undef;          my $args = {@_};
148          } else {          my $id = $args->{id};
149                  my $cache_file = "$cache_path/$id";  
150                  if (-r $cache_file) {          $log->logconfess("got hash, but without id") unless (defined($id));
151                          my $ds_ref = retrieve($cache_file);          $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);
152                          if ($ds_ref) {  
153                                  $log->debug("cache hit: $cache_file");          my $database = $args->{database} || $self->{database};
154                                  my $ok = 1;  
155  #                               foreach my $f (qw(current_filename headline)) {          $log->logconfess("can't find database name") unless ($database);
156  #                                       if ($ds_ref->{$f}) {  
157  #                                               $self->{$f} = $ds_ref->{$f};          my $cache_file = "$cache_path/$database#$id";
158  #                                       } else {          $cache_file =~ s#//#/#g;
159  #                                               $ok = 0;  
160  #                                       }          $log->debug("using cache_file $cache_file");
161  #                               };  
162                                  if ($ok && $ds_ref->{'ds'}) {          if (-r $cache_file) {
163                                          return $ds_ref->{'ds'};                  my $ds_ref = retrieve($cache_file);
164                                  } else {                  if ($ds_ref) {
165                                          $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");                          $log->debug("cache hit: $cache_file");
166                                          undef $self->{'path'};                          if ($ds_ref->{'ds'}) {
167                                  }                                  return $ds_ref->{'ds'};
168                            } else {
169                                    $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
170                                    undef $self->{'path'};
171                          }                          }
                 } else {  
                         #$log->warn("cache entry $cache_file doesn't exist");  
                         return undef;  
172                  }                  }
173            } else {
174                    #$log->warn("cache entry $cache_file doesn't exist");
175                    return undef;
176          }          }
177    
178          return undef;          return undef;
# Line 187  Store data_structure on disk. Line 184  Store data_structure on disk.
184    
185    $db->save_ds(    $db->save_ds(
186          id => $ds->{000}->[0],          id => $ds->{000}->[0],
187            database => 'name',
188          ds => $ds,          ds => $ds,
189    );    );
190    
# Line 211  sub save_ds { Line 209  sub save_ds {
209                  $log->logconfess("need $f") unless ($arg->{$f});                  $log->logconfess("need $f") unless ($arg->{$f});
210          }          }
211    
212          my $cache_file = $self->{path} . '/' . $arg->{id};          my $database = $arg->{database} ||  $self->{database};
213            $log->logconfess("can't find database name") unless ($database);
214    
215            my $cache_file = $self->{path} . '/' . $database . '#' . $arg->{id};
216    
217          $log->debug("creating storable cache file $cache_file");          $log->debug("creating storable cache file $cache_file");
218    

Legend:
Removed from v.216  
changed lines
  Added in v.217

  ViewVC Help
Powered by ViewVC 1.1.26