1 package WebPAC::Lookup;
6 use base qw/WebPAC::Common WebPAC::Normalize/;
13 WebPAC::Lookup - simple normalisation plugin to produce lookup
21 our $VERSION = '0.02';
25 This module will produce in-memory lookups for easy resolution of lookups
26 to different records in source files. This will enable you to resolve
27 relational data in source format.
29 It can also be use with C<WebPAC::Tree> to produce tree hierarchies.
31 Lookups are defined in C<conf/lookup/isis.pm>.
33 C<lookup> argument is an array of lookups to create. Each lookup must have C<key> and
34 C<val>. Optional parametar C<eval> is perl code to evaluate before storing
38 { 'key' => 'd:v900', 'val' => 'v250^a' },
39 { 'eval' => '"v901^a" eq "Podruèje"',
40 'key' => 'pa:v561^4:v562^4:v461^1',
44 Just for a reference, lookup data is internally stored in
45 C<< $self->{'_lookup_data'} >>.
51 Create new lookup object.
53 my $lookup = new WebPAC::Lookup(
54 lookup_file => '/path/to/conf/lookup/lookup.pm',
55 is_lookup_regex => 'lookup{[^\{\}]+}';
56 save_lookup_regex => 'lookup{([^\{\}]+)}';
66 my $log = $self->_get_logger();
68 my $lookup_file = $self->{'lookup_file'} || $log->logconfess("need path to lookup file in lookup_file parametar");
70 my $lookup_code = read_file($lookup_file) || $log->logconfess("can't read lookup file $lookup_file: $!");
72 if ($lookup_file =~ m#\.pm$#) {
74 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");
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:'");
80 $log->logide("unsupported lookup file $lookup_file");
82 $log->debug("lookup_def: " . Dumper( $self->{lookup_def} ));
84 $log->logconfess("lookup config file isn't ARRAY but ", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
86 $self->{'is_lookup_regex'} ||= 'lookup{[^\{\}]+}';
87 $self->{'save_lookup_regex'} ||= 'lookup{([^\{\}]+)}';
90 $self->{'LOOKUP_REGEX'} = qr/$self->{'is_lookup_regex'}/;
91 $self->{'LOOKUP_REGEX_SAVE'} = qr/$self->{'save_lookup_regex'}/;
93 $log->debug("regexps lookup:", $self->{'LOOKUP_REGEX'}, " save:", $self->{'LOOKUP_REGEX_SAVE'});
95 $self ? return $self : return undef;
100 Create lookup from record using lookup definition.
104 Returns true if this record produced lookup.
111 my $log = $self->_get_logger();
113 my $rec = shift || $log->logconfess("need record to create lookup");
114 $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
115 $log->logconfess("need HASH as first argument!") if ($self->{'lookup_def'} !~ /ARRAY/o);
119 foreach my $i (@{ $self->{'lookup_def'} }) {
120 $log->logconfess("need key in ", Dumper($i) ) unless defined($i->{'key'});
121 $log->logconfess("need val in ", Dumper($i) ) unless defined($i->{'val'});
125 if (defined($i->{'eval'})) {
126 # eval first, so we can skip fill_in for key and val
127 my $eval = $self->fill_in($rec,$i->{'eval'}) || next;
128 if ($self->_eval($eval)) {
129 my $key = $self->fill_in($rec,$i->{'key'}) || next;
130 my @val = $self->fill_in($rec,$i->{'val'}) || next;
131 $log->debug("stored $key = ",sub { join(" | ",@val) });
132 push @{$self->{'_lookup_data'}->{$key}}, @val;
135 my $key = $self->fill_in($rec,$i->{'key'}) || next;
136 my @val = $self->fill_in($rec,$i->{'val'}) || next;
137 $log->debug("stored $key = ",sub { join(" | ",@val) });
138 push @{$self->{'_lookup_data'}->{$key}}, @val;
147 Perform lookups on format supplied to it.
149 my $text = $lookup->lookup('lookup{v900}');
151 Lookups can be nested (like lookup{B<d:>lookup{B<a:>lookup{B<v900>}}}).
158 my $log = $self->_get_logger();
160 my $tmp = shift || $log->logconfess("need format");
162 if ($tmp =~ $self->{'LOOKUP_REGEX'}) {
166 while (my $f = shift @in) {
167 if ($f =~ $self->{'LOOKUP_REGEX_SAVE'}) {
169 if ($self->{'_lookup_data'}->{$k}) {
170 foreach my $nv (@{$self->{'_lookup_data'}->{$k}}) {
172 $tmp2 =~ s/lookup{$k}/$nv/g;
182 $log->debug("lookup for: ",$tmp, " returned: ", join(", ",@out));
184 $log->logconfess("return is array and it's not expected!") unless wantarray;
194 Returns precompiled regex for lookup format.
196 if ($foo =~ $lookup->reges) { ... }
203 return $self->{'LOOKUP_REGEX'};
208 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
210 =head1 COPYRIGHT & LICENSE
212 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
214 This program is free software; you can redistribute it and/or modify it
215 under the same terms as Perl itself.
219 1; # End of WebPAC::Lookup