/[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 818 by dpavlin, Thu Apr 5 21:53:52 2007 UTC revision 823 by dpavlin, Wed Apr 11 12:22:37 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.17  Version 0.18
20    
21  =cut  =cut
22    
23  our $VERSION = '0.17';  our $VERSION = '0.18';
24    
25  =head1 SYNOPSIS  =head1 SYNOPSIS
26    
# Line 565  sub dump_ascii { Line 565  sub dump_ascii {
565          }          }
566  }  }
567    
568  =head2 modify_record_regexps  =head2 _get_regex
569    
570  Generate hash with regexpes to be applied using L<filter>.  Helper function called which create regexps to be execute on code.
571    
572    my $regexpes = $input->modify_record_regexps(    _get_regex( 900, 'regex:[0-9]+' ,'numbers' );
573                  900 => { '^a' => { ' : ' => '^b' } },    _get_regex( 900, '^b', ' : ^b' );
574                  901 => { '*' => { '^b' => ' ; ' } },  
575    );  It supports perl regexps with C<regex:> prefix to from value and has
576    additional logic to skip empty subfields.
577    
578  =cut  =cut
579    
# Line 589  sub _get_regex { Line 590  sub _get_regex {
590                  $from = '\Q' . $from . '\E';                  $from = '\Q' . $from . '\E';
591          }          }
592          if ($sf =~ /^\^/) {          if ($sf =~ /^\^/) {
593                    my $need_subfield_data = '*';   # no
594                    # if from is also subfield, require some data in between
595                    # to correctly skip empty subfields
596                    $need_subfield_data = '+' if ($from =~ m/^\\Q\^/);
597                  return                  return
598                          's/\Q'. $sf .'\E([^\^]*?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/';                          's/\Q'. $sf .'\E([^\^]' . $need_subfield_data . '?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/';
599          } else {          } else {
600                  return                  return
601                          's/'. $from .'/'. $to .'/g';                          's/'. $from .'/'. $to .'/g';
602          }          }
603  }  }
604    
605    
606    =head2 modify_record_regexps
607    
608    Generate hash with regexpes to be applied using L<filter>.
609    
610      my $regexpes = $input->modify_record_regexps(
611                    900 => { '^a' => { ' : ' => '^b' } },
612                    901 => { '*' => { '^b' => ' ; ' } },
613      );
614    
615    =cut
616    
617  sub modify_record_regexps {  sub modify_record_regexps {
618          my $self = shift;          my $self = shift;
619          my $modify_record = {@_};          my $modify_record = {@_};
Legend:
Removed from v.818  
changed lines
  Added in v.823
  ViewVC Help
Powered by ViewVC 1.1.26