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

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

revision 537 by dpavlin, Mon Jun 26 16:39:51 2006 UTC revision 538 by dpavlin, Thu Jun 29 15:29:19 2006 UTC
# Line 1  Line 1 
1  package WebPAC::Normalize;  package WebPAC::Normalize;
2  use Exporter 'import';  use Exporter 'import';
3  @EXPORT = qw/  @EXPORT = qw/
4          set_rec set_lookup          _set_rec _set_lookup
5          get_ds clean_ds          _get_ds _clean_ds
6    
7          tag search display          tag search display
8          rec1 rec2 rec          rec1 rec2 rec
9          regex prefix suffix surround          regex prefix suffix surround
# Line 21  WebPAC::Normalize - describe normalisato Line 22  WebPAC::Normalize - describe normalisato
22    
23  =head1 VERSION  =head1 VERSION
24    
25  Version 0.04  Version 0.05
26    
27  =cut  =cut
28    
29  our $VERSION = '0.04';  our $VERSION = '0.05';
30    
31  =head1 SYNOPSIS  =head1 SYNOPSIS
32    
# Line 42  types (on the left side of definition) a Line 43  types (on the left side of definition) a
43    
44  =head1 FUNCTIONS  =head1 FUNCTIONS
45    
46    Functions which start with C<_> are private and used by WebPAC internally.
47    All other functions are available for use within normalisation rules.
48    
49  =head2 data_structure  =head2 data_structure
50    
51  Return data structure  Return data structure
52    
53    my $ds = WebPAC::Normalize(    my $ds = WebPAC::Normalize::data_structure(
54          lookup => $lookup->lookup_hash,          lookup => $lookup->lookup_hash,
55          row => $row,          row => $row,
56          rules => $normalize_pl_config,          rules => $normalize_pl_config,
# Line 54  Return data structure Line 58  Return data structure
58    
59  This function will B<die> if normalizastion can't be evaled.  This function will B<die> if normalizastion can't be evaled.
60    
61    Since this function isn't exported you have to call it with
62    C<WebPAC::Normalize::data_structure>.
63    
64  =cut  =cut
65    
66  sub data_structure {  sub data_structure {
# Line 63  sub data_structure { Line 70  sub data_structure {
70          die "need normalisation argument" unless ($arg->{rules});          die "need normalisation argument" unless ($arg->{rules});
71    
72          no strict 'subs';          no strict 'subs';
73          set_lookup( $arg->{lookup} );          _set_lookup( $arg->{lookup} );
74          set_rec( $arg->{row} );          _set_rec( $arg->{row} );
75          clean_ds();          _clean_ds();
76          eval "$arg->{rules}";          eval "$arg->{rules}";
77          die "error evaling $arg->{rules}: $@\n" if ($@);          die "error evaling $arg->{rules}: $@\n" if ($@);
78          return get_ds();          return _get_ds();
79  }  }
80    
81  =head2 set_rec  =head2 _set_rec
82    
83  Set current record hash  Set current record hash
84    
85    set_rec( $rec );    _set_rec( $rec );
86    
87  =cut  =cut
88    
89  my $rec;  my $rec;
90    
91  sub set_rec {  sub _set_rec {
92          $rec = shift or die "no record hash";          $rec = shift or die "no record hash";
93  }  }
94    
95    =head2 _get_ds
96    
97    Return hash formatted as data structure
98    
99      my $ds = _get_ds();
100    
101    =cut
102    
103    my $out;
104    
105    sub _get_ds {
106            return $out;
107    }
108    
109    =head2 _clean_ds
110    
111    Clean data structure hash for next record
112    
113      _clean_ds();
114    
115    =cut
116    
117    sub _clean_ds {
118            $out = undef;
119    }
120    
121    =head2 _set_lookup
122    
123    Set current lookup hash
124    
125      _set_lookup( $lookup );
126    
127    =cut
128    
129    my $lookup;
130    
131    sub _set_lookup {
132            $lookup = shift;
133    }
134    
135  =head2 tag  =head2 tag
136    
137  Define new tag for I<search> and I<display>.  Define new tag for I<search> and I<display>.
# Line 94  Define new tag for I<search> and I<displ Line 141  Define new tag for I<search> and I<displ
141    
142  =cut  =cut
143    
 my $out;  
   
144  sub tag {  sub tag {
145          my $name = shift or die "tag needs name as first argument";          my $name = shift or die "tag needs name as first argument";
146          my @o = grep { defined($_) && $_ ne '' } @_;          my @o = grep { defined($_) && $_ ne '' } @_;
# Line 137  sub search { Line 182  sub search {
182          $out->{$name}->{search} = \@o;          $out->{$name}->{search} = \@o;
183  }  }
184    
 =head2 get_ds  
   
 Return hash formatted as data structure  
   
   my $ds = get_ds();  
   
 =cut  
   
 sub get_ds {  
         return $out;  
 }  
   
 =head2 clean_ds  
   
 Clean data structure hash for next record  
   
   clean_ds();  
   
 =cut  
   
 sub clean_ds {  
         $out = undef;  
 }  
   
 =head2 set_lookup  
   
 Set current lookup hash  
   
   set_lookup( $lookup );  
   
 =cut  
   
 my $lookup;  
   
 sub set_lookup {  
         $lookup = shift;  
 }  
   
185  =head2 rec1  =head2 rec1
186    
187  Return all values in some field  Return all values in some field

Legend:
Removed from v.537  
changed lines
  Added in v.538

  ViewVC Help
Powered by ViewVC 1.1.26