15 |
rec1 rec2 rec |
rec1 rec2 rec |
16 |
regex prefix suffix surround |
regex prefix suffix surround |
17 |
first lookup join_with |
first lookup join_with |
18 |
|
save_into_lookup |
19 |
|
|
20 |
split_rec_on |
split_rec_on |
21 |
/; |
/; |
37 |
|
|
38 |
=head1 VERSION |
=head1 VERSION |
39 |
|
|
40 |
Version 0.19 |
Version 0.20 |
41 |
|
|
42 |
=cut |
=cut |
43 |
|
|
44 |
our $VERSION = '0.19'; |
our $VERSION = '0.20'; |
45 |
|
|
46 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
47 |
|
|
67 |
Return data structure |
Return data structure |
68 |
|
|
69 |
my $ds = WebPAC::Normalize::data_structure( |
my $ds = WebPAC::Normalize::data_structure( |
70 |
lookup => $lookup->lookup_hash, |
lookup => $lookup_variable, |
71 |
row => $row, |
row => $row, |
72 |
rules => $normalize_pl_config, |
rules => $normalize_pl_config, |
73 |
marc_encoding => 'utf-8', |
marc_encoding => 'utf-8', |
74 |
config => $config, |
config => $config, |
75 |
); |
); |
76 |
|
|
77 |
Options C<lookup>, C<row>, C<rules> and C<log> are mandatory while all |
Options C<row>, C<rules> and C<log> are mandatory while all |
78 |
other are optional. |
other are optional. |
79 |
|
|
80 |
This function will B<die> if normalizastion can't be evaled. |
This function will B<die> if normalizastion can't be evaled. |
91 |
die "need normalisation argument" unless ($arg->{rules}); |
die "need normalisation argument" unless ($arg->{rules}); |
92 |
|
|
93 |
no strict 'subs'; |
no strict 'subs'; |
94 |
_set_lookup( $arg->{lookup} ); |
_set_lookup( $arg->{lookup} ) if (defined( $arg->{lookup} )); |
95 |
_set_rec( $arg->{row} ); |
_set_rec( $arg->{row} ); |
96 |
_set_config( $arg->{config} ); |
_set_config( $arg->{config} ) if (defined( $arg->{config} )); |
97 |
_clean_ds( %{ $arg } ); |
_clean_ds( %{ $arg } ); |
98 |
eval "$arg->{rules}"; |
eval "$arg->{rules}"; |
99 |
die "error evaling $arg->{rules}: $@\n" if ($@); |
die "error evaling $arg->{rules}: $@\n" if ($@); |
187 |
$lookup = shift; |
$lookup = shift; |
188 |
} |
} |
189 |
|
|
190 |
|
=head2 _get_lookup |
191 |
|
|
192 |
|
Get current lookup hash |
193 |
|
|
194 |
|
my $lookup = _get_lookup(); |
195 |
|
|
196 |
|
=cut |
197 |
|
|
198 |
|
sub _get_lookup { |
199 |
|
return $lookup; |
200 |
|
} |
201 |
|
|
202 |
=head2 _get_marc_fields |
=head2 _get_marc_fields |
203 |
|
|
204 |
Get all fields defined by calls to C<marc> |
Get all fields defined by calls to C<marc> |
944 |
@v = lookup( $v ); |
@v = lookup( $v ); |
945 |
@v = lookup( @v ); |
@v = lookup( @v ); |
946 |
|
|
947 |
|
FIXME B<currently this one is broken!> |
948 |
|
|
949 |
=cut |
=cut |
950 |
|
|
951 |
sub lookup { |
sub lookup { |
958 |
} |
} |
959 |
} |
} |
960 |
|
|
961 |
|
=head2 save_into_lookup |
962 |
|
|
963 |
|
Save value into lookup. |
964 |
|
|
965 |
|
save_into_lookup($key,sub { |
966 |
|
# code which produce one or more values |
967 |
|
}); |
968 |
|
|
969 |
|
This function shouldn't be called directly, it's called from code created by L<WebPAC::Parser>. |
970 |
|
|
971 |
|
=cut |
972 |
|
|
973 |
|
sub save_into_lookup { |
974 |
|
my ($k,$coderef) = @_; |
975 |
|
die "save_into_lookup needs key" unless defined($k); |
976 |
|
die "save_into_lookup needs CODE" unless ( defined($coderef) && ref($coderef) eq 'CODE' ); |
977 |
|
my $mfn = $rec->{'000'}->[0] || die "mfn not defined or zero"; |
978 |
|
foreach my $v ( $coderef->() ) { |
979 |
|
$lookup->{$k}->{$v}->{$mfn}++; |
980 |
|
warn "# lookup $k $v $mfn saved\n"; # if ($debug > 1); |
981 |
|
} |
982 |
|
} |
983 |
|
|
984 |
=head2 config |
=head2 config |
985 |
|
|
986 |
Consult config values stored in C<config.yml> |
Consult config values stored in C<config.yml> |