--- trunk/lib/WebPAC/Store.pm 2007/05/27 14:09:30 853 +++ trunk/lib/WebPAC/Store.pm 2007/09/03 15:26:46 887 @@ -3,7 +3,10 @@ use warnings; use strict; -use base 'WebPAC::Common'; +use WebPAC::Common; +use base qw/WebPAC::Common Class::Accessor/; +__PACKAGE__->mk_accessors(qw/database/); + use Storable; use File::Path; use Data::Dump qw/dump/; @@ -14,11 +17,11 @@ =head1 VERSION -Version 0.14 +Version 0.15 =cut -our $VERSION = '0.14'; +our $VERSION = '0.15'; =head1 SYNOPSIS @@ -34,104 +37,24 @@ This has additional advantage. I can create single place to plugin other file formats which provide better performance for particular type of data. -For now, this is a prototype version. - - use WebPAC::Store; - - my $store = WebPAC::Store->new(); - ... - =head1 FUNCTIONS =head2 new Create new normalised database object - my $store = new WebPAC::Store( - path => '/path/to/cache/ds/', + my $store = new WebPAC::Store({ database => 'name', - read_only => 1, - ); + }); Optional parameter C defines path to directory in which cache file for C call will be created. -If called with C it will not disable caching if -called without write permission (but will die on C). - Optional parametar C will be used used as subdirectory in path if no database in specified when calling other functions. =cut -sub new { - my $class = shift; - my $self = {@_}; - bless($self, $class); - - my $log = $self->_get_logger(); - - foreach my $p (qw/path/) { - $log->logconfess("need $p") unless ($self->{$p}); - } - - $self->path( $self->{'path'} ); - - $self ? return $self : return undef; -} - -=head2 path - -Check if specified cache directory exist, and if not, disable caching. - - $store->path('./cache/'); - -If you pass false or zero value to this function, it will disable -cacheing. - -You can also call this function to get current cache path. - - my $cache_path = $store->path; - -=cut - -sub path { - my $self = shift; - - my $dir = shift; - - return $self->{path} unless defined($dir); - - my $log = $self->_get_logger(); - - if ($dir) { - my $msg; - if (! -e $dir) { - if ($self->{'read_only'}) { - $msg = "doesn't exist"; - } else { - $log->info("creating $dir"); - mkpath $dir; - } - } elsif (! -d $dir) { - $msg = "is not directory"; - } elsif (! -w $dir) { - $msg = "not writable" unless ($self->{'read_only'}); - } - - if ($msg) { - $log->warn("cache path $dir $msg, disabling..."); - undef $self->{'path'}; - } else { - $log->debug("using cache dir $dir"); - $self->{'path'} = $dir; - } - } else { - $log->debug("disabling cache"); - undef $self->{'path'}; - } -} - =head2 load_ds Retrive from disk one data_structure records usually using field 000 as key @@ -161,13 +84,6 @@ my $log = $self->_get_logger; - my $cache_path = $self->{'path'}; - - if (! $cache_path) { - $log->warn("path not set, ignoring load_ds"); - return; - } - $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1)); my $args = {@_}; @@ -176,12 +92,11 @@ $log->logconfess("got hash, but without id") unless (defined($id)); $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/); - my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); + my $database = $args->{database} || $self->database || $log->logconfess("no database?"); my $input = $args->{input} || ''; - my $cache_file = "$cache_path/ds/$database/$input/$id"; - $cache_file =~ s#//#/#go; + my $cache_file = $self->var_path( 'ds', $database, $input, $id ); $log->debug("using cache_file $cache_file"); @@ -192,8 +107,7 @@ if ($ds_ref->{'ds'}) { return $ds_ref->{'ds'}; } else { - $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!"); - undef $self->{'path'}; + $log->warn("cache entry $cache_file corrupt. Use rm $cache_file to re-create it on next run!"); } } } else { @@ -222,10 +136,6 @@ sub save_ds { my $self = shift; - die "can't write to database in read_only mode!" if ($self->{'read_only'}); - - return unless($self->{'path'}); - my $args = {@_}; my $log = $self->_get_logger; @@ -240,12 +150,11 @@ my $input = $args->{input} || ''; - my $cache_file = $self->{path} . "/ds/$database/$input/"; - $cache_file =~ s#//#/#go; + my $cache_file = $self->var_path( 'ds', $database, $input ); mkpath($cache_file) unless (-d $cache_file); - $cache_file .= $args->{id}; + $cache_file = $self->var_path( 'ds', $database, $input, $args->{id} ); $log->debug("creating storable cache file $cache_file"); @@ -282,7 +191,7 @@ my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); - my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key}; + my $path = $self->var_path( 'lookup', $database, $args->{input}, $args->{key} ); if (! -e $path) { $log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input}); @@ -325,7 +234,7 @@ my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); - my $path = $self->{path} . "/lookup/$database/" . $args->{input}; + my $path = $self->var_path( 'lookup', $database, $args->{input} ); mkpath($path) unless (-d $path); @@ -368,7 +277,7 @@ my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); - my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id}; + my $path = $self->var_path( 'row', $database, $args->{input}, $args->{id} ); if (! -e $path) { $log->warn("input row $path doesn't exist, skipping"); @@ -411,7 +320,7 @@ my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); - my $path = $self->{path} . "/row/$database/" . $args->{input}; + my $path = $self->var_path( 'row', $database, $args->{input} ); mkpath($path) unless (-d $path);