/[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 44 by dpavlin, Mon Nov 14 16:12:20 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
# Line 116  Returns array or undef if cacheing is di Line 120  Returns array or undef if cacheing is di
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 161  sub load_gs { Line 166  sub load_gs {
166          return undef;          return undef;
167  }  }
168    
169  =head2 save_gs  =head2 save_ds
170    
171  Store data_structure on disk.  Store data_structure on disk.
172    
173    $db->save_gs(    $db->save_ds(
174          ds => \@ds,          ds => \@ds,
175          current_filename => $self->{'current_filename'},          current_filename => $self->{'current_filename'},
176          headline => $self->{'headline'},          headline => $self->{'headline'},
# Line 173  Store data_structure on disk. Line 178  Store data_structure on disk.
178    
179  B<Totally broken, but fast.>  B<Totally broken, but fast.>
180    
181  Depends on filename generated by C<load_gs>.  Depends on filename generated by C<load_ds>.
182    
183  =cut  =cut
184    
185  sub save_gs {  sub save_ds {
186          my $self = shift;          my $self = shift;
187    
188            die "can't write to database in read_only mode!" if ($self->{'read_only'});
189    
190          return unless($self->{'path'});          return unless($self->{'path'});
191          return unless (@_);          return unless (@_);
192    
# Line 187  sub save_gs { Line 194  sub save_gs {
194    
195          my $log = $self->_get_logger;          my $log = $self->_get_logger;
196    
197          $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'});
198    
199          foreach my $e (qw/ds current_filename headline/) {          foreach my $e (qw/ds current_filename headline/) {
200                  $log->logdie("missing $e") unless $arg->{$e};                  $log->logconfess("missing $e") unless $arg->{$e};
201          }          }
202    
203          $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.44
  ViewVC Help
Powered by ViewVC 1.1.26