From 2631edba4bc458cfc69d3a3fe4025709c7897054 Mon Sep 17 00:00:00 2001 From: Dobrica Pavlinusic Date: Mon, 3 Sep 2007 15:26:46 +0000 Subject: [PATCH 1/1] r1322@llin: dpavlin | 2007-09-03 16:44:01 +0200 - replace Data::Dumper usage with Data::Dump - rewrite WebPAC::Store to use Class::Accessor git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@887 07558da8-63fa-0310-ba24-9fe276d99e06 --- Makefile.PL | 2 +- conf/llin.yml | 3 +- lib/WebPAC/Common.pm | 65 ++++++++++++--- lib/WebPAC/Output/Estraier.pm | 6 +- lib/WebPAC/Output/EstraierNative.pm | 8 +- lib/WebPAC/Output/KinoSearch.pm | 6 +- lib/WebPAC/Output/TT.pm | 4 +- lib/WebPAC/Search/Estraier.pm | 10 +-- lib/WebPAC/Store.pm | 125 ++++------------------------ run.pl | 19 +---- t/0-common.t | 5 +- t/2-input-excel.t | 4 +- t/4-store.t | 44 +++------- t/6-unit.t | 11 ++- t/7-est.t | 2 +- 15 files changed, 113 insertions(+), 201 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index c0bfcf9..ef00bbd 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -13,7 +13,6 @@ WriteMakefile( 'YAML' => 0, 'File::Slurp' => 0, 'Log::Log4perl' => 1.02, - 'Data::Dumper' => 0, 'Cwd' => 0, 'Storable' => 0, 'DBM::Deep' => 0, @@ -38,6 +37,7 @@ WriteMakefile( 'Pod::Usage' => 0, 'Class::Accessor' => 0, 'JSON' => 0, + 'File::Spec' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'WebPAC-* pod2html Makefile tags' }, diff --git a/conf/llin.yml b/conf/llin.yml index 83bae3a..21dcdde 100644 --- a/conf/llin.yml +++ b/conf/llin.yml @@ -339,7 +339,8 @@ databases: input: name: 'FFZG - Psihologija' type: marc - path: 'ps.marc' +# path: 'ps.marc' + path: 'ffsf-librim.marc' encoding: 'cp852' #limit: 100 normalize: diff --git a/lib/WebPAC/Common.pm b/lib/WebPAC/Common.pm index 365c971..e427cd3 100644 --- a/lib/WebPAC/Common.pm +++ b/lib/WebPAC/Common.pm @@ -6,9 +6,10 @@ use strict; use Log::Log4perl qw/get_logger :levels/; use Time::HiRes qw/time/; use Data::Dump qw/dump/; +use File::Spec; -# If ture, enable logging debug -my $log_debug = 0; +use base qw/Class::Accessor/; +__PACKAGE__->mk_accessors( qw/log_debug no_log debug/ ); =head1 NAME @@ -16,17 +17,42 @@ WebPAC::Common - internal methods called from other WebPAC modules =head1 VERSION -Version 0.04 +Version 0.05 =cut -our $VERSION = '0.04'; +our $VERSION = '0.05'; =head1 SYNOPSYS This module defines common functions, and is used as base for other, more specific modules. +my $o = WebPAC::Common->new({ + log_debug => 1, + no_log => 1, + debug => 1, +}); + +Options: + +=over 20 + +=item log_debug + +Generate additional debugging log on C + +=item no_log + +Disable all logging (useful for tests) + +=item debug + +Use debugging logger which dumps output only yo C + +=back + + =head1 FUNCTIONS =head2 progress_bar @@ -131,6 +157,19 @@ sub fill_in { # # +=head2 var_path + + my $path = $self->var_path('data_dir', 'data_file', ... ); + +=cut + +sub var_path { + my $self = shift; + + return File::Spec->catfile('var', @_); +} + + =head1 INTERNAL METHODS Here is a quick list of internal methods, mostly useful to turn debugging @@ -190,9 +229,9 @@ sub _init_logger { my $name = (caller(2))[3] || caller; my $conf = q( ); - if ($self->{'no_log'}) { - warn "# $name disabled logging\n" if ($log_debug); - } elsif ($self->{'debug'}) { + if ($self->no_log) { + warn "# $name disabled logging\n" if $self->log_debug; + } elsif ($self->debug) { $conf = << '_log4perl_'; log4perl.rootLogger=INFO, SCREEN @@ -204,15 +243,15 @@ log4perl.appender.SCREEN.layout=PatternLayout log4perl.appender.SCREEN.layout.ConversionPattern=%d %p> %F{1}:%L %M - %m%n _log4perl_ - warn "# $name is using debug logger\n" if ($log_debug); + warn "# $name is using debug logger\n" if $self->log_debug; } elsif ($name =~ m/Test::Exception/o) { - warn "# disabled logging for Text::Exception\n" if ($log_debug); + warn "# disabled logging for Text::Exception\n" if $self->log_debug; } elsif (-e $file) { - warn "# $name is using $file logger\n" if ($log_debug); + warn "# $name is using $file logger\n" if $self->log_debug; Log::Log4perl->init($file); return 1; } else { - warn "# $name is using null logger\n" if ($log_debug); + warn "# $name is using null logger\n" if $self->log_debug; } Log::Log4perl->init( \$conf ); @@ -238,7 +277,7 @@ sub _get_logger { # make name full my $f = ''; - if ($log_debug) { + if ( $self->log_debug ) { foreach ( 0 .. 5 ) { my $s = (caller($_))[3]; $f .= "#### $_ >> $s\n" if ($s); @@ -248,7 +287,7 @@ sub _get_logger { $self->{'_logger_'} ||= $self->_init_logger; my $log = get_logger( $name ); - warn "# get_logger( $name ) level ", $log->level, "\n$f" if ($log_debug && !defined($_logger_seen->{$name})); + warn "# get_logger( $name ) level ", $log->level, "\n$f" if ($self->log_debug && !defined($_logger_seen->{$name})); $_logger_seen->{$name}++; return $log; } diff --git a/lib/WebPAC/Output/Estraier.pm b/lib/WebPAC/Output/Estraier.pm index 45beb8f..1a77b47 100644 --- a/lib/WebPAC/Output/Estraier.pm +++ b/lib/WebPAC/Output/Estraier.pm @@ -7,7 +7,7 @@ use base qw/WebPAC::Common/; use Search::Estraier 0.06; use Encode qw/from_to/; -use Data::Dumper; +use Data::Dump qw/dump/; use LWP; use URI::Escape; use List::Util qw/first/; @@ -88,7 +88,7 @@ sub new { my $log = $self->_get_logger; - #$log->debug("self: ", sub { Dumper($self) }); + #$log->debug("self: ", sub { dump($self) }); foreach my $p (qw/masterurl user passwd database/) { $log->logdie("need $p") unless ($self->{$p}); @@ -166,7 +166,7 @@ sub add { my $doc = Search::Estraier::Document->new; $doc->add_attr('@uri', $self->convert($uri) ); - $log->debug("ds = ", sub { Dumper($args->{'ds'}) } ); + $log->debug("ds = ", sub { dump($args->{'ds'}) } ); # filter all tags which have type defined my @tags = grep { diff --git a/lib/WebPAC/Output/EstraierNative.pm b/lib/WebPAC/Output/EstraierNative.pm index 9be62e3..bbd2154 100644 --- a/lib/WebPAC/Output/EstraierNative.pm +++ b/lib/WebPAC/Output/EstraierNative.pm @@ -7,7 +7,7 @@ use base qw/WebPAC::Common/; use Estraier; use Encode qw/from_to/; -use Data::Dumper; +use Data::Dump; use LWP; use URI::Escape; use List::Util qw/first/; @@ -82,7 +82,7 @@ sub new { my $log = $self->_get_logger; - #$log->debug("self: ", sub { Dumper($self) }); + #$log->debug("self: ", sub { dump($self) }); foreach my $p (qw/path database/) { $log->logdie("need $p") unless ($self->{$p}); @@ -166,7 +166,7 @@ sub add { $doc->add_hidden_text('_database:' . $database); $doc->add_attr('_type', $type ); - $log->debug("ds = ", sub { Dumper($args->{'ds'}) } ); + $log->debug("ds = ", sub { dump($args->{'ds'}) } ); # filter all tags which have type defined my @tags = grep { @@ -179,7 +179,7 @@ sub add { foreach my $tag (@tags) { - $log->debug("$tag :: $type == ",Dumper( $args->{'ds'}->{$tag}->{$type} ) ); + $log->debug("$tag :: $type == ",dump( $args->{'ds'}->{$tag}->{$type} ) ); my $vals = join(" ", @{ $args->{'ds'}->{$tag}->{$type} }); diff --git a/lib/WebPAC/Output/KinoSearch.pm b/lib/WebPAC/Output/KinoSearch.pm index 35421bb..2c03ec6 100644 --- a/lib/WebPAC/Output/KinoSearch.pm +++ b/lib/WebPAC/Output/KinoSearch.pm @@ -8,7 +8,7 @@ use base qw/WebPAC::Common/; use KinoSearch::InvIndexer; use KinoSearch::Analysis::PolyAnalyzer; use Encode qw/from_to/; -use Data::Dumper; +use Data::Dump qw/dump/; use Storable; =head1 NAME @@ -80,7 +80,7 @@ sub new { my $log = $self->_get_logger; - #$log->debug("self: ", sub { Dumper($self) }); + #$log->debug("self: ", sub { dump($self) }); foreach my $p (qw/index_path fields database/) { $log->logdie("need $p") unless ($self->{$p}); @@ -185,7 +185,7 @@ sub add { _add_value($self,$log,$doc, 'uri', $uri); - $log->debug("ds = ", sub { Dumper($args->{'ds'}) } ); + $log->debug("ds = ", sub { dump($args->{'ds'}) } ); # filter all tags which have type defined my @tags = grep { diff --git a/lib/WebPAC/Output/TT.pm b/lib/WebPAC/Output/TT.pm index 8699e12..2a035fc 100644 --- a/lib/WebPAC/Output/TT.pm +++ b/lib/WebPAC/Output/TT.pm @@ -7,7 +7,7 @@ use base qw/WebPAC::Common/; use Template; use List::Util qw/first/; -use Data::Dumper; +use Data::Dump qw/dump/; use Encode; =head1 NAME @@ -59,7 +59,7 @@ sub new { $log->logdie("can't create TT object: $Template::ERROR") unless ($self->{'tt'}); - $log->debug("filters defined: ",Dumper($self->{'filters'})); + $log->debug("filters defined: ",dump($self->{'filters'})); $self ? return $self : return undef; } diff --git a/lib/WebPAC/Search/Estraier.pm b/lib/WebPAC/Search/Estraier.pm index 61c0024..ed9e494 100644 --- a/lib/WebPAC/Search/Estraier.pm +++ b/lib/WebPAC/Search/Estraier.pm @@ -5,7 +5,7 @@ use strict; use Search::Estraier; use Encode qw/from_to/; -use Data::Dumper; +use Data::Dump qw/dump/; =head1 NAME @@ -135,7 +135,7 @@ sub search { my $log = $self->_get_logger; - #$log->debug( 'search args: ' . Dumper($args) ); + #$log->debug( 'search args: ', dump($args) ); $self->confess('need db in object') unless ($self->{db}); $self->confess('need get_attr') unless ($args->{get_attr}); @@ -144,7 +144,7 @@ sub search { my $q = $args->{phrase}; - $log->debug("args: " . Dumper( $args )); + $log->debug("args: ", dump( $args )); my $cond = Search::Estraier::Condition->new(); if ( ref($args->{add_attr}) eq 'ARRAY' ) { @@ -169,7 +169,7 @@ sub search { $cond->set_max( $page * $max ); my $result = $self->{db}->search($cond, ( $args->{depth} || 0 )) || - $log->logdie("can't search for ", sub { Dumper( $args ) }); + $log->logdie("can't search for ", sub { dump( $args ) }); my $hits = $result->doc_num; $log->debug("found $hits hits for '$q'"); @@ -199,7 +199,7 @@ sub search { } -# $log->debug("results " . Dumper( \@results )); +# $log->debug("results " . dump( \@results )); $self->confess("expected to return array") unless (wantarray); diff --git a/lib/WebPAC/Store.pm b/lib/WebPAC/Store.pm index e9bbebc..f8da8bc 100644 --- a/lib/WebPAC/Store.pm +++ b/lib/WebPAC/Store.pm @@ -3,7 +3,10 @@ package WebPAC::Store; use warnings; use strict; -use base 'WebPAC::Common'; +use WebPAC::Common; +use base qw/WebPAC::Common Class::Accessor/; +__PACKAGE__->mk_accessors(qw/database/); + use Storable; use File::Path; use Data::Dump qw/dump/; @@ -14,11 +17,11 @@ WebPAC::Store - Store WebPAC data on disk =head1 VERSION -Version 0.14 +Version 0.15 =cut -our $VERSION = '0.14'; +our $VERSION = '0.15'; =head1 SYNOPSIS @@ -34,104 +37,24 @@ databases just yet :-) 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 $store = WebPAC::Store->new(); - ... - =head1 FUNCTIONS =head2 new Create new normalised database object - my $store = new WebPAC::Store( - path => '/path/to/cache/ds/', + my $store = new WebPAC::Store({ database => 'name', - read_only => 1, - ); + }); Optional parameter C defines path to directory in which cache file for C call will be created. -If called with C it will not disable caching if -called without write permission (but will die on C). - Optional parametar C will be used used as subdirectory in path if no database in specified when calling other functions. =cut -sub new { - my $class = shift; - my $self = {@_}; - bless($self, $class); - - my $log = $self->_get_logger(); - - foreach my $p (qw/path/) { - $log->logconfess("need $p") unless ($self->{$p}); - } - - $self->path( $self->{'path'} ); - - $self ? return $self : return undef; -} - -=head2 path - -Check if specified cache directory exist, and if not, disable caching. - - $store->path('./cache/'); - -If you pass false or zero value to this function, it will disable -cacheing. - -You can also call this function to get current cache path. - - my $cache_path = $store->path; - -=cut - -sub path { - my $self = shift; - - my $dir = shift; - - return $self->{path} unless defined($dir); - - my $log = $self->_get_logger(); - - if ($dir) { - my $msg; - if (! -e $dir) { - if ($self->{'read_only'}) { - $msg = "doesn't exist"; - } else { - $log->info("creating $dir"); - mkpath $dir; - } - } 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 usually using field 000 as key @@ -161,13 +84,6 @@ sub load_ds { my $log = $self->_get_logger; - my $cache_path = $self->{'path'}; - - if (! $cache_path) { - $log->warn("path not set, ignoring load_ds"); - return; - } - $log->logconfess("arguments for load_ds must be HASH") unless (ref(\@_) eq 'ARRAY' && ($#_ % 2 == 1)); my $args = {@_}; @@ -176,12 +92,11 @@ sub load_ds { $log->logconfess("got hash, but without id") unless (defined($id)); $log->logconfess("got hash, but id [$id] isn't number") unless ($id =~ /^\d+$/); - my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); + my $database = $args->{database} || $self->database || $log->logconfess("no database?"); my $input = $args->{input} || ''; - my $cache_file = "$cache_path/ds/$database/$input/$id"; - $cache_file =~ s#//#/#go; + my $cache_file = $self->var_path( 'ds', $database, $input, $id ); $log->debug("using cache_file $cache_file"); @@ -192,8 +107,7 @@ sub load_ds { if ($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'}; + $log->warn("cache entry $cache_file corrupt. Use rm $cache_file to re-create it on next run!"); } } } else { @@ -222,10 +136,6 @@ C and C are optional. 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 $args = {@_}; my $log = $self->_get_logger; @@ -240,12 +150,11 @@ sub save_ds { my $input = $args->{input} || ''; - my $cache_file = $self->{path} . "/ds/$database/$input/"; - $cache_file =~ s#//#/#go; + my $cache_file = $self->var_path( 'ds', $database, $input ); mkpath($cache_file) unless (-d $cache_file); - $cache_file .= $args->{id}; + $cache_file = $self->var_path( 'ds', $database, $input, $args->{id} ); $log->debug("creating storable cache file $cache_file"); @@ -282,7 +191,7 @@ sub load_lookup { my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); - my $path = $self->{path} . "/lookup/$database/" . $args->{input} . '/' . $args->{key}; + my $path = $self->var_path( 'lookup', $database, $args->{input}, $args->{key} ); if (! -e $path) { $log->error("lookup $path doesn't exist, lookups will be disabled. Try re-indexing $database/", $args->{input}); @@ -325,7 +234,7 @@ sub save_lookup { my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); - my $path = $self->{path} . "/lookup/$database/" . $args->{input}; + my $path = $self->var_path( 'lookup', $database, $args->{input} ); mkpath($path) unless (-d $path); @@ -368,7 +277,7 @@ sub load_row { my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); - my $path = $self->{path} . "/row/$database/" . $args->{input} . '/' . $args->{id}; + my $path = $self->var_path( 'row', $database, $args->{input}, $args->{id} ); if (! -e $path) { $log->warn("input row $path doesn't exist, skipping"); @@ -411,7 +320,7 @@ sub save_row { my $database = $args->{database} || $self->{database} || $log->logconfess("no database?"); - my $path = $self->{path} . "/row/$database/" . $args->{input}; + my $path = $self->var_path( 'row', $database, $args->{input} ); mkpath($path) unless (-d $path); diff --git a/run.pl b/run.pl index 7264865..26c6b9a 100755 --- a/run.pl +++ b/run.pl @@ -9,7 +9,7 @@ use lib './lib'; use WebPAC::Common 0.02; use WebPAC::Parser 0.08; use WebPAC::Input 0.16; -use WebPAC::Store 0.14; +use WebPAC::Store 0.15; use WebPAC::Normalize 0.22; use WebPAC::Output::TT; use WebPAC::Validate 0.11; @@ -298,22 +298,9 @@ foreach my $database ( sort keys %{ $config->databases } ) { # # now WebPAC::Store # - my $abs_path = abs_path($0); - $abs_path =~ s#/[^/]*$#/#; # - - my $db_path = $config->webpac('db_path'); - - if ($clean) { - $log->info("creating new database '$database' in $db_path"); - rmtree( $db_path ) || $log->warn("can't remove $db_path: $!"); - } else { - $log->info("working on database '$database' in $db_path"); - } - - my $store = new WebPAC::Store( - path => $db_path, + my $store = new WebPAC::Store({ debug => $debug, - ); + }); # # prepare output diff --git a/t/0-common.t b/t/0-common.t index d21e2aa..fbefc51 100755 --- a/t/0-common.t +++ b/t/0-common.t @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 6; +use Test::More tests => 7; use Test::Exception; use blib; @@ -15,7 +15,7 @@ use_ok( 'WebPAC::Common' ); my $debug = shift @ARGV; ok(my $abs_path = abs_path($0), "abs_path"); -$abs_path =~ s#/[^/]*$#/#; +$abs_path =~ s#/[^/]*$#/#; # my $path = "$abs_path/conf/test.yml"; @@ -27,3 +27,4 @@ throws_ok { $common->fill_in() } qr/no format/, 'fill_in without format'; throws_ok { $common->fill_in( '$foo', bar => 42 ) } qr/unknown var/, 'fill_in no variable'; cmp_ok( $common->fill_in( 'foo = $foo bar = $bar', foo => 42, bar => 1 ), 'eq', 'foo = 42 bar = 1', 'fill_in' ); +like $common->var_path( qw/foo bar baz/ ), qr/var.foo.bar.baz/, 'var_path'; diff --git a/t/2-input-excel.t b/t/2-input-excel.t index 465fed3..9b091d3 100755 --- a/t/2-input-excel.t +++ b/t/2-input-excel.t @@ -6,7 +6,7 @@ use Cwd qw/abs_path/; use blib; use strict; -use Data::Dumper; +use Data::Dump qw/dump/; my $debug = 1; @@ -42,6 +42,6 @@ foreach my $mfn ( 1 ... $size ) { cmp_ok($input->pos, '==', $mfn, "pos $mfn"); - diag "rec: ", Dumper($rec), "\n"; + diag "rec: ", dump($rec), "\n"; } diff --git a/t/4-store.t b/t/4-store.t index fe234d3..5fce5d9 100755 --- a/t/4-store.t +++ b/t/4-store.t @@ -1,21 +1,16 @@ #!/usr/bin/perl -w -use Test::More tests => 47; +use Test::More tests => 37; use Test::Exception; -use Cwd qw/abs_path/; use blib; use File::Temp qw/tempdir/; use strict; -use Data::Dumper; +use Data::Dump; 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 = shift @ARGV; my $no_log = 1; # force no log output @@ -23,13 +18,9 @@ $no_log = 0 if ($debug); diag "NULL Store"; -throws_ok { new WebPAC::Store() } qr/path/, 'new without path'; - -ok(new WebPAC::Store( path => '/tmp' ), 'new without database'); - -ok($db = new WebPAC::Store( path => '/tmp', database => 'foobar', debug => $debug ), "new"); +ok(new WebPAC::Store(), 'new without database'); -cmp_ok($db->path, 'eq', '/tmp', "path"); +ok($db = new WebPAC::Store({ database => 'foobar', debug => $debug }), "new"); throws_ok { $db->load_ds() } qr/id/, 'load_ds without id'; ok(! $db->load_ds( id => 000 ), 'load_ds'); @@ -39,22 +30,7 @@ throws_ok { $db->save_ds( id => 000 ) } qr/ds/, 'save_ds without ds'; undef $db; -ok(my $path = tempdir( CLEANUP => $debug ? 0 : 1 ), "path"); - -diag "Store path: $path"; - -ok($db = new WebPAC::Store( path => $path, database => 'webpac-test', debug => $debug, no_log => $no_log ), "new"); - -cmp_ok($db->{'path'}, 'eq', $path, "path"); -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 = new WebPAC::Store({ database => 'webpac-test', debug => $debug, no_log => $no_log }), "new"); # # test *_ds @@ -95,7 +71,7 @@ is_deeply($ds, $ds2, "loaded data"); ok(! $db->load_ds( id => 42 ), "load_ds non-existing"); -ok($db = new WebPAC::Store( path => $path, database => 'webpac-test', debug => $debug, no_log => $no_log ), "new"); +ok($db = new WebPAC::Store({ database => 'webpac-test', debug => $debug, no_log => $no_log }), "new"); ok(! $db->load_ds( id => 1, input => 'foobar' ), "load_ds with invalid input"); @@ -115,13 +91,13 @@ ok(! $db->load_lookup( input => 'non-existant', key => 'foo' ), 'invalid load_lo ok($db->save_lookup( input => 'foo', key => 'bar', data => $l ), "save_lookup"); -ok(-e $db->path . '/lookup/webpac-test/foo/bar', "exists"); +ok(-e $db->var_path( 'lookup', 'webpac-test', 'foo', 'bar'), "exists"); is_deeply($db->load_lookup( input => 'foo', key => 'bar' ), $l, 'load_lookup'); ok($db->save_lookup( database => 'baz', input => 'foo', key => 'bar', data => $l ), "save_lookup with database"); -ok(-e $db->path . '/lookup/baz/foo/bar', "exists"); +ok(-e $db->var_path( '/lookup','baz','foo','bar'), "exists"); is_deeply($db->load_lookup( database => 'baz', input => 'foo', key => 'bar' ), $l, 'load_lookup'); @@ -138,13 +114,13 @@ ok(! $db->load_row( input => 'non-existant', id => 1234 ), 'invalid load_row'); ok($db->save_row( input => 'foo', id => 1234, row => $row ), "save_row"); -ok(-e $db->path . '/row/webpac-test/foo/1234', "exists"); +ok(-e $db->var_path( 'row','webpac-test','foo',1234), "exists"); is_deeply($db->load_row( input => 'foo', id => 1234 ), $row, 'load_row'); ok($db->save_row( database => 'baz', input => 'foo', id => 1234, row => $row ), "save_row with database"); -ok(-e $db->path . '/row/baz/foo/1234', "exists"); +ok(-e $db->var_path( 'row','baz','foo',1234), "exists"); is_deeply($db->load_row( database => 'baz', input => 'foo', id => 1234 ), $row, 'load_row'); diff --git a/t/6-unit.t b/t/6-unit.t index 6e226b3..ab27783 100755 --- a/t/6-unit.t +++ b/t/6-unit.t @@ -7,7 +7,7 @@ use Test::Exception; use Cwd qw/abs_path/; use File::Temp qw/tempdir/; use File::Slurp; -use Data::Dumper; +use Data::Dump qw/dump/; use Time::HiRes qw/time/; use blib; @@ -56,10 +56,9 @@ ok(my $maxmfn = $isis->open( ok(my $path = tempdir( CLEANUP => 1 ), "path"); -ok(my $db = new WebPAC::Store( - path => $path, +ok(my $db = new WebPAC::Store({ database => '.', -), "new Store"); +}), "new Store"); ok(my $norm_pl = read_file( $normalize_set_pl ), "set definitions: $normalize_set_pl" ); @@ -74,7 +73,7 @@ foreach my $pos ( 0 ... $isis->size ) { my $row = $isis->fetch || next; - diag " row $pos => ",Dumper($row) if ($debug); + diag " row $pos => ",dump($row) if ($debug); my $t = time(); ok( my $ds = WebPAC::Normalize::data_structure( @@ -83,7 +82,7 @@ foreach my $pos ( 0 ... $isis->size ) { ), "Set data_structure"); $t_norm += time() - $t; - diag " ds $pos => ",Dumper($ds) if ($debug); + diag " ds $pos => ",dump($ds) if ($debug); ok(my $html = $out->apply( template => 'html.tt', diff --git a/t/7-est.t b/t/7-est.t index 7014b94..bc61623 100755 --- a/t/7-est.t +++ b/t/7-est.t @@ -6,7 +6,7 @@ use Test::More tests => 13; use Test::Exception; use Cwd qw/abs_path/; use File::Temp qw/tempdir/; -use Data::Dumper; +use Data::Dump; use blib; BEGIN { -- 2.20.1