/[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 40 by dpavlin, Sat Nov 12 21:32:03 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    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  Perhaps a little code snippet.  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      );
48    
49  =head2 function1  Optional parameter C<path> defines path to directory
50    in which cache file for C<data_structure> call will be created.
51    
52  =cut  =cut
53    
54  sub function1 {  sub new {
55            my $class = shift;
56            my $self = {@_};
57            bless($self, $class);
58    
59            $self->path( $self->{'path'} );
60    
61            $self ? return $self : return undef;
62  }  }
63    
64  =head2 function2  =head2 path
65    
66    Check if specified cache directory exist, and if not, disable caching.
67    
68     $db->path('./cache/ds/');
69    
70    If you pass false or zero value to this function, it will disable
71    cacheing.
72    
73  =cut  =cut
74    
75  sub function2 {  sub path {
76            my $self = shift;
77    
78            my $dir = shift;
79    
80            my $log = $self->_get_logger();
81    
82            if ($dir) {
83                    my $msg;
84                    if (! -e $dir) {
85                            $msg = "doesn't exist";
86                    } elsif (! -d $dir) {
87                            $msg = "is not directory";
88                    } elsif (! -w $dir) {
89                            $msg = "not writable";
90                    }
91    
92                    if ($msg) {
93                            $log->warn("cache path $dir $msg, disabling...");
94                            undef $self->{'path'};
95                    } else {
96                            $log->debug("using cache dir $dir");
97                            $self->{'path'} = $dir;
98                    }
99            } else {
100                    $log->debug("disabling cache");
101                    undef $self->{'path'};
102            }
103  }  }
104    
105  =head1 AUTHOR  =head2 load_ds
106    
107  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Retrive from disk one data_structure records using field 000 as key
108    
109      my @ds = $db->load_ds($rec);
110    
111    This function will also perform basic sanity checking on returned
112    data and disable caching if data is corrupted (or changed since last
113    update).
114    
115    Returns array or undef if cacheing is disabled or unavailable.
116    
117    =cut
118    
119    sub load_ds {
120            my $self = shift;
121    
122            return unless $self->{'path'};
123    
124  =head1 BUGS          my $rec = shift || return;
125    
126  Please report any bugs or feature requests to          my $log = $self->_get_logger;
 C<bug-webpac-db@rt.cpan.org>, or through the web interface at  
 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WebPAC>.  
 I will be notified, and then you'll automatically be notified of progress on  
 your bug as I make changes.  
127    
128  =head1 ACKNOWLEDGEMENTS          my $cache_path = $self->{'path'};
129    
130            my $id = $rec->{'000'};
131            $id = $rec->{'000'}->[0] if ($id =~ m/^ARRAY/o);
132    
133            unless (defined($id)) {
134                    $log->warn("Can't use cacheing on records without unique identifier in field 000");
135                    undef $self->{'path'};
136            } else {
137                    my $cache_file = "$cache_path/$id";
138                    $self->{'cache_file'} = $cache_file;
139                    if (-r $cache_file) {
140                            my $ds_ref = retrieve($cache_file);
141                            if ($ds_ref) {
142                                    $log->debug("cache hit: $cache_file");
143                                    my $ok = 1;
144                                    foreach my $f (qw(current_filename headline)) {
145                                            if ($ds_ref->{$f}) {
146                                                    $self->{$f} = $ds_ref->{$f};
147                                            } else {
148                                                    $ok = 0;
149                                            }
150                                    };
151                                    if ($ok && $ds_ref->{'ds'}) {
152                                            return @{ $ds_ref->{'ds'} };
153                                    } else {
154                                            $log->warn("cache entry $cache_path corrupt. Use rm $cache_path/* to re-create it on next run!");
155                                            undef $self->{'path'};
156                                    }
157                            }
158                    }
159            }
160    
161            return undef;
162    }
163    
164    =head2 save_ds
165    
166    Store data_structure on disk.
167    
168      $db->save_ds(
169            ds => \@ds,
170            current_filename => $self->{'current_filename'},
171            headline => $self->{'headline'},
172      );
173    
174    B<Totally broken, but fast.>
175    
176    Depends on filename generated by C<load_ds>.
177    
178    =cut
179    
180    sub save_ds {
181            my $self = shift;
182    
183            return unless($self->{'path'});
184            return unless (@_);
185    
186            my $arg = {@_};
187    
188            my $log = $self->_get_logger;
189    
190            $log->logdie("save_ds without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});
191    
192            foreach my $e (qw/ds current_filename headline/) {
193                    $log->logconfess("missing $e") unless $arg->{$e};
194            }
195    
196            $log->debug("creating storable cache file ",$self->{'cache_file'});
197    
198            store {
199                    ds => $arg->{'ds'},
200                    current_filename => $arg->{'current_filename'},
201                    headline => $arg->{'headline'},
202            }, $self->{'cache_file'};
203    
204    }
205    
206    =head1 AUTHOR
207    
208    Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
209    
210  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
211    
Legend:
Removed from v.1  
changed lines
  Added in v.40
  ViewVC Help
Powered by ViewVC 1.1.26