--- trunk/lib/WebPAC/Input.pm 2005/07/16 20:54:28 11 +++ trunk/lib/WebPAC/Input.pm 2005/12/18 21:06:46 286 @@ -3,39 +3,57 @@ use warnings; use strict; +use blib; + +use WebPAC::Common; +use base qw/WebPAC::Common/; +use Text::Iconv; + =head1 NAME -WebPAC::Input - core module for input file format +WebPAC::Input - read different file formats into WebPAC =head1 VERSION -Version 0.01 +Version 0.03 =cut -our $VERSION = '0.01'; +our $VERSION = '0.03'; =head1 SYNOPSIS -This module will load particular loader module and execute it's functions. +This module implements input as database which have fixed and known +I while indexing and single unique numeric identifier for database +position ranging from 1 to I. + +Simply, something that is indexed by unmber from 1 .. I. + +Examples of such databases are CDS/ISIS files, MARC files, lines in +text file, and so on. + +Specific file formats are implemented using low-level interface modules, +located in C namespace which export C, +C and optional C functions. Perhaps a little code snippet. use WebPAC::Input; my $db = WebPAC::Input->new( - format => 'NULL', - config => $config, - lookup => $lookup_obj, - low_mem => 1, + module => 'WebPAC::Input::ISIS', + config => $config, + lookup => $lookup_obj, + low_mem => 1, ); $db->open('/path/to/database'); print "database size: ",$db->size,"\n"; - while (my $row = $db->fetch) { - ... + while (my $rec = $db->fetch) { } + + =head1 FUNCTIONS =head2 new @@ -43,28 +61,56 @@ Create new input database object. my $db = new WebPAC::Input( - format => 'NULL' + module => 'WebPAC::Input::MARC', code_page => 'ISO-8859-2', low_mem => 1, ); +C is low-level file format module. See L and +L. + Optional parametar C specify application code page (which will be used internally). This should probably be your terminal encoding, and by default, it C. Default is not to use C options (see L below). +This function will also call low-level C if it exists with same +parametars. + =cut sub new { - my $class = shift; - my $self = {@_}; + my $class = shift; + my $self = {@_}; bless($self, $class); - $self->{'code_page'} ||= 'ISO-8859-2'; - my $log = $self->_get_logger; + $log->logconfess("specify low-level file format module") unless ($self->{module}); + my $module = $self->{module}; + $module =~ s#::#/#g; + $module .= '.pm'; + $log->debug("require low-level module $self->{module} from $module"); + require $module; + eval $self->{module} .'->import'; + + # check if required subclasses are implemented + foreach my $subclass (qw/open_db fetch_rec/) { + if ( $self->can($subclass) ) { + $log->debug("imported $subclass"); + } else { + $log->warn("missing $subclass in $self->{module}"); + } + } + + if ($self->can('init')) { + $log->debug("calling init"); + $self->init(@_); + } + + $self->{'code_page'} ||= 'ISO-8859-2'; + # 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)"); @@ -94,6 +140,226 @@ $self ? return $self : return undef; } +=head2 open + +This function will read whole database in memory and produce lookups. + + $input->open( + path => '/path/to/database/file', + code_page => '852', + limit => 500, + offset => 6000, + lookup => $lookup_obj, + ); + +By default, C is assumed to be C<852>. + +C is optional parametar to position at some offset before reading from database. + +C is optional parametar to read just C records from database + +Returns size of database, regardless of C and C +parametars, see also C. + +=cut + +sub open { + my $self = shift; + my $arg = {@_}; + + my $log = $self->_get_logger(); + + $log->logcroak("need path") if (! $arg->{'path'}); + my $code_page = $arg->{'code_page'} || '852'; + + # store data in object + $self->{'code_page'} = $code_page; + foreach my $v (qw/path offset limit/) { + $self->{$v} = $arg->{$v} if ($arg->{$v}); + } + + # create Text::Iconv object + $self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'}); + + my ($db, $size) = $self->open_db( + path => $arg->{path}, + ); + + unless ($db) { + $log->logwarn("can't open database $arg->{path}, skipping..."); + return; + } + + unless ($size) { + $log->logwarn("no records in database $arg->{path}, skipping..."); + return; + } + + my $offset = 1; + my $limit = $size; + + if (my $s = $self->{offset}) { + $log->info("skipping to MFN $s"); + $offset = $s; + } else { + $self->{offset} = $offset; + } + + if ($self->{limit}) { + $log->info("limiting to ",$self->{limit}," records"); + $limit = $offset + $self->{limit} - 1; + $limit = $size if ($limit > $size); + } + + # store size for later + $self->{size} = ($limit - $offset) ? ($limit - $offset + 1) : 0; + + $log->info("processing $self->{size} records in $code_page, convert to $self->{code_page}"); + + # read database + for (my $pos = $offset; $pos <= $limit; $mfn++) { + + $log->debug("position: $pos\n"); + + my $rec = $self->fetch_rec( $db, $pos ); + + if (! $rec) { + $log->warn("record $pos empty? skipping..."); + next; + } + + # store + if ($self->{low_mem}) { + $self->{db}->put($pos, $rec); + } else { + $self->{data}->{$pos} = $rec; + } + + # create lookup + $self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'}); + + $self->progress_bar($pos,$limit); + + } + + $self->{pos} = -1; + $self->{last_pcnt} = 0; + + # store max mfn and return it. + $self->{max_pos} = $limit; + $log->debug("max_pos: $limit"); + + return $size; +} + +=head2 fetch + +Fetch next record from database. It will also displays progress bar. + + my $rec = $isis->fetch; + +Record from this function should probably go to C for +normalisation. + +=cut + +sub fetch { + my $self = shift; + + my $log = $self->_get_logger(); + + $log->logconfess("it seems that you didn't load database!") unless ($self->{pos}); + + if ($self->{pos} == -1) { + $self->{pos} = $self->{offset}; + } else { + $self->{pos}++; + } + + my $mfn = $self->{pos}; + + if ($mfn > $self->{max_pos}) { + $self->{pos} = $self->{max_pos}; + $log->debug("at EOF"); + return; + } + + $self->progress_bar($mfn,$self->{max_pos}); + + my $rec; + + if ($self->{low_mem}) { + $rec = $self->{db}->get($mfn); + } else { + $rec = $self->{data}->{$mfn}; + } + + $rec ||= 0E0; +} + +=head2 pos + +Returns current record number (MFN). + + print $isis->pos; + +First record in database has position 1. + +=cut + +sub pos { + my $self = shift; + return $self->{pos}; +} + + +=head2 size + +Returns number of records in database + + print $isis->size; + +Result from this function can be used to loop through all records + + foreach my $mfn ( 1 ... $isis->size ) { ... } + +because it takes into account C and C. + +=cut + +sub size { + my $self = shift; + return $self->{size}; +} + +=head2 seek + +Seek to specified MFN in file. + + $isis->seek(42); + +First record in database has position 1. + +=cut + +sub seek { + my $self = shift; + my $pos = shift || return; + + my $log = $self->_get_logger(); + + if ($pos < 1) { + $log->warn("seek before first record"); + $pos = 1; + } elsif ($pos > $self->{max_pos}) { + $log->warn("seek beyond last record"); + $pos = $self->{max_pos}; + } + + return $self->{pos} = (($pos - 1) || -1); +} + + =head1 MEMORY USAGE C options is double-edged sword. If enabled, WebPAC