/[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 1100 by dpavlin, Sat Aug 2 23:46:41 2008 UTC revision 1307 by dpavlin, Mon Sep 21 16:42:25 2009 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;  use lib 'lib';
7    
8  use WebPAC::Common;  use WebPAC::Common;
9  use base qw/WebPAC::Common/;  use base qw/WebPAC::Common/;
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
11  use Encode qw/decode from_to/;  use Encode qw/decode from_to/;
12    use YAML;
13    
14  =head1 NAME  =head1 NAME
15    
# Line 136  This function will read whole database i Line 137  This function will read whole database i
137    
138  By default, C<input_encoding> is assumed to be C<cp852>.  By default, C<input_encoding> is assumed to be C<cp852>.
139    
140  C<offset> is optional parametar to position at some offset before reading from database.  C<offset> is optional parametar to skip records at beginning.
141    
142  C<limit> is optional parametar to read just C<limit> records from database  C<limit> is optional parametar to read just C<limit> records from database
143    
# Line 181  sub open { Line 182  sub open {
182          my $input_encoding = $arg->{'input_encoding'} || $self->{'input_encoding'} || 'cp852';          my $input_encoding = $arg->{'input_encoding'} || $self->{'input_encoding'} || 'cp852';
183    
184          # store data in object          # store data in object
185          foreach my $v (qw/path offset limit/) {          $self->{$_} = $arg->{$_} foreach grep { defined $arg->{$_} } qw(path offset limit);
                 $self->{$v} = $arg->{$v} if ($arg->{$v});  
         }  
186    
187          if ($arg->{load_row} || $arg->{save_row}) {          if ($arg->{load_row} || $arg->{save_row}) {
188                  $log->logconfess("save_row and load_row must be defined in pair and be CODE") unless (                  $log->logconfess("save_row and load_row must be defined in pair and be CODE") unless (
# Line 229  sub open { Line 228  sub open {
228    
229          my $class = $self->{module} || $log->logconfess("can't get low-level module name!");          my $class = $self->{module} || $log->logconfess("can't get low-level module name!");
230    
231            $arg->{$_} = $self->{$_} foreach qw(offset limit);
232    
233          my $ll_db = $class->new(          my $ll_db = $class->new(
234                  path => $arg->{path},                  path => $arg->{path},
235                  input_config => $arg->{input_config} || $self->{input_config},                  input_config => $arg->{input_config} || $self->{input_config},
# Line 242  sub open { Line 243  sub open {
243                  %{ $arg },                  %{ $arg },
244          );          );
245    
246            # save for dump and input_module
247            $self->{ll_db} = $ll_db;
248    
249          unless (defined($ll_db)) {          unless (defined($ll_db)) {
250                  $log->logwarn("can't open database $arg->{path}, skipping...");                  $log->logwarn("can't open database $arg->{path}, skipping...");
251                  return;                  return;
# Line 258  sub open { Line 262  sub open {
262          my $to_rec = $size;          my $to_rec = $size;
263    
264          if (my $s = $self->{offset}) {          if (my $s = $self->{offset}) {
265                  $log->debug("skipping to MFN $s");                  $log->debug("offset $s records");
266                  $from_rec = $s;                  $from_rec = $s + 1;
267          } else {          } else {
268                  $self->{offset} = $from_rec;                  $self->{offset} = $from_rec - 1;
269          }          }
270    
271          if ($self->{limit}) {          if ($self->{limit}) {
# Line 270  sub open { Line 274  sub open {
274                  $to_rec = $size if ($to_rec > $size);                  $to_rec = $size if ($to_rec > $size);
275          }          }
276    
         # store size for later  
         $self->{size} = ($to_rec - $from_rec) ? ($to_rec - $from_rec + 1) : 0;  
   
277          my $strict_encoding = $arg->{strict_encoding} || $self->{strict_encoding}; ## FIXME should be 1 really          my $strict_encoding = $arg->{strict_encoding} || $self->{strict_encoding}; ## FIXME should be 1 really
278    
279          $log->info("processing $self->{size}/$size records [$from_rec-$to_rec]",          $log->info("processing $self->{size}/$size records [$from_rec-$to_rec]",
# Line 280  sub open { Line 281  sub open {
281                  $self->{stats} ? ' [stats]' : '',                  $self->{stats} ? ' [stats]' : '',
282          );          );
283    
284            $self->{size} = 0;
285    
286          # read database          # read database
287          for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {          for (my $pos = $from_rec; $pos <= $to_rec; $pos++) {
288    
289                  $log->debug("position: $pos\n");                  $log->debug("position: $pos\n");
290    
291                    $self->{size}++; # XXX I could move this more down if I didn't want empty records...
292    
293                  my $rec = $ll_db->fetch_rec($pos, sub {                  my $rec = $ll_db->fetch_rec($pos, sub {
294                                  my ($l,$f_nr,$debug) = @_;                                  my ($l,$f_nr,$debug) = @_;
295  #                               return unless defined($l);  #                               return unless defined($l);
# Line 296  sub open { Line 301  sub open {
301                                  $log->debug("-=> $f_nr ## $l");                                  $log->debug("-=> $f_nr ## $l");
302    
303                                  # codepage conversion and recode_regex                                  # codepage conversion and recode_regex
304  #                               $l = decode($input_encoding, $l, 1);                                  $l = decode($input_encoding, $l, 1);
                                 from_to( $l, $input_encoding, 'utf-8', 1 );  
305                                  $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);                                  $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
306    
307                                  # apply regexps                                  # apply regexps
# Line 316  sub open { Line 320  sub open {
320                                                          warn "*** $d\n" if ($debug);                                                          warn "*** $d\n" if ($debug);
321    
322                                                  }                                                  }
323                                                  $log->error("error applying regex: $r") if ($@);                                                  $log->error("error applying regex: ",dump($r), $@) if $@;
324                                          }                                          }
325                                  }                                  }
326    
# Line 386  sub open { Line 390  sub open {
390          $self->{max_pos} = $to_rec;          $self->{max_pos} = $to_rec;
391          $log->debug("max_pos: $to_rec");          $log->debug("max_pos: $to_rec");
392    
         # save for dump  
         $self->{ll_db} = $ll_db;  
   
393          return $size;          return $size;
394  }  }
395    
396    sub input_module { $_[0]->{ll_db} }
397    
398  =head2 fetch  =head2 fetch
399    
400  Fetch next record from database. It will also displays progress bar.  Fetch next record from database. It will also displays progress bar.
# Line 411  sub fetch { Line 414  sub fetch {
414          $log->logconfess("it seems that you didn't load database!") unless ($self->{pos});          $log->logconfess("it seems that you didn't load database!") unless ($self->{pos});
415    
416          if ($self->{pos} == -1) {          if ($self->{pos} == -1) {
417                  $self->{pos} = $self->{offset};                  $self->{pos} = $self->{offset} + 1;
418          } else {          } else {
419                  $self->{pos}++;                  $self->{pos}++;
420          }          }
# Line 469  because it takes into account C<offset> Line 472  because it takes into account C<offset>
472    
473  sub size {  sub size {
474          my $self = shift;          my $self = shift;
475          return $self->{size};          return $self->{size}; # FIXME this is buggy if open is called multiple times!
476  }  }
477    
478  =head2 seek  =head2 seek
# Line 562  sub stats { Line 565  sub stats {
565    
566          $log->debug( sub { dump($s) } );          $log->debug( sub { dump($s) } );
567    
568            my $path = 'var/stats.yml';
569            YAML::DumpFile( $path, $s );
570            $log->info( 'created ', $path, ' with ', -s $path, ' bytes' );
571    
572          return $out;          return $out;
573  }  }
574    
# Line 720  sub modify_file_regexps { Line 727  sub modify_file_regexps {
727                                  line => $.,                                  line => $.,
728                          };                          };
729                          $log->debug("regex: $regex");                          $log->debug("regex: $regex");
730                    } else {
731                            die "can't parse: $_";
732                  }                  }
733          }          }
734    

Legend:
Removed from v.1100  
changed lines
  Added in v.1307

  ViewVC Help
Powered by ViewVC 1.1.26