/[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 15 by dpavlin, Sun Jul 17 10:42:23 2005 UTC revision 252 by dpavlin, Thu Dec 15 17:01:04 2005 UTC
# Line 3  package WebPAC::Lookup; Line 3  package WebPAC::Lookup;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
 use WebPAC::Common;  
   
6  use base qw/WebPAC::Common WebPAC::Normalize/;  use base qw/WebPAC::Common WebPAC::Normalize/;
7  use File::Slurp;  use File::Slurp;
8    use YAML qw/LoadFile/;
9  use Data::Dumper;  use Data::Dumper;
10    
11  =head1 NAME  =head1 NAME
# Line 15  WebPAC::Lookup - simple normalisation pl Line 14  WebPAC::Lookup - simple normalisation pl
14    
15  =head1 VERSION  =head1 VERSION
16    
17  Version 0.01  Version 0.02
18    
19  =cut  =cut
20    
21  our $VERSION = '0.01';  our $VERSION = '0.02';
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
# Line 42  value in lookup. Line 41  value in lookup.
41      'val' => 'v900' },      'val' => 'v900' },
42   ];   ];
43    
44    Just for a reference, lookup data is internally stored in
45    C<< $self->{'_lookup_data'} >>.
46    
47  =head1 FUNCTIONS  =head1 FUNCTIONS
48    
# Line 68  sub new { Line 69  sub new {
69    
70          my $lookup_code = read_file($lookup_file) || $log->logconfess("can't read lookup file $lookup_file: $!");          my $lookup_code = read_file($lookup_file) || $log->logconfess("can't read lookup file $lookup_file: $!");
71    
72          {          if ($lookup_file =~ m#\.pm$#) {
73                  no strict 'vars';                  no strict 'vars';
74                  do $lookup_file or $log->logdie("Failed to read configuration parameters '$lookup_file' $! $@");                  do $lookup_file or $log->logdie("Failed to read configuration parameters '$lookup_file' $! $@");
75                  $self->{'lookup_def'} = \@lookup || $log->logdie("lookup config $lookup_file doesn't produce \@lookup array");                  $self->{'lookup_def'} = \@lookup || $log->logdie("lookup config $lookup_file doesn't produce \@lookup array");
76            } elsif ($lookup_file =~ m#\.(:?yml|yaml)$#) {
77                    my $yaml = LoadFile( $lookup_file ) || $log->logdie("lookup YAML file $lookup_file error: $!");
78                    $self->{'lookup_def'} = $yaml->{lookup} || $log->logdie("lookup YAML file $lookup_file should begin with 'lookup:'");
79            } else {
80                    $log->logide("unsupported lookup file $lookup_file");
81          }          }
82            $log->debug("lookup_def: " . Dumper( $self->{lookup_def} ));
83    
84          $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 but ", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
85    
86          $self->{'is_lookup_regex'} ||= 'lookup{[^\{\}]+}';          $self->{'is_lookup_regex'} ||= 'lookup{[^\{\}]+}';
87          $self->{'save_lookup_regex'} ||= 'lookup{([^\{\}]+)}';          $self->{'save_lookup_regex'} ||= 'lookup{([^\{\}]+)}';
# Line 83  sub new { Line 90  sub new {
90          $self->{'LOOKUP_REGEX'} = qr/$self->{'is_lookup_regex'}/;          $self->{'LOOKUP_REGEX'} = qr/$self->{'is_lookup_regex'}/;
91          $self->{'LOOKUP_REGEX_SAVE'} = qr/$self->{'save_lookup_regex'}/;          $self->{'LOOKUP_REGEX_SAVE'} = qr/$self->{'save_lookup_regex'}/;
92    
93          $log->debug("regexps: ", $self->{'LOOKUP_REGEX'}, " ", $self->{'LOOKUP_REGEX_SAVE'});          $log->debug("regexps lookup:", $self->{'LOOKUP_REGEX'}, " save:", $self->{'LOOKUP_REGEX_SAVE'});
94    
95          $self ? return $self : return undef;          $self ? return $self : return undef;
96  }  }
# Line 98  Returns true if this record produced loo Line 105  Returns true if this record produced loo
105    
106  =cut  =cut
107    
108  sub add($) {  sub add {
109          my $self = shift;          my $self = shift;
110    
111          my $log = $self->_get_logger();          my $log = $self->_get_logger();
# Line 110  sub add($) { Line 117  sub add($) {
117          my $n = 0;          my $n = 0;
118    
119          foreach my $i (@{ $self->{'lookup_def'} }) {          foreach my $i (@{ $self->{'lookup_def'} }) {
120                  $log->logconfess("need key") unless defined($i->{'key'});                  $log->logconfess("need key in ", Dumper($i) ) unless defined($i->{'key'});
121                  $log->logconfess("need val") unless defined($i->{'val'});                  $log->logconfess("need val in ", Dumper($i) ) unless defined($i->{'val'});
122    
123                  $n++;                  $n++;
124    
# Line 122  sub add($) { Line 129  sub add($) {
129                                  my $key = $self->fill_in($rec,$i->{'key'}) || next;                                  my $key = $self->fill_in($rec,$i->{'key'}) || next;
130                                  my @val = $self->fill_in($rec,$i->{'val'}) || next;                                  my @val = $self->fill_in($rec,$i->{'val'}) || next;
131                                  $log->debug("stored $key = ",sub { join(" | ",@val) });                                  $log->debug("stored $key = ",sub { join(" | ",@val) });
132                                  push @{$self->{'lookup'}->{$key}}, @val;                                  push @{$self->{'_lookup_data'}->{$key}}, @val;
133                          }                          }
134                  } else {                  } else {
135                          my $key = $self->fill_in($rec,$i->{'key'}) || next;                          my $key = $self->fill_in($rec,$i->{'key'}) || next;
136                          my @val = $self->fill_in($rec,$i->{'val'}) || next;                          my @val = $self->fill_in($rec,$i->{'val'}) || next;
137                          $log->debug("stored $key = ",sub { join(" | ",@val) });                          $log->debug("stored $key = ",sub { join(" | ",@val) });
138                          push @{$self->{'lookup'}->{$key}}, @val;                          push @{$self->{'_lookup_data'}->{$key}}, @val;
139                  }                  }
140          }          }
141    
# Line 155  sub lookup { Line 162  sub lookup {
162          if ($tmp =~ $self->{'LOOKUP_REGEX'}) {          if ($tmp =~ $self->{'LOOKUP_REGEX'}) {
163                  my @in = ( $tmp );                  my @in = ( $tmp );
164    
                 $log->debug("lookup for: ",$tmp);  
   
165                  my @out;                  my @out;
166                  while (my $f = shift @in) {                  while (my $f = shift @in) {
167                          if ($f =~ $self->{'LOOKUP_REGEX_SAVE'}) {                          if ($f =~ $self->{'LOOKUP_REGEX_SAVE'}) {
168                                  my $k = $1;                                  my $k = $1;
169                                  if ($self->{'lookup'}->{$k}) {                                  if ($self->{'_lookup_data'}->{$k}) {
170                                          foreach my $nv (@{$self->{'lookup'}->{$k}}) {                                          foreach my $nv (@{$self->{'_lookup_data'}->{$k}}) {
171                                                  my $tmp2 = $f;                                                  my $tmp2 = $f;
172                                                  $tmp2 =~ s/lookup{$k}/$nv/g;                                                  $tmp2 =~ s/lookup{$k}/$nv/g;
173                                                  push @in, $tmp2;                                                  push @in, $tmp2;
# Line 174  sub lookup { Line 179  sub lookup {
179                                  push @out, $f;                                  push @out, $f;
180                          }                          }
181                  }                  }
182                    $log->debug("lookup for: ",$tmp, " returned: ", join(", ",@out));
183    
184                  $log->logconfess("return is array and it's not expected!") unless wantarray;                  $log->logconfess("return is array and it's not expected!") unless wantarray;
185    
186                  return @out;                  return @out;
187          } else {          } else {
188                  return $tmp;                  return $tmp;
Legend:
Removed from v.15  
changed lines
  Added in v.252
  ViewVC Help
Powered by ViewVC 1.1.26