/[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 771 by dpavlin, Fri Nov 3 20:40:33 2006 UTC revision 797 by dpavlin, Sun Feb 4 13:28:30 2007 UTC
# Line 16  WebPAC::Input - read different file form Line 16  WebPAC::Input - read different file form
16    
17  =head1 VERSION  =head1 VERSION
18    
19  Version 0.15  Version 0.17
20    
21  =cut  =cut
22    
23  our $VERSION = '0.15';  our $VERSION = '0.17';
24    
25  =head1 SYNOPSIS  =head1 SYNOPSIS
26    
# Line 469  First record in database has position 1. Line 469  First record in database has position 1.
469    
470  sub seek {  sub seek {
471          my $self = shift;          my $self = shift;
472          my $pos = shift || return;          my $pos = shift;
473    
474          my $log = $self->_get_logger();          my $log = $self->_get_logger();
475    
476            $log->logconfess("called without pos") unless defined($pos);
477    
478          if ($pos < 1) {          if ($pos < 1) {
479                  $log->warn("seek before first record");                  $log->warn("seek before first record");
480                  $pos = 1;                  $pos = 1;
# Line 535  sub stats { Line 537  sub stats {
537          return $out;          return $out;
538  }  }
539    
540  =head2 dump  =head2 dump_ascii
541    
542  Display humanly readable dump of record  Display humanly readable dump of record
543    
544  =cut  =cut
545    
546  sub dump {  sub dump_ascii {
547          my $self = shift;          my $self = shift;
548    
549          return unless $self->{ll_db};          return unless $self->{ll_db};
550    
551          if ($self->{ll_db}->can('dump_rec')) {          if ($self->{ll_db}->can('dump_rec')) {
552                  return $self->{ll_db}->dump_rec( $self->{pos} );                  return $self->{ll_db}->dump_ascii( $self->{pos} );
553          } else {          } else {
554                  return dump( $self->{ll_db}->fetch_rec( $self->{pos} ) );                  return dump( $self->{ll_db}->fetch_rec( $self->{pos} ) );
555          }          }
# Line 566  Generate hash with regexpes to be applie Line 568  Generate hash with regexpes to be applie
568    
569  sub _get_regex {  sub _get_regex {
570          my ($sf,$from,$to) = @_;          my ($sf,$from,$to) = @_;
571    
572            # protect /
573            $from =~ s!/!\\/!gs;
574            $to =~ s!/!\\/!gs;
575    
576            if ($from =~ m/^regex:(.+)$/) {
577                    $from = $1;
578            } else {
579                    $from = '\Q' . $from . '\E';
580            }
581          if ($sf =~ /^\^/) {          if ($sf =~ /^\^/) {
582                  return                  return
583                          's/\Q'. $sf .'\E([^\^]*?)\Q'. $from .'\E([^\^]*?)/'. $sf .'$1'. $to .'$2/';                          's/\Q'. $sf .'\E([^\^]*?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/';
584          } else {          } else {
585                  return                  return
586                          's/\Q'. $from .'\E/'. $to .'/g';                          's/'. $from .'/'. $to .'/g';
587          }          }
588  }  }
589    
Legend:
Removed from v.771  
changed lines
  Added in v.797
  ViewVC Help
Powered by ViewVC 1.1.26