/[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 17 by dpavlin, Sat Jul 16 20:35:30 2005 UTC revision 18 by dpavlin, Sun Jul 17 14:53:37 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    
# Line 28  Perhaps a little code snippet. Line 38  Perhaps a little code snippet.
38    
39  =head1 FUNCTIONS  =head1 FUNCTIONS
40    
41  =head2 function1  =head2 new
42    
43    Create new normalised database object
44    
45      my $db = new WebPAC::DB(
46            path = '/path/to/cache/ds/',
47      );
48    
49    Optional parameter C<path> defines path to directory
50    in which cache file for C<data_structure> call will be created.
51    
52    =cut
53    
54    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 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
74    
75    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                            undef $self->{'cache_data_structure'};
94                            $log->warn("cache_data_structure $dir $msg, disabling...");
95                    } else {
96                            $log->debug("using cache dir $dir");
97                    }
98            } else {
99                    $log->debug("disabling cache");
100                    undef $self->{'cache_data_structure'};
101            }
102    }
103    
104    =head2 load_gs
105    
106    Retrive from disk one data_structure records using field 000 as key
107    
108      my @ds = $db->load_gs($rec);
109    
110    This function will also perform basic sanity checking on returned
111    data and disable caching if data is corrupted (or changed since last
112    update).
113    
114    Returns array or undef if cacheing is disabled or unavailable.
115    
116  =cut  =cut
117    
118  sub function1 {  sub load_gs {
119            my $self = shift;
120    
121            return unless $self->{'path'};
122    
123            my $rec = shift || return;
124    
125            my $log = $self->_get_logger;
126    
127            my $cache_path = $self->{'path'};
128    
129            my $id = $rec->{'000'};
130            $id = $rec->{'000'}->[0] if ($id =~ m/^ARRAY/o);
131    
132            unless (defined($id)) {
133                    $log->warn("Can't use cacheing on records without unique identifier in field 000");
134                    undef $self->{'path'};
135            } else {
136                    my $cache_file = "$cache_path/$id";
137                    $self->{'cache_file'} = $cache_file;
138                    if (-r $cache_file) {
139                            my $ds_ref = retrieve($cache_file);
140                            if ($ds_ref) {
141                                    $log->debug("cache hit: $cache_file");
142                                    my $ok = 1;
143                                    foreach my $f (qw(current_filename headline)) {
144                                            if ($ds_ref->{$f}) {
145                                                    $self->{$f} = $ds_ref->{$f};
146                                            } else {
147                                                    $ok = 0;
148                                            }
149                                    };
150                                    if ($ok && $ds_ref->{'ds'}) {
151                                            return @{ $ds_ref->{'ds'} };
152                                    } else {
153                                            $log->warn("cache entry $cache_path corrupt. Use rm $cache_path/* to re-create it on next run!");
154                                            undef $self->{'path'};
155                                    }
156                            }
157                    }
158            }
159    
160            return undef;
161    }
162    
163    =head2 save_gs
164    
165    Store data_structure on disk.
166    
167      $db->save_gs(
168            ds => \@ds,
169            current_filename => $self->{'current_filename'},
170            headline => $self->{'headline'},
171      );
172    
173    B<Totally broken, but fast.>
174    
175    Depends on filename generated by C<load_gs>.
176    
177    =cut
178    
179    sub save_gs {
180            my $self = shift;
181    
182            return unless($self->{'path'});
183            return unless (@_);
184    
185            my $arg = {@_};
186    
187            my $log = $self->_get_logger;
188    
189            $log->logdie("save_gs without cache_file -- did you called gs_get before?") unless ($self->{'cache_file'});
190    
191            foreach my $e (qw/ds current_filename headline/) {
192                    $log->logdie("missing $e") unless $arg->{$e};
193            }
194    
195            $log->debug("creating storable cache file ",$self->{'cache_file'});
196    
197            store {
198                    ds => $arg->{'ds'},
199                    current_filename => $arg->{'current_filename'},
200                    headline => $arg->{'headline'},
201            }, $self->{'cache_file'};
202    
203  }  }
204    
205  =head1 AUTHOR  =head1 AUTHOR
Legend:
Removed from v.17  
changed lines
  Added in v.18
  ViewVC Help
Powered by ViewVC 1.1.26