6 use base 'WebPAC::Common';
13 WebPAC::Store - Store normalized data on disk
21 our $VERSION = '0.05';
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>).
66 $self->path( $self->{'path'} );
68 $self ? return $self : return undef;
73 Check if specified cache directory exist, and if not, disable caching.
75 $db->path('./cache/ds/');
77 If you pass false or zero value to this function, it will disable
80 You can also example C<< $db->{path} >> to get current cache path.
89 my $log = $self->_get_logger();
94 if ($self->{'read_only'}) {
95 $msg = "doesn't exist";
97 $log->info("creating $dir");
100 } elsif (! -d $dir) {
101 $msg = "is not directory";
102 } elsif (! -w $dir) {
103 $msg = "not writable" unless ($self->{'read_only'});
107 $log->warn("cache path $dir $msg, disabling...");
108 undef $self->{'path'};
110 $log->debug("using cache dir $dir");
111 $self->{'path'} = $dir;
114 $log->debug("disabling cache");
115 undef $self->{'path'};
121 Retrive from disk one data_structure records usually using field 000 as key
123 my $ds = $db->load_ds( id => 42, database => 'name' );
125 This function will also perform basic sanity checking on returned
126 data and disable caching if data is corrupted (or changed since last
129 Returns hash or undef if cacheing is disabled or unavailable.
136 my $log = $self->_get_logger;
138 my $cache_path = $self->{'path'};
141 $log->warn("path not set, ignoring load_ds");
145 $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
148 my $id = $args->{id};
150 $log->logconfess("got hash, but without id") unless (defined($id));
151 $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);
153 my $database = $args->{database} || $self->{database};
155 $log->logconfess("can't find database name") unless ($database);
157 my $cache_file = "$cache_path/$database#$id";
158 $cache_file =~ s#//#/#g;
160 $log->debug("using cache_file $cache_file");
162 if (-r $cache_file) {
163 my $ds_ref = retrieve($cache_file);
165 $log->debug("cache hit: $cache_file");
166 if ($ds_ref->{'ds'}) {
167 return $ds_ref->{'ds'};
169 $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
170 undef $self->{'path'};
174 #$log->warn("cache entry $cache_file doesn't exist");
183 Store data_structure on disk.
186 id => $ds->{000}->[0],
191 B<Totally broken, but fast.>
193 Depends on filename generated by C<load_ds>.
200 die "can't write to database in read_only mode!" if ($self->{'read_only'});
202 return unless($self->{'path'});
206 my $log = $self->_get_logger;
208 foreach my $f (qw/id ds/) {
209 $log->logconfess("need $f") unless ($arg->{$f});
212 my $database = $arg->{database} || $self->{database};
213 $log->logconfess("can't find database name") unless ($database);
215 my $cache_file = $self->{path} . '/' . $database . '#' . $arg->{id};
217 $log->debug("creating storable cache file $cache_file");
228 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
230 =head1 COPYRIGHT & LICENSE
232 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
234 This program is free software; you can redistribute it and/or modify it
235 under the same terms as Perl itself.
239 1; # End of WebPAC::Store