4 |
use strict; |
use strict; |
5 |
|
|
6 |
use WebPAC::Input; |
use WebPAC::Input; |
7 |
use base qw/WebPAC::Common/; |
use WebPAC::Input::Helper; |
8 |
|
use base qw/WebPAC::Common WebPAC::Input::Helper/; |
9 |
use XBase; |
use XBase; |
10 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
11 |
use Encode qw/encode_utf8/; |
use Encode qw/encode_utf8/; |
172 |
return $self->{size}; |
return $self->{size}; |
173 |
} |
} |
174 |
|
|
|
=head2 _to_hash |
|
|
|
|
|
Return hash from row. Taken from L<Biblio::Isis> |
|
|
|
|
|
my $rec = $ll_db->_to_hash( |
|
|
mfn => $mfn, |
|
|
row => $row, |
|
|
); |
|
|
|
|
|
=cut |
|
|
|
|
|
sub _to_hash { |
|
|
my $self = shift; |
|
|
|
|
|
my $arg = {@_}; |
|
|
|
|
|
my $log = $self->_get_logger(); |
|
|
|
|
|
my $hash_filter = $arg->{hash_filter}; |
|
|
my $mfn = $arg->{mfn} || $log->logconfess("need mfn in arguments"); |
|
|
my $row = $arg->{row} || $log->logconfess("need row in arguments"); |
|
|
|
|
|
# init record to include MFN as field 000 |
|
|
my $rec = { '000' => [ $mfn ] }; |
|
|
|
|
|
foreach my $f_nr (keys %{$row}) { |
|
|
foreach my $l (@{$row->{$f_nr}}) { |
|
|
|
|
|
# filter output |
|
|
$l = $hash_filter->($l, $f_nr) if ($hash_filter); |
|
|
next unless defined($l); |
|
|
|
|
|
my $val; |
|
|
my $r_sf; # repeatable subfields in this record |
|
|
|
|
|
# has subfields? |
|
|
if ($l =~ m/\^/) { |
|
|
foreach my $t (split(/\^/,$l)) { |
|
|
next if (! $t); |
|
|
my ($sf,$v) = (substr($t,0,1), substr($t,1)); |
|
|
next unless (defined($v) && $v ne ''); |
|
|
|
|
|
if (ref( $val->{$sf} ) eq 'ARRAY') { |
|
|
|
|
|
push @{ $val->{$sf} }, $v; |
|
|
|
|
|
# record repeatable subfield it it's offset |
|
|
push @{ $val->{subfields} }, ( $sf, $#{ $val->{$sf} } ); |
|
|
$r_sf->{$sf}++; |
|
|
|
|
|
} elsif (defined( $val->{$sf} )) { |
|
|
|
|
|
# convert scalar field to array |
|
|
$val->{$sf} = [ $val->{$sf}, $v ]; |
|
|
|
|
|
push @{ $val->{subfields} }, ( $sf, 1 ); |
|
|
$r_sf->{$sf}++; |
|
|
|
|
|
} else { |
|
|
$val->{$sf} = $v; |
|
|
push @{ $val->{subfields} }, ( $sf, 0 ); |
|
|
} |
|
|
} |
|
|
} else { |
|
|
$val = $l; |
|
|
} |
|
|
|
|
|
push @{$rec->{$f_nr}}, $val; |
|
|
} |
|
|
} |
|
|
|
|
|
return $rec; |
|
|
} |
|
|
|
|
175 |
=head1 AUTHOR |
=head1 AUTHOR |
176 |
|
|
177 |
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >> |
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >> |