/[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 19 by dpavlin, Sun Jul 17 15:04:39 2005 UTC revision 127 by dpavlin, Thu Nov 24 11:47:29 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 43  For now, this is a prototype version. Line 43  For now, this is a prototype version.
43  Create new normalised database object  Create new normalised database object
44    
45    my $db = new WebPAC::DB(    my $db = new WebPAC::DB(
46          path = '/path/to/cache/ds/',          path => '/path/to/cache/ds/',
47            read_only => 1,
48    );    );
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    
53    If called with C<read_only> it will not disable caching if
54    called without write permission (but will die on C<save_ds>).
55    
56  =cut  =cut
57    
58  sub new {  sub new {
# Line 70  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 86  sub path { Line 92  sub path {
92                  } elsif (! -d $dir) {                  } elsif (! -d $dir) {
93                          $msg = "is not directory";                          $msg = "is not directory";
94                  } elsif (! -w $dir) {                  } elsif (! -w $dir) {
95                          $msg = "not writable";                          $msg = "not writable" unless ($self->{'read_only'});
96                  }                  }
97    
98                  if ($msg) {                  if ($msg) {
# Line 102  sub path { Line 108  sub path {
108          }          }
109  }  }
110    
111  =head2 load_gs  =head2 load_ds
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_gs($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
123  update).  update).
124    
125  Returns array or undef if cacheing is disabled or unavailable.  Returns hash or undef if cacheing is disabled or unavailable.
126    
127  =cut  =cut
128    
129  sub load_gs {  sub load_ds {
130          my $self = shift;          my $self = shift;
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->{'000'};          my $id = shift;
139          $id = $rec->{'000'}->[0] if ($id =~ m/^ARRAY/o);          if (lc($id) eq 'id') {
140                    $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 {
170                            #$log->warn("cache entry $cache_file doesn't exist");
171                            return undef;
172                  }                  }
173          }          }
174    
175          return undef;          return undef;
176  }  }
177    
178  =head2 save_gs  =head2 save_ds
179    
180  Store data_structure on disk.  Store data_structure on disk.
181    
182    $db->save_gs(    $db->save_ds(
183          ds => \@ds,          id => $ds->{000}->[0],
184          current_filename => $self->{'current_filename'},          ds => $ds,
         headline => $self->{'headline'},  
185    );    );
186    
187  B<Totally broken, but fast.>  B<Totally broken, but fast.>
188    
189  Depends on filename generated by C<load_gs>.  Depends on filename generated by C<load_ds>.
190    
191  =cut  =cut
192    
193  sub save_gs {  sub save_ds {
194          my $self = shift;          my $self = shift;
195    
196            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_gs 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});
         foreach my $e (qw/ds current_filename headline/) {  
                 $log->logdie("missing $e") 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.19  
changed lines
  Added in v.127
  ViewVC Help
Powered by ViewVC 1.1.26