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 XML::LibXML; |
use XML::LibXML; |
10 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
11 |
use Encode qw/encode_utf8/; |
use Encode qw/encode_utf8/; |
16 |
|
|
17 |
=head1 VERSION |
=head1 VERSION |
18 |
|
|
19 |
Version 0.01 |
Version 0.02 |
20 |
|
|
21 |
=cut |
=cut |
22 |
|
|
23 |
our $VERSION = '0.01'; |
our $VERSION = '0.02'; |
24 |
|
|
25 |
|
|
26 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
101 |
$etext_no =~ s/^etext//; |
$etext_no =~ s/^etext//; |
102 |
|
|
103 |
my $row = { |
my $row = { |
|
'000' => [ $mfn ], |
|
104 |
'001' => [ $etext_no ], |
'001' => [ $etext_no ], |
105 |
}; |
}; |
106 |
|
|
166 |
return $self->{size}; |
return $self->{size}; |
167 |
} |
} |
168 |
|
|
|
=head2 _to_hash |
|
|
|
|
|
Return hash from row. Taken from L<Biblio::Isis> |
|
|
|
|
|
my $rec = $ll_db->_to_hash( |
|
|
mfn => $mfn; |
|
|
$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; |
|
|
} |
|
|
|
|
169 |
=head1 AUTHOR |
=head1 AUTHOR |
170 |
|
|
171 |
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >> |
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >> |