/[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 886 by dpavlin, Sun May 27 14:09:30 2007 UTC revision 887 by dpavlin, Mon Sep 3 15:26:46 2007 UTC
# Line 3  package WebPAC::Store; Line 3  package WebPAC::Store;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use base 'WebPAC::Common';  use WebPAC::Common;
7    use base qw/WebPAC::Common Class::Accessor/;
8    __PACKAGE__->mk_accessors(qw/database/);
9    
10  use Storable;  use Storable;
11  use File::Path;  use File::Path;
12  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
# Line 14  WebPAC::Store - Store WebPAC data on dis Line 17  WebPAC::Store - Store WebPAC data on dis
17    
18  =head1 VERSION  =head1 VERSION
19    
20  Version 0.14  Version 0.15
21    
22  =cut  =cut
23    
24  our $VERSION = '0.14';  our $VERSION = '0.15';
25    
26  =head1 SYNOPSIS  =head1 SYNOPSIS
27    
# Line 34  databases just yet :-) Line 37  databases just yet :-)
37  This has additional advantage. I can create single place to plugin other  This has additional advantage. I can create single place to plugin other
38  file formats which provide better performance for particular type of data.  file formats which provide better performance for particular type of data.
39    
 For now, this is a prototype version.  
   
     use WebPAC::Store;  
   
     my $store = WebPAC::Store->new();  
     ...  
   
40  =head1 FUNCTIONS  =head1 FUNCTIONS
41    
42  =head2 new  =head2 new
43    
44  Create new normalised database object  Create new normalised database object
45    
46    my $store = new WebPAC::Store(    my $store = new WebPAC::Store({
         path => '/path/to/cache/ds/',  
47          database => 'name',          database => 'name',
48          read_only => 1,    });
   );  
49    
50  Optional parameter C<path> defines path to directory  Optional parameter C<path> defines path to directory
51  in which cache file for C<data_structure> call will be created.  in which cache file for C<data_structure> call will be created.
52    
 If called with C<read_only> it will not disable caching if  
 called without write permission (but will die on C<save_ds>).  
   
53  Optional parametar C<database> will be used used as subdirectory in path if no  Optional parametar C<database> will be used used as subdirectory in path if no
54  database in specified when calling other functions.  database in specified when calling other functions.
55    
56  =cut  =cut
57    
 sub new {  
         my $class = shift;  
         my $self = {@_};  
         bless($self, $class);  
   
         my $log = $self->_get_logger();  
   
         foreach my $p (qw/path/) {  
                 $log->logconfess("need $p") unless ($self->{$p});  
         }  
   
         $self->path( $self->{'path'} );  
   
         $self ? return $self : return undef;  
 }  
   
 =head2 path  
   
 Check if specified cache directory exist, and if not, disable caching.  
   
  $store->path('./cache/');  
   
 If you pass false or zero value to this function, it will disable  
 cacheing.  
   
 You can also call this function to get current cache path.  
   
  my $cache_path = $store->path;  
   
 =cut  
   
 sub path {  
         my $self = shift;  
   
         my $dir = shift;  
           
         return $self->{path} unless defined($dir);  
   
         my $log = $self->_get_logger();  
   
         if ($dir) {  
                 my $msg;  
                 if (! -e $dir) {  
                         if ($self->{'read_only'}) {  
                                 $msg = "doesn't exist";  
                         } else {  
                                 $log->info("creating $dir");  
                                 mkpath $dir;  
                         }  
                 } elsif (! -d $dir) {  
                         $msg = "is not directory";  
                 } elsif (! -w $dir) {  
                         $msg = "not writable" unless ($self->{'read_only'});  
                 }  
   
                 if ($msg) {  
                         $log->warn("cache path $dir $msg, disabling...");  
                         undef $self->{'path'};  
                 } else {  
                         $log->debug("using cache dir $dir");  
                         $self->{'path'} = $dir;  
                 }  
         } else {  
                 $log->debug("disabling cache");  
                 undef $self->{'path'};  
         }  
 }  
   
58  =head2 load_ds  =head2 load_ds
59    
60  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
# Line 161  sub load_ds { Line 84  sub load_ds {
84    
85          my $log = $self->_get_logger;          my $log = $self->_get_logger;
86    
         my $cache_path = $self->{'path'};  
   
         if (! $cache_path) {  
                 $log->warn("path not set, ignoring load_ds");  
                 return;  
         }  
   
87          $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));          $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
88    
89          my $args = {@_};          my $args = {@_};
# Line 176  sub load_ds { Line 92  sub load_ds {
92          $log->logconfess("got hash, but without id") unless (defined($id));          $log->logconfess("got hash, but without id") unless (defined($id));
93          $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);          $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
94    
95          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");          my $database = $args->{database} || $self->database || $log->logconfess("no database?");
96    
97          my $input = $args->{input} || '';          my $input = $args->{input} || '';
98    
99          my $cache_file = "$cache_path/ds/$database/$input/$id";          my $cache_file = $self->var_path( 'ds', $database, $input, $id );
         $cache_file =~ s#//#/#go;  
100    
101          $log->debug("using cache_file $cache_file");          $log->debug("using cache_file $cache_file");
102    
# Line 192  sub load_ds { Line 107  sub load_ds {
107                          if ($ds_ref->{'ds'}) {                          if ($ds_ref->{'ds'}) {
108                                  return $ds_ref->{'ds'};                                  return $ds_ref->{'ds'};
109                          } else {                          } else {
110                                  $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");                                  $log->warn("cache entry $cache_file corrupt. Use rm $cache_file to re-create it on next run!");
                                 undef $self->{'path'};  
111                          }                          }
112                  }                  }
113          } else {          } else {
# Line 222  C<database> and C<input> are optional. Line 136  C<database> and C<input> are optional.
136  sub save_ds {  sub save_ds {
137          my $self = shift;          my $self = shift;
138    
         die "can't write to database in read_only mode!" if ($self->{'read_only'});  
   
         return unless($self->{'path'});  
   
139          my $args = {@_};          my $args = {@_};
140    
141          my $log = $self->_get_logger;          my $log = $self->_get_logger;
# Line 240  sub save_ds { Line 150  sub save_ds {
150    
151          my $input = $args->{input} || '';          my $input = $args->{input} || '';
152    
153          my $cache_file = $self->{path} . "/ds/$database/$input/";          my $cache_file = $self->var_path( 'ds', $database, $input );
         $cache_file =~ s#//#/#go;  
154    
155          mkpath($cache_file) unless (-d $cache_file);          mkpath($cache_file) unless (-d $cache_file);
156    
157          $cache_file .= $args->{id};          $cache_file = $self->var_path( 'ds', $database, $input, $args->{id} );
158    
159          $log->debug("creating storable cache file $cache_file");          $log->debug("creating storable cache file $cache_file");
160    
# Line 282  sub load_lookup { Line 191  sub load_lookup {
191    
192          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
193    
194          my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key};          my $path = $self->var_path( 'lookup', $database, $args->{input}, $args->{key} );
195    
196          if (! -e $path) {          if (! -e $path) {
197                  $log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input});                  $log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input});
# Line 325  sub save_lookup { Line 234  sub save_lookup {
234    
235          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
236    
237          my $path = $self->{path} . "/lookup/$database/" . $args->{input};          my $path = $self->var_path( 'lookup', $database, $args->{input} );
238    
239          mkpath($path) unless (-d $path);          mkpath($path) unless (-d $path);
240    
# Line 368  sub load_row { Line 277  sub load_row {
277    
278          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
279    
280          my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id};          my $path = $self->var_path( 'row', $database, $args->{input}, $args->{id} );
281    
282          if (! -e $path) {          if (! -e $path) {
283                  $log->warn("input row $path doesn't exist, skipping");                  $log->warn("input row $path doesn't exist, skipping");
# Line 411  sub save_row { Line 320  sub save_row {
320    
321          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");          my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
322    
323          my $path = $self->{path} . "/row/$database/" . $args->{input};          my $path = $self->var_path( 'row', $database, $args->{input} );
324    
325          mkpath($path) unless (-d $path);          mkpath($path) unless (-d $path);
326    
Legend:
Removed from v.886  
changed lines
  Added in v.887
  ViewVC Help
Powered by ViewVC 1.1.26