/[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

trunk/lib/WebPAC/Normalize/Lookup.pm revision 3 by dpavlin, Sat Jul 16 11:07:38 2005 UTC trunk/lib/WebPAC/Lookup.pm revision 4 by dpavlin, Sat Jul 16 12:37:18 2005 UTC
# Line 1  Line 1 
1  package WebPAC::Normalize::Lookup;  package WebPAC::Lookup;
2    
3  use warnings;  use warnings;
4  use strict;  use strict;
# Line 7  use WebPAC::Common; Line 7  use WebPAC::Common;
7    
8  use base qw/WebPAC::Common/;  use base qw/WebPAC::Common/;
9  use File::Slurp;  use File::Slurp;
10    use Data::Dumper;
11    
12  =head1 NAME  =head1 NAME
13    
14  WebPAC::Normalize::Lookup - simple normalisation plugin to produce lookup  WebPAC::Lookup - simple normalisation plugin to produce lookup
15    
16  =head1 VERSION  =head1 VERSION
17    
# Line 23  our $VERSION = '0.01'; Line 24  our $VERSION = '0.01';
24  =head1 SYNOPSIS  =head1 SYNOPSIS
25    
26  This module will produce in-memory lookups for easy resolution of lookups  This module will produce in-memory lookups for easy resolution of lookups
27  to different records in source files. It can also be use with  to different records in source files. This will enable you to resolve
28  C<WebPAC::Normalize::Tree> to produce tree hierarchies.  relational data in source format.
29    
30  Lookups are defined in C<config/lookup.pm>.  It can also be use with C<WebPAC::Tree> to produce tree hierarchies.
31    
32    Lookups are defined in C<conf/lookup/isis.pm>.
33    
34  C<lookup> argument is an array of lookups to create. Each lookup must have C<key> and  C<lookup> argument is an array of lookups to create. Each lookup must have C<key> and
35  C<val>. Optional parametar C<eval> is perl code to evaluate before storing  C<val>. Optional parametar C<eval> is perl code to evaluate before storing
36  value in index.  value in lookup.
37    
38   my $lookup => [   @lookup = [
39    { 'key' => 'd:v900', 'val' => 'v250^a' },    { 'key' => 'd:v900', 'val' => 'v250^a' },
40    { 'eval' => '"v901^a" eq "Područje"',    { 'eval' => '"v901^a" eq "Područje"',
41      'key' => 'pa:v561^4:v562^4:v461^1',      'key' => 'pa:v561^4:v562^4:v461^1',
# Line 46  value in index. Line 49  value in index.
49    
50  Create new lookup object.  Create new lookup object.
51    
52    my $lookup = new WebPAC::Normalize::Lookup(    my $lookup = new WebPAC::Lookup(
53          config => '/path/to/conf/lookup/lookup.pm',          lookup_file => '/path/to/conf/lookup/lookup.pm',
54    );    );
55    
56  =cut  =cut
# Line 59  sub new { Line 62  sub new {
62    
63          my $log = $self->_get_logger();          my $log = $self->_get_logger();
64    
65          my $config = $self->{'config'} || $log->logconfess("need path to lookup file in config parametar");          my $lookup_file = $self->{'lookup_file'} || $log->logconfess("need path to lookup file in lookup_file parametar");
66    
67          my $lookup_code = read_file($config) || $log->logconfess("can't read lookup file $config: $!");          my $lookup_code = read_file($lookup_file) || $log->logconfess("can't read lookup file $lookup_file: $!");
68    
69          {          {
70                  no strict 'vars';                  no strict 'vars';
71                  do $config or $log->logdie("Failed to read configuration parameters '$config' $! $@");                  do $lookup_file or $log->logdie("Failed to read configuration parameters '$lookup_file' $! $@");
72                  $self->{'lookup_def'} = \@lookup || $log->logdie("lookup config doesn't produce \@lookup array");                  $self->{'lookup_def'} = \@lookup || $log->logdie("lookup config $lookup_file doesn't produce \@lookup array");
73          }          }
74    
75          $log->logconfess("lookup config file isn't ARRAY") if ($self->{'lookup_def'} !~ /ARRAY/o);          $log->logconfess("lookup config file isn't ARRAY", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
76    
77          $self ? return $self : return undef;          $self ? return $self : return undef;
78  }  }
79    
80  =head2 create_lookup  =head2 add
81    
82  Create lookup from record using lookup definition.  Create lookup from record using lookup definition.
83    
84   $self->create_lookup($rec, @lookups);   $self->create_lookup($rec);
85    
86  Called internally by C<open_*> methods.  Returns true if this record produced lookup.
87    
88  =cut  =cut
89    
90  sub create_lookup {  sub add($) {
91          my $self = shift;          my $self = shift;
92    
93          my $log = $self->_get_logger();          my $log = $self->_get_logger();
94    
95          my $rec = shift || $log->logconfess("need record to create lookup");          my $rec = shift || $log->logconfess("need record to create lookup");
96          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
97            $log->logconfess("need HASH as first argument!") if ($self->{'lookup_def'} !~ /ARRAY/o);
98    
99            my $n = 0;
100    
101          foreach my $i ($self->{'loookup_def'}) {          foreach my $i (@{ $self->{'lookup_def'} }) {
102                  $log->logconfess("need key") unless defined($i->{'key'});                  $log->logconfess("need key") unless defined($i->{'key'});
103                  $log->logconfess("need val") unless defined($i->{'val'});                  $log->logconfess("need val") unless defined($i->{'val'});
104    
105                    $n++;
106    
107                  if (defined($i->{'eval'})) {                  if (defined($i->{'eval'})) {
108                          # eval first, so we can skip fill_in for key and val                          # eval first, so we can skip fill_in for key and val
109                          my $eval = $self->fill_in($rec,$i->{'eval'}) || next;                          my $eval = $self->fill_in($rec,$i->{'eval'}) || next;
# Line 112  sub create_lookup { Line 120  sub create_lookup {
120                          push @{$self->{'lookup'}->{$key}}, @val;                          push @{$self->{'lookup'}->{$key}}, @val;
121                  }                  }
122          }          }
123    
124            return $n;
125  }  }
126    
127  =head1 AUTHOR  =head1 AUTHOR
# Line 127  under the same terms as Perl itself. Line 137  under the same terms as Perl itself.
137    
138  =cut  =cut
139    
140  1; # End of WebPAC::Normalize::Lookup  1; # End of WebPAC::Lookup
Legend:
Removed from v.3  
changed lines
  Added in v.4
  ViewVC Help
Powered by ViewVC 1.1.26