WebPAC/Input/Helper.pm

package WebPAC::Input::Helper;

use strict;
use warnings;

=head1 NAME

WebPAC::Input::Helper - set of routines to make writing input modules easier

=cut

=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;
}

1;
1	dpavlin	871	package WebPAC::Input::Helper;
2
3			use strict;
4			use warnings;
5
6			=head1 NAME
7
8			WebPAC::Input::Helper - set of routines to make writing input modules easier
9
10			=cut
11
12			=head2 _to_hash
13
14			Return hash from row. Taken from L<Biblio::Isis>
15
16			my $rec = $ll_db->_to_hash(
17			mfn => $mfn,
18			row => $row,
19			);
20
21			=cut
22
23			sub _to_hash {
24			my $self = shift;
25
26			my $arg = {@_};
27
28			my $log = $self->_get_logger();
29
30			my $hash_filter = $arg->{hash_filter};
31			my $mfn = $arg->{mfn} \|\| $log->logconfess("need mfn in arguments");
32			my $row = $arg->{row} \|\| $log->logconfess("need row in arguments");
33
34			# init record to include MFN as field 000
35			my $rec = { '000' => [ $mfn ] };
36
37			foreach my $f_nr (keys %{$row}) {
38			foreach my $l (@{$row->{$f_nr}}) {
39
40			# filter output
41			$l = $hash_filter->($l, $f_nr) if ($hash_filter);
42			next unless defined($l);
43
44			my $val;
45			my $r_sf; # repeatable subfields in this record
46
47			# has subfields?
48			if ($l =~ m/\^/) {
49			foreach my $t (split(/\^/,$l)) {
50			next if (! $t);
51			my ($sf,$v) = (substr($t,0,1), substr($t,1));
52			next unless (defined($v) && $v ne '');
53
54			if (ref( $val->{$sf} ) eq 'ARRAY') {
55
56			push @{ $val->{$sf} }, $v;
57
58			# record repeatable subfield it it's offset
59			push @{ $val->{subfields} }, ( $sf, $#{ $val->{$sf} } );
60			$r_sf->{$sf}++;
61
62			} elsif (defined( $val->{$sf} )) {
63
64			# convert scalar field to array
65			$val->{$sf} = [ $val->{$sf}, $v ];
66
67			push @{ $val->{subfields} }, ( $sf, 1 );
68			$r_sf->{$sf}++;
69
70			} else {
71			$val->{$sf} = $v;
72			push @{ $val->{subfields} }, ( $sf, 0 );
73			}
74			}
75			} else {
76			$val = $l;
77			}
78
79			push @{$rec->{$f_nr}}, $val;
80			}
81			}
82
83			return $rec;
84			}
85
86			1;