6 use base 'WebPAC::Common';
13 WebPAC::Store - Store normalized data on disk
21 our $VERSION = '0.09';
25 This module provides disk storage for normalised data.
27 It is newest component of WebPAC, so it will change quite often or be in
28 flux. However, I will try to keep backward compatiblity by providing
31 This has additional advantage. I can create single place to plugin other
32 file formats which provide better performance for particular type of data.
34 For now, this is a prototype version.
38 my $foo = WebPAC::Store->new();
45 Create new normalised database object
47 my $db = new WebPAC::Store(
48 path => '/path/to/cache/ds/',
53 Optional parameter C<path> defines path to directory
54 in which cache file for C<data_structure> call will be created.
56 If called with C<read_only> it will not disable caching if
57 called without write permission (but will die on C<save_ds>).
59 Mandatory parametar C<database> is used as subdirectory in database directory.
68 my $log = $self->_get_logger();
70 foreach my $p (qw/path database/) {
71 $log->logconfess("need $p") unless ($self->{$p});
74 $self->path( $self->{'path'} );
76 $self ? return $self : return undef;
81 Check if specified cache directory exist, and if not, disable caching.
83 $db->path('./cache/ds/');
85 If you pass false or zero value to this function, it will disable
88 You can also example C<< $db->{path} >> to get current cache path.
97 my $log = $self->_get_logger();
102 if ($self->{'read_only'}) {
103 $msg = "doesn't exist";
105 $log->info("creating $dir");
108 } elsif (! -d $dir) {
109 $msg = "is not directory";
110 } elsif (! -w $dir) {
111 $msg = "not writable" unless ($self->{'read_only'});
115 $log->warn("cache path $dir $msg, disabling...");
116 undef $self->{'path'};
118 $log->debug("using cache dir $dir");
119 $self->{'path'} = $dir;
122 $log->debug("disabling cache");
123 undef $self->{'path'};
129 Retrive from disk one data_structure records usually using field 000 as key
131 my $ds = $db->load_ds( id => 42, prefix => 'name', database => 'ps' );
133 This function will also perform basic sanity checking on returned
134 data and disable caching if data is corrupted (or changed since last
137 C<prefix> is used to differenciate different source input databases
138 which are indexed in same database.
140 C<database> if B<optional> argument which will override database name used when creating
141 C<WebPAC::Store> object (for simple retrival from multiple databases).
143 Returns hash or undef if cacheing is disabled or unavailable.
150 my $log = $self->_get_logger;
152 my $cache_path = $self->{'path'};
155 $log->warn("path not set, ignoring load_ds");
159 $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
162 my $id = $args->{id};
164 $log->logconfess("got hash, but without id") unless (defined($id));
165 $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
167 my $database = $args->{database} || $self->{database};
168 my $prefix = $args->{prefix} || '';
170 $log->logconfess("can't find database name") unless ($database);
172 my $cache_file = "$cache_path/$database/$prefix/$id";
173 $cache_file =~ s#//#/#go;
175 open(my $fh, '>>', '/tmp/foo');
176 print $fh "LOAD $cache_path / $database / $prefix / $id ==> $cache_file\n";
179 $log->debug("using cache_file $cache_file");
181 if (-r $cache_file) {
182 my $ds_ref = retrieve($cache_file);
184 $log->debug("cache hit: $cache_file");
185 if ($ds_ref->{'ds'}) {
186 return $ds_ref->{'ds'};
188 $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
189 undef $self->{'path'};
193 #$log->warn("cache entry $cache_file doesn't exist");
202 Store data_structure on disk.
205 id => $ds->{000}->[0],
210 B<Totally broken, but fast.>
212 Depends on filename generated by C<load_ds>.
219 die "can't write to database in read_only mode!" if ($self->{'read_only'});
221 return unless($self->{'path'});
225 my $log = $self->_get_logger;
227 foreach my $f (qw/id ds/) {
228 $log->logconfess("need $f") unless ($arg->{$f});
231 my $database = $self->{database};
232 $log->logconfess("can't find database name") unless ($database);
234 my $prefix = $arg->{prefix} || '';
236 my $cache_file = $self->{path} . '/' . $prefix . '/';
237 $cache_file =~ s#//#/#go;
239 mkpath($cache_file) unless (-d $cache_file);
241 $cache_file .= $arg->{id};
243 $log->debug("creating storable cache file $cache_file");
254 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
256 =head1 COPYRIGHT & LICENSE
258 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
260 This program is free software; you can redistribute it and/or modify it
261 under the same terms as Perl itself.
265 1; # End of WebPAC::Store