/[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 912 by dpavlin, Tue Oct 30 17:40:13 2007 UTC revision 983 by dpavlin, Sun Nov 4 11:12:38 2007 UTC
# Line 1  Line 1 
1  package WebPAC::Normalize;  package WebPAC::Normalize;
2  use Exporter 'import';  use Exporter 'import';
3  @EXPORT = qw/  our @EXPORT = qw/
4          _set_rec _set_lookup          _set_ds _set_lookup
5            get_ds
6          _set_load_row          _set_load_row
7          _get_ds _clean_ds          _get_ds _clean_ds
8          _debug          _debug
9          _pack_subfields_hash          _pack_subfields_hash
10    
11          search_display search display          search_display search display sorted
12    
13          marc marc_indicators marc_repeatable_subfield          marc marc_indicators marc_repeatable_subfield
14          marc_compose marc_leader marc_fixed          marc_compose marc_leader marc_fixed
# Line 15  use Exporter 'import'; Line 16  use Exporter 'import';
16          marc_original_order          marc_original_order
17    
18          rec1 rec2 rec          rec1 rec2 rec
19            frec
20          regex prefix suffix surround          regex prefix suffix surround
21          first lookup join_with          first lookup join_with
22          save_into_lookup          save_into_lookup
# Line 23  use Exporter 'import'; Line 25  use Exporter 'import';
25    
26          get set          get set
27          count          count
28    
29  /;  /;
30    
31  use warnings;  use warnings;
# Line 36  use Carp qw/confess/; Line 39  use Carp qw/confess/;
39  # debugging warn(s)  # debugging warn(s)
40  my $debug = 0;  my $debug = 0;
41    
42    use WebPAC::Normalize::ISBN;
43    push @EXPORT, ( 'isbn_10', 'isbn_13' );
44    
45  =head1 NAME  =head1 NAME
46    
47  WebPAC::Normalize - describe normalisaton rules using sets  WebPAC::Normalize - describe normalisaton rules using sets
48    
 =head1 VERSION  
   
 Version 0.30  
   
49  =cut  =cut
50    
51  our $VERSION = '0.30';  our $VERSION = '0.32';
52    
53  =head1 SYNOPSIS  =head1 SYNOPSIS
54    
# Line 79  Return data structure Line 80  Return data structure
80          marc_encoding => 'utf-8',          marc_encoding => 'utf-8',
81          config => $config,          config => $config,
82          load_row_coderef => sub {          load_row_coderef => sub {
83                  my ($database,$input,$mfn) = shift;                  my ($database,$input,$mfn) = @_;
84                  $store->load_row( database => $database, input => $input, id => $mfn );                  $store->load_row( database => $database, input => $input, id => $mfn );
85          },          },
86    );    );
# Line 107  sub data_structure { Line 108  sub data_structure {
108    
109          no strict 'subs';          no strict 'subs';
110          _set_lookup( $arg->{lookup} ) if defined($arg->{lookup});          _set_lookup( $arg->{lookup} ) if defined($arg->{lookup});
111          _set_rec( $arg->{row} );          _set_ds( $arg->{row} );
112          _set_config( $arg->{config} ) if defined($arg->{config});          _set_config( $arg->{config} ) if defined($arg->{config});
113          _clean_ds( %{ $arg } );          _clean_ds( %{ $arg } );
114          $load_row_coderef = $arg->{load_row_coderef};          $load_row_coderef = $arg->{load_row_coderef};
# Line 118  sub data_structure { Line 119  sub data_structure {
119          return _get_ds();          return _get_ds();
120  }  }
121    
122  =head2 _set_rec  =head2 _set_ds
123    
124  Set current record hash  Set current record hash
125    
126    _set_rec( $rec );    _set_ds( $rec );
127    
128  =cut  =cut
129    
130  my $rec;  my $rec;
131    
132  sub _set_rec {  sub _set_ds {
133          $rec = shift or die "no record hash";          $rec = shift or die "no record hash";
134  }  }
135    
136    =head2 get_ds
137    
138    Access to original record from input module
139    
140      my $ds = get_rec;
141    
142    =cut
143    
144    sub get_ds {
145            return $rec;
146    }
147    
148  =head2 _set_config  =head2 _set_config
149    
150  Set current config hash  Set current config hash
# Line 172  my ($out, $marc_record, $marc_encoding, Line 185  my ($out, $marc_record, $marc_encoding,
185  my ($marc_record_offset, $marc_fetch_offset) = (0, 0);  my ($marc_record_offset, $marc_fetch_offset) = (0, 0);
186    
187  sub _get_ds {  sub _get_ds {
188    #warn "## out = ",dump($out);
189          return $out;          return $out;
190  }  }
191    
# Line 460  sub search_display { Line 474  sub search_display {
474          $out->{$name}->{display} = \@o;          $out->{$name}->{display} = \@o;
475  }  }
476    
477    =head2 tag
478    
479    Old name for L<search_display>, but supported
480    
481    =cut
482    
483    sub tag {
484            search_display( @_ );
485    }
486    
487  =head2 display  =head2 display
488    
489  Define output just for I<display>  Define output just for I<display>
# Line 468  Define output just for I<display> Line 492  Define output just for I<display>
492    
493  =cut  =cut
494    
495  sub display {  sub _field {
496          my $name = shift or die "display needs name as first argument";          my $type = shift or confess "need type -- BUG?";
497            my $name = shift or confess "needs name as first argument";
498          my @o = grep { defined($_) && $_ ne '' } @_;          my @o = grep { defined($_) && $_ ne '' } @_;
499          return unless (@o);          return unless (@o);
500          $out->{$name}->{display} = \@o;          $out->{$name}->{$type} = \@o;
501  }  }
502    
503    sub display { _field( 'display', @_ ) }
504    
505  =head2 search  =head2 search
506    
507  Prepare values just for I<search>  Prepare values just for I<search>
# Line 483  Prepare values just for I<search> Line 510  Prepare values just for I<search>
510    
511  =cut  =cut
512    
513  sub search {  sub search { _field( 'search', @_ ) }
514          my $name = shift or die "search needs name as first argument";  
515          my @o = grep { defined($_) && $_ ne '' } @_;  =head2 sorted
516          return unless (@o);  
517          $out->{$name}->{search} = \@o;  Insert into lists which will be automatically sorted
518  }  
519     sorted('Title', rec('200','a') );
520    
521    =cut
522    
523    sub sorted { _field( 'sorted', @_ ) }
524    
525    
526  =head2 marc_leader  =head2 marc_leader
527    
# Line 979  return scalar, not array. Line 1012  return scalar, not array.
1012    
1013  =cut  =cut
1014    
1015    sub frec {
1016            my @out = rec(@_);
1017            warn "rec(",dump(@_),") has more than one return value, ignoring\n" if $#out > 0;
1018            return shift @out;
1019    }
1020    
1021  sub rec {  sub rec {
1022          my @out;          my @out;
1023          if ($#_ == 0) {          if ($#_ == 0) {

Legend:
Removed from v.912  
changed lines
  Added in v.983

  ViewVC Help
Powered by ViewVC 1.1.26