/[webpac2]/trunk/lib/WebPAC/Input.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Input.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 11 by dpavlin, Sat Jul 16 20:54:28 2005 UTC revision 308 by dpavlin, Tue Dec 20 19:01:22 2005 UTC
# Line 3  package WebPAC::Input; Line 3  package WebPAC::Input;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6    use WebPAC::Common;
7    use base qw/WebPAC::Common/;
8    use Text::Iconv;
9    use Data::Dumper;
10    
11  =head1 NAME  =head1 NAME
12    
13  WebPAC::Input - core module for input file format  WebPAC::Input - read different file formats into WebPAC
14    
15  =head1 VERSION  =head1 VERSION
16    
17  Version 0.01  Version 0.03
18    
19  =cut  =cut
20    
21  our $VERSION = '0.01';  our $VERSION = '0.03';
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
25  This module will load particular loader module and execute it's functions.  This module implements input as database which have fixed and known
26    I<size> while indexing and single unique numeric identifier for database
27    position ranging from 1 to I<size>.
28    
29    Simply, something that is indexed by unmber from 1 .. I<size>.
30    
31    Examples of such databases are CDS/ISIS files, MARC files, lines in
32    text file, and so on.
33    
34    Specific file formats are implemented using low-level interface modules,
35    located in C<WebPAC::Input::*> namespace which export C<open_db>,
36    C<fetch_rec> and optional C<init> functions.
37    
38  Perhaps a little code snippet.  Perhaps a little code snippet.
39    
40      use WebPAC::Input;      use WebPAC::Input;
41    
42      my $db = WebPAC::Input->new(      my $db = WebPAC::Input->new(
43          format => 'NULL',          module => 'WebPAC::Input::ISIS',
44          config => $config,                  config => $config,
45          lookup => $lookup_obj,                  lookup => $lookup_obj,
46          low_mem => 1,                  low_mem => 1,
47      );      );
48    
49      $db->open('/path/to/database');      $db->open('/path/to/database');
50      print "database size: ",$db->size,"\n";      print "database size: ",$db->size,"\n";
51      while (my $row = $db->fetch) {      while (my $rec = $db->fetch) {
         ...  
52      }      }
53    
54    
55    
56  =head1 FUNCTIONS  =head1 FUNCTIONS
57    
58  =head2 new  =head2 new
# Line 43  Perhaps a little code snippet. Line 60  Perhaps a little code snippet.
60  Create new input database object.  Create new input database object.
61    
62    my $db = new WebPAC::Input(    my $db = new WebPAC::Input(
63          format => 'NULL'          module => 'WebPAC::Input::MARC',
64          code_page => 'ISO-8859-2',          code_page => 'ISO-8859-2',
65          low_mem => 1,          low_mem => 1,
66    );    );
67    
68    C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
69    L<WebPAC::Input::MARC>.
70    
71  Optional parametar C<code_page> specify application code page (which will be  Optional parametar C<code_page> specify application code page (which will be
72  used internally). This should probably be your terminal encoding, and by  used internally). This should probably be your terminal encoding, and by
73  default, it C<ISO-8859-2>.  default, it C<ISO-8859-2>.
74    
75  Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).  Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
76    
77    This function will also call low-level C<init> if it exists with same
78    parametars.
79    
80  =cut  =cut
81    
82  sub new {  sub new {
83          my $class = shift;          my $class = shift;
84          my $self = {@_};          my $self = {@_};
85          bless($self, $class);          bless($self, $class);
86    
         $self->{'code_page'} ||= 'ISO-8859-2';  
   
87          my $log = $self->_get_logger;          my $log = $self->_get_logger;
88    
89            $log->logconfess("specify low-level file format module") unless ($self->{module});
90            my $module = $self->{module};
91            $module =~ s#::#/#g;
92            $module .= '.pm';
93            $log->debug("require low-level module $self->{module} from $module");
94    
95            require $module;
96            #eval $self->{module} .'->import';
97    
98            # check if required subclasses are implemented
99            foreach my $subclass (qw/open_db fetch_rec init/) {
100                    my $n = $self->{module} . '::' . $subclass;
101                    if (! defined &{ $n }) {
102                            my $missing = "missing $subclass in $self->{module}";
103                            $self->{$subclass} = sub { $log->logwarn($missing) };
104                    } else {
105                            $self->{$subclass} = \&{ $n };
106                    }
107            }
108    
109            if ($self->{init}) {
110                    $log->debug("calling init");
111                    $self->{init}->($self, @_);
112            }
113    
114            $self->{'code_page'} ||= 'ISO-8859-2';
115    
116          # running with low_mem flag? well, use DBM::Deep then.          # running with low_mem flag? well, use DBM::Deep then.
117          if ($self->{'low_mem'}) {          if ($self->{'low_mem'}) {
118                  $log->info("running with low_mem which impacts performance (<32 Mb memory usage)");                  $log->info("running with low_mem which impacts performance (<32 Mb memory usage)");
# Line 94  sub new { Line 142  sub new {
142          $self ? return $self : return undef;          $self ? return $self : return undef;
143  }  }
144    
145    =head2 open
146    
147    This function will read whole database in memory and produce lookups.
148    
149     $input->open(
150            path => '/path/to/database/file',
151            code_page => '852',
152            limit => 500,
153            offset => 6000,
154            lookup => $lookup_obj,
155     );
156    
157    By default, C<code_page> is assumed to be C<852>.
158    
159    C<offset> is optional parametar to position at some offset before reading from database.
160    
161    C<limit> is optional parametar to read just C<limit> records from database
162    
163    Returns size of database, regardless of C<offset> and C<limit>
164    parametars, see also C<size>.
165    
166    =cut
167    
168    sub open {
169            my $self = shift;
170            my $arg = {@_};
171    
172            my $log = $self->_get_logger();
173    
174            $log->logcroak("need path") if (! $arg->{'path'});
175            my $code_page = $arg->{'code_page'} || '852';
176    
177            # store data in object
178            $self->{'input_code_page'} = $code_page;
179            foreach my $v (qw/path offset limit/) {
180                    $self->{$v} = $arg->{$v} if ($arg->{$v});
181            }
182    
183            # create Text::Iconv object
184            $self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'});
185    
186            my ($db, $size) = $self->{open_db}->( $self,
187                    path => $arg->{path},
188            );
189    
190            unless ($db) {
191                    $log->logwarn("can't open database $arg->{path}, skipping...");
192                    return;
193            }
194    
195            unless ($size) {
196                    $log->logwarn("no records in database $arg->{path}, skipping...");
197                    return;
198            }
199    
200            my $offset = 1;
201            my $limit = $size;
202    
203            if (my $s = $self->{offset}) {
204                    $log->info("skipping to MFN $s");
205                    $offset = $s;
206            } else {
207                    $self->{offset} = $offset;
208            }
209    
210            if ($self->{limit}) {
211                    $log->debug("limiting to ",$self->{limit}," records");
212                    $limit = $offset + $self->{limit} - 1;
213                    $limit = $size if ($limit > $size);
214            }
215    
216            # store size for later
217            $self->{size} = ($limit - $offset) ? ($limit - $offset + 1) : 0;
218    
219            $log->info("processing $self->{size} records in $code_page, convert to $self->{code_page}");
220    
221            # read database
222            for (my $pos = $offset; $pos <= $limit; $pos++) {
223    
224                    $log->debug("position: $pos\n");
225    
226                    my $rec = $self->{fetch_rec}->($self, $db, $pos );
227    
228                    $log->debug(sub { Dumper($rec) });
229    
230                    if (! $rec) {
231                            $log->warn("record $pos empty? skipping...");
232                            next;
233                    }
234    
235                    # store
236                    if ($self->{low_mem}) {
237                            $self->{db}->put($pos, $rec);
238                    } else {
239                            $self->{data}->{$pos} = $rec;
240                    }
241    
242                    # create lookup
243                    $self->{'lookup'}->add( $rec ) if ($rec && $self->{'lookup'});
244    
245                    $self->progress_bar($pos,$limit);
246    
247            }
248    
249            $self->{pos} = -1;
250            $self->{last_pcnt} = 0;
251    
252            # store max mfn and return it.
253            $self->{max_pos} = $limit;
254            $log->debug("max_pos: $limit");
255    
256            return $size;
257    }
258    
259    =head2 fetch
260    
261    Fetch next record from database. It will also displays progress bar.
262    
263     my $rec = $isis->fetch;
264    
265    Record from this function should probably go to C<data_structure> for
266    normalisation.
267    
268    =cut
269    
270    sub fetch {
271            my $self = shift;
272    
273            my $log = $self->_get_logger();
274    
275            $log->logconfess("it seems that you didn't load database!") unless ($self->{pos});
276    
277            if ($self->{pos} == -1) {
278                    $self->{pos} = $self->{offset};
279            } else {
280                    $self->{pos}++;
281            }
282    
283            my $mfn = $self->{pos};
284    
285            if ($mfn > $self->{max_pos}) {
286                    $self->{pos} = $self->{max_pos};
287                    $log->debug("at EOF");
288                    return;
289            }
290    
291            $self->progress_bar($mfn,$self->{max_pos});
292    
293            my $rec;
294    
295            if ($self->{low_mem}) {
296                    $rec = $self->{db}->get($mfn);
297            } else {
298                    $rec = $self->{data}->{$mfn};
299            }
300    
301            $rec ||= 0E0;
302    }
303    
304    =head2 pos
305    
306    Returns current record number (MFN).
307    
308     print $isis->pos;
309    
310    First record in database has position 1.
311    
312    =cut
313    
314    sub pos {
315            my $self = shift;
316            return $self->{pos};
317    }
318    
319    
320    =head2 size
321    
322    Returns number of records in database
323    
324     print $isis->size;
325    
326    Result from this function can be used to loop through all records
327    
328     foreach my $mfn ( 1 ... $isis->size ) { ... }
329    
330    because it takes into account C<offset> and C<limit>.
331    
332    =cut
333    
334    sub size {
335            my $self = shift;
336            return $self->{size};
337    }
338    
339    =head2 seek
340    
341    Seek to specified MFN in file.
342    
343     $isis->seek(42);
344    
345    First record in database has position 1.
346    
347    =cut
348    
349    sub seek {
350            my $self = shift;
351            my $pos = shift || return;
352    
353            my $log = $self->_get_logger();
354    
355            if ($pos < 1) {
356                    $log->warn("seek before first record");
357                    $pos = 1;
358            } elsif ($pos > $self->{max_pos}) {
359                    $log->warn("seek beyond last record");
360                    $pos = $self->{max_pos};
361            }
362    
363            return $self->{pos} = (($pos - 1) || -1);
364    }
365    
366    
367  =head1 MEMORY USAGE  =head1 MEMORY USAGE
368    
369  C<low_mem> options is double-edged sword. If enabled, WebPAC  C<low_mem> options is double-edged sword. If enabled, WebPAC
Legend:
Removed from v.11  
changed lines
  Added in v.308
  ViewVC Help
Powered by ViewVC 1.1.26