/[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 89 by dpavlin, Tue Nov 22 08:37:55 2005 UTC
# 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 86  sub path { Line 90  sub path {
90                  } elsif (! -d $dir) {                  } elsif (! -d $dir) {
91                          $msg = "is not directory";                          $msg = "is not directory";
92                  } elsif (! -w $dir) {                  } elsif (! -w $dir) {
93                          $msg = "not writable";                          $msg = "not writable" unless ($self->{'read_only'});
94                  }                  }
95    
96                  if ($msg) {                  if ($msg) {
# Line 102  sub path { Line 106  sub path {
106          }          }
107  }  }
108    
109  =head2 load_gs  =head2 load_ds
110    
111  Retrive from disk one data_structure records using field 000 as key  Retrive from disk one data_structure records using field 000 as key
112    
113    my @ds = $db->load_gs($rec);    my $ds = $db->load_ds($rec);
114    
115  This function will also perform basic sanity checking on returned  This function will also perform basic sanity checking on returned
116  data and disable caching if data is corrupted (or changed since last  data and disable caching if data is corrupted (or changed since last
117  update).  update).
118    
119  Returns array or undef if cacheing is disabled or unavailable.  Returns hash or undef if cacheing is disabled or unavailable.
120    
121  =cut  =cut
122    
123  sub load_gs {  sub load_ds {
124          my $self = shift;          my $self = shift;
125    
126          return unless $self->{'path'};          return unless $self->{'path'};
# Line 127  sub load_gs { Line 131  sub load_gs {
131    
132          my $cache_path = $self->{'path'};          my $cache_path = $self->{'path'};
133    
134          my $id = $rec->{'000'};          my $id = $rec;
135          $id = $rec->{'000'}->[0] if ($id =~ m/^ARRAY/o);          $id = $rec->{'000'} if (ref($id) eq 'HASH');
136            $id = $rec->{'000'}->[0] if (ref($id) eq 'ARRAY');
137    
138          unless (defined($id)) {          unless (defined($id)) {
139                  $log->warn("Can't use cacheing on records without unique identifier in field 000");                  $log->warn("Can't use cacheing on records without unique identifier in field 000");
# Line 149  sub load_gs { Line 154  sub load_gs {
154                                          }                                          }
155                                  };                                  };
156                                  if ($ok && $ds_ref->{'ds'}) {                                  if ($ok && $ds_ref->{'ds'}) {
157                                          return @{ $ds_ref->{'ds'} };                                          return $ds_ref->{'ds'};
158                                  } else {                                  } else {
159                                          $log->warn("cache entry $cache_path corrupt. Use rm $cache_path/* to re-create it on next run!");                                          $log->warn("cache entry $cache_path corrupt. Use rm $cache_path/* to re-create it on next run!");
160                                          undef $self->{'path'};                                          undef $self->{'path'};
161                                  }                                  }
162                          }                          }
163                    } else {
164                            return undef;
165                  }                  }
166          }          }
167    
168          return undef;          return undef;
169  }  }
170    
171  =head2 save_gs  =head2 save_ds
172    
173  Store data_structure on disk.  Store data_structure on disk.
174    
175    $db->save_gs(    $db->save_ds(
176          ds => \@ds,          ds => $ds,
177          current_filename => $self->{'current_filename'},          current_filename => $self->{'current_filename'},
178          headline => $self->{'headline'},          headline => $self->{'headline'},
179    );    );
180    
181  B<Totally broken, but fast.>  B<Totally broken, but fast.>
182    
183  Depends on filename generated by C<load_gs>.  Depends on filename generated by C<load_ds>.
184    
185  =cut  =cut
186    
187  sub save_gs {  sub save_ds {
188          my $self = shift;          my $self = shift;
189    
190            die "can't write to database in read_only mode!" if ($self->{'read_only'});
191    
192          return unless($self->{'path'});          return unless($self->{'path'});
193          return unless (@_);          return unless (@_);
194    
# Line 187  sub save_gs { Line 196  sub save_gs {
196    
197          my $log = $self->_get_logger;          my $log = $self->_get_logger;
198    
199          $log->logdie("save_gs without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});          $log->logdie("save_ds without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});
200    
201          foreach my $e (qw/ds current_filename headline/) {          foreach my $e (qw/ds current_filename headline/) {
202                  $log->logdie("missing $e") unless $arg->{$e};                  $log->warn("missing $e") unless $arg->{$e};
203          }          }
204    
205          $log->debug("creating storable cache file ",$self->{'cache_file'});          $log->debug("creating storable cache file ",$self->{'cache_file'});
Legend:
Removed from v.19  
changed lines
  Added in v.89
  ViewVC Help
Powered by ViewVC 1.1.26