--- trunk/lib/WebPAC/Store.pm 2005/12/05 17:48:14 220 +++ trunk/lib/WebPAC/Store.pm 2006/09/26 14:07:20 716 @@ -6,27 +6,30 @@ use base 'WebPAC::Common'; use Storable; use File::Path; -use Data::Dumper; +use Data::Dump qw/dump/; =head1 NAME -WebPAC::Store - Store normalized data on disk +WebPAC::Store - Store WebPAC data on disk =head1 VERSION -Version 0.06 +Version 0.12 =cut -our $VERSION = '0.06'; +our $VERSION = '0.12'; =head1 SYNOPSIS -This module provides disk storage for normalised data. +This module provides disk storage for normalised data and lookups. -It is newest component of WebPAC, so it will change quite often or be in -flux. However, I will try to keep backward compatiblity by providing -multiple back-ends. +It is one of newer components of WebPAC, so it will change from time to +time. + +I will try to keep backward compatiblity by providing multiple back-ends, +but this can't be garanteed. In other words, don't delete your input +databases just yet :-) This has additional advantage. I can create single place to plugin other file formats which provide better performance for particular type of data. @@ -56,18 +59,19 @@ 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 sub new { my $class = shift; - my $self = {@_}; - bless($self, $class); + my $self = {@_}; + bless($self, $class); my $log = $self->_get_logger(); - foreach my $p (qw/path database/) { + foreach my $p (qw/path/) { $log->logconfess("need $p") unless ($self->{$p}); } @@ -85,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 @@ -93,6 +99,8 @@ my $self = shift; my $dir = shift; + + return $self->{path} unless defined($dir); my $log = $self->_get_logger(); @@ -128,15 +136,22 @@ Retrive from disk one data_structure records usually using field 000 as key - my $ds = $db->load_ds( id => 42, prefix => 'name' ); + 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 +C object (for simple retrival from multiple databases). + Returns hash or undef if cacheing is disabled or unavailable. =cut @@ -161,18 +176,13 @@ $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 = $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/$prefix#$id"; + my $cache_file = "$cache_path/$database/$input/$id"; $cache_file =~ s#//#/#go; -open(my $fh, '>>', '/tmp/foo'); -print $fh "LOAD $cache_path / $prefix # $id ==> $cache_file\n"; -close($fh); - $log->debug("using cache_file $cache_file"); if (-r $cache_file) { @@ -199,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 @@ -217,38 +226,128 @@ 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#" . $arg->{id}; + my $cache_file = $self->{path} . "/$database/$input/"; $cache_file =~ s#//#/#go; + mkpath($cache_file) unless (-d $cache_file); + + $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 + +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 $args = {@_}; + + my $log = $self->_get_logger; + + 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 .= "/" . $args->{key}; + + if (store $args->{data}, $path) { + $log->info("saved lookup $path"); + return 1; + } else { + $log->logwarn("can't save lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!"); + return undef; + } +} + + =head1 AUTHOR Dobrica Pavlinusic, C<< >> =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.