+++ /dev/null
-package WebPAC::DB;
-
-use warnings;
-use strict;
-
-use base 'WebPAC::Common';
-use Storable;
-
-=head1 NAME
-
-WebPAC::DB - Store normalized data on disk
-
-=head1 VERSION
-
-Version 0.02
-
-=cut
-
-our $VERSION = '0.02';
-
-=head1 SYNOPSIS
-
-This module provides disk storage for normalised data.
-
-It is newest component of WebPAC, so it will change quite often or be in
-flux. However, I will try to keep backward compatiblity by providing
-multiple back-ends.
-
-This has additional advantage. I can create single place to plugin other
-file formats which provide better performance for particular type of data.
-
-For now, this is a prototype version.
-
- use WebPAC::DB;
-
- my $foo = WebPAC::DB->new();
- ...
-
-=head1 FUNCTIONS
-
-=head2 new
-
-Create new normalised database object
-
- my $db = new WebPAC::DB(
- path => '/path/to/cache/ds/',
- read_only => 1,
- );
-
-Optional parameter C<path> defines path to directory
-in which cache file for C<data_structure> call will be created.
-
-If called with C<read_only> it will not disable caching if
-called without write permission (but will die on C<save_ds>).
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = {@_};
- bless($self, $class);
-
- $self->path( $self->{'path'} );
-
- $self ? return $self : return undef;
-}
-
-=head2 path
-
-Check if specified cache directory exist, and if not, disable caching.
-
- $db->path('./cache/ds/');
-
-If you pass false or zero value to this function, it will disable
-cacheing.
-
-You can also example C<< $db->{path} >> to get current cache path.
-
-=cut
-
-sub path {
- my $self = shift;
-
- my $dir = shift;
-
- my $log = $self->_get_logger();
-
- if ($dir) {
- my $msg;
- if (! -e $dir) {
- $msg = "doesn't exist";
- } elsif (! -d $dir) {
- $msg = "is not directory";
- } elsif (! -w $dir) {
- $msg = "not writable" unless ($self->{'read_only'});
- }
-
- if ($msg) {
- $log->warn("cache path $dir $msg, disabling...");
- undef $self->{'path'};
- } else {
- $log->debug("using cache dir $dir");
- $self->{'path'} = $dir;
- }
- } else {
- $log->debug("disabling cache");
- undef $self->{'path'};
- }
-}
-
-=head2 load_ds
-
-Retrive from disk one data_structure records using field 000 as key
-
- my $ds = $db->load_ds( 42 );
-
-There is also a more verbose form, similar to C<save_ds>
-
- my $ds = $db->load_ds( id => 42 );
-
-This function will also perform basic sanity checking on returned
-data and disable caching if data is corrupted (or changed since last
-update).
-
-Returns hash or undef if cacheing is disabled or unavailable.
-
-=cut
-
-sub load_ds {
- my $self = shift;
-
- return unless $self->{'path'};
-
- my $log = $self->_get_logger;
-
- my $cache_path = $self->{'path'};
-
- my $id = shift;
- if (lc($id) eq 'id') {
- $id = shift;
- $log->logconfess("got hash, but without key id") unless (defined($id));
- $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);
- }
-
- if (! defined($id)) {
- $log->warn("called without id");
- return undef;
- } else {
- my $cache_file = "$cache_path/$id";
- if (-r $cache_file) {
- my $ds_ref = retrieve($cache_file);
- if ($ds_ref) {
- $log->debug("cache hit: $cache_file");
- my $ok = 1;
-# foreach my $f (qw(current_filename headline)) {
-# if ($ds_ref->{$f}) {
-# $self->{$f} = $ds_ref->{$f};
-# } else {
-# $ok = 0;
-# }
-# };
- if ($ok && $ds_ref->{'ds'}) {
- return $ds_ref->{'ds'};
- } else {
- $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
- undef $self->{'path'};
- }
- }
- } else {
- #$log->warn("cache entry $cache_file doesn't exist");
- return undef;
- }
- }
-
- return undef;
-}
-
-=head2 save_ds
-
-Store data_structure on disk.
-
- $db->save_ds(
- id => $ds->{000}->[0],
- ds => $ds,
- );
-
-B<Totally broken, but fast.>
-
-Depends on filename generated by C<load_ds>.
-
-=cut
-
-sub save_ds {
- my $self = shift;
-
- die "can't write to database in read_only mode!" if ($self->{'read_only'});
-
- return unless($self->{'path'});
-
- my $arg = {@_};
-
- my $log = $self->_get_logger;
-
- foreach my $f (qw/id ds/) {
- $log->logconfess("need $f") unless ($arg->{$f});
- }
-
- my $cache_file = $self->{path} . '/' . $arg->{id};
-
- $log->debug("creating storable cache file $cache_file");
-
- return store {
- ds => $arg->{ds},
- id => $arg->{id},
- }, $cache_file;
-
-}
-
-=head1 AUTHOR
-
-Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut
-
-1; # End of WebPAC::DB
=cut
-1; # End of WebPAC::DB
+1; # End of WebPAC::Normalize
--- /dev/null
+package WebPAC::Store;
+
+use warnings;
+use strict;
+
+use base 'WebPAC::Common';
+use Storable;
+
+=head1 NAME
+
+WebPAC::Store - Store normalized data on disk
+
+=head1 VERSION
+
+Version 0.03
+
+=cut
+
+our $VERSION = '0.03';
+
+=head1 SYNOPSIS
+
+This module provides disk storage for normalised data.
+
+It is newest component of WebPAC, so it will change quite often or be in
+flux. However, I will try to keep backward compatiblity by providing
+multiple back-ends.
+
+This has additional advantage. I can create single place to plugin other
+file formats which provide better performance for particular type of data.
+
+For now, this is a prototype version.
+
+ use WebPAC::Store;
+
+ my $foo = WebPAC::Store->new();
+ ...
+
+=head1 FUNCTIONS
+
+=head2 new
+
+Create new normalised database object
+
+ my $db = new WebPAC::Store(
+ path => '/path/to/cache/ds/',
+ read_only => 1,
+ );
+
+Optional parameter C<path> defines path to directory
+in which cache file for C<data_structure> call will be created.
+
+If called with C<read_only> it will not disable caching if
+called without write permission (but will die on C<save_ds>).
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = {@_};
+ bless($self, $class);
+
+ $self->path( $self->{'path'} );
+
+ $self ? return $self : return undef;
+}
+
+=head2 path
+
+Check if specified cache directory exist, and if not, disable caching.
+
+ $db->path('./cache/ds/');
+
+If you pass false or zero value to this function, it will disable
+cacheing.
+
+You can also example C<< $db->{path} >> to get current cache path.
+
+=cut
+
+sub path {
+ my $self = shift;
+
+ my $dir = shift;
+
+ my $log = $self->_get_logger();
+
+ if ($dir) {
+ my $msg;
+ if (! -e $dir) {
+ $msg = "doesn't exist";
+ } elsif (! -d $dir) {
+ $msg = "is not directory";
+ } elsif (! -w $dir) {
+ $msg = "not writable" unless ($self->{'read_only'});
+ }
+
+ if ($msg) {
+ $log->warn("cache path $dir $msg, disabling...");
+ undef $self->{'path'};
+ } else {
+ $log->debug("using cache dir $dir");
+ $self->{'path'} = $dir;
+ }
+ } else {
+ $log->debug("disabling cache");
+ undef $self->{'path'};
+ }
+}
+
+=head2 load_ds
+
+Retrive from disk one data_structure records using field 000 as key
+
+ my $ds = $db->load_ds( 42 );
+
+There is also a more verbose form, similar to C<save_ds>
+
+ my $ds = $db->load_ds( id => 42 );
+
+This function will also perform basic sanity checking on returned
+data and disable caching if data is corrupted (or changed since last
+update).
+
+Returns hash or undef if cacheing is disabled or unavailable.
+
+=cut
+
+sub load_ds {
+ my $self = shift;
+
+ return unless $self->{'path'};
+
+ my $log = $self->_get_logger;
+
+ my $cache_path = $self->{'path'};
+
+ my $id = shift;
+ if (lc($id) eq 'id') {
+ $id = shift;
+ $log->logconfess("got hash, but without key id") unless (defined($id));
+ $log->logconfess("got hash, but id isn't number") unless ($id =~ /^\d+$/);
+ }
+
+ if (! defined($id)) {
+ $log->warn("called without id");
+ return undef;
+ } else {
+ my $cache_file = "$cache_path/$id";
+ if (-r $cache_file) {
+ my $ds_ref = retrieve($cache_file);
+ if ($ds_ref) {
+ $log->debug("cache hit: $cache_file");
+ my $ok = 1;
+# foreach my $f (qw(current_filename headline)) {
+# if ($ds_ref->{$f}) {
+# $self->{$f} = $ds_ref->{$f};
+# } else {
+# $ok = 0;
+# }
+# };
+ if ($ok && $ds_ref->{'ds'}) {
+ return $ds_ref->{'ds'};
+ } else {
+ $log->warn("cache entry $cache_file corrupt. Use rm $cache_path/* to re-create it on next run!");
+ undef $self->{'path'};
+ }
+ }
+ } else {
+ #$log->warn("cache entry $cache_file doesn't exist");
+ return undef;
+ }
+ }
+
+ return undef;
+}
+
+=head2 save_ds
+
+Store data_structure on disk.
+
+ $db->save_ds(
+ id => $ds->{000}->[0],
+ ds => $ds,
+ );
+
+B<Totally broken, but fast.>
+
+Depends on filename generated by C<load_ds>.
+
+=cut
+
+sub save_ds {
+ my $self = shift;
+
+ die "can't write to database in read_only mode!" if ($self->{'read_only'});
+
+ return unless($self->{'path'});
+
+ my $arg = {@_};
+
+ my $log = $self->_get_logger;
+
+ foreach my $f (qw/id ds/) {
+ $log->logconfess("need $f") unless ($arg->{$f});
+ }
+
+ my $cache_file = $self->{path} . '/' . $arg->{id};
+
+ $log->debug("creating storable cache file $cache_file");
+
+ return store {
+ ds => $arg->{ds},
+ id => $arg->{id},
+ }, $cache_file;
+
+}
+
+=head1 AUTHOR
+
+Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of WebPAC::Store
use WebPAC::Lookup;
use WebPAC::Input::ISIS;
-use WebPAC::DB 0.02;
+use WebPAC::Store 0.03;
use WebPAC::Normalize::XML;
use WebPAC::Output::TT;
use WebPAC::Output::Estraier;
my $path = './db/';
-my $db = new WebPAC::DB(
+my $db = new WebPAC::Store(
path => $config->{webpac}->{db_path},
);
use_ok( 'WebPAC' );
use_ok( 'WebPAC::Input' );
use_ok( 'WebPAC::Input::ISIS' );
-use_ok( 'WebPAC::DB' );
+use_ok( 'WebPAC::Store' );
use_ok( 'WebPAC::Lookup' );
use_ok( 'WebPAC::Normalize::XML' );
use_ok( 'WebPAC::Output' );
+++ /dev/null
-#!/usr/bin/perl -w
-
-use Test::More tests => 25;
-use Test::Exception;
-use Cwd qw/abs_path/;
-use blib;
-use File::Temp qw/tempdir/;
-use strict;
-use Data::Dumper;
-
-BEGIN {
-use_ok( 'WebPAC::DB' );
-}
-
-ok(my $abs_path = abs_path($0), "abs_path");
-$abs_path =~ s#/[^/]*$#/#;
-diag "abs_path: $abs_path";
-
-my $db;
-my $debug = 1;
-my $no_log = 1; # force no log output
-
-diag "NULL DB";
-
-ok($db = new WebPAC::DB( debug => $debug, ), "new");
-
-ok(! $db->path, "path");
-
-ok(! $db->load_ds(), 'load_ds');
-ok(! $db->load_ds( id => 000 ), 'load_ds');
-
-ok(! $db->save_ds(), "save_ds");
-ok(! $db->save_ds( id => 000 ), 'save_ds');
-
-undef $db;
-
-ok(my $path = tempdir( CLEANUP => 1 ), "path");
-
-diag "DB path: $path";
-
-ok($db = new WebPAC::DB( path => $path, debug => $debug, no_log => $no_log ), "new");
-
-cmp_ok($db->{'path'}, 'eq', $path, "path");
-
-ok(! $db->path(''), "path - disable caching");
-
-ok(! defined($db->{'path'}), "no path");
-
-ok($db->path( $path ), "path($path)");
-
-cmp_ok($db->{'path'}, 'eq', $path, "path");
-
-ok(! $db->load_ds(), 'load_ds');
-ok(! $db->load_ds( id => 000 ), 'load_ds');
-
-throws_ok { $db->save_ds() } qr/id/, "save_ds - need id";
-
-my $ds = {
- 'Source' => {
- 'name' => 'Izvor: ',
- 'tag' => 'Source',
- 'display' => [ 'foo' ]
- },
- 'ID' => {
- 'name' => 'ID',
- 'tag' => 'IDths',
- 'swish' => [ 'bar' ],
- 'lookup_key' => [ 'bar' ]
- },
-};
-
-throws_ok { $db->save_ds( id => 1 ) } qr/ds/, "save_ds - need ds";
-
-ok($db->save_ds( id => 1, ds => $ds ), "save_ds");
-
-ok(my $ds2 = $db->load_ds( id => 1 ), "load_ds with id");
-
-is_deeply($ds, $ds2, "loaded data");
-
-ok($ds2 = $db->load_ds( 1 ), "load_ds without id");
-
-is_deeply($ds, $ds2, "loaded data");
-
-ok(! $db->load_ds( id => 42 ), "load_ds non-existing");
-
-undef $db;
-
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test::More tests => 25;
+use Test::Exception;
+use Cwd qw/abs_path/;
+use blib;
+use File::Temp qw/tempdir/;
+use strict;
+use Data::Dumper;
+
+BEGIN {
+use_ok( 'WebPAC::Store' );
+}
+
+ok(my $abs_path = abs_path($0), "abs_path");
+$abs_path =~ s#/[^/]*$#/#;
+diag "abs_path: $abs_path";
+
+my $db;
+my $debug = 1;
+my $no_log = 1; # force no log output
+
+diag "NULL Store";
+
+ok($db = new WebPAC::Store( debug => $debug, ), "new");
+
+ok(! $db->path, "path");
+
+ok(! $db->load_ds(), 'load_ds');
+ok(! $db->load_ds( id => 000 ), 'load_ds');
+
+ok(! $db->save_ds(), "save_ds");
+ok(! $db->save_ds( id => 000 ), 'save_ds');
+
+undef $db;
+
+ok(my $path = tempdir( CLEANUP => 1 ), "path");
+
+diag "Store path: $path";
+
+ok($db = new WebPAC::Store( path => $path, debug => $debug, no_log => $no_log ), "new");
+
+cmp_ok($db->{'path'}, 'eq', $path, "path");
+
+ok(! $db->path(''), "path - disable caching");
+
+ok(! defined($db->{'path'}), "no path");
+
+ok($db->path( $path ), "path($path)");
+
+cmp_ok($db->{'path'}, 'eq', $path, "path");
+
+ok(! $db->load_ds(), 'load_ds');
+ok(! $db->load_ds( id => 000 ), 'load_ds');
+
+throws_ok { $db->save_ds() } qr/id/, "save_ds - need id";
+
+my $ds = {
+ 'Source' => {
+ 'name' => 'Izvor: ',
+ 'tag' => 'Source',
+ 'display' => [ 'foo' ]
+ },
+ 'ID' => {
+ 'name' => 'ID',
+ 'tag' => 'IDths',
+ 'swish' => [ 'bar' ],
+ 'lookup_key' => [ 'bar' ]
+ },
+};
+
+throws_ok { $db->save_ds( id => 1 ) } qr/ds/, "save_ds - need ds";
+
+ok($db->save_ds( id => 1, ds => $ds ), "save_ds");
+
+ok(my $ds2 = $db->load_ds( id => 1 ), "load_ds with id");
+
+is_deeply($ds, $ds2, "loaded data");
+
+ok($ds2 = $db->load_ds( 1 ), "load_ds without id");
+
+is_deeply($ds, $ds2, "loaded data");
+
+ok(! $db->load_ds( id => 42 ), "load_ds non-existing");
+
+undef $db;
+
BEGIN {
use_ok( 'WebPAC::Lookup' );
use_ok( 'WebPAC::Input::ISIS' );
-use_ok( 'WebPAC::DB' );
+use_ok( 'WebPAC::Store' );
use_ok( 'WebPAC::Normalize::XML' );
use_ok( 'WebPAC::Output::TT' );
}
ok(my $path = tempdir( CLEANUP => 1 ), "path");
-ok(my $db = new WebPAC::DB(
+ok(my $db = new WebPAC::Store(
path => $path,
-), "new DB");
+), "new Store");
ok(my $n = new WebPAC::Normalize::XML(
# filter => { 'foo' => sub { shift } },
projects / webpac2 / commitdiff