6 use base 'WebPAC::Common';
12 WebPAC::Store - Store normalized data on disk
20 our $VERSION = '0.04';
24 This module provides disk storage for normalised data.
26 It is newest component of WebPAC, so it will change quite often or be in
27 flux. However, I will try to keep backward compatiblity by providing
30 This has additional advantage. I can create single place to plugin other
31 file formats which provide better performance for particular type of data.
33 For now, this is a prototype version.
37 my $foo = WebPAC::Store->new();
44 Create new normalised database object
46 my $db = new WebPAC::Store(
47 path => '/path/to/cache/ds/',
51 Optional parameter C<path> defines path to directory
52 in which cache file for C<data_structure> call will be created.
54 If called with C<read_only> it will not disable caching if
55 called without write permission (but will die on C<save_ds>).
64 $self->path( $self->{'path'} );
66 $self ? return $self : return undef;
71 Check if specified cache directory exist, and if not, disable caching.
73 $db->path('./cache/ds/');
75 If you pass false or zero value to this function, it will disable
78 You can also example C<< $db->{path} >> to get current cache path.
87 my $log = $self->_get_logger();
92 if ($self->{'read_only'}) {
93 $msg = "doesn't exist";
95 $log->info("creating $dir");
99 $msg = "is not directory";
100 } elsif (! -w $dir) {
101 $msg = "not writable" unless ($self->{'read_only'});
105 $log->warn("cache path $dir $msg, disabling...");
106 undef $self->{'path'};
108 $log->debug("using cache dir $dir");
109 $self->{'path'} = $dir;
112 $log->debug("disabling cache");
113 undef $self->{'path'};
119 Retrive from disk one data_structure records using field 000 as key
121 my $ds = $db->load_ds( 42 );
123 There is also a more verbose form, similar to C<save_ds>
125 my $ds = $db->load_ds( id => 42 );
127 This function will also perform basic sanity checking on returned
128 data and disable caching if data is corrupted (or changed since last
131 Returns hash or undef if cacheing is disabled or unavailable.
138 return unless $self->{'path'};
140 my $log = $self->_get_logger;
142 my $cache_path = $self->{'path'};
145 if (lc($id) eq 'id') {
147 $log->logconfess("got hash, but without key id") unless (defined($id));
148 $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);
151 if (! defined($id)) {
152 $log->warn("called without id");
155 my $cache_file = "$cache_path/$id";
156 if (-r $cache_file) {
157 my $ds_ref = retrieve($cache_file);
159 $log->debug("cache hit: $cache_file");
161 # foreach my $f (qw(current_filename headline)) {
162 # if ($ds_ref->{$f}) {
163 # $self->{$f} = $ds_ref->{$f};
168 if ($ok && $ds_ref->{'ds'}) {
169 return $ds_ref->{'ds'};
171 $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
172 undef $self->{'path'};
176 #$log->warn("cache entry $cache_file doesn't exist");
186 Store data_structure on disk.
189 id => $ds->{000}->[0],
193 B<Totally broken, but fast.>
195 Depends on filename generated by C<load_ds>.
202 die "can't write to database in read_only mode!" if ($self->{'read_only'});
204 return unless($self->{'path'});
208 my $log = $self->_get_logger;
210 foreach my $f (qw/id ds/) {
211 $log->logconfess("need $f") unless ($arg->{$f});
214 my $cache_file = $self->{path} . '/' . $arg->{id};
216 $log->debug("creating storable cache file $cache_file");
227 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
229 =head1 COPYRIGHT & LICENSE
231 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
233 This program is free software; you can redistribute it and/or modify it
234 under the same terms as Perl itself.
238 1; # End of WebPAC::Store