/[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 127 by dpavlin, Thu Nov 24 11:47:29 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    
15  Version 0.01  Version 0.02
16    
17  =cut  =cut
18    
19  our $VERSION = '0.01';  our $VERSION = '0.02';
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    You can also example C<< $db->{path} >> to get current cache path.
78    
79  =cut  =cut
80    
81  sub function2 {  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  =head1 AUTHOR  =head2 load_ds
112    
113  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  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  =head1 BUGS          return unless $self->{'path'};
133    
134  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.  
135    
136  =head1 ACKNOWLEDGEMENTS          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  =head1 COPYRIGHT & LICENSE
224    
Legend:
Removed from v.1  
changed lines
  Added in v.127
  ViewVC Help
Powered by ViewVC 1.1.26