'YAML' => 0,
'File::Slurp' => 0,
'Log::Log4perl' => 1.02,
- 'Data::Dumper' => 0,
'Cwd' => 0,
'Storable' => 0,
'DBM::Deep' => 0,
'Pod::Usage' => 0,
'Class::Accessor' => 0,
'JSON' => 0,
+ 'File::Spec' => 0,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'WebPAC-* pod2html Makefile tags' },
input:
name: 'FFZG - Psihologija'
type: marc
- path: 'ps.marc'
+# path: 'ps.marc'
+ path: 'ffsf-librim.marc'
encoding: 'cp852'
#limit: 100
normalize:
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
=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<STDERR>
+
+=item no_log
+
+Disable all logging (useful for tests)
+
+=item debug
+
+Use debugging logger which dumps output only yo C<STDERR>
+
+=back
+
+
=head1 FUNCTIONS
=head2 progress_bar
#
#
+=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
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
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 );
# make name full
my $f = '';
- if ($log_debug) {
+ if ( $self->log_debug ) {
foreach ( 0 .. 5 ) {
my $s = (caller($_))[3];
$f .= "#### $_ >> $s\n" if ($s);
$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;
}
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/;
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});
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 {
use Estraier;
use Encode qw/from_to/;
-use Data::Dumper;
+use Data::Dump;
use LWP;
use URI::Escape;
use List::Util qw/first/;
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});
$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 {
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} });
use KinoSearch::InvIndexer;
use KinoSearch::Analysis::PolyAnalyzer;
use Encode qw/from_to/;
-use Data::Dumper;
+use Data::Dump qw/dump/;
use Storable;
=head1 NAME
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});
_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 {
use Template;
use List::Util qw/first/;
-use Data::Dumper;
+use Data::Dump qw/dump/;
use Encode;
=head1 NAME
$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;
}
use Search::Estraier;
use Encode qw/from_to/;
-use Data::Dumper;
+use Data::Dump qw/dump/;
=head1 NAME
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});
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' ) {
$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'");
}
-# $log->debug("results " . Dumper( \@results ));
+# $log->debug("results " . dump( \@results ));
$self->confess("expected to return array") unless (wantarray);
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/;
=head1 VERSION
-Version 0.14
+Version 0.15
=cut
-our $VERSION = '0.14';
+our $VERSION = '0.15';
=head1 SYNOPSIS
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<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>).
-
Optional parametar C<database> 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
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 = {@_};
$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");
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 {
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;
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");
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});
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);
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");
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);
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;
#
# 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
#!/usr/bin/perl -w
use strict;
-use Test::More tests => 6;
+use Test::More tests => 7;
use Test::Exception;
use blib;
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";
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';
use blib;
use strict;
-use Data::Dumper;
+use Data::Dump qw/dump/;
my $debug = 1;
cmp_ok($input->pos, '==', $mfn, "pos $mfn");
- diag "rec: ", Dumper($rec), "\n";
+ diag "rec: ", dump($rec), "\n";
}
#!/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
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');
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
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");
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');
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');
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;
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" );
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(
), "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',
use Test::Exception;
use Cwd qw/abs_path/;
use File::Temp qw/tempdir/;
-use Data::Dumper;
+use Data::Dump;
use blib;
BEGIN {
projects / webpac2 / commitdiff