/[webpac2]/trunk/lib/WebPAC/DB.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/DB.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 123 by dpavlin, Wed Nov 23 00:14:05 2005 UTC revision 124 by dpavlin, Thu Nov 24 11:47:10 2005 UTC
# Line 12  WebPAC::DB - Store normalized data on di Line 12  WebPAC::DB - Store normalized data on di
12    
13  =head1 VERSION  =head1 VERSION
14    
15  Version 0.01  Version 0.02
16    
17  =cut  =cut
18    
19  our $VERSION = '0.01';  our $VERSION = '0.02';
20    
21  =head1 SYNOPSIS  =head1 SYNOPSIS
22    
# Line 74  Check if specified cache directory exist Line 74  Check if specified cache directory exist
74  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
75  cacheing.  cacheing.
76    
77    You can also example C<< $db->{path} >> to get current cache path.
78    
79  =cut  =cut
80    
81  sub path {  sub path {
# Line 110  sub path { Line 112  sub path {
112    
113  Retrive from disk one data_structure records using field 000 as key  Retrive from disk one data_structure records using field 000 as key
114    
115    my $ds = $db->load_ds($rec);    my $ds = $db->load_ds( 42 );
116    
117    There is also a more verbose form, similar to C<save_ds>
118    
119      my $ds = $db->load_ds( id => 42 );
120    
121  This function will also perform basic sanity checking on returned  This function will also perform basic sanity checking on returned
122  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 125  sub load_ds { Line 131  sub load_ds {
131    
132          return unless $self->{'path'};          return unless $self->{'path'};
133    
         my $rec = shift || return;  
   
134          my $log = $self->_get_logger;          my $log = $self->_get_logger;
135    
136          my $cache_path = $self->{'path'};          my $cache_path = $self->{'path'};
137    
138          my $id = $rec;          my $id = shift;
139          $id = $rec->{'000'} if (ref($id) eq 'HASH');          if (lc($id) eq 'id') {
140          $id = $rec->{'000'}->[0] if (ref($id) eq 'ARRAY');                  $id = shift;
141                    $log->logconfess("got hash, but without key id") unless (defined($id));
142                    $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);
143            }
144    
145          unless (defined($id)) {          if (! defined($id)) {
146                  $log->warn("Can't use cacheing on records without unique identifier in field 000");                  $log->warn("called without id");
147                  undef $self->{'path'};                  return undef;
148          } else {          } else {
149                  my $cache_file = "$cache_path/$id";                  my $cache_file = "$cache_path/$id";
                 $self->{'cache_file'} = $cache_file;  
150                  if (-r $cache_file) {                  if (-r $cache_file) {
151                          my $ds_ref = retrieve($cache_file);                          my $ds_ref = retrieve($cache_file);
152                          if ($ds_ref) {                          if ($ds_ref) {
153                                  $log->debug("cache hit: $cache_file");                                  $log->debug("cache hit: $cache_file");
154                                  my $ok = 1;                                  my $ok = 1;
155                                  foreach my $f (qw(current_filename headline)) {  #                               foreach my $f (qw(current_filename headline)) {
156                                          if ($ds_ref->{$f}) {  #                                       if ($ds_ref->{$f}) {
157                                                  $self->{$f} = $ds_ref->{$f};  #                                               $self->{$f} = $ds_ref->{$f};
158                                          } else {  #                                       } else {
159                                                  $ok = 0;  #                                               $ok = 0;
160                                          }  #                                       }
161                                  };  #                               };
162                                  if ($ok && $ds_ref->{'ds'}) {                                  if ($ok && $ds_ref->{'ds'}) {
163                                          return $ds_ref->{'ds'};                                          return $ds_ref->{'ds'};
164                                  } else {                                  } else {
165                                          $log->warn("cache entry $cache_path corrupt. Use rm $cache_path/* to re-create it on next run!");                                          $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
166                                          undef $self->{'path'};                                          undef $self->{'path'};
167                                  }                                  }
168                          }                          }
169                  } else {                  } else {
170                            $log->warn("cache entry $cache_file doesn't exist");
171                          return undef;                          return undef;
172                  }                  }
173          }          }
# Line 173  sub load_ds { Line 180  sub load_ds {
180  Store data_structure on disk.  Store data_structure on disk.
181    
182    $db->save_ds(    $db->save_ds(
183            id => $ds->{000}->[0],
184          ds => $ds,          ds => $ds,
         current_filename => $self->{'current_filename'},  
         headline => $self->{'headline'},  
185    );    );
186    
187  B<Totally broken, but fast.>  B<Totally broken, but fast.>
# Line 190  sub save_ds { Line 196  sub save_ds {
196          die "can't write to database in read_only mode!" if ($self->{'read_only'});          die "can't write to database in read_only mode!" if ($self->{'read_only'});
197    
198          return unless($self->{'path'});          return unless($self->{'path'});
         return unless (@_);  
199    
200          my $arg = {@_};          my $arg = {@_};
201    
202          my $log = $self->_get_logger;          my $log = $self->_get_logger;
203    
204          $log->logdie("save_ds without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});          foreach my $f (qw/id ds/) {
205                    $log->logconfess("need $f") unless ($arg->{$f});
         $log->logdie("need ds") unless ($arg->{ds});  
   
         foreach my $e (qw/current_filename headline/) {  
                 my $mfn = $arg->{ds}->{000}->[0] || '?';  
                 $log->warn("missing $e in record $mfn") unless $arg->{$e};  
206          }          }
207    
208          $log->debug("creating storable cache file ",$self->{'cache_file'});          my $cache_file = $self->{path} . '/' . $arg->{id};
209    
210            $log->debug("creating storable cache file $cache_file");
211    
212          store {          return store {
213                  ds => $arg->{'ds'},                  ds => $arg->{ds},
214                  current_filename => $arg->{'current_filename'},                  id => $arg->{id},
215                  headline => $arg->{'headline'},          }, $cache_file;
         }, $self->{'cache_file'};  
216    
217  }  }
218    
Legend:
Removed from v.123  
changed lines
  Added in v.124
  ViewVC Help
Powered by ViewVC 1.1.26