3 |
use warnings; |
use warnings; |
4 |
use strict; |
use strict; |
5 |
|
|
6 |
use base 'WebPAC::Common'; |
use WebPAC::Common; |
7 |
|
use base qw/WebPAC::Common Class::Accessor/; |
8 |
|
__PACKAGE__->mk_accessors(qw/database/); |
9 |
|
|
10 |
use Storable; |
use Storable; |
11 |
use File::Path; |
use File::Path; |
12 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
17 |
|
|
18 |
=head1 VERSION |
=head1 VERSION |
19 |
|
|
20 |
Version 0.14 |
Version 0.15 |
21 |
|
|
22 |
=cut |
=cut |
23 |
|
|
24 |
our $VERSION = '0.14'; |
our $VERSION = '0.15'; |
25 |
|
|
26 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
27 |
|
|
37 |
This has additional advantage. I can create single place to plugin other |
This has additional advantage. I can create single place to plugin other |
38 |
file formats which provide better performance for particular type of data. |
file formats which provide better performance for particular type of data. |
39 |
|
|
|
For now, this is a prototype version. |
|
|
|
|
|
use WebPAC::Store; |
|
|
|
|
|
my $store = WebPAC::Store->new(); |
|
|
... |
|
|
|
|
40 |
=head1 FUNCTIONS |
=head1 FUNCTIONS |
41 |
|
|
42 |
=head2 new |
=head2 new |
43 |
|
|
44 |
Create new normalised database object |
Create new normalised database object |
45 |
|
|
46 |
my $store = new WebPAC::Store( |
my $store = new WebPAC::Store({ |
|
path => '/path/to/cache/ds/', |
|
47 |
database => 'name', |
database => 'name', |
48 |
read_only => 1, |
}); |
|
); |
|
49 |
|
|
50 |
Optional parameter C<path> defines path to directory |
Optional parameter C<path> defines path to directory |
51 |
in which cache file for C<data_structure> call will be created. |
in which cache file for C<data_structure> call will be created. |
52 |
|
|
|
If called with C<read_only> it will not disable caching if |
|
|
called without write permission (but will die on C<save_ds>). |
|
|
|
|
53 |
Optional parametar C<database> will be used used as subdirectory in path if no |
Optional parametar C<database> will be used used as subdirectory in path if no |
54 |
database in specified when calling other functions. |
database in specified when calling other functions. |
55 |
|
|
56 |
=cut |
=cut |
57 |
|
|
|
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'}; |
|
|
} |
|
|
} |
|
|
|
|
58 |
=head2 load_ds |
=head2 load_ds |
59 |
|
|
60 |
Retrive from disk one data_structure records usually using field 000 as key |
Retrive from disk one data_structure records usually using field 000 as key |
84 |
|
|
85 |
my $log = $self->_get_logger; |
my $log = $self->_get_logger; |
86 |
|
|
|
my $cache_path = $self->{'path'}; |
|
|
|
|
|
if (! $cache_path) { |
|
|
$log->warn("path not set, ignoring load_ds"); |
|
|
return; |
|
|
} |
|
|
|
|
87 |
$log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1)); |
$log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1)); |
88 |
|
|
89 |
my $args = {@_}; |
my $args = {@_}; |
92 |
$log->logconfess("got hash, but without id") unless (defined($id)); |
$log->logconfess("got hash, but without id") unless (defined($id)); |
93 |
$log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/); |
$log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/); |
94 |
|
|
95 |
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
my $database = $args->{database} || $self->database || $log->logconfess("no database?"); |
96 |
|
|
97 |
my $input = $args->{input} || ''; |
my $input = $args->{input} || ''; |
98 |
|
|
99 |
my $cache_file = "$cache_path/ds/$database/$input/$id"; |
my $cache_file = $self->var_path( 'ds', $database, $input, $id ); |
|
$cache_file =~ s#//#/#go; |
|
100 |
|
|
101 |
$log->debug("using cache_file $cache_file"); |
$log->debug("using cache_file $cache_file"); |
102 |
|
|
107 |
if ($ds_ref->{'ds'}) { |
if ($ds_ref->{'ds'}) { |
108 |
return $ds_ref->{'ds'}; |
return $ds_ref->{'ds'}; |
109 |
} else { |
} else { |
110 |
$log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!"); |
$log->warn("cache entry $cache_file corrupt. Use rm $cache_file to re-create it on next run!"); |
|
undef $self->{'path'}; |
|
111 |
} |
} |
112 |
} |
} |
113 |
} else { |
} else { |
136 |
sub save_ds { |
sub save_ds { |
137 |
my $self = shift; |
my $self = shift; |
138 |
|
|
|
die "can't write to database in read_only mode!" if ($self->{'read_only'}); |
|
|
|
|
|
return unless($self->{'path'}); |
|
|
|
|
139 |
my $args = {@_}; |
my $args = {@_}; |
140 |
|
|
141 |
my $log = $self->_get_logger; |
my $log = $self->_get_logger; |
142 |
$log->debug("save_ds arguments:", dump( \@_ )); |
$log->debug("save_ds arguments:", sub { dump( \@_ ) }); |
143 |
|
|
144 |
foreach my $f (qw/id ds/) { |
foreach my $f (qw/id ds/) { |
145 |
$log->logconfess("need $f") unless (defined($args->{$f})); |
$log->logconfess("need $f") unless (defined($args->{$f})); |
150 |
|
|
151 |
my $input = $args->{input} || ''; |
my $input = $args->{input} || ''; |
152 |
|
|
153 |
my $cache_file = $self->{path} . "/ds/$database/$input/"; |
my $cache_file = $self->var_path( 'ds', $database, $input ); |
|
$cache_file =~ s#//#/#go; |
|
154 |
|
|
155 |
mkpath($cache_file) unless (-d $cache_file); |
mkpath($cache_file) unless (-d $cache_file); |
156 |
|
|
157 |
$cache_file .= $args->{id}; |
$cache_file = $self->var_path( 'ds', $database, $input, $args->{id} ); |
158 |
|
|
159 |
$log->debug("creating storable cache file $cache_file"); |
$log->debug("creating storable cache file $cache_file"); |
160 |
|
|
191 |
|
|
192 |
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
193 |
|
|
194 |
my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key}; |
my $path = $self->var_path( 'lookup', $database, $args->{input}, $args->{key} ); |
195 |
|
|
196 |
if (! -e $path) { |
if (! -e $path) { |
197 |
$log->warn("lookup $path doesn't exist, skipping"); |
$log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input}); |
198 |
return; |
return; |
199 |
} |
} |
200 |
|
|
234 |
|
|
235 |
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
236 |
|
|
237 |
my $path = $self->{path} . "/lookup/$database/" . $args->{input}; |
my $path = $self->var_path( 'lookup', $database, $args->{input} ); |
238 |
|
|
239 |
mkpath($path) unless (-d $path); |
mkpath($path) unless (-d $path); |
240 |
|
|
241 |
$path .= "/" . $args->{key}; |
$path .= "/" . $args->{key}; |
242 |
|
|
243 |
|
my $t = time(); |
244 |
|
|
245 |
if (store $args->{data}, $path) { |
if (store $args->{data}, $path) { |
246 |
$log->info("saved lookup $path"); |
$log->info(sprintf("saved lookup $path in %.2fs", time() - $t)); |
247 |
return 1; |
return 1; |
248 |
} else { |
} else { |
249 |
$log->logwarn("can't save lookup to $path: $!"); |
$log->logwarn("can't save lookup to $path: $!"); |
277 |
|
|
278 |
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
279 |
|
|
280 |
my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id}; |
my $path = $self->var_path( 'row', $database, $args->{input}, $args->{id} ); |
281 |
|
|
282 |
if (! -e $path) { |
if (! -e $path) { |
283 |
$log->warn("input row $path doesn't exist, skipping"); |
$log->warn("input row $path doesn't exist, skipping"); |
320 |
|
|
321 |
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
322 |
|
|
323 |
my $path = $self->{path} . "/row/$database/" . $args->{input}; |
my $path = $self->var_path( 'row', $database, $args->{input} ); |
324 |
|
|
325 |
mkpath($path) unless (-d $path); |
mkpath($path) unless (-d $path); |
326 |
|
|