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 {
} elsif (! -d $dir) {
$msg = "is not directory";
} elsif (! -w $dir) {
- $msg = "not writable";
+ $msg = "not writable" unless ($self->{'read_only'});
}
if ($msg) {
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
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");
}
};
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;
}
}
Store data_structure on disk.
$db->save_ds(
- ds => \@ds,
+ ds => $ds,
current_filename => $self->{'current_filename'},
headline => $self->{'headline'},
);
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 (@_);
$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->logconfess("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'});