1 package WebPAC::Lookup;
8 use base qw/WebPAC::Common/;
12 my $LOOKUP_REGEX = 'lookup{[^\{\}]+}';
13 my $LOOKUP_REGEX_SAVE = 'lookup{([^\{\}]+)}';
17 WebPAC::Lookup - simple normalisation plugin to produce lookup
25 our $VERSION = '0.01';
29 This module will produce in-memory lookups for easy resolution of lookups
30 to different records in source files. This will enable you to resolve
31 relational data in source format.
33 It can also be use with C<WebPAC::Tree> to produce tree hierarchies.
35 Lookups are defined in C<conf/lookup/isis.pm>.
37 C<lookup> argument is an array of lookups to create. Each lookup must have C<key> and
38 C<val>. Optional parametar C<eval> is perl code to evaluate before storing
42 { 'key' => 'd:v900', 'val' => 'v250^a' },
43 { 'eval' => '"v901^a" eq "Podruèje"',
44 'key' => 'pa:v561^4:v562^4:v461^1',
53 Create new lookup object.
55 my $lookup = new WebPAC::Lookup(
56 lookup_file => '/path/to/conf/lookup/lookup.pm',
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: $!");
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");
78 $log->logconfess("lookup config file isn't ARRAY", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
80 $self ? return $self : return undef;
85 Create lookup from record using lookup definition.
89 Returns true if this record produced lookup.
96 my $log = $self->_get_logger();
98 my $rec = shift || $log->logconfess("need record to create lookup");
99 $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
100 $log->logconfess("need HASH as first argument!") if ($self->{'lookup_def'} !~ /ARRAY/o);
104 foreach my $i (@{ $self->{'lookup_def'} }) {
105 $log->logconfess("need key") unless defined($i->{'key'});
106 $log->logconfess("need val") unless defined($i->{'val'});
110 if (defined($i->{'eval'})) {
111 # eval first, so we can skip fill_in for key and val
112 my $eval = $self->fill_in($rec,$i->{'eval'}) || next;
113 if ($self->_eval($eval)) {
114 my $key = $self->fill_in($rec,$i->{'key'}) || next;
115 my @val = $self->fill_in($rec,$i->{'val'}) || next;
116 $log->debug("stored $key = ",sub { join(" | ",@val) });
117 push @{$self->{'lookup'}->{$key}}, @val;
120 my $key = $self->fill_in($rec,$i->{'key'}) || next;
121 my @val = $self->fill_in($rec,$i->{'val'}) || next;
122 $log->debug("stored $key = ",sub { join(" | ",@val) });
123 push @{$self->{'lookup'}->{$key}}, @val;
132 Perform lookups on format supplied to it.
134 my $text = $lookup->lookup('[v900]');
136 Lookups can be nested (like C<[d:[a:[v900]]]>).
143 my $log = $self->_get_logger();
145 my $tmp = shift || $log->logconfess("need format");
147 if ($tmp =~ /$LOOKUP_REGEX/o) {
150 $log->debug("lookup for: ",$tmp);
153 while (my $f = shift @in) {
154 if ($f =~ /$LOOKUP_REGEX_SAVE/o) {
156 if ($self->{'lookup'}->{$k}) {
157 foreach my $nv (@{$self->{'lookup'}->{$k}}) {
159 $tmp2 =~ s/lookup{$k}/$nv/g;
169 $log->logconfess("return is array and it's not expected!") unless wantarray;
178 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
180 =head1 COPYRIGHT & LICENSE
182 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
184 This program is free software; you can redistribute it and/or modify it
185 under the same terms as Perl itself.
189 1; # End of WebPAC::Lookup