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         if (store $args->{data}, $path) {
 335                 $log->info("saved lookup $path");
 336                 return 1;
 337         } else {
 338                 $log->logwarn("can't save lookup to $path: $!");
 339                 return undef;
 340         }
 341 }
 342
 343 =head2 load_row
 344
 345 Loads row from input database cache (used for lookups)
 346
 347   $row = $store->load_row(
 348         database => $database,
 349         input => $input,
 350         id => 42,
 351   );
 352
 353 C<database> is optional.
 354
 355 =cut
 356
 357 sub load_row {
 358         my $self = shift;
 359         my $args = {@_};
 360
 361         my $log = $self->_get_logger;
 362
 363         foreach my $r (qw/input id/) {
 364                 $log->logconfess("need '$r'") unless defined($args->{$r});
 365         }
 366
 367         my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
 368
 369         my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id};
 370
 371         if (! -e $path) {
 372                 $log->warn("input row $path doesn't exist, skipping");
 373                 return;
 374         }
 375
 376         if (my $data = retrieve($path)) {
 377                 $log->debug("loaded row $path");
 378                 return $data;
 379         } else {
 380                 $log->logwarn("can't load row from $path: $!");
 381                 return undef;
 382         }
 383 }
 384
 385 =head2 save_row
 386
 387 Save row data to file.
 388
 389   $store->save_row(
 390         database => $database,
 391         input => $input,
 392         id => $mfn,
 393         row => $lookup,
 394   );
 395
 396 C<database> is optional.
 397
 398 =cut
 399
 400 sub save_row {
 401         my $self = shift;
 402         my $args = {@_};
 403
 404         my $log = $self->_get_logger;
 405
 406         foreach my $r (qw/input id row/) {
 407                 $log->logconfess("need '$r'") unless defined($args->{$r});
 408         }
 409
 410         my $database = $args->{database} || $self->{database} || $log->logconfess("no database?");
 411
 412         my $path = $self->{path} . "/row/$database/" . $args->{input};
 413
 414         mkpath($path) unless (-d $path);
 415
 416         $path .= "/" . $args->{id};
 417
 418         if (store $args->{row}, $path) {
 419                 $log->debug("saved row $path");
 420                 return 1;
 421         } else {
 422                 $log->logwarn("can't save row to $path: $!");
 423                 return undef;
 424         }
 425 }
 426
 427
 428 =head1 AUTHOR
 429
 430 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 431
 432 =head1 COPYRIGHT & LICENSE
 433
 434 Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved.
 435
 436 This program is free software; you can redistribute it and/or modify it
 437 under the same terms as Perl itself.
 438
 439 =cut
 440
 441 1; # End of WebPAC::Store