/[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 536 by dpavlin, Mon Jun 26 16:39:51 2006 UTC revision 540 by dpavlin, Thu Jun 29 15:29:41 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            marc21
9    
10          rec1 rec2 rec          rec1 rec2 rec
11          regex prefix suffix surround          regex prefix suffix surround
12          first lookup join_with          first lookup join_with
# Line 21  WebPAC::Normalize - describe normalisato Line 24  WebPAC::Normalize - describe normalisato
24    
25  =head1 VERSION  =head1 VERSION
26    
27  Version 0.04  Version 0.05
28    
29  =cut  =cut
30    
31  our $VERSION = '0.04';  our $VERSION = '0.05';
32    
33  =head1 SYNOPSIS  =head1 SYNOPSIS
34    
# Line 38  means that you check it's validity befor Line 41  means that you check it's validity befor
41  C<perl -c normalize.pl>.  C<perl -c normalize.pl>.
42    
43  Normalisation can generate multiple output normalized data. For now, supported output  Normalisation can generate multiple output normalized data. For now, supported output
44  types (on the left side of definition) are: C<tag>, C<display> and C<search>.  types (on the left side of definition) are: C<tag>, C<display>, C<search> and
45    C<marc21>.
46    
47  =head1 FUNCTIONS  =head1 FUNCTIONS
48    
49    Functions which start with C<_> are private and used by WebPAC internally.
50    All other functions are available for use within normalisation rules.
51    
52  =head2 data_structure  =head2 data_structure
53    
54  Return data structure  Return data structure
55    
56    my $ds = WebPAC::Normalize(    my $ds = WebPAC::Normalize::data_structure(
57          lookup => $lookup->lookup_hash,          lookup => $lookup->lookup_hash,
58          row => $row,          row => $row,
59          rules => $normalize_pl_config,          rules => $normalize_pl_config,
60    );    );
61    
62    Options C<lookup>, C<row>, C<rules> and C<log> are mandatory while all
63    other are optional.
64    
65  This function will B<die> if normalizastion can't be evaled.  This function will B<die> if normalizastion can't be evaled.
66    
67    Since this function isn't exported you have to call it with
68    C<WebPAC::Normalize::data_structure>.
69    
70  =cut  =cut
71    
72  sub data_structure {  sub data_structure {
# Line 63  sub data_structure { Line 76  sub data_structure {
76          die "need normalisation argument" unless ($arg->{rules});          die "need normalisation argument" unless ($arg->{rules});
77    
78          no strict 'subs';          no strict 'subs';
79          set_lookup( $arg->{lookup} );          _set_lookup( $arg->{lookup} );
80          set_rec( $arg->{row} );          _set_rec( $arg->{row} );
81          clean_ds();          _clean_ds();
82    
83          eval "$arg->{rules}";          eval "$arg->{rules}";
84          die "error evaling $arg->{rules}: $@\n" if ($@);          die "error evaling $arg->{rules}: $@\n" if ($@);
85          return get_ds();  
86            return _get_ds();
87  }  }
88    
89  =head2 set_rec  =head2 _set_rec
90    
91  Set current record hash  Set current record hash
92    
93    set_rec( $rec );    _set_rec( $rec );
94    
95  =cut  =cut
96    
97  my $rec;  my $rec;
98    
99  sub set_rec {  sub _set_rec {
100          $rec = shift or die "no record hash";          $rec = shift or die "no record hash";
101  }  }
102    
103    =head2 _get_ds
104    
105    Return hash formatted as data structure
106    
107      my $ds = _get_ds();
108    
109    =cut
110    
111    my $out;
112    my $marc21;
113    
114    sub _get_ds {
115            return $out;
116    }
117    
118    =head2 _clean_ds
119    
120    Clean data structure hash for next record
121    
122      _clean_ds();
123    
124    =cut
125    
126    sub _clean_ds {
127            $out = undef;
128            $marc21 = undef;
129    }
130    
131    =head2 _set_lookup
132    
133    Set current lookup hash
134    
135      _set_lookup( $lookup );
136    
137    =cut
138    
139    my $lookup;
140    
141    sub _set_lookup {
142            $lookup = shift;
143    }
144    
145    =head2 _get_marc21_fields
146    
147    Get all fields defined by calls to C<marc21>
148    
149            $marc->add_fields( WebPAC::Normalize:_get_marc21_fields() );
150    
151    =cut
152    
153    sub _get_marc21_fields {
154            return @{$marc21};
155    }
156    
157    =head1 Functions to create C<data_structure>
158    
159    Those functions generally have to first in your normalization file.
160    
161  =head2 tag  =head2 tag
162    
163  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 167  Define new tag for I<search> and I<displ
167    
168  =cut  =cut
169    
 my $out;  
   
170  sub tag {  sub tag {
171          my $name = shift or die "tag needs name as first argument";          my $name = shift or die "tag needs name as first argument";
172          my @o = grep { defined($_) && $_ ne '' } @_;          my @o = grep { defined($_) && $_ ne '' } @_;
# Line 137  sub search { Line 208  sub search {
208          $out->{$name}->{search} = \@o;          $out->{$name}->{search} = \@o;
209  }  }
210    
211  =head2 get_ds  =head2 marc21
212    
213  Return hash formatted as data structure  Save value for MARC field
214    
215    my $ds = get_ds();    marc21('900','a', rec('200','a') );
216    
217  =cut  =cut
218    
219  sub get_ds {  sub marc21 {
220          return $out;          my $f = shift or die "marc21 needs field";
221  }          die "marc21 field must be numer" unless ($f =~ /^\d+$/);
   
 =head2 clean_ds  
   
 Clean data structure hash for next record  
222    
223    clean_ds();          my $sf = shift or die "marc21 needs subfield";
224    
225  =cut          foreach my $v (@_) {
226                    push @{ $marc21 }, [ $f, ' ', ' ', $sf => $v ];
227  sub clean_ds {          }
         $out = undef;  
228  }  }
229    
230  =head2 set_lookup  =head1 Functions to extract data from input
   
 Set current lookup hash  
   
   set_lookup( $lookup );  
   
 =cut  
231    
232  my $lookup;  This function should be used inside functions to create C<data_structure> described
233    above.
 sub set_lookup {  
         $lookup = shift;  
 }  
234    
235  =head2 rec1  =head2 rec1
236    
Legend:
Removed from v.536  
changed lines
  Added in v.540
  ViewVC Help
Powered by ViewVC 1.1.26