/[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 1236 by dpavlin, Fri Jul 10 13:54:55 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 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 296  sub open { Line 300  sub open {
300                                  $log->debug("-=> $f_nr ## $l");                                  $log->debug("-=> $f_nr ## $l");
301    
302                                  # codepage conversion and recode_regex                                  # codepage conversion and recode_regex
303  #                               $l = decode($input_encoding, $l, 1);                                  $l = decode($input_encoding, $l, 1);
                                 from_to( $l, $input_encoding, 'utf-8', 1 );  
304                                  $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);
305    
306                                  # apply regexps                                  # apply regexps
# Line 316  sub open { Line 319  sub open {
319                                                          warn "*** $d\n" if ($debug);                                                          warn "*** $d\n" if ($debug);
320    
321                                                  }                                                  }
322                                                  $log->error("error applying regex: $r") if ($@);                                                  $log->error("error applying regex: ",dump($r), $@) if $@;
323                                          }                                          }
324                                  }                                  }
325    
# Line 386  sub open { Line 389  sub open {
389          $self->{max_pos} = $to_rec;          $self->{max_pos} = $to_rec;
390          $log->debug("max_pos: $to_rec");          $log->debug("max_pos: $to_rec");
391    
         # save for dump  
         $self->{ll_db} = $ll_db;  
   
392          return $size;          return $size;
393  }  }
394    
395    sub input_module { $_[0]->{ll_db} }
396    
397  =head2 fetch  =head2 fetch
398    
399  Fetch next record from database. It will also displays progress bar.  Fetch next record from database. It will also displays progress bar.
# Line 562  sub stats { Line 564  sub stats {
564    
565          $log->debug( sub { dump($s) } );          $log->debug( sub { dump($s) } );
566    
567            my $path = 'var/stats.yml';
568            YAML::DumpFile( $path, $s );
569            $log->info( 'created ', $path, ' with ', -s $path, ' bytes' );
570    
571          return $out;          return $out;
572  }  }
573    
# Line 720  sub modify_file_regexps { Line 726  sub modify_file_regexps {
726                                  line => $.,                                  line => $.,
727                          };                          };
728                          $log->debug("regex: $regex");                          $log->debug("regex: $regex");
729                    } else {
730                            die "can't parse: $_";
731                  }                  }
732          }          }
733    
Legend:
Removed from v.1100  
changed lines
  Added in v.1236
  ViewVC Help
Powered by ViewVC 1.1.26