/[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

Diff of /trunk/lib/WebPAC/DB.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by dpavlin, Sat Jun 25 20:23:23 2005 UTC revision 113 by dpavlin, Wed Nov 23 00:14:05 2005 UTC
# Line 3  package WebPAC::DB; Line 3  package WebPAC::DB;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6    use base 'WebPAC::Common';
7    use Storable;
8    
9  =head1 NAME  =head1 NAME
10    
11  WebPAC::DB - The great new WebPAC::DB!  WebPAC::DB - Store normalized data on disk
12    
13  =head1 VERSION  =head1 VERSION
14    
# Line 17  our $VERSION = '0.01'; Line 20  our $VERSION = '0.01';
20    
21  =head1 SYNOPSIS  =head1 SYNOPSIS
22    
23  Quick summary of what the module does.  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  Perhaps a little code snippet.  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;      use WebPAC::DB;
35    
36      my $foo = WebPAC::DB->new();      my $foo = WebPAC::DB->new();
37      ...      ...
38    
39  =head1 EXPORT  =head1 FUNCTIONS
40    
41  A list of functions that can be exported.  You can delete this section  =head2 new
 if you don't export anything, such as for a purely object-oriented module.  
42    
43  =head1 FUNCTIONS  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  =head2 function1  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  =cut
57    
58  sub function1 {  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 function2  =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  =cut  =cut
78    
79  sub function2 {  sub path {
80            my $self = shift;
81    
82            my $dir = shift;
83    
84            my $log = $self->_get_logger();
85    
86            if ($dir) {
87                    my $msg;
88                    if (! -e $dir) {
89                            $msg = "doesn't exist";
90                    } elsif (! -d $dir) {
91                            $msg = "is not directory";
92                    } elsif (! -w $dir) {
93                            $msg = "not writable" unless ($self->{'read_only'});
94                    }
95    
96                    if ($msg) {
97                            $log->warn("cache path $dir $msg, disabling...");
98                            undef $self->{'path'};
99                    } else {
100                            $log->debug("using cache dir $dir");
101                            $self->{'path'} = $dir;
102                    }
103            } else {
104                    $log->debug("disabling cache");
105                    undef $self->{'path'};
106            }
107  }  }
108    
109  =head1 AUTHOR  =head2 load_ds
110    
111  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Retrive from disk one data_structure records using field 000 as key
112    
113      my $ds = $db->load_ds($rec);
114    
115    This function will also perform basic sanity checking on returned
116    data and disable caching if data is corrupted (or changed since last
117    update).
118    
119    Returns hash or undef if cacheing is disabled or unavailable.
120    
121    =cut
122    
123    sub load_ds {
124            my $self = shift;
125    
126            return unless $self->{'path'};
127    
128            my $rec = shift || return;
129    
130  =head1 BUGS          my $log = $self->_get_logger;
131    
132  Please report any bugs or feature requests to          my $cache_path = $self->{'path'};
133  C<bug-webpac-db@rt.cpan.org>, or through the web interface at  
134  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WebPAC>.          my $id = $rec;
135  I will be notified, and then you'll automatically be notified of progress on          $id = $rec->{'000'} if (ref($id) eq 'HASH');
136  your bug as I make changes.          $id = $rec->{'000'}->[0] if (ref($id) eq 'ARRAY');
137    
138            unless (defined($id)) {
139                    $log->warn("Can't use cacheing on records without unique identifier in field 000");
140                    undef $self->{'path'};
141            } else {
142                    my $cache_file = "$cache_path/$id";
143                    $self->{'cache_file'} = $cache_file;
144                    if (-r $cache_file) {
145                            my $ds_ref = retrieve($cache_file);
146                            if ($ds_ref) {
147                                    $log->debug("cache hit: $cache_file");
148                                    my $ok = 1;
149                                    foreach my $f (qw(current_filename headline)) {
150                                            if ($ds_ref->{$f}) {
151                                                    $self->{$f} = $ds_ref->{$f};
152                                            } else {
153                                                    $ok = 0;
154                                            }
155                                    };
156                                    if ($ok && $ds_ref->{'ds'}) {
157                                            return $ds_ref->{'ds'};
158                                    } else {
159                                            $log->warn("cache entry $cache_path corrupt. Use rm $cache_path/* to re-create it on next run!");
160                                            undef $self->{'path'};
161                                    }
162                            }
163                    } else {
164                            return undef;
165                    }
166            }
167    
168  =head1 ACKNOWLEDGEMENTS          return undef;
169    }
170    
171    =head2 save_ds
172    
173    Store data_structure on disk.
174    
175      $db->save_ds(
176            ds => $ds,
177            current_filename => $self->{'current_filename'},
178            headline => $self->{'headline'},
179      );
180    
181    B<Totally broken, but fast.>
182    
183    Depends on filename generated by C<load_ds>.
184    
185    =cut
186    
187    sub save_ds {
188            my $self = shift;
189    
190            die "can't write to database in read_only mode!" if ($self->{'read_only'});
191    
192            return unless($self->{'path'});
193            return unless (@_);
194    
195            my $arg = {@_};
196    
197            my $log = $self->_get_logger;
198    
199            $log->logdie("save_ds without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});
200    
201            $log->logdie("need ds") unless ($arg->{ds});
202    
203            foreach my $e (qw/current_filename headline/) {
204                    my $mfn = $arg->{ds}->{000}->[0] || '?';
205                    $log->warn("missing $e in record $mfn") unless $arg->{$e};
206            }
207    
208            $log->debug("creating storable cache file ",$self->{'cache_file'});
209    
210            store {
211                    ds => $arg->{'ds'},
212                    current_filename => $arg->{'current_filename'},
213                    headline => $arg->{'headline'},
214            }, $self->{'cache_file'};
215    
216    }
217    
218    =head1 AUTHOR
219    
220    Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
221    
222  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
223    
Legend:
Removed from v.1  
changed lines
  Added in v.113
  ViewVC Help
Powered by ViewVC 1.1.26