Makefile.PL
README
lib/WebPAC.pm
+lib/WebPAC/Common.pm
+lib/WebPAC/Lookup.pm
lib/WebPAC/DB.pm
lib/WebPAC/Input.pm
+lib/WebPAC/Input/ISIS.pm
+lib/WebPAC/Normalize.pm
+lib/WebPAC/Normalize/XML.pm
lib/WebPAC/Output.pm
lib/WebPAC/Output/CDBI.pm
lib/WebPAC/Output/Estraier.pm
lib/WebPAC/Output/OAI.pm
lib/WebPAC/Output/html.pm
+lib/WebPAC/Manual.pod
t/0-load.t
+t/1-lookup.t
+t/2-input-isis.t
+t/winisis/BIBL.CNT
+t/winisis/BIBL.FDT
+t/winisis/BIBL.IFP
+t/winisis/BIBL.l01
+t/winisis/BIBL.l02
+t/winisis/BIBL.mst
+t/winisis/BIBL.N01
+t/winisis/BIBL.N02
+t/winisis/BIBL.XRF
t/pod-coverage.t
t/pod.t
+conf/input/isis.ini
+conf/lookup/example.pm
+conf/lookup/isis.pm
+conf/normalize/isis.xml
'Data::Dumper' => 0,
'Cwd' => 0,
'Text::Iconv' => 0,
+ 'Storable' => 0,
+ 'DBM::Deep' => 0,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'WebPAC-* pod2html Makefile tags' },
$webpac->_init_logger('/path/to/log.conf');
If no path to configuration file is given, dummy empty configuration
-will be create.
+will be created. If any mode which inherits from this one is called
+with C<debug> flag, it will turn logging to debug level.
=cut
Log::Log4perl->init($file);
} else {
my $conf = q( );
+ if ($self->{'debug'}) {
+ $conf = << '_log4perl_';
+
+log4perl.rootLogger=INFO, SCREEN
+
+log4perl.logger.WebPAC.=DEBUG
+
+log4perl.appender.SCREEN=Log::Log4perl::Appender::Screen
+log4perl.appender.SCREEN.layout=PatternLayout
+log4perl.appender.SCREEN.layout.ConversionPattern=%d %p> %F{1}:%L %M - %m%n
+
+_log4perl_
+ }
Log::Log4perl->init( \$conf );
}
}
my $foo = WebPAC::DB->new();
...
-=head1 EXPORT
-
-A list of functions that can be exported. You can delete this section
-if you don't export anything, such as for a purely object-oriented module.
-
=head1 FUNCTIONS
=head2 function1
sub function1 {
}
-=head2 function2
-
-=cut
-
-sub function2 {
-}
-
=head1 AUTHOR
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
-=head1 BUGS
-
-Please report any bugs or feature requests to
-C<bug-webpac-db@rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WebPAC>.
-I will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
-=head1 ACKNOWLEDGEMENTS
-
=head1 COPYRIGHT & LICENSE
Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
format => 'NULL',
config => $config,
lookup => $lookup_obj,
+ low_mem => 1,
);
$db->open('/path/to/database');
my $db = new WebPAC::Input(
format => 'NULL'
code_page => 'ISO-8859-2',
+ low_mem => 1,
);
Optional parametar C<code_page> specify application code page (which will be
used internally). This should probably be your terminal encoding, and by
default, it C<ISO-8859-2>.
+Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
+
=cut
sub new {
$self->{'code_page'} ||= 'ISO-8859-2';
+ my $log = $self->_get_logger;
+
+ # running with low_mem flag? well, use DBM::Deep then.
+ if ($self->{'low_mem'}) {
+ $log->info("running with low_mem which impacts performance (<32 Mb memory usage)");
+
+ my $db_file = "data.db";
+
+ if (-e $db_file) {
+ unlink $db_file or $log->logdie("can't remove '$db_file' from last run");
+ $log->debug("removed '$db_file' from last run");
+ }
+
+ require DBM::Deep;
+
+ my $db = new DBM::Deep $db_file;
+
+ $log->logdie("DBM::Deep error: $!") unless ($db);
+
+ if ($db->error()) {
+ $log->logdie("can't open '$db_file' under low_mem: ",$db->error());
+ } else {
+ $log->debug("using file '$db_file' for DBM::Deep");
+ }
+
+ $self->{'db'} = $db;
+ }
+
$self ? return $self : return undef;
}
return $self->{'max_mfn'} = $maxmfn;
}
-=head2 fetch_rec
+=head2 fetch
Fetch next record from database. It will also displays progress bar.
- my $rec = $webpac->fetch_rec;
+ my $rec = $isis->fetch;
-You should rearly have the need to call this function directly. Instead use
-C<fetch_data_structure> which returns normalised data.
+Record from this function should probably go to C<data_structure> for
+normalisation.
=cut
-sub fetch_rec {
+sub fetch {
my $self = shift;
my $log = $self->_get_logger();
}
}
-=head2 fetch_data_structure
+=head2 pos
-Fetch data structure of next record from database.
+Returns current record number (MFN).
+
+ print $isis->pos;
- my @ds = $webpac->fetch_data_structure;
+First record in database has position 1.
=cut
-sub fetch_data_structure {
+sub pos {
my $self = shift;
+ return $self->{'current_mfn'};
+}
+
+
+=head2 size
+
+Returns number of records in database
+
+ print $isis->size;
+
+=cut
- return $self->data_structure(
- $self->fetch_rec(@_)
- );
+sub size {
+ my $self = shift;
+ return $self->{'max_mfn'};
}
-=head2 mfn
+=head2 seek
-Returns current record number (MFN).
+Seek to specified MFN in file.
+
+ $isis->seek(42);
- print $webpac->mfn;
+First record in database has position 1.
=cut
-sub mfn {
+sub seek {
my $self = shift;
- return $self->{'current_mfn'};
+ my $pos = shift || return;
+
+ my $log = $self->_get_logger();
+
+ if ($pos < 1) {
+ $log->warn("seek before first record");
+ $pos = 1;
+ } elsif ($pos > $self->{'max_mfn'}) {
+ $log->warn("seek beyond last record");
+ $pos = $self->{'max_mfn'};
+ }
+
+ return $self->{'current_mfn'} = (($pos - 1) || -1);
}
=head1 AUTHOR
--- /dev/null
+package WebPAC::Normalize;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+WebPAC::Normalize - normalisation of source file
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+This package contains code that could be helpful in implementing different
+normalisation front-ends.
+
+=head1 FUNCTIONS
+
+=head2 none_yet
+
+=cut
+
+sub none_yet {
+}
+
+=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
use strict;
use base qw/WebPAC::Common/;
+use Storable;
=head1 NAME
$log->debug("format: $format");
my @v;
- if ($format =~ /$LOOKUP_REGEX/o) {
+ # FIXME this is a cludge!
+ if ($format =~ /$WebPAC::Lookup::LOOKUP_REGEX/o) {
@v = $self->fill_in_to_arr($rec,$format);
} else {
@v = $self->parse_to_arr($rec,$format);
#!/usr/bin/perl -w
-use Test::More tests => 9;
+use Test::More tests => 11;
use blib;
use strict;
#!/usr/bin/perl -w
-use Test::More tests => 6;
+use Test::More tests => 36;
use Test::Exception;
use Cwd qw/abs_path/;
use blib;
$abs_path =~ s#/[^/]*$#/#;
ok(my $isis = new WebPAC::Input::ISIS(), "new");
+ok(my $isis_lm = new WebPAC::Input::ISIS( low_mem => 1 ), "new");
throws_ok { $isis->open() } qr/filename/, "need filename";
throws_ok { $isis->open( filename => '/dev/null' ) } qr/can't find database/ , "open";
ok($isis->open( filename => "$abs_path/winisis/BIBL" ), "open");
+ok($isis_lm->open( filename => "$abs_path/winisis/BIBL", low_mem => 1 ), "open");
+
+cmp_ok($isis->pos, '==', -1, "mfn");
+
+ok(my $size = $isis->size, "size");
+
+my @db1;
+
+foreach my $mfn ( 1 ... $size ) {
+ ok(my $rec = $isis->fetch, "fetch");
+ cmp_ok($isis->pos, '==', $mfn, "rec $mfn");
+ push @db1, $rec;
+}
+
+my @db2;
+
+foreach my $mfn ( 1 ... $size ) {
+ ok($isis_lm->seek($mfn), "seek");
+ ok(my $rec = $isis_lm->fetch, "fetch");
+ cmp_ok($isis_lm->pos, '==', $mfn, "rec $mfn");
+ push @db2, $rec;
+}
+
+is_deeply(\@db1, \@db2, "seek working");
projects / webpac2 / commitdiff