/[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 729 by dpavlin, Fri Sep 29 20:18:30 2006 UTC revision 740 by dpavlin, Sat Oct 7 16:33:37 2006 UTC
# Line 2  package WebPAC::Normalize; Line 2  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          _set_load_ds          _set_load_row
6          _get_ds _clean_ds          _get_ds _clean_ds
7          _debug          _debug
8          _pack_subfields_hash          _pack_subfields_hash
# Line 39  WebPAC::Normalize - describe normalisato Line 39  WebPAC::Normalize - describe normalisato
39    
40  =head1 VERSION  =head1 VERSION
41    
42  Version 0.21  Version 0.22
43    
44  =cut  =cut
45    
46  our $VERSION = '0.21';  our $VERSION = '0.22';
47    
48  =head1 SYNOPSIS  =head1 SYNOPSIS
49    
# Line 74  Return data structure Line 74  Return data structure
74          rules => $normalize_pl_config,          rules => $normalize_pl_config,
75          marc_encoding => 'utf-8',          marc_encoding => 'utf-8',
76          config => $config,          config => $config,
77          load_ds_coderef => sub {          load_row_coderef => sub {
78                  my ($database,$input,$mfn) = shift;                  my ($database,$input,$mfn) = shift;
79                  $store->load_ds( database => $database, input => $input, id => $mfn );                  $store->load_row( database => $database, input => $input, id => $mfn );
80          },          },
81    );    );
82    
83  Options C<row>, C<rules> and C<log> are mandatory while all  Options C<row>, C<rules> and C<log> are mandatory while all
84  other are optional.  other are optional.
85    
86  C<load_ds_coderef> is closure only used when executing lookups, so they will  C<load_row_coderef> is closure only used when executing lookups, so they will
87  die if it's not defined.  die if it's not defined.
88    
89  This function will B<die> if normalizastion can't be evaled.  This function will B<die> if normalizastion can't be evaled.
# Line 93  C<WebPAC::Normalize::data_structure>. Line 93  C<WebPAC::Normalize::data_structure>.
93    
94  =cut  =cut
95    
96  my $load_ds_coderef;  my $load_row_coderef;
97    
98  sub data_structure {  sub data_structure {
99          my $arg = {@_};          my $arg = {@_};
# Line 102  sub data_structure { Line 102  sub data_structure {
102          die "need normalisation argument" unless ($arg->{rules});          die "need normalisation argument" unless ($arg->{rules});
103    
104          no strict 'subs';          no strict 'subs';
105          _set_lookup( $arg->{lookup} );          _set_lookup( $arg->{lookup} ) if defined($arg->{lookup});
106          _set_rec( $arg->{row} );          _set_rec( $arg->{row} );
107          _set_config( $arg->{config} );          _set_config( $arg->{config} ) if defined($arg->{config});
108          _clean_ds( %{ $arg } );          _clean_ds( %{ $arg } );
109          $load_ds_coderef = $arg->{load_ds_coderef};          $load_row_coderef = $arg->{load_row_coderef};
110    
111          eval "$arg->{rules}";          eval "$arg->{rules}";
112          die "error evaling $arg->{rules}: $@\n" if ($@);          die "error evaling $arg->{rules}: $@\n" if ($@);
# Line 212  sub _get_lookup { Line 212  sub _get_lookup {
212          return $lookup;          return $lookup;
213  }  }
214    
215  =head2 _set_load_ds  =head2 _set_load_row
216    
217  Setup code reference which will return L<data_structure> from  Setup code reference which will return L<data_structure> from
218  L<WebPAC::Store>  L<WebPAC::Store>
219    
220    _set_load_ds(sub {    _set_load_row(sub {
221                  my ($database,$input,$mfn) = @_;                  my ($database,$input,$mfn) = @_;
222                  $store->load_ds( database => $database, input => $input, id => $mfn );                  $store->load_row( database => $database, input => $input, id => $mfn );
223    });    });
224    
225  =cut  =cut
226    
227  sub _set_load_ds {  sub _set_load_row {
228          my $coderef = shift;          my $coderef = shift;
229          confess "argument isn't CODE" unless ref($coderef) eq 'CODE';          confess "argument isn't CODE" unless ref($coderef) eq 'CODE';
230    
231          $load_ds_coderef = $coderef;          $load_row_coderef = $coderef;
232  }  }
233    
234  =head2 _get_marc_fields  =head2 _get_marc_fields
# Line 1022  sub lookup { Line 1022  sub lookup {
1022          warn "## lookup ($database, $input, $key)", $/ if ($debug > 1);          warn "## lookup ($database, $input, $key)", $/ if ($debug > 1);
1023          return unless (defined($lookup->{$database}->{$input}->{$key}));          return unless (defined($lookup->{$database}->{$input}->{$key}));
1024    
1025          confess "lookup really need load_ds_coderef added to data_structure\n" unless ($load_ds_coderef);          confess "lookup really need load_row_coderef added to data_structure\n" unless ($load_row_coderef);
1026    
1027          my $mfns;          my $mfns;
1028          my @having = $having->();          my @having = $having->();
# Line 1046  sub lookup { Line 1046  sub lookup {
1046          my @out;          my @out;
1047    
1048          foreach my $mfn (@mfns) {          foreach my $mfn (@mfns) {
1049                  $rec = $load_ds_coderef->( $database, $input, $mfn );                  $rec = $load_row_coderef->( $database, $input, $mfn );
1050    
1051                  warn "got $database/$input/$mfn = ", dump($rec), $/;                  warn "got $database/$input/$mfn = ", dump($rec), $/;
1052    
# Line 1067  sub lookup { Line 1067  sub lookup {
1067    
1068          warn "## lookup returns = ", dump(@out), $/;          warn "## lookup returns = ", dump(@out), $/;
1069    
1070          return @out;          if ($#out == 0) {
1071                    return $out[0];
1072            } else {
1073                    return @out;
1074            }
1075  }  }
1076    
1077  =head2 save_into_lookup  =head2 save_into_lookup

Legend:
Removed from v.729  
changed lines
  Added in v.740

  ViewVC Help
Powered by ViewVC 1.1.26