14 |
|
|
15 |
=head1 VERSION |
=head1 VERSION |
16 |
|
|
17 |
Version 0.12 |
Version 0.14 |
18 |
|
|
19 |
=cut |
=cut |
20 |
|
|
21 |
our $VERSION = '0.12'; |
our $VERSION = '0.14'; |
22 |
|
|
23 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
24 |
|
|
38 |
|
|
39 |
use WebPAC::Store; |
use WebPAC::Store; |
40 |
|
|
41 |
my $foo = WebPAC::Store->new(); |
my $store = WebPAC::Store->new(); |
42 |
... |
... |
43 |
|
|
44 |
=head1 FUNCTIONS |
=head1 FUNCTIONS |
47 |
|
|
48 |
Create new normalised database object |
Create new normalised database object |
49 |
|
|
50 |
my $db = new WebPAC::Store( |
my $store = new WebPAC::Store( |
51 |
path => '/path/to/cache/ds/', |
path => '/path/to/cache/ds/', |
52 |
database => 'name', |
database => 'name', |
53 |
read_only => 1, |
read_only => 1, |
84 |
|
|
85 |
Check if specified cache directory exist, and if not, disable caching. |
Check if specified cache directory exist, and if not, disable caching. |
86 |
|
|
87 |
$db->path('./cache/ds/'); |
$store->path('./cache/'); |
88 |
|
|
89 |
If you pass false or zero value to this function, it will disable |
If you pass false or zero value to this function, it will disable |
90 |
cacheing. |
cacheing. |
91 |
|
|
92 |
You can also call this function to get current cache path. |
You can also call this function to get current cache path. |
93 |
|
|
94 |
my $cache_path = $db->path; |
my $cache_path = $store->path; |
95 |
|
|
96 |
=cut |
=cut |
97 |
|
|
136 |
|
|
137 |
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 |
138 |
|
|
139 |
my $ds = $db->load_ds( |
my $ds = $store->load_ds( |
140 |
database => 'ps', |
database => 'ps', |
141 |
input => 'name', |
input => 'name', |
142 |
id => 42, |
id => 42, |
180 |
|
|
181 |
my $input = $args->{input} || ''; |
my $input = $args->{input} || ''; |
182 |
|
|
183 |
my $cache_file = "$cache_path/$database/$input/$id"; |
my $cache_file = "$cache_path/ds/$database/$input/$id"; |
184 |
$cache_file =~ s#//#/#go; |
$cache_file =~ s#//#/#go; |
185 |
|
|
186 |
$log->debug("using cache_file $cache_file"); |
$log->debug("using cache_file $cache_file"); |
208 |
|
|
209 |
Store data_structure on disk. |
Store data_structure on disk. |
210 |
|
|
211 |
$db->save_ds( |
$store->save_ds( |
212 |
database => 'name', |
database => 'name', |
213 |
input => 'name', |
input => 'name', |
214 |
id => $ds->{000}->[0], |
id => $ds->{000}->[0], |
215 |
ds => $ds, |
ds => $ds, |
216 |
); |
); |
217 |
|
|
218 |
B<Totally broken, but fast.> |
C<database> and C<input> are optional. |
|
|
|
|
Depends on filename generated by C<load_ds>. |
|
219 |
|
|
220 |
=cut |
=cut |
221 |
|
|
240 |
|
|
241 |
my $input = $args->{input} || ''; |
my $input = $args->{input} || ''; |
242 |
|
|
243 |
my $cache_file = $self->{path} . "/$database/$input/"; |
my $cache_file = $self->{path} . "/ds/$database/$input/"; |
244 |
$cache_file =~ s#//#/#go; |
$cache_file =~ s#//#/#go; |
245 |
|
|
246 |
mkpath($cache_file) unless (-d $cache_file); |
mkpath($cache_file) unless (-d $cache_file); |
258 |
|
|
259 |
=head2 load_lookup |
=head2 load_lookup |
260 |
|
|
261 |
$data = $db->load_lookup( |
Loads lookup hash from file |
262 |
|
|
263 |
|
$data = $store->load_lookup( |
264 |
database => $database, |
database => $database, |
265 |
input => $input, |
input => $input, |
266 |
key => $key, |
key => $key, |
267 |
); |
); |
268 |
|
|
269 |
|
C<database> is optional. |
270 |
|
|
271 |
=cut |
=cut |
272 |
|
|
273 |
sub load_lookup { |
sub load_lookup { |
285 |
my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key}; |
my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key}; |
286 |
|
|
287 |
if (! -e $path) { |
if (! -e $path) { |
288 |
$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}); |
289 |
return; |
return; |
290 |
} |
} |
291 |
|
|
300 |
|
|
301 |
=head2 save_lookup |
=head2 save_lookup |
302 |
|
|
303 |
$db->save_lookup( |
Save lookup data to file. |
304 |
|
|
305 |
|
$store->save_lookup( |
306 |
database => $database, |
database => $database, |
307 |
input => $input, |
input => $input, |
308 |
key => $key, |
key => $key, |
309 |
data => $lookup, |
data => $lookup, |
310 |
); |
); |
311 |
|
|
312 |
|
C<database> is optional. |
313 |
|
|
314 |
=cut |
=cut |
315 |
|
|
316 |
sub save_lookup { |
sub save_lookup { |
335 |
$log->info("saved lookup $path"); |
$log->info("saved lookup $path"); |
336 |
return 1; |
return 1; |
337 |
} else { |
} else { |
338 |
$log->logwarn("can't save lookup $database/", $args->{input}, "/", $args->{key}, " in $path: $!"); |
$log->logwarn("can't save lookup to $path: $!"); |
339 |
|
return undef; |
340 |
|
} |
341 |
|
} |
342 |
|
|
343 |
|
=head2 load_row |
344 |
|
|
345 |
|
Loads row from input database cache (used for lookups) |
346 |
|
|
347 |
|
$row = $store->load_row( |
348 |
|
database => $database, |
349 |
|
input => $input, |
350 |
|
id => 42, |
351 |
|
); |
352 |
|
|
353 |
|
C<database> is optional. |
354 |
|
|
355 |
|
=cut |
356 |
|
|
357 |
|
sub load_row { |
358 |
|
my $self = shift; |
359 |
|
my $args = {@_}; |
360 |
|
|
361 |
|
my $log = $self->_get_logger; |
362 |
|
|
363 |
|
foreach my $r (qw/input id/) { |
364 |
|
$log->logconfess("need '$r'") unless defined($args->{$r}); |
365 |
|
} |
366 |
|
|
367 |
|
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
368 |
|
|
369 |
|
my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id}; |
370 |
|
|
371 |
|
if (! -e $path) { |
372 |
|
$log->warn("input row $path doesn't exist, skipping"); |
373 |
|
return; |
374 |
|
} |
375 |
|
|
376 |
|
if (my $data = retrieve($path)) { |
377 |
|
$log->debug("loaded row $path"); |
378 |
|
return $data; |
379 |
|
} else { |
380 |
|
$log->logwarn("can't load row from $path: $!"); |
381 |
|
return undef; |
382 |
|
} |
383 |
|
} |
384 |
|
|
385 |
|
=head2 save_row |
386 |
|
|
387 |
|
Save row data to file. |
388 |
|
|
389 |
|
$store->save_row( |
390 |
|
database => $database, |
391 |
|
input => $input, |
392 |
|
id => $mfn, |
393 |
|
row => $lookup, |
394 |
|
); |
395 |
|
|
396 |
|
C<database> is optional. |
397 |
|
|
398 |
|
=cut |
399 |
|
|
400 |
|
sub save_row { |
401 |
|
my $self = shift; |
402 |
|
my $args = {@_}; |
403 |
|
|
404 |
|
my $log = $self->_get_logger; |
405 |
|
|
406 |
|
foreach my $r (qw/input id row/) { |
407 |
|
$log->logconfess("need '$r'") unless defined($args->{$r}); |
408 |
|
} |
409 |
|
|
410 |
|
my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); |
411 |
|
|
412 |
|
my $path = $self->{path} . "/row/$database/" . $args->{input}; |
413 |
|
|
414 |
|
mkpath($path) unless (-d $path); |
415 |
|
|
416 |
|
$path .= "/" . $args->{id}; |
417 |
|
|
418 |
|
if (store $args->{row}, $path) { |
419 |
|
$log->debug("saved row $path"); |
420 |
|
return 1; |
421 |
|
} else { |
422 |
|
$log->logwarn("can't save row to $path: $!"); |
423 |
return undef; |
return undef; |
424 |
} |
} |
425 |
} |
} |
431 |
|
|
432 |
=head1 COPYRIGHT & LICENSE |
=head1 COPYRIGHT & LICENSE |
433 |
|
|
434 |
Copyright 2005 Dobrica Pavlinusic, All Rights Reserved. |
Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved. |
435 |
|
|
436 |
This program is free software; you can redistribute it and/or modify it |
This program is free software; you can redistribute it and/or modify it |
437 |
under the same terms as Perl itself. |
under the same terms as Perl itself. |