r8853@llin: dpavlin | 2005-11-14 01:41:33 +0100

 added read_only mode

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@44 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/lib/WebPAC/DB.pm b/lib/WebPAC/DB.pm
index 788e82b..24c33e4 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) {
@@ -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");
@@ -180,6 +185,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 (@_);