1 package WebPAC::Normalize::Lookup;
8 use base qw/WebPAC::Common/;
13 WebPAC::Normalize::Lookup - simple normalisation plugin to produce lookup
21 our $VERSION = '0.01';
25 This module will produce in-memory lookups for easy resolution of lookups
26 to different records in source files. It can also be use with
27 C<WebPAC::Normalize::Tree> to produce tree hierarchies.
29 Lookups are defined in C<config/lookup.pm>.
31 C<lookup> argument is an array of lookups to create. Each lookup must have C<key> and
32 C<val>. Optional parametar C<eval> is perl code to evaluate before storing
36 { 'key' => 'd:v900', 'val' => 'v250^a' },
37 { 'eval' => '"v901^a" eq "Podruèje"',
38 'key' => 'pa:v561^4:v562^4:v461^1',
47 Create new lookup object.
49 my $lookup = new WebPAC::Normalize::Lookup(
50 config => '/path/to/conf/lookup/lookup.pm',
60 my $log = $self->_get_logger();
62 my $config = $self->{'config'} || $log->logconfess("need path to lookup file in config parametar");
64 my $lookup_code = read_file($config) || $log->logconfess("can't read lookup file $config: $!");
68 do $config or $log->logdie("Failed to read configuration parameters '$config' $! $@");
69 $self->{'lookup_def'} = \@lookup || $log->logdie("lookup config doesn't produce \@lookup array");
72 $log->logconfess("lookup config file isn't ARRAY") if ($self->{'lookup_def'} !~ /ARRAY/o);
74 $self ? return $self : return undef;
79 Create lookup from record using lookup definition.
81 $self->create_lookup($rec, @lookups);
83 Called internally by C<open_*> methods.
90 my $log = $self->_get_logger();
92 my $rec = shift || $log->logconfess("need record to create lookup");
93 $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
95 foreach my $i ($self->{'loookup_def'}) {
96 $log->logconfess("need key") unless defined($i->{'key'});
97 $log->logconfess("need val") unless defined($i->{'val'});
99 if (defined($i->{'eval'})) {
100 # eval first, so we can skip fill_in for key and val
101 my $eval = $self->fill_in($rec,$i->{'eval'}) || next;
102 if ($self->_eval($eval)) {
103 my $key = $self->fill_in($rec,$i->{'key'}) || next;
104 my @val = $self->fill_in($rec,$i->{'val'}) || next;
105 $log->debug("stored $key = ",sub { join(" | ",@val) });
106 push @{$self->{'lookup'}->{$key}}, @val;
109 my $key = $self->fill_in($rec,$i->{'key'}) || next;
110 my @val = $self->fill_in($rec,$i->{'val'}) || next;
111 $log->debug("stored $key = ",sub { join(" | ",@val) });
112 push @{$self->{'lookup'}->{$key}}, @val;
119 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
121 =head1 COPYRIGHT & LICENSE
123 Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
125 This program is free software; you can redistribute it and/or modify it
126 under the same terms as Perl itself.
130 1; # End of WebPAC::Normalize::Lookup