6 use base 'WebPAC::Common';
13 WebPAC::Store - Store WebPAC data on disk
21 our $VERSION = '0.10';
25 This module provides disk storage for normalised data and lookups.
27 It is one of newer components of WebPAC, so it will change from time to
30 I will try to keep backward compatiblity by providing multiple back-ends,
31 but this can't be garanteed. In other words, don't delete your input
32 databases just yet :-)
34 This has additional advantage. I can create single place to plugin other
35 file formats which provide better performance for particular type of data.
37 For now, this is a prototype version.
41 my $foo = WebPAC::Store->new();
48 Create new normalised database object
50 my $db = new WebPAC::Store(
51 path => '/path/to/cache/ds/',
56 Optional parameter C<path> defines path to directory
57 in which cache file for C<data_structure> call will be created.
59 If called with C<read_only> it will not disable caching if
60 called without write permission (but will die on C<save_ds>).
62 Mandatory parametar C<database> is used as subdirectory in database directory.
71 my $log = $self->_get_logger();
73 foreach my $p (qw/path database/) {
74 $log->logconfess("need $p") unless ($self->{$p});
77 $self->path( $self->{'path'} );
79 $self ? return $self : return undef;
84 Check if specified cache directory exist, and if not, disable caching.
86 $db->path('./cache/ds/');
88 If you pass false or zero value to this function, it will disable
91 You can also example C<< $db->{path} >> to get current cache path.
100 my $log = $self->_get_logger();
105 if ($self->{'read_only'}) {
106 $msg = "doesn't exist";
108 $log->info("creating $dir");
111 } elsif (! -d $dir) {
112 $msg = "is not directory";
113 } elsif (! -w $dir) {
114 $msg = "not writable" unless ($self->{'read_only'});
118 $log->warn("cache path $dir $msg, disabling...");
119 undef $self->{'path'};
121 $log->debug("using cache dir $dir");
122 $self->{'path'} = $dir;
125 $log->debug("disabling cache");
126 undef $self->{'path'};
132 Retrive from disk one data_structure records usually using field 000 as key
134 my $ds = $db->load_ds( id => 42, prefix => 'name', database => 'ps' );
136 This function will also perform basic sanity checking on returned
137 data and disable caching if data is corrupted (or changed since last
140 C<prefix> is used to differenciate different source input databases
141 which are indexed in same database.
143 C<database> if B<optional> argument which will override database name used when creating
144 C<WebPAC::Store> object (for simple retrival from multiple databases).
146 Returns hash or undef if cacheing is disabled or unavailable.
153 my $log = $self->_get_logger;
155 my $cache_path = $self->{'path'};
158 $log->warn("path not set, ignoring load_ds");
162 $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
165 my $id = $args->{id};
167 $log->logconfess("got hash, but without id") unless (defined($id));
168 $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
170 my $database = $args->{database} || $self->{database};
171 my $prefix = $args->{prefix} || '';
173 $log->logconfess("can't find database name") unless ($database);
175 my $cache_file = "$cache_path/$database/$prefix/$id";
176 $cache_file =~ s#//#/#go;
178 $log->debug("using cache_file $cache_file");
180 if (-r $cache_file) {
181 my $ds_ref = retrieve($cache_file);
183 $log->debug("cache hit: $cache_file");
184 if ($ds_ref->{'ds'}) {
185 return $ds_ref->{'ds'};
187 $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
188 undef $self->{'path'};
192 #$log->warn("cache entry $cache_file doesn't exist");
201 Store data_structure on disk.
204 id => $ds->{000}->[0],
209 B<Totally broken, but fast.>
211 Depends on filename generated by C<load_ds>.
218 die "can't write to database in read_only mode!" if ($self->{'read_only'});
220 return unless($self->{'path'});
224 my $log = $self->_get_logger;
226 foreach my $f (qw/id ds/) {
227 $log->logconfess("need $f") unless ($arg->{$f});
230 my $database = $self->{database};
231 $log->logconfess("can't find database name") unless ($database);
233 my $prefix = $arg->{prefix} || '';
235 my $cache_file = $self->{path} . '/' . $prefix . '/';
236 $cache_file =~ s#//#/#go;
238 mkpath($cache_file) unless (-d $cache_file);
240 $cache_file .= $arg->{id};
242 $log->debug("creating storable cache file $cache_file");
253 $db->save_lookup( $database, $input, $key, $lookup );
259 my ($database, $input, $key, $lookup) = @_;
261 my $log = $self->_get_logger;
263 my $path = $self->{'path'} . "/lookup/$input";
265 mkpath($path) unless (-d $path);
269 if (store $lookup, $path) {
270 $log->info("saved lookup $path");
272 $log->logwarn("can't store lookup $database/$input/$key in $path: $!");
281 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
283 =head1 COPYRIGHT & LICENSE
285 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
287 This program is free software; you can redistribute it and/or modify it
288 under the same terms as Perl itself.
292 1; # End of WebPAC::Store