21 |
|
|
22 |
=head1 VERSION |
=head1 VERSION |
23 |
|
|
24 |
Version 0.03 |
Version 0.04 |
25 |
|
|
26 |
=cut |
=cut |
27 |
|
|
28 |
our $VERSION = '0.03'; |
our $VERSION = '0.04'; |
29 |
|
|
30 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
31 |
|
|
42 |
|
|
43 |
=head1 FUNCTIONS |
=head1 FUNCTIONS |
44 |
|
|
45 |
|
=head2 data_structure |
46 |
|
|
47 |
|
Return data structure |
48 |
|
|
49 |
|
my $ds = WebPAC::Normalize::Set( |
50 |
|
lookup => $lookup->lookup_hash, |
51 |
|
row => $row, |
52 |
|
rules => $normalize_pl_config, |
53 |
|
); |
54 |
|
|
55 |
|
This function will B<die> if normalizastion can't be evaled. |
56 |
|
|
57 |
|
=cut |
58 |
|
|
59 |
|
sub data_structure { |
60 |
|
my $arg = {@_}; |
61 |
|
|
62 |
|
die "need row argument" unless ($arg->{row}); |
63 |
|
die "need normalisation argument" unless ($arg->{rules}); |
64 |
|
|
65 |
|
no strict 'subs'; |
66 |
|
set_lookup( $arg->{lookup} ); |
67 |
|
set_rec( $arg->{row} ); |
68 |
|
clean_ds(); |
69 |
|
eval "$arg->{rules}"; |
70 |
|
die "error evaling $arg->{rules}: $@\n" if ($@); |
71 |
|
return get_ds(); |
72 |
|
} |
73 |
|
|
74 |
=head2 set_rec |
=head2 set_rec |
75 |
|
|
76 |
Set current record hash |
Set current record hash |
187 |
|
|
188 |
sub rec1 { |
sub rec1 { |
189 |
my $f = shift; |
my $f = shift; |
190 |
return unless (defined($rec && $rec->{$f})); |
return unless (defined($rec) && defined($rec->{$f})); |
191 |
if (ref($rec->{$f}) eq 'ARRAY') { |
if (ref($rec->{$f}) eq 'ARRAY') { |
192 |
if (ref($rec->{$f}->[0]) eq 'HASH') { |
return map { |
193 |
return map { values %{$_} } @{ $rec->{$f} }; |
if (ref($_) eq 'HASH') { |
194 |
} else { |
values %{$_}; |
195 |
return @{ $rec->{$f} }; |
} else { |
196 |
} |
$_; |
197 |
|
} |
198 |
|
} @{ $rec->{$f} }; |
199 |
} elsif( defined($rec->{$f}) ) { |
} elsif( defined($rec->{$f}) ) { |
200 |
return $rec->{$f}; |
return $rec->{$f}; |
201 |
} |
} |
213 |
my $f = shift; |
my $f = shift; |
214 |
return unless (defined($rec && $rec->{$f})); |
return unless (defined($rec && $rec->{$f})); |
215 |
my $sf = shift; |
my $sf = shift; |
216 |
return map { $_->{$sf} } grep { $_->{$sf} } @{ $rec->{$f} }; |
return map { $_->{$sf} } grep { ref($_) eq 'HASH' && $_->{$sf} } @{ $rec->{$f} }; |
217 |
} |
} |
218 |
|
|
219 |
=head2 rec |
=head2 rec |