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