/[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 714 by dpavlin, Tue Sep 26 12:47:52 2006 UTC revision 735 by dpavlin, Mon Oct 2 09:31:25 2006 UTC
# Line 14  WebPAC::Store - Store WebPAC data on dis Line 14  WebPAC::Store - Store WebPAC data on dis
14    
15  =head1 VERSION  =head1 VERSION
16    
17  Version 0.11  Version 0.14
18    
19  =cut  =cut
20    
21  our $VERSION = '0.11';  our $VERSION = '0.14';
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
# Line 38  For now, this is a prototype version. Line 38  For now, this is a prototype version.
38    
39      use WebPAC::Store;      use WebPAC::Store;
40    
41      my $foo = WebPAC::Store->new();      my $store = WebPAC::Store->new();
42      ...      ...
43    
44  =head1 FUNCTIONS  =head1 FUNCTIONS
# Line 47  For now, this is a prototype version. Line 47  For now, this is a prototype version.
47    
48  Create new normalised database object  Create new normalised database object
49    
50    my $db = new WebPAC::Store(    my $store = new WebPAC::Store(
51          path => '/path/to/cache/ds/',          path => '/path/to/cache/ds/',
52          database => 'name',          database => 'name',
53          read_only => 1,          read_only => 1,
# Line 84  sub new { Line 84  sub new {
84    
85  Check if specified cache directory exist, and if not, disable caching.  Check if specified cache directory exist, and if not, disable caching.
86    
87   $db->path('./cache/ds/');   $store->path('./cache/');
88    
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 call this function to get current cache path.  You can also call this function to get current cache path.
93    
94   my $cache_path = $db->path;   my $cache_path = $store->path;
95    
96  =cut  =cut
97    
# Line 136  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(    my $ds = $store->load_ds(
140                  database => 'ps',                  database => 'ps',
141                  input => 'name',                  input => 'name',
142                  id => 42,                  id => 42,
# Line 180  sub load_ds { Line 180  sub load_ds {
180    
181          my $input = $args->{input} || '';          my $input = $args->{input} || '';
182    
183          my $cache_file = "$cache_path/$database/$input/$id";          my $cache_file = "$cache_path/ds/$database/$input/$id";
184          $cache_file =~ s#//#/#go;          $cache_file =~ s#//#/#go;
185    
186          $log->debug("using cache_file $cache_file");          $log->debug("using cache_file $cache_file");
# Line 208  sub load_ds { Line 208  sub load_ds {
208    
209  Store data_structure on disk.  Store data_structure on disk.
210    
211    $db->save_ds(    $store->save_ds(
212          database => 'name',          database => 'name',
213          input => 'name',          input => 'name',
214          id => $ds->{000}->[0],          id => $ds->{000}->[0],
215          ds => $ds,          ds => $ds,
216    );    );
217    
218  B<Totally broken, but fast.>  C<database> and C<input> are optional.
   
 Depends on filename generated by C<load_ds>.  
219    
220  =cut  =cut
221    
# Line 242  sub save_ds { Line 240  sub save_ds {
240    
241          my $input = $args->{input} || '';          my $input = $args->{input} || '';
242    
243          my $cache_file = $self->{path} . "/$database/$input/";          my $cache_file = $self->{path} . "/ds/$database/$input/";
244          $cache_file =~ s#//#/#go;          $cache_file =~ s#//#/#go;
245    
246          mkpath($cache_file) unless (-d $cache_file);          mkpath($cache_file) unless (-d $cache_file);
# Line 258  sub save_ds { Line 256  sub save_ds {
256    
257  }  }
258    
259    =head2 load_lookup
260    
261    Loads lookup hash from file
262    
263      $data = $store->load_lookup(
264            database => $database,
265            input => $input,
266            key => $key,
267      );
268    
269    C<database> is optional.
270    
271    =cut
272    
273    sub load_lookup {
274            my $self = shift;
275            my $args = {@_};
276    
277            my $log = $self->_get_logger;
278    
279            foreach my $r (qw/input key/) {
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} . '/' . $args->{key};
286    
287            if (! -e $path) {
288                    $log->warn("lookup $path doesn't exist, skipping");
289                    return;
290            }
291    
292            if (my $data = retrieve($path)) {
293                    $log->info("loaded lookup $path");
294                    return $data;
295            } else {
296                    $log->logwarn("can't load lookup $database/", $args->{input}, "/", $args->{key}, " from $path: $!");
297                    return undef;
298            }
299    }
300    
301  =head2 save_lookup  =head2 save_lookup
302    
303    $db->save_lookup(  Save lookup data to file.
304    
305      $store->save_lookup(
306          database => $database,          database => $database,
307          input => $input,          input => $input,
308          key => $key,          key => $key,
309          data => $lookup,          data => $lookup,
310    );    );
311    
312    C<database> is optional.
313    
314  =cut  =cut
315    
316  sub save_lookup {  sub save_lookup {
# Line 291  sub save_lookup { Line 335  sub save_lookup {
335                  $log->info("saved lookup $path");                  $log->info("saved lookup $path");
336                  return 1;                  return 1;
337          } else {          } else {
338                  $log->logwarn("can't store lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!");                  $log->logwarn("can't save lookup to $path: $!");
339                    return undef;
340            }
341    }
342    
343    =head2 load_row
344    
345    Loads row from input database cache (used for lookups)
346    
347      $row = $store->load_row(
348            database => $database,
349            input => $input,
350            id => 42,
351      );
352    
353    C<database> is optional.
354    
355    =cut
356    
357    sub load_row {
358            my $self = shift;
359            my $args = {@_};
360    
361            my $log = $self->_get_logger;
362    
363            foreach my $r (qw/input id/) {
364                    $log->logconfess("need '$r'") unless defined($args->{$r});
365            }
366    
367            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
368    
369            my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id};
370    
371            if (! -e $path) {
372                    $log->warn("input row $path doesn't exist, skipping");
373                    return;
374            }
375    
376            if (my $data = retrieve($path)) {
377                    $log->debug("loaded row $path");
378                    return $data;
379            } else {
380                    $log->logwarn("can't load row from $path: $!");
381                    return undef;
382            }
383    }
384    
385    =head2 save_row
386    
387    Save row data to file.
388    
389      $store->save_row(
390            database => $database,
391            input => $input,
392            id => $mfn,
393            row => $lookup,
394      );
395    
396    C<database> is optional.
397    
398    =cut
399    
400    sub save_row {
401            my $self = shift;
402            my $args = {@_};
403    
404            my $log = $self->_get_logger;
405    
406            foreach my $r (qw/input id row/) {
407                    $log->logconfess("need '$r'") unless defined($args->{$r});
408            }
409    
410            my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
411    
412            my $path = $self->{path} . "/row/$database/" . $args->{input};
413    
414            mkpath($path) unless (-d $path);
415    
416            $path .= "/" . $args->{id};
417    
418            if (store $args->{row}, $path) {
419                    $log->debug("saved row $path");
420                    return 1;
421            } else {
422                    $log->logwarn("can't save row to $path: $!");
423                  return undef;                  return undef;
424          }          }
425  }  }
# Line 303  Dobrica Pavlinusic, C<< <dpavlin@rot13.o Line 431  Dobrica Pavlinusic, C<< <dpavlin@rot13.o
431    
432  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
433    
434  Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.  Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved.
435    
436  This program is free software; you can redistribute it and/or modify it  This program is free software; you can redistribute it and/or modify it
437  under the same terms as Perl itself.  under the same terms as Perl itself.
Legend:
Removed from v.714  
changed lines
  Added in v.735
  ViewVC Help
Powered by ViewVC 1.1.26