/[webpac2]/trunk/lib/WebPAC/Lookup.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/Lookup.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 7 by dpavlin, Sat Jul 16 16:00:19 2005 UTC revision 12 by dpavlin, Sat Jul 16 22:57:26 2005 UTC
# Line 9  use base qw/WebPAC::Common/; Line 9  use base qw/WebPAC::Common/;
9  use File::Slurp;  use File::Slurp;
10  use Data::Dumper;  use Data::Dumper;
11    
 my $LOOKUP_REGEX = 'lookup{[^\{\}]+}';  
 my $LOOKUP_REGEX_SAVE = 'lookup{([^\{\}]+)}';  
   
12  =head1 NAME  =head1 NAME
13    
14  WebPAC::Lookup - simple normalisation plugin to produce lookup  WebPAC::Lookup - simple normalisation plugin to produce lookup
# Line 54  Create new lookup object. Line 51  Create new lookup object.
51    
52    my $lookup = new WebPAC::Lookup(    my $lookup = new WebPAC::Lookup(
53          lookup_file => '/path/to/conf/lookup/lookup.pm',          lookup_file => '/path/to/conf/lookup/lookup.pm',
54            is_lookup_regex => 'lookup{[^\{\}]+}';
55            save_lookup_regex => 'lookup{([^\{\}]+)}';
56    );    );
57    
58  =cut  =cut
# Line 77  sub new { Line 76  sub new {
76    
77          $log->logconfess("lookup config file isn't ARRAY", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);          $log->logconfess("lookup config file isn't ARRAY", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
78    
79            $self->{'is_lookup_regex'} ||= 'lookup{[^\{\}]+}';
80            $self->{'save_lookup_regex'} ||= 'lookup{([^\{\}]+)}';
81    
82    
83            $self->{'LOOKUP_REGEX'} = qr/$self->{'is_lookup_regex'}/;
84            $self->{'LOOKUP_REGEX_SAVE'} = qr/$self->{'save_lookup_regex'}/;
85    
86            $log->debug("regexps: ", $self->{'LOOKUP_REGEX'}, " ", $self->{'LOOKUP_REGEX_SAVE'});
87    
88          $self ? return $self : return undef;          $self ? return $self : return undef;
89  }  }
90    
# Line 144  sub lookup { Line 152  sub lookup {
152    
153          my $tmp = shift || $log->logconfess("need format");          my $tmp = shift || $log->logconfess("need format");
154    
155          if ($tmp =~ /$LOOKUP_REGEX/o) {          if ($tmp =~ $self->{'LOOKUP_REGEX'}) {
156                  my @in = ( $tmp );                  my @in = ( $tmp );
157    
158                  $log->debug("lookup for: ",$tmp);                  $log->debug("lookup for: ",$tmp);
159    
160                  my @out;                  my @out;
161                  while (my $f = shift @in) {                  while (my $f = shift @in) {
162                          if ($f =~ /$LOOKUP_REGEX_SAVE/o) {                          if ($f =~ $self->{'LOOKUP_REGEX_SAVE'}) {
163                                  my $k = $1;                                  my $k = $1;
164                                  if ($self->{'lookup'}->{$k}) {                                  if ($self->{'lookup'}->{$k}) {
165                                          foreach my $nv (@{$self->{'lookup'}->{$k}}) {                                          foreach my $nv (@{$self->{'lookup'}->{$k}}) {
# Line 173  sub lookup { Line 181  sub lookup {
181          }          }
182  }  }
183    
184    =head2 regex
185    
186    Returns precompiled regex for lookup format.
187    
188     if ($foo =~ $lookup->reges) { ... }
189    
190    =cut
191    
192    sub regex {
193            my $self = shift;
194    
195            return $self->{'LOOKUP_REGEX'};
196    }
197    
198  =head1 AUTHOR  =head1 AUTHOR
199    
200  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.7  
changed lines
  Added in v.12
  ViewVC Help
Powered by ViewVC 1.1.26