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 |
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 |
|
|
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. |
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 = {@_}; |
106 |
_set_rec( $arg->{row} ); |
_set_rec( $arg->{row} ); |
107 |
_set_config( $arg->{config} ) if defined($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 ($@); |
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 |
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->(); |
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 |
|
|