7 |
BEGIN { |
BEGIN { |
8 |
use Exporter (); |
use Exporter (); |
9 |
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
10 |
$VERSION = 0.22_1; |
$VERSION = 0.22; |
11 |
@ISA = qw (Exporter); |
@ISA = qw (Exporter); |
12 |
#Give a hoot don't pollute, do not export more than needed by default |
#Give a hoot don't pollute, do not export more than needed by default |
13 |
@EXPORT = qw (); |
@EXPORT = qw (); |
84 |
read_fdt => 1, |
read_fdt => 1, |
85 |
include_deleted => 1, |
include_deleted => 1, |
86 |
hash_filter => sub { |
hash_filter => sub { |
87 |
my $v = shift; |
my ($v,$field_number) = @_; |
88 |
$v =~ s#foo#bar#g; |
$v =~ s#foo#bar#g; |
89 |
}, |
}, |
90 |
debug => 1, |
debug => 1, |
114 |
|
|
115 |
=item hash_filter |
=item hash_filter |
116 |
|
|
117 |
Filter code ref which will be used before data is converted to hash. |
Filter code ref which will be used before data is converted to hash. It will |
118 |
|
receive two arguments, whole line from current field (in C<< $_[0] >>) and |
119 |
|
field number (in C<< $_[1] >>). |
120 |
|
|
121 |
=item debug |
=item debug |
122 |
|
|
521 |
my $hash = $isis->to_hash({ |
my $hash = $isis->to_hash({ |
522 |
mfn => 42, |
mfn => 42, |
523 |
include_subfields => 1, |
include_subfields => 1, |
|
regexps => [ |
|
|
's/something/else/g', |
|
|
], |
|
524 |
}); |
}); |
525 |
|
|
526 |
Each option controll creation of hash: |
Each option controll creation of hash: |
564 |
$mfn = $arg->{mfn} || confess "need mfn in arguments"; |
$mfn = $arg->{mfn} || confess "need mfn in arguments"; |
565 |
} |
} |
566 |
|
|
|
confess "regexps must be HASH" if ($arg->{regexps} && ref($arg->{regexps}) ne 'HASH'); |
|
|
|
|
567 |
# init record to include MFN as field 000 |
# init record to include MFN as field 000 |
568 |
my $rec = { '000' => [ $mfn ] }; |
my $rec = { '000' => [ $mfn ] }; |
569 |
|
|
578 |
|
|
579 |
# filter output |
# filter output |
580 |
if ($self->{'hash_filter'}) { |
if ($self->{'hash_filter'}) { |
581 |
$l = $self->{'hash_filter'}->($l); |
$l = $self->{'hash_filter'}->($l, $f_nr); |
582 |
next unless defined($l); |
next unless defined($l); |
583 |
} |
} |
584 |
|
|
|
# apply regexps |
|
|
if ($arg->{regexps} && defined($arg->{regexps}->{$f_nr})) { |
|
|
confess "regexps->{$f_nr} must be ARRAY" if (ref($arg->{regexps}->{$f_nr}) ne 'ARRAY'); |
|
|
my $c = 0; |
|
|
foreach my $r (@{ $arg->{regexps}->{$f_nr} }) { |
|
|
while ( eval '$l =~ ' . $r ) { $c++ }; |
|
|
} |
|
|
warn "## field $f_nr triggered $c regexpes\n" if ($c && $self->{debug}); |
|
|
} |
|
|
|
|
585 |
my $val; |
my $val; |
586 |
my $r_sf; # repeatable subfields in this record |
my $r_sf; # repeatable subfields in this record |
587 |
|
|
753 |
|
|
754 |
=over 8 |
=over 8 |
755 |
|
|
756 |
|
=item 0.22 |
757 |
|
|
758 |
|
Added field number when calling C<hash_filter> |
759 |
|
|
760 |
=item 0.21 |
=item 0.21 |
761 |
|
|
762 |
Added C<join_subfields_with> to L</new> and L</to_hash>. |
Added C<join_subfields_with> to L</new> and L</to_hash>. |