/[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 299 by dpavlin, Mon Dec 19 20:55:05 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.09
18    
19  =cut  =cut
20    
21  our $VERSION = '0.04';  our $VERSION = '0.09';
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 54  in which cache file for C<data_structure Line 56  in which cache file for C<data_structure
56  If called with C<read_only> it will not disable caching if  If called with C<read_only> it will not disable caching if
57  called without write permission (but will die on C<save_ds>).  called without write permission (but will die on C<save_ds>).
58    
59    Mandatory parametar C<database> is used as subdirectory in database directory.
60    
61  =cut  =cut
62    
63  sub new {  sub new {
# Line 61  sub new { Line 65  sub new {
65          my $self = {@_};          my $self = {@_};
66          bless($self, $class);          bless($self, $class);
67    
68            my $log = $self->_get_logger();
69    
70            foreach my $p (qw/path database/) {
71                    $log->logconfess("need $p") unless ($self->{$p});
72            }
73    
74          $self->path( $self->{'path'} );          $self->path( $self->{'path'} );
75    
76          $self ? return $self : return undef;          $self ? return $self : return undef;
# Line 116  sub path { Line 126  sub path {
126    
127  =head2 load_ds  =head2 load_ds
128    
129  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
   
   my $ds = $db->load_ds( 42 );  
   
 There is also a more verbose form, similar to C<save_ds>  
130    
131    my $ds = $db->load_ds( id => 42 );    my $ds = $db->load_ds( id => 42, prefix => 'name', database => 'ps' );
132    
133  This function will also perform basic sanity checking on returned  This function will also perform basic sanity checking on returned
134  data and disable caching if data is corrupted (or changed since last  data and disable caching if data is corrupted (or changed since last
135  update).  update).
136    
137    C<prefix> is used to differenciate different source input databases
138    which are indexed in same database.
139    
140    C<database> if B<optional> argument which will override database name used when creating
141    C<WebPAC::Store> object (for simple retrival from multiple databases).
142    
143  Returns hash or undef if cacheing is disabled or unavailable.  Returns hash or undef if cacheing is disabled or unavailable.
144    
145  =cut  =cut
# Line 135  Returns hash or undef if cacheing is dis Line 147  Returns hash or undef if cacheing is dis
147  sub load_ds {  sub load_ds {
148          my $self = shift;          my $self = shift;
149    
         return unless $self->{'path'};  
   
150          my $log = $self->_get_logger;          my $log = $self->_get_logger;
151    
152          my $cache_path = $self->{'path'};          my $cache_path = $self->{'path'};
153    
154          my $id = shift;          if (! $cache_path) {
155          if (lc($id) eq 'id') {                  $log->warn("path not set, ignoring load_ds");
156                  $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+$/);  
157          }          }
158    
159          if (! defined($id)) {          $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
160                  $log->warn("called without id");  
161                  return undef;          my $args = {@_};
162          } else {          my $id = $args->{id};
163                  my $cache_file = "$cache_path/$id";  
164                  if (-r $cache_file) {          $log->logconfess("got hash, but without id") unless (defined($id));
165                          my $ds_ref = retrieve($cache_file);          $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
166                          if ($ds_ref) {  
167                                  $log->debug("cache hit: $cache_file");          my $database = $args->{database} || $self->{database};
168                                  my $ok = 1;          my $prefix = $args->{prefix} || '';
169  #                               foreach my $f (qw(current_filename headline)) {  
170  #                                       if ($ds_ref->{$f}) {          $log->logconfess("can't find database name") unless ($database);
171  #                                               $self->{$f} = $ds_ref->{$f};  
172  #                                       } else {          my $cache_file = "$cache_path/$database/$prefix/$id";
173  #                                               $ok = 0;          $cache_file =~ s#//#/#go;
174  #                                       }  
175  #                               };  open(my $fh, '>>', '/tmp/foo');
176                                  if ($ok && $ds_ref->{'ds'}) {  print $fh "LOAD $cache_path / $database / $prefix / $id ==> $cache_file\n";
177                                          return $ds_ref->{'ds'};  close($fh);
178                                  } else {  
179                                          $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");          $log->debug("using cache_file $cache_file");
180                                          undef $self->{'path'};  
181                                  }          if (-r $cache_file) {
182                    my $ds_ref = retrieve($cache_file);
183                    if ($ds_ref) {
184                            $log->debug("cache hit: $cache_file");
185                            if ($ds_ref->{'ds'}) {
186                                    return $ds_ref->{'ds'};
187                            } else {
188                                    $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
189                                    undef $self->{'path'};
190                          }                          }
                 } else {  
                         #$log->warn("cache entry $cache_file doesn't exist");  
                         return undef;  
191                  }                  }
192            } else {
193                    #$log->warn("cache entry $cache_file doesn't exist");
194                    return undef;
195          }          }
196    
197          return undef;          return undef;
# Line 187  Store data_structure on disk. Line 203  Store data_structure on disk.
203    
204    $db->save_ds(    $db->save_ds(
205          id => $ds->{000}->[0],          id => $ds->{000}->[0],
206            prefix => 'name',
207          ds => $ds,          ds => $ds,
208    );    );
209    
# Line 211  sub save_ds { Line 228  sub save_ds {
228                  $log->logconfess("need $f") unless ($arg->{$f});                  $log->logconfess("need $f") unless ($arg->{$f});
229          }          }
230    
231          my $cache_file = $self->{path} . '/' . $arg->{id};          my $database = $self->{database};
232            $log->logconfess("can't find database name") unless ($database);
233    
234            my $prefix = $arg->{prefix} || '';
235    
236            my $cache_file = $self->{path} . '/' . $prefix . '/';
237            $cache_file =~ s#//#/#go;
238    
239            mkpath($cache_file) unless (-d $cache_file);
240    
241            $cache_file .= $arg->{id};
242    
243          $log->debug("creating storable cache file $cache_file");          $log->debug("creating storable cache file $cache_file");
244    
Legend:
Removed from v.215  
changed lines
  Added in v.299
  ViewVC Help
Powered by ViewVC 1.1.26