/[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 4 by dpavlin, Sat Jul 16 12:37:18 2005 UTC revision 234 by dpavlin, Tue Dec 6 19:41:17 2005 UTC
# Line 3  package WebPAC::Lookup; Line 3  package WebPAC::Lookup;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use WebPAC::Common;  use base qw/WebPAC::Common WebPAC::Normalize/;
   
 use base qw/WebPAC::Common/;  
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 51  Create new lookup object. Line 52  Create new lookup object.
52    
53    my $lookup = new WebPAC::Lookup(    my $lookup = new WebPAC::Lookup(
54          lookup_file => '/path/to/conf/lookup/lookup.pm',          lookup_file => '/path/to/conf/lookup/lookup.pm',
55            is_lookup_regex => 'lookup{[^\{\}]+}';
56            save_lookup_regex => 'lookup{([^\{\}]+)}';
57    );    );
58    
59  =cut  =cut
# Line 66  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    
83          $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);
84    
85            $self->{'is_lookup_regex'} ||= 'lookup{[^\{\}]+}';
86            $self->{'save_lookup_regex'} ||= 'lookup{([^\{\}]+)}';
87    
88    
89            $self->{'LOOKUP_REGEX'} = qr/$self->{'is_lookup_regex'}/;
90            $self->{'LOOKUP_REGEX_SAVE'} = qr/$self->{'save_lookup_regex'}/;
91    
92            $log->debug("regexps: ", $self->{'LOOKUP_REGEX'}, " ", $self->{'LOOKUP_REGEX_SAVE'});
93    
94          $self ? return $self : return undef;          $self ? return $self : return undef;
95  }  }
# Line 81  sub new { Line 98  sub new {
98    
99  Create lookup from record using lookup definition.  Create lookup from record using lookup definition.
100    
101   $self->create_lookup($rec);   $self->add($rec);
102    
103  Returns true if this record produced lookup.  Returns true if this record produced lookup.
104    
# Line 111  sub add($) { Line 128  sub add($) {
128                                  my $key = $self->fill_in($rec,$i->{'key'}) || next;                                  my $key = $self->fill_in($rec,$i->{'key'}) || next;
129                                  my @val = $self->fill_in($rec,$i->{'val'}) || next;                                  my @val = $self->fill_in($rec,$i->{'val'}) || next;
130                                  $log->debug("stored $key = ",sub { join(" | ",@val) });                                  $log->debug("stored $key = ",sub { join(" | ",@val) });
131                                  push @{$self->{'lookup'}->{$key}}, @val;                                  push @{$self->{'_lookup_data'}->{$key}}, @val;
132                          }                          }
133                  } else {                  } else {
134                          my $key = $self->fill_in($rec,$i->{'key'}) || next;                          my $key = $self->fill_in($rec,$i->{'key'}) || next;
135                          my @val = $self->fill_in($rec,$i->{'val'}) || next;                          my @val = $self->fill_in($rec,$i->{'val'}) || next;
136                          $log->debug("stored $key = ",sub { join(" | ",@val) });                          $log->debug("stored $key = ",sub { join(" | ",@val) });
137                          push @{$self->{'lookup'}->{$key}}, @val;                          push @{$self->{'_lookup_data'}->{$key}}, @val;
138                  }                  }
139          }          }
140    
141          return $n;          return $n;
142  }  }
143    
144    =head2 lookup
145    
146    Perform lookups on format supplied to it.
147    
148     my $text = $lookup->lookup('[v900]');
149    
150    Lookups can be nested (like C<[d:[a:[v900]]]>).
151    
152    =cut
153    
154    sub lookup {
155            my $self = shift;
156    
157            my $log = $self->_get_logger();
158    
159            my $tmp = shift || $log->logconfess("need format");
160    
161            if ($tmp =~ $self->{'LOOKUP_REGEX'}) {
162                    my @in = ( $tmp );
163    
164                    $log->debug("lookup for: ",$tmp);
165    
166                    my @out;
167                    while (my $f = shift @in) {
168                            if ($f =~ $self->{'LOOKUP_REGEX_SAVE'}) {
169                                    my $k = $1;
170                                    if ($self->{'_lookup_data'}->{$k}) {
171                                            foreach my $nv (@{$self->{'_lookup_data'}->{$k}}) {
172                                                    my $tmp2 = $f;
173                                                    $tmp2 =~ s/lookup{$k}/$nv/g;
174                                                    push @in, $tmp2;
175                                            }
176                                    } else {
177                                            undef $f;
178                                    }
179                            } elsif ($f) {
180                                    push @out, $f;
181                            }
182                    }
183                    $log->logconfess("return is array and it's not expected!") unless wantarray;
184                    return @out;
185            } else {
186                    return $tmp;
187            }
188    }
189    
190    =head2 regex
191    
192    Returns precompiled regex for lookup format.
193    
194     if ($foo =~ $lookup->reges) { ... }
195    
196    =cut
197    
198    sub regex {
199            my $self = shift;
200    
201            return $self->{'LOOKUP_REGEX'};
202    }
203    
204  =head1 AUTHOR  =head1 AUTHOR
205    
206  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.4  
changed lines
  Added in v.234
  ViewVC Help
Powered by ViewVC 1.1.26