/[webpac2]/trunk/lib/WebPAC/DB.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/DB.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 127 - (show annotations)
Thu Nov 24 11:47:29 2005 UTC (18 years, 4 months ago) by dpavlin
File size: 4532 byte(s)
 r9091@llin:  dpavlin | 2005-11-24 12:49:05 +0100
 small tweaks

1 package WebPAC::DB;
2
3 use warnings;
4 use strict;
5
6 use base 'WebPAC::Common';
7 use Storable;
8
9 =head1 NAME
10
11 WebPAC::DB - Store normalized data on disk
12
13 =head1 VERSION
14
15 Version 0.02
16
17 =cut
18
19 our $VERSION = '0.02';
20
21 =head1 SYNOPSIS
22
23 This module provides disk storage for normalised data.
24
25 It is newest component of WebPAC, so it will change quite often or be in
26 flux. However, I will try to keep backward compatiblity by providing
27 multiple back-ends.
28
29 This has additional advantage. I can create single place to plugin other
30 file formats which provide better performance for particular type of data.
31
32 For now, this is a prototype version.
33
34 use WebPAC::DB;
35
36 my $foo = WebPAC::DB->new();
37 ...
38
39 =head1 FUNCTIONS
40
41 =head2 new
42
43 Create new normalised database object
44
45 my $db = new WebPAC::DB(
46 path => '/path/to/cache/ds/',
47 read_only => 1,
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 If called with C<read_only> it will not disable caching if
54 called without write permission (but will die on C<save_ds>).
55
56 =cut
57
58 sub new {
59 my $class = shift;
60 my $self = {@_};
61 bless($self, $class);
62
63 $self->path( $self->{'path'} );
64
65 $self ? return $self : return undef;
66 }
67
68 =head2 path
69
70 Check if specified cache directory exist, and if not, disable caching.
71
72 $db->path('./cache/ds/');
73
74 If you pass false or zero value to this function, it will disable
75 cacheing.
76
77 You can also example C<< $db->{path} >> to get current cache path.
78
79 =cut
80
81 sub path {
82 my $self = shift;
83
84 my $dir = shift;
85
86 my $log = $self->_get_logger();
87
88 if ($dir) {
89 my $msg;
90 if (! -e $dir) {
91 $msg = "doesn't exist";
92 } elsif (! -d $dir) {
93 $msg = "is not directory";
94 } elsif (! -w $dir) {
95 $msg = "not writable" unless ($self->{'read_only'});
96 }
97
98 if ($msg) {
99 $log->warn("cache path $dir $msg, disabling...");
100 undef $self->{'path'};
101 } else {
102 $log->debug("using cache dir $dir");
103 $self->{'path'} = $dir;
104 }
105 } else {
106 $log->debug("disabling cache");
107 undef $self->{'path'};
108 }
109 }
110
111 =head2 load_ds
112
113 Retrive from disk one data_structure records using field 000 as key
114
115 my $ds = $db->load_ds( 42 );
116
117 There is also a more verbose form, similar to C<save_ds>
118
119 my $ds = $db->load_ds( id => 42 );
120
121 This function will also perform basic sanity checking on returned
122 data and disable caching if data is corrupted (or changed since last
123 update).
124
125 Returns hash or undef if cacheing is disabled or unavailable.
126
127 =cut
128
129 sub load_ds {
130 my $self = shift;
131
132 return unless $self->{'path'};
133
134 my $log = $self->_get_logger;
135
136 my $cache_path = $self->{'path'};
137
138 my $id = shift;
139 if (lc($id) eq 'id') {
140 $id = shift;
141 $log->logconfess("got hash, but without key id") unless (defined($id));
142 $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);
143 }
144
145 if (! defined($id)) {
146 $log->warn("called without id");
147 return undef;
148 } else {
149 my $cache_file = "$cache_path/$id";
150 if (-r $cache_file) {
151 my $ds_ref = retrieve($cache_file);
152 if ($ds_ref) {
153 $log->debug("cache hit: $cache_file");
154 my $ok = 1;
155 # foreach my $f (qw(current_filename headline)) {
156 # if ($ds_ref->{$f}) {
157 # $self->{$f} = $ds_ref->{$f};
158 # } else {
159 # $ok = 0;
160 # }
161 # };
162 if ($ok && $ds_ref->{'ds'}) {
163 return $ds_ref->{'ds'};
164 } else {
165 $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
166 undef $self->{'path'};
167 }
168 }
169 } else {
170 #$log->warn("cache entry $cache_file doesn't exist");
171 return undef;
172 }
173 }
174
175 return undef;
176 }
177
178 =head2 save_ds
179
180 Store data_structure on disk.
181
182 $db->save_ds(
183 id => $ds->{000}->[0],
184 ds => $ds,
185 );
186
187 B<Totally broken, but fast.>
188
189 Depends on filename generated by C<load_ds>.
190
191 =cut
192
193 sub save_ds {
194 my $self = shift;
195
196 die "can't write to database in read_only mode!" if ($self->{'read_only'});
197
198 return unless($self->{'path'});
199
200 my $arg = {@_};
201
202 my $log = $self->_get_logger;
203
204 foreach my $f (qw/id ds/) {
205 $log->logconfess("need $f") unless ($arg->{$f});
206 }
207
208 my $cache_file = $self->{path} . '/' . $arg->{id};
209
210 $log->debug("creating storable cache file $cache_file");
211
212 return store {
213 ds => $arg->{ds},
214 id => $arg->{id},
215 }, $cache_file;
216
217 }
218
219 =head1 AUTHOR
220
221 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
222
223 =head1 COPYRIGHT & LICENSE
224
225 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
226
227 This program is free software; you can redistribute it and/or modify it
228 under the same terms as Perl itself.
229
230 =cut
231
232 1; # End of WebPAC::DB

  ViewVC Help
Powered by ViewVC 1.1.26