git.rot13.org Git - webpac2/blob - lib/WebPAC/Store.pm

   1 package WebPAC::Store;
   2
   3 use warnings;
   4 use strict;
   5
   6 use base 'WebPAC::Common';
   7 use Storable;
   8 use File::Path;
   9 use Data::Dump qw/dump/;
  10
  11 =head1 NAME
  12
  13 WebPAC::Store - Store WebPAC data on disk
  14
  15 =head1 VERSION
  16
  17 Version 0.14
  18
  19 =cut
  20
  21 our $VERSION = '0.14';
  22
  23 =head1 SYNOPSIS
  24
  25 This module provides disk storage for normalised data and lookups.
  26
  27 It is one of newer components of WebPAC, so it will change from time to
  28 time.
  29
  30 I will try to keep backward compatiblity by providing multiple back-ends,
  31 but this can't be garanteed. In other words, don't delete your input
  32 databases just yet :-)
  33
  34 This has additional advantage. I can create single place to plugin other
  35 file formats which provide better performance for particular type of data.
  36
  37 For now, this is a prototype version.
  38
  39     use WebPAC::Store;
  40
  41     my $store = WebPAC::Store->new();
  42     ...
  43
  44 =head1 FUNCTIONS
  45
  46 =head2 new
  47
  48 Create new normalised database object
  49
  50   my $store = new WebPAC::Store(
  51         path => '/path/to/cache/ds/',
  52         database => 'name',
  53         read_only => 1,
  54   );
  55
  56 Optional parameter C<path> defines path to directory
  57 in which cache file for C<data_structure> call will be created.
  58
  59 If called with C<read_only> it will not disable caching if
  60 called without write permission (but will die on C<save_ds>).
  61
  62 Optional parametar C<database> will be used used as subdirectory in path if no
  63 database in specified when calling other functions.
  64
  65 =cut
  66
  67 sub new {
  68         my $class = shift;
  69         my $self = {@_};
  70         bless($self, $class);
  71
  72         my $log = $self->_get_logger();
  73
  74         foreach my $p (qw/path/) {
  75                 $log->logconfess("need $p") unless ($self->{$p});
  76         }
  77
  78         $self->path( $self->{'path'} );
  79
  80         $self ? return $self : return undef;
  81 }
  82
  83 =head2 path
  84
  85 Check if specified cache directory exist, and if not, disable caching.
  86
  87  $store->path('./cache/');
  88
  89 If you pass false or zero value to this function, it will disable
  90 cacheing.
  91
  92 You can also call this function to get current cache path.
  93
  94  my $cache_path = $store->path;
  95
  96 =cut
  97
  98 sub path {
  99         my $self = shift;
 100
 101         my $dir = shift;
 102
 103         return $self->{path} unless defined($dir);
 104
 105         my $log = $self->_get_logger();
 106
 107         if ($dir) {
 108                 my $msg;
 109                 if (! -e $dir) {
 110                         if ($self->{'read_only'}) {
 111                                 $msg = "doesn't exist";
 112                         } else {
 113                                 $log->info("creating $dir");
 114                                 mkpath $dir;
 115                         }
 116                 } elsif (! -d $dir) {
 117                         $msg = "is not directory";
 118                 } elsif (! -w $dir) {
 119                         $msg = "not writable" unless ($self->{'read_only'});
 120                 }
 121
 122                 if ($msg) {
 123                         $log->warn("cache path $dir $msg, disabling...");
 124                         undef $self->{'path'};
 125                 } else {
 126                         $log->debug("using cache dir $dir");
 127                         $self->{'path'} = $dir;
 128                 }
 129         } else {
 130                 $log->debug("disabling cache");
 131                 undef $self->{'path'};
 132         }
 133 }
 134
 135 =head2 load_ds
 136
 137 Retrive from disk one data_structure records usually using field 000 as key
 138
 139   my $ds = $store->load_ds(
 140                 database => 'ps',
 141                 input => 'name',
 142                 id => 42,
 143   );
 144
 145 This function will also perform basic sanity checking on returned
 146 data and disable caching if data is corrupted (or changed since last
 147 update).
 148
 149 C<input> is used to differenciate different source input databases
 150 which are indexed in same database.
 151
 152 C<database> if B<optional> argument which will override database name used when creating
 153 C<WebPAC::Store> object (for simple retrival from multiple databases).
 154
 155 Returns hash or undef if cacheing is disabled or unavailable.
 156
 157 =cut
 158
 159 sub load_ds {
 160         my $self = shift;
 161
 162         my $log = $self->_get_logger;
 163
 164         my $cache_path = $self->{'path'};
 165
 166         if (! $cache_path) {
 167                 $log->warn("path not set, ignoring load_ds");
 168                 return;
 169         }
 170
 171         $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1));
 172
 173         my $args = {@_};
 174         my $id = $args->{id};
 175
 176         $log->logconfess("got hash, but without id") unless (defined($id));
 177         $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/);
 178
 179         my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
 180
 181         my $input = $args->{input} || '';
 182
 183         my $cache_file = "$cache_path/ds/$database/$input/$id";
 184         $cache_file =~ s#//#/#go;
 185
 186         $log->debug("using cache_file $cache_file");
 187
 188         if (-r $cache_file) {
 189                 my $ds_ref = retrieve($cache_file);
 190                 if ($ds_ref) {
 191                         $log->debug("cache hit: $cache_file");
 192                         if ($ds_ref->{'ds'}) {
 193                                 return $ds_ref->{'ds'};
 194                         } else {
 195                                 $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
 196                                 undef $self->{'path'};
 197                         }
 198                 }
 199         } else {
 200                 #$log->warn("cache entry $cache_file doesn't exist");
 201                 return undef;
 202         }
 203
 204         return undef;
 205 }
 206
 207 =head2 save_ds
 208
 209 Store data_structure on disk.
 210
 211   $store->save_ds(
 212         database => 'name',
 213         input => 'name',
 214         id => $ds->{000}->[0],
 215         ds => $ds,
 216   );
 217
 218 C<database> and C<input> are optional.
 219
 220 =cut
 221
 222 sub save_ds {
 223         my $self = shift;
 224
 225         die "can't write to database in read_only mode!" if ($self->{'read_only'});
 226
 227         return unless($self->{'path'});
 228
 229         my $args = {@_};
 230
 231         my $log = $self->_get_logger;
 232         $log->debug("save_ds arguments:", dump( \@_ ));
 233
 234         foreach my $f (qw/id ds/) {
 235                 $log->logconfess("need $f") unless (defined($args->{$f}));
 236         }
 237
 238         my $database = $args->{database} || $self->{database};
 239         $log->logconfess("can't find database name") unless (defined($database));
 240
 241         my $input = $args->{input} || '';
 242
 243         my $cache_file = $self->{path} . "/ds/$database/$input/";
 244         $cache_file =~ s#//#/#go;
 245
 246         mkpath($cache_file) unless (-d $cache_file);
 247
 248         $cache_file .= $args->{id};
 249
 250         $log->debug("creating storable cache file $cache_file");
 251
 252         return store {
 253                 ds => $args->{ds},
 254                 id => $args->{id},
 255         }, $cache_file;
 256
 257 }
 258
 259 =head2 load_lookup
 260
 261 Loads lookup hash from file
 262
 263   $data = $store->load_lookup(
 264         database => $database,
 265         input => $input,
 266         key => $key,
 267   );
 268
 269 C<database> is optional.
 270
 271 =cut
 272
 273 sub load_lookup {
 274         my $self = shift;
 275         my $args = {@_};
 276
 277         my $log = $self->_get_logger;
 278
 279         foreach my $r (qw/input key/) {
 280                 $log->logconfess("need '$r'") unless defined($args->{$r});
 281         }
 282
 283         my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
 284
 285         my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key};
 286
 287         if (! -e $path) {
 288                 $log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input});
 289                 return;
 290         }
 291
 292         if (my $data = retrieve($path)) {
 293                 $log->info("loaded lookup $path");
 294                 return $data;
 295         } else {
 296                 $log->logwarn("can't load lookup $database/", $args->{input}, "/", $args->{key}, " from $path: $!");
 297                 return undef;
 298         }
 299 }
 300
 301 =head2 save_lookup
 302
 303 Save lookup data to file.
 304
 305   $store->save_lookup(
 306         database => $database,
 307         input => $input,
 308         key => $key,
 309         data => $lookup,
 310   );
 311
 312 C<database> is optional.
 313
 314 =cut
 315
 316 sub save_lookup {
 317         my $self = shift;
 318         my $args = {@_};
 319
 320         my $log = $self->_get_logger;
 321
 322         foreach my $r (qw/input key data/) {
 323                 $log->logconfess("need '$r'") unless defined($args->{$r});
 324         }
 325
 326         my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
 327
 328         my $path = $self->{path} . "/lookup/$database/" . $args->{input};
 329
 330         mkpath($path) unless (-d $path);
 331
 332         $path .= "/" . $args->{key};
 333
 334         my $t = time();
 335
 336         if (store $args->{data}, $path) {
 337                 $log->info(sprintf("saved lookup $path in %.2fs", time() - $t));
 338                 return 1;
 339         } else {
 340                 $log->logwarn("can't save lookup to $path: $!");
 341                 return undef;
 342         }
 343 }
 344
 345 =head2 load_row
 346
 347 Loads row from input database cache (used for lookups)
 348
 349   $row = $store->load_row(
 350         database => $database,
 351         input => $input,
 352         id => 42,
 353   );
 354
 355 C<database> is optional.
 356
 357 =cut
 358
 359 sub load_row {
 360         my $self = shift;
 361         my $args = {@_};
 362
 363         my $log = $self->_get_logger;
 364
 365         foreach my $r (qw/input id/) {
 366                 $log->logconfess("need '$r'") unless defined($args->{$r});
 367         }
 368
 369         my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
 370
 371         my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id};
 372
 373         if (! -e $path) {
 374                 $log->warn("input row $path doesn't exist, skipping");
 375                 return;
 376         }
 377
 378         if (my $data = retrieve($path)) {
 379                 $log->debug("loaded row $path");
 380                 return $data;
 381         } else {
 382                 $log->logwarn("can't load row from $path: $!");
 383                 return undef;
 384         }
 385 }
 386
 387 =head2 save_row
 388
 389 Save row data to file.
 390
 391   $store->save_row(
 392         database => $database,
 393         input => $input,
 394         id => $mfn,
 395         row => $lookup,
 396   );
 397
 398 C<database> is optional.
 399
 400 =cut
 401
 402 sub save_row {
 403         my $self = shift;
 404         my $args = {@_};
 405
 406         my $log = $self->_get_logger;
 407
 408         foreach my $r (qw/input id row/) {
 409                 $log->logconfess("need '$r'") unless defined($args->{$r});
 410         }
 411
 412         my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
 413
 414         my $path = $self->{path} . "/row/$database/" . $args->{input};
 415
 416         mkpath($path) unless (-d $path);
 417
 418         $path .= "/" . $args->{id};
 419
 420         if (store $args->{row}, $path) {
 421                 $log->debug("saved row $path");
 422                 return 1;
 423         } else {
 424                 $log->logwarn("can't save row to $path: $!");
 425                 return undef;
 426         }
 427 }
 428
 429
 430 =head1 AUTHOR
 431
 432 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 433
 434 =head1 COPYRIGHT & LICENSE
 435
 436 Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved.
 437
 438 This program is free software; you can redistribute it and/or modify it
 439 under the same terms as Perl itself.
 440
 441 =cut
 442
 443 1; # End of WebPAC::Store