/[webpac2]/trunk/lib/WebPAC/Store.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/lib/WebPAC/Store.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1083 - (show annotations)
Sun Dec 23 19:41:10 2007 UTC (16 years, 2 months ago) by dpavlin
File size: 7397 byte(s)
report size of loaded/saved file

1 package WebPAC::Store;
2
3 use warnings;
4 use strict;
5
6 use WebPAC::Common;
7 use base qw/WebPAC::Common Class::Accessor/;
8 __PACKAGE__->mk_accessors(qw/database/);
9
10 use Storable;
11 use File::Path;
12 use Data::Dump qw/dump/;
13
14 =head1 NAME
15
16 WebPAC::Store - Store WebPAC data on disk
17
18 =head1 VERSION
19
20 Version 0.15
21
22 =cut
23
24 our $VERSION = '0.15';
25
26 =head1 SYNOPSIS
27
28 This module provides disk storage for normalised data and lookups.
29
30 It is one of newer components of WebPAC, so it will change from time to
31 time.
32
33 I will try to keep backward compatiblity by providing multiple back-ends,
34 but this can't be garanteed. In other words, don't delete your input
35 databases just yet :-)
36
37 This has additional advantage. I can create single place to plugin other
38 file formats which provide better performance for particular type of data.
39
40 =head1 FUNCTIONS
41
42 =head2 new
43
44 Create new normalised database object
45
46 my $store = new WebPAC::Store({
47 database => 'name',
48 });
49
50 Optional parameter C<path> defines path to directory
51 in which cache file for C<data_structure> call will be created.
52
53 Optional parametar C<database> will be used used as subdirectory in path if no
54 database in specified when calling other functions.
55
56 =cut
57
58 =head2 load_ds
59
60 Retrive from disk one data_structure records usually using field 000 as key
61
62 my $ds = $store->load_ds(
63 database => 'ps',
64 input => 'name',
65 id => 42,
66 );
67
68 This function will also perform basic sanity checking on returned
69 data and disable caching if data is corrupted (or changed since last
70 update).
71
72 C<input> is used to differenciate different source input databases
73 which are indexed in same database.
74
75 C<database> if B<optional> argument which will override database name used when creating
76 C<WebPAC::Store> object (for simple retrival from multiple databases).
77
78 Returns hash or undef if cacheing is disabled or unavailable.
79
80 =cut
81
82 sub load_ds {
83 my $self = shift;
84
85 my $log = $self->_get_logger;
86
87 $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
88
89 my $args = {@_};
90 my $id = $args->{id};
91
92 $log->logconfess("got hash, but without id") unless (defined($id));
93 $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?");
96
97 my $input = $args->{input} || '';
98
99 my $cache_file = $self->var_path( 'ds', $database, $input, $id );
100
101 $log->debug("using cache_file $cache_file");
102
103 if (-r $cache_file) {
104 my $ds_ref = retrieve($cache_file);
105 if ($ds_ref) {
106 $log->debug("cache hit: $cache_file");
107 if ($ds_ref->{'ds'}) {
108 return $ds_ref->{'ds'};
109 } else {
110 $log->warn("cache entry $cache_file corrupt. Use rm $cache_file to re-create it on next run!");
111 }
112 }
113 } else {
114 #$log->warn("cache entry $cache_file doesn't exist");
115 return undef;
116 }
117
118 return undef;
119 }
120
121 =head2 save_ds
122
123 Store data_structure on disk.
124
125 $store->save_ds(
126 database => 'name',
127 input => 'name',
128 id => $ds->{000}->[0],
129 ds => $ds,
130 );
131
132 C<database> and C<input> are optional.
133
134 =cut
135
136 sub save_ds {
137 my $self = shift;
138
139 my $args = {@_};
140
141 my $log = $self->_get_logger;
142 $log->debug("save_ds arguments:", sub { dump( \@_ ) });
143
144 foreach my $f (qw/id ds/) {
145 $log->logconfess("need $f") unless (defined($args->{$f}));
146 }
147
148 my $database = $args->{database} || $self->{database};
149 $log->logconfess("can't find database name") unless (defined($database));
150
151 my $input = $args->{input} || '';
152
153 my $cache_file = $self->var_path( 'ds', $database, $input );
154
155 mkpath($cache_file) unless (-d $cache_file);
156
157 $cache_file = $self->var_path( 'ds', $database, $input, $args->{id} );
158
159 $log->debug("creating storable cache file $cache_file");
160
161 return store {
162 ds => $args->{ds},
163 id => $args->{id},
164 }, $cache_file;
165
166 }
167
168 =head2 load_lookup
169
170 Loads lookup hash from file
171
172 $data = $store->load_lookup(
173 database => $database,
174 input => $input,
175 key => $key,
176 );
177
178 C<database> is optional.
179
180 =cut
181
182 sub load_lookup {
183 my $self = shift;
184 my $args = {@_};
185
186 my $log = $self->_get_logger;
187
188 foreach my $r (qw/input key/) {
189 $log->logconfess("need '$r'") unless defined($args->{$r});
190 }
191
192 my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
193
194 my $path = $self->var_path( 'lookup', $database, $args->{input}, $args->{key} );
195
196 if (! -e $path) {
197 $log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input});
198 return;
199 }
200
201 if (my $data = retrieve($path)) {
202 $log->info("loaded lookup $path ", -s $path, " bytes");
203 return $data;
204 } else {
205 $log->logwarn("can't load lookup $database/", $args->{input}, "/", $args->{key}, " from $path: $!");
206 return undef;
207 }
208 }
209
210 =head2 save_lookup
211
212 Save lookup data to file.
213
214 $store->save_lookup(
215 database => $database,
216 input => $input,
217 key => $key,
218 data => $lookup,
219 );
220
221 C<database> is optional.
222
223 =cut
224
225 sub save_lookup {
226 my $self = shift;
227 my $args = {@_};
228
229 my $log = $self->_get_logger;
230
231 foreach my $r (qw/input key data/) {
232 $log->logconfess("need '$r'") unless defined($args->{$r});
233 }
234
235 my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
236
237 my $path = $self->var_path( 'lookup', $database, $args->{input} );
238
239 mkpath($path) unless (-d $path);
240
241 $path .= "/" . $args->{key};
242
243 my $t = time();
244
245 if (store $args->{data}, $path) {
246 $log->info(sprintf("saved lookup %s %d bytes in %.2fs", $path, -s $path, time() - $t));
247 return 1;
248 } else {
249 $log->logwarn("can't save lookup to $path: $!");
250 return undef;
251 }
252 }
253
254 =head2 load_row
255
256 Loads row from input database cache (used for lookups)
257
258 $row = $store->load_row(
259 database => $database,
260 input => $input,
261 id => 42,
262 );
263
264 C<database> is optional.
265
266 =cut
267
268 sub load_row {
269 my $self = shift;
270 my $args = {@_};
271
272 my $log = $self->_get_logger;
273
274 foreach my $r (qw/input id/) {
275 $log->logconfess("need '$r'") unless defined($args->{$r});
276 }
277
278 my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
279
280 my $path = $self->var_path( 'row', $database, $args->{input}, $args->{id} );
281
282 if (! -e $path) {
283 $log->warn("input row $path doesn't exist, skipping");
284 return;
285 }
286
287 if (my $data = retrieve($path)) {
288 $log->debug("loaded row $path");
289 return $data;
290 } else {
291 $log->logwarn("can't load row from $path: $!");
292 return undef;
293 }
294 }
295
296 =head2 save_row
297
298 Save row data to file.
299
300 $store->save_row(
301 database => $database,
302 input => $input,
303 id => $mfn,
304 row => $lookup,
305 );
306
307 C<database> is optional.
308
309 =cut
310
311 sub save_row {
312 my $self = shift;
313 my $args = {@_};
314
315 my $log = $self->_get_logger;
316
317 foreach my $r (qw/input id row/) {
318 $log->logconfess("need '$r'") unless defined($args->{$r});
319 }
320
321 my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
322
323 my $path = $self->var_path( 'row', $database, $args->{input} );
324
325 mkpath($path) unless (-d $path);
326
327 $path .= "/" . $args->{id};
328
329 if (store $args->{row}, $path) {
330 $log->debug("saved row $path");
331 return 1;
332 } else {
333 $log->logwarn("can't save row to $path: $!");
334 return undef;
335 }
336 }
337
338
339 =head1 AUTHOR
340
341 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
342
343 =head1 COPYRIGHT & LICENSE
344
345 Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved.
346
347 This program is free software; you can redistribute it and/or modify it
348 under the same terms as Perl itself.
349
350 =cut
351
352 1; # End of WebPAC::Store

  ViewVC Help
Powered by ViewVC 1.1.26