r9064@llin: dpavlin | 2005-11-23 01:15:24 +0100

[webpac2] / lib / WebPAC / DB.pm

diff --git a/lib/WebPAC/DB.pm b/lib/WebPAC/DB.pm
index 0a10dfc..f9e58e0 100644 (file)
--- a/lib/WebPAC/DB.pm
+++ b/lib/WebPAC/DB.pm
@@ -43,12 +43,16 @@ For now, this is a prototype version.
 Create new normalised database object
 
   my $db = new WebPAC::DB(
-       path = '/path/to/cache/ds/',
+       path => '/path/to/cache/ds/',
+       read_only => 1,
   );
 
 Optional parameter C<path> defines path to directory
 in which cache file for C<data_structure> call will be created.
 
+If called with C<read_only> it will not disable caching if
+called without write permission (but will die on C<save_ds>).
+
 =cut
 
 sub new {
@@ -86,7 +90,7 @@ sub path {
                } elsif (! -d $dir) {
                        $msg = "is not directory";
                } elsif (! -w $dir) {
-                       $msg = "not writable";
+                       $msg = "not writable" unless ($self->{'read_only'});
                }
 
                if ($msg) {
@@ -106,13 +110,13 @@ sub path {
 
 Retrive from disk one data_structure records using field 000 as key
 
-  my @ds = $db->load_ds($rec);
+  my $ds = $db->load_ds($rec);
 
 This function will also perform basic sanity checking on returned
 data and disable caching if data is corrupted (or changed since last
 update).
 
-Returns array or undef if cacheing is disabled or unavailable.
+Returns hash or undef if cacheing is disabled or unavailable.
 
 =cut
 
@@ -127,8 +131,9 @@ sub load_ds {
 
        my $cache_path = $self->{'path'};
 
-       my $id = $rec->{'000'};
-       $id = $rec->{'000'}->[0] if ($id =~ m/^ARRAY/o);
+       my $id = $rec;
+       $id = $rec->{'000'} if (ref($id) eq 'HASH');
+       $id = $rec->{'000'}->[0] if (ref($id) eq 'ARRAY');
 
        unless (defined($id)) {
                $log->warn("Can't use cacheing on records without unique identifier in field 000");
@@ -149,12 +154,14 @@ sub load_ds {
                                        }
                                };
                                if ($ok && $ds_ref->{'ds'}) {
-                                       return @{ $ds_ref->{'ds'} };
+                                       return $ds_ref->{'ds'};
                                } else {
                                        $log->warn("cache entry $cache_path corrupt. Use rm $cache_path/* to re-create it on next run!");
                                        undef $self->{'path'};
                                }
                        }
+               } else {
+                       return undef;
                }
        }
 
@@ -166,7 +173,7 @@ sub load_ds {
 Store data_structure on disk.
 
   $db->save_ds(
-       ds => \@ds,
+       ds => $ds,
        current_filename => $self->{'current_filename'},
        headline => $self->{'headline'},
   );
@@ -180,6 +187,8 @@ Depends on filename generated by C<load_ds>.
 sub save_ds {
        my $self = shift;
 
+       die "can't write to database in read_only mode!" if ($self->{'read_only'});
+
        return unless($self->{'path'});
        return unless (@_);
 
@@ -189,8 +198,11 @@ sub save_ds {
 
        $log->logdie("save_ds without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});
 
-       foreach my $e (qw/ds current_filename headline/) {
-               $log->logdie("missing $e") unless $arg->{$e};
+       $log->logdie("need ds") unless ($arg->{ds});
+
+       foreach my $e (qw/current_filename headline/) {
+               my $mfn = $arg->{ds}->{000}->[0] || '?';
+               $log->warn("missing $e in record $mfn") unless $arg->{$e};
        }
 
        $log->debug("creating storable cache file ",$self->{'cache_file'});