/[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 536 by dpavlin, Mon Jun 26 16:39:51 2006 UTC
# Line 1  Line 1 
1  package WebPAC::Normalize::Lookup;  package WebPAC::Lookup;
2    
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use WebPAC::Common;  use base qw/WebPAC::Common WebPAC::Lookup::Normalize/;
   
 use base qw/WebPAC::Common/;  
7  use File::Slurp;  use File::Slurp;
8    use YAML qw/LoadFile/;
9    use Data::Dumper;
10    
11  =head1 NAME  =head1 NAME
12    
13  WebPAC::Normalize::Lookup - simple normalisation plugin to produce lookup  WebPAC::Lookup - simple normalisation plugin to produce lookup
14    
15  =head1 VERSION  =head1 VERSION
16    
17  Version 0.01  Version 0.03
18    
19  =cut  =cut
20    
21  our $VERSION = '0.01';  our $VERSION = '0.03';
22    
23  =head1 SYNOPSIS  =head1 SYNOPSIS
24    
25  This module will produce in-memory lookups for easy resolution of lookups  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  to different records in source files. This will enable you to resolve
27  C<WebPAC::Normalize::Tree> to produce tree hierarchies.  relational data in source format.
28    
29    It can also be use with C<WebPAC::Tree> to produce tree hierarchies.
30    
31  Lookups are defined in C<config/lookup.pm>.  Lookups are defined in C<conf/lookup/isis.pm>.
32    
33  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
34  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
35  value in index.  value in lookup.
36    
37   my $lookup => [   @lookup = [
38    { 'key' => 'd:v900', 'val' => 'v250^a' },    { 'key' => 'd:v900', 'val' => 'v250^a' },
39    { 'eval' => '"v901^a" eq "Područje"',    { 'eval' => '"v901^a" eq "Područje"',
40      'key' => 'pa:v561^4:v562^4:v461^1',      'key' => 'pa:v561^4:v562^4:v461^1',
41      'val' => 'v900' },      'val' => 'v900' },
42   ];   ];
43    
   
44  =head1 FUNCTIONS  =head1 FUNCTIONS
45    
46  =head2 new  =head2 new
47    
48  Create new lookup object.  Create new lookup object.
49    
50    my $lookup = new WebPAC::Normalize::Lookup(    my $lookup = new WebPAC::Lookup(
51          config => '/path/to/conf/lookup/lookup.pm',          lookup_file => '/path/to/conf/lookup/lookup.pm',
52            is_lookup_regex => 'lookup{[^\{\}]+}';
53            save_lookup_regex => 'lookup{([^\{\}]+)}';
54    );    );
55    
56  =cut  =cut
57    
58  sub new {  sub new {
59          my $class = shift;          my $class = shift;
60          my $self = {@_};          my $self = {@_};
61          bless($self, $class);          bless($self, $class);
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          {          if ($lookup_file =~ m#\.pm$#) {
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            } elsif ($lookup_file =~ m#\.(:?yml|yaml)$#) {
74                    my $yaml = LoadFile( $lookup_file ) || $log->logdie("lookup YAML file $lookup_file error: $!");
75                    $self->{'lookup_def'} = $yaml->{lookup} || $log->logdie("lookup YAML file $lookup_file should begin with 'lookup:'");
76            } else {
77                    $log->logide("unsupported lookup file $lookup_file");
78          }          }
79            $log->debug("lookup_def: " . Dumper( $self->{lookup_def} ));
80    
81            $log->logconfess("lookup config file isn't ARRAY but ", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
82    
83            $self->{'is_lookup_regex'} ||= 'lookup{[^\{\}]+}';
84            $self->{'save_lookup_regex'} ||= 'lookup{([^\{\}]+)}';
85    
86    
87          $log->logconfess("lookup config file isn't ARRAY") if ($self->{'lookup_def'} !~ /ARRAY/o);          $self->{'LOOKUP_REGEX'} = qr/$self->{'is_lookup_regex'}/;
88            $self->{'LOOKUP_REGEX_SAVE'} = qr/$self->{'save_lookup_regex'}/;
89    
90            $log->debug("regexps lookup:", $self->{'LOOKUP_REGEX'}, " save:", $self->{'LOOKUP_REGEX_SAVE'});
91    
92          $self ? return $self : return undef;          $self ? return $self : return undef;
93  }  }
94    
95  =head2 create_lookup  =head2 add
96    
97  Create lookup from record using lookup definition.  Create lookup from record using lookup definition.
98    
99   $self->create_lookup($rec, @lookups);   $self->add($rec);
100    
101  Called internally by C<open_*> methods.  Returns true if this record produced lookup.
102    
103  =cut  =cut
104    
105  sub create_lookup {  sub add {
106          my $self = shift;          my $self = shift;
107    
108          my $log = $self->_get_logger();          my $log = $self->_get_logger();
109    
110          my $rec = shift || $log->logconfess("need record to create lookup");          my $rec = shift || $log->logconfess("need record to create lookup");
111          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
112            $log->logconfess("need HASH as first argument!") if ($self->{'lookup_def'} !~ /ARRAY/o);
113    
114            my $n = 0;
115    
116            foreach my $i (@{ $self->{'lookup_def'} }) {
117                    $log->logconfess("need key in ", Dumper($i) ) unless defined($i->{'key'});
118                    $log->logconfess("need val in ", Dumper($i) ) unless defined($i->{'val'});
119    
120          foreach my $i ($self->{'loookup_def'}) {                  $n++;
                 $log->logconfess("need key") unless defined($i->{'key'});  
                 $log->logconfess("need val") unless defined($i->{'val'});  
121    
122                  if (defined($i->{'eval'})) {                  if (defined($i->{'eval'})) {
123                          # eval first, so we can skip fill_in for key and val                          # eval first, so we can skip fill_in for key and val
# Line 103  sub create_lookup { Line 126  sub create_lookup {
126                                  my $key = $self->fill_in($rec,$i->{'key'}) || next;                                  my $key = $self->fill_in($rec,$i->{'key'}) || next;
127                                  my @val = $self->fill_in($rec,$i->{'val'}) || next;                                  my @val = $self->fill_in($rec,$i->{'val'}) || next;
128                                  $log->debug("stored $key = ",sub { join(" | ",@val) });                                  $log->debug("stored $key = ",sub { join(" | ",@val) });
129                                  push @{$self->{'lookup'}->{$key}}, @val;                                  push @{$self->{'_lookup_data'}->{$key}}, @val;
130                          }                          }
131                  } else {                  } else {
132                          my $key = $self->fill_in($rec,$i->{'key'}) || next;                          my $key = $self->fill_in($rec,$i->{'key'}) || next;
133                          my @val = $self->fill_in($rec,$i->{'val'}) || next;                          my @val = $self->fill_in($rec,$i->{'val'}) || next;
134                          $log->debug("stored $key = ",sub { join(" | ",@val) });                          $log->debug("stored $key = ",sub { join(" | ",@val) });
135                          push @{$self->{'lookup'}->{$key}}, @val;                          push @{$self->{'_lookup_data'}->{$key}}, @val;
136                    }
137            }
138    
139            return $n;
140    }
141    
142    =head2 lookup
143    
144    Perform lookups on format supplied to it.
145    
146     my $text = $lookup->lookup('lookup{v900}');
147    
148    Lookups can be nested (like lookup{B<d:>lookup{B<a:>lookup{B<v900>}}}).
149    
150    =cut
151    
152    sub lookup {
153            my $self = shift;
154    
155            my $log = $self->_get_logger();
156    
157            my $tmp = shift || $log->logconfess("need format");
158    
159            if ($tmp =~ $self->{'LOOKUP_REGEX'}) {
160                    my @in = ( $tmp );
161    
162                    my @out;
163                    while (my $f = shift @in) {
164                            if ($f =~ $self->{'LOOKUP_REGEX_SAVE'}) {
165                                    my $k = $1;
166                                    if ($self->{'_lookup_data'}->{$k}) {
167                                            foreach my $nv (@{$self->{'_lookup_data'}->{$k}}) {
168                                                    my $tmp2 = $f;
169                                                    $tmp2 =~ s/lookup{$k}/$nv/g;
170                                                    push @in, $tmp2;
171                                            }
172                                    } else {
173                                            undef $f;
174                                    }
175                            } elsif ($f) {
176                                    push @out, $f;
177                            }
178                  }                  }
179                    $log->debug("lookup for: ",$tmp, " returned: ", join(", ",@out));
180    
181                    $log->logconfess("return is array and it's not expected!") unless wantarray;
182    
183                    return @out;
184            } else {
185                    return $tmp;
186          }          }
187  }  }
188    
189    =head2 lookup_hash
190    
191    Returns hash representation of lookup data
192    
193      my $l_hash = $lookup->lookup_hash;
194    
195    =cut
196    
197    sub lookup_hash {
198            my $self = shift;
199            return $self->{_lookup_data};
200    }
201    
202    =head2 regex
203    
204    Returns precompiled regex for lookup format.
205    
206     if ($foo =~ $lookup->reges) { ... }
207    
208    =cut
209    
210    sub regex {
211            my $self = shift;
212    
213            return $self->{'LOOKUP_REGEX'};
214    }
215    
216  =head1 AUTHOR  =head1 AUTHOR
217    
218  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
219    
220  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
221    
222  Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.  Copyright 2005-2006 Dobrica Pavlinusic, All Rights Reserved.
223    
224  This program is free software; you can redistribute it and/or modify it  This program is free software; you can redistribute it and/or modify it
225  under the same terms as Perl itself.  under the same terms as Perl itself.
226    
227  =cut  =cut
228    
229  1; # End of WebPAC::Normalize::Lookup  1; # End of WebPAC::Lookup
Legend:
Removed from v.3  
changed lines
  Added in v.536
  ViewVC Help
Powered by ViewVC 1.1.26