/[webpac2]/trunk/lib/WebPAC/Normalize/Set.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/Normalize/Set.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 461 by dpavlin, Fri May 12 14:54:25 2006 UTC revision 472 by dpavlin, Sat May 13 12:07:46 2006 UTC
# Line 4  use Exporter 'import'; Line 4  use Exporter 'import';
4          set_rec set_lookup          set_rec set_lookup
5          get_ds clean_ds          get_ds clean_ds
6          tag search display          tag search display
7          rec1 rec2 rec regex first lookup join_with          rec1 rec2 rec
8            regex prefix
9            first lookup join_with
10  /;  /;
11    
12  use warnings;  use warnings;
# Line 19  WebPAC::Normalize::Set - describe normal Line 21  WebPAC::Normalize::Set - describe normal
21    
22  =head1 VERSION  =head1 VERSION
23    
24  Version 0.02  Version 0.03
25    
26  =cut  =cut
27    
28  our $VERSION = '0.02';  our $VERSION = '0.03';
29    
30  =head1 SYNOPSIS  =head1 SYNOPSIS
31    
32  This module uses C<conf/normalize/*.pl> files to perform normalisation  This module uses C<conf/normalize/*.pl> files to perform normalisation
33  from input records  from input records using perl functions which are specialized for set
34    processing.
35    
36    Sets are implemented as arrays, and normalisation file is valid perl, which
37    means that you check it's validity before running WebPAC using
38    C<perl -c normalize.pl>.
39    
40    Normalisation can generate multiple output normalized data. For now, supported output
41    types (on the left side of definition) are: C<tag>, C<display> and C<search>.
42    
43  =head1 FUNCTIONS  =head1 FUNCTIONS
44    
# Line 48  sub set_rec { Line 58  sub set_rec {
58    
59  =head2 tag  =head2 tag
60    
61  Define new tag for output  Define new tag for I<search> and I<display>.
62    
63    tag('Title', rec('200','a') );    tag('Title', rec('200','a') );
64    
 By default, output will go into I<search> and I<display>.  
65    
66  =cut  =cut
67    
68  my $out;  my $out;
69    
70  sub tag {  sub tag {
71          my $name = shift or "tag needs name as first argument";          my $name = shift or die "tag needs name as first argument";
72          return unless (@_);          my @o = grep { defined($_) && $_ ne '' } @_;
73            return unless (@o);
74          $out->{$name}->{tag} = $name;          $out->{$name}->{tag} = $name;
75          $out->{$name}->{search} = \@_;          $out->{$name}->{search} = \@o;
76          $out->{$name}->{display} = \@_;          $out->{$name}->{display} = \@o;
77  }  }
78    
79  =head2 display  =head2 display
# Line 75  Define tag just for I<display> Line 85  Define tag just for I<display>
85  =cut  =cut
86    
87  sub display {  sub display {
88          my $name = shift or "display needs name as first argument";          my $name = shift or die "display needs name as first argument";
89          return unless (@_);          my @o = grep { defined($_) && $_ ne '' } @_;
90            return unless (@o);
91          $out->{$name}->{tag} = $name;          $out->{$name}->{tag} = $name;
92          $out->{$name}->{display} = \@_;          $out->{$name}->{display} = \@o;
93  }  }
94    
95  =head2 search  =head2 search
# Line 90  Prepare values just for I<search> Line 101  Prepare values just for I<search>
101  =cut  =cut
102    
103  sub search {  sub search {
104          my $name = shift or "search needs name as first argument";          my $name = shift or die "search needs name as first argument";
105          return unless (@_);          my @o = grep { defined($_) && $_ ne '' } @_;
106            return unless (@o);
107          $out->{$name}->{tag} = $name;          $out->{$name}->{tag} = $name;
108          $out->{$name}->{search} = \@_;          $out->{$name}->{search} = \@o;
109  }  }
110    
111  =head2 get_ds  =head2 get_ds
# Line 201  Apply regex to some or all values Line 213  Apply regex to some or all values
213  sub regex {  sub regex {
214          my $r = shift;          my $r = shift;
215          my @out;          my @out;
216          warn "r: $r\n",Dumper(\@_);          #warn "r: $r\n",Dumper(\@_);
217          foreach my $t (@_) {          foreach my $t (@_) {
218                  eval "\$t =~ $r";                  eval "\$t =~ $r";
219                  push @out, $t;                  push @out, $t;
# Line 209  sub regex { Line 221  sub regex {
221          return @out;          return @out;
222  }  }
223    
224    =head2 prefix
225    
226    Prefix all values with a string
227    
228      @v = prefix( 'my_', @v );
229    
230    =cut
231    
232    sub prefix {
233            my $p = shift or die "prefix needs string as first argument";
234            return map { $p . $_ } grep { defined($_) } @_;
235    }
236    
237  =head2 first  =head2 first
238    
239  Return first element  Return first element
# Line 232  Consult lookup hashes for some value Line 257  Consult lookup hashes for some value
257  =cut  =cut
258    
259  sub lookup {  sub lookup {
260          my $k = shift;          my $k = shift or return;
261          return unless ($lookup && defined($lookup->{$k}));          return unless (defined($lookup->{$k}));
262          if (ref($lookup->{$k}) eq 'ARRAY') {          if (ref($lookup->{$k}) eq 'ARRAY') {
263                  return @{ $lookup->{$k} };                  return @{ $lookup->{$k} };
264          } else {          } else {
Legend:
Removed from v.461  
changed lines
  Added in v.472
  ViewVC Help
Powered by ViewVC 1.1.26