--- trunk/lib/WebPAC/Store.pm 2006/09/25 18:58:43 710 +++ trunk/lib/WebPAC/Store.pm 2006/09/26 14:07:20 716 @@ -6,7 +6,7 @@ use base 'WebPAC::Common'; use Storable; use File::Path; -use Data::Dumper; +use Data::Dump qw/dump/; =head1 NAME @@ -14,11 +14,11 @@ =head1 VERSION -Version 0.10 +Version 0.12 =cut -our $VERSION = '0.10'; +our $VERSION = '0.12'; =head1 SYNOPSIS @@ -59,7 +59,8 @@ If called with C it will not disable caching if called without write permission (but will die on C). -Mandatory parametar C is used as subdirectory in database directory. +Optional parametar C will be used used as subdirectory in path if no +database in specified when calling other functions. =cut @@ -70,7 +71,7 @@ my $log = $self->_get_logger(); - foreach my $p (qw/path database/) { + foreach my $p (qw/path/) { $log->logconfess("need $p") unless ($self->{$p}); } @@ -88,7 +89,9 @@ If you pass false or zero value to this function, it will disable cacheing. -You can also example C<< $db->{path} >> to get current cache path. +You can also call this function to get current cache path. + + my $cache_path = $db->path; =cut @@ -96,6 +99,8 @@ my $self = shift; my $dir = shift; + + return $self->{path} unless defined($dir); my $log = $self->_get_logger(); @@ -131,13 +136,17 @@ Retrive from disk one data_structure records usually using field 000 as key - my $ds = $db->load_ds( id => 42, prefix => 'name', database => 'ps' ); + my $ds = $db->load_ds( + database => 'ps', + input => 'name', + id => 42, + ); This function will also perform basic sanity checking on returned data and disable caching if data is corrupted (or changed since last update). -C is used to differenciate different source input databases +C is used to differenciate different source input databases which are indexed in same database. C if B argument which will override database name used when creating @@ -167,12 +176,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}; - my $prefix = $args->{prefix} || ''; + my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); - $log->logconfess("can't find database name") unless ($database); + my $input = $args->{input} || ''; - my $cache_file = "$cache_path/$database/$prefix/$id"; + my $cache_file = "$cache_path/$database/$input/$id"; $cache_file =~ s#//#/#go; $log->debug("using cache_file $cache_file"); @@ -201,14 +209,13 @@ Store data_structure on disk. $db->save_ds( + database => 'name', + input => 'name', id => $ds->{000}->[0], - prefix => 'name', ds => $ds, ); -B - -Depends on filename generated by C. +C and C are optional. =cut @@ -219,60 +226,118 @@ return unless($self->{'path'}); - my $arg = {@_}; + my $args = {@_}; my $log = $self->_get_logger; + $log->debug("save_ds arguments:", dump( \@_ )); foreach my $f (qw/id ds/) { - $log->logconfess("need $f") unless ($arg->{$f}); + $log->logconfess("need $f") unless (defined($args->{$f})); } - my $database = $self->{database}; - $log->logconfess("can't find database name") unless ($database); + my $database = $args->{database} || $self->{database}; + $log->logconfess("can't find database name") unless (defined($database)); - my $prefix = $arg->{prefix} || ''; + my $input = $args->{input} || ''; - my $cache_file = $self->{path} . '/' . $prefix . '/'; + my $cache_file = $self->{path} . "/$database/$input/"; $cache_file =~ s#//#/#go; mkpath($cache_file) unless (-d $cache_file); - $cache_file .= $arg->{id}; + $cache_file .= $args->{id}; $log->debug("creating storable cache file $cache_file"); return store { - ds => $arg->{ds}, - id => $arg->{id}, + ds => $args->{ds}, + id => $args->{id}, }, $cache_file; } +=head2 load_lookup + +Loads lookup hash from file + + $data = $db->load_lookup( + database => $database, + input => $input, + key => $key, + ); + +C is optional. + +=cut + +sub load_lookup { + my $self = shift; + my $args = {@_}; + + my $log = $self->_get_logger; + + foreach my $r (qw/input key/) { + $log->logconfess("need '$r'") unless defined($args->{$r}); + } + + my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); + + my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key}; + + if (! -e $path) { + $log->warn("lookup $path doesn't exist, skipping"); + return; + } + + if (my $data = retrieve($path)) { + $log->info("loaded lookup $path"); + return $data; + } else { + $log->logwarn("can't load lookup $database/", $args->{input}, "/", $args->{key}, " from $path: $!"); + return undef; + } +} + =head2 save_lookup - $db->save_lookup( $database, $input, $key, $lookup ); +Save lookup data to file. + + $db->save_lookup( + database => $database, + input => $input, + key => $key, + data => $lookup, + ); + +C is optional. =cut sub save_lookup { my $self = shift; - my ($database, $input, $key, $lookup) = @_; + my $args = {@_}; my $log = $self->_get_logger; - my $path = $self->{'path'} . "/lookup/$input"; + foreach my $r (qw/input key data/) { + $log->logconfess("need '$r'") unless defined($args->{$r}); + } + + my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); + + my $path = $self->{path} . "/lookup/$database/" . $args->{input}; mkpath($path) unless (-d $path); - $path .= "/$key"; + $path .= "/" . $args->{key}; - if (store $lookup, $path) { + if (store $args->{data}, $path) { $log->info("saved lookup $path"); + return 1; } else { - $log->logwarn("can't store lookup $database/$input/$key in $path: $!"); + $log->logwarn("can't save lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!"); + return undef; } - - } @@ -282,7 +347,7 @@ =head1 COPYRIGHT & LICENSE -Copyright 2005 Dobrica Pavlinusic, All Rights Reserved. +Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.