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.02; |
$VERSION = 0.04; |
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 (); |
42 |
quiet => 0, |
quiet => 0, |
43 |
debug => 0, |
debug => 0, |
44 |
assert => 0, |
assert => 0, |
45 |
|
hash_filter => sub { |
46 |
|
my ($t, $record_number) = @_; |
47 |
|
$t =~ s/foo/bar/; |
48 |
|
return $t; |
49 |
|
}, |
50 |
); |
); |
51 |
|
|
52 |
=cut |
=cut |
270 |
|
|
271 |
my $row = $self->fetch($mfn) || return; |
my $row = $self->fetch($mfn) || return; |
272 |
|
|
273 |
foreach my $k (keys %{$row}) { |
foreach my $rec_nr (keys %{$row}) { |
274 |
foreach my $l (@{$row->{$k}}) { |
foreach my $l (@{$row->{$rec_nr}}) { |
275 |
|
|
276 |
# remove end marker |
# remove end marker |
277 |
$l =~ s/\x1E$//; |
$l =~ s/\x1E$//; |
278 |
|
|
279 |
# filter output |
# filter output |
280 |
$l = $self->{'hash_filter'}->($l) if ($self->{'hash_filter'}); |
$l = $self->{'hash_filter'}->($l, $rec_nr) if ($self->{'hash_filter'}); |
281 |
|
|
282 |
my $val; |
my $val; |
283 |
|
|
288 |
if ($l =~ m/\x1F/) { |
if ($l =~ m/\x1F/) { |
289 |
foreach my $t (split(/\x1F/,$l)) { |
foreach my $t (split(/\x1F/,$l)) { |
290 |
next if (! $t); |
next if (! $t); |
291 |
|
my $f = substr($t,0,1); |
292 |
|
# repeatable subfileds. When we hit first one, |
293 |
|
# store CURRENT (up to that) in first repetition |
294 |
|
# of this record. Then, new record with same |
295 |
|
# identifiers will be created. |
296 |
|
if ($val->{$f}) { |
297 |
|
push @{$rec->{$rec_nr}}, $val; |
298 |
|
$val = { |
299 |
|
i1 => $val->{i1}, |
300 |
|
i2 => $val->{i2}, |
301 |
|
}; |
302 |
|
} |
303 |
$val->{substr($t,0,1)} = substr($t,1); |
$val->{substr($t,0,1)} = substr($t,1); |
304 |
} |
} |
305 |
} else { |
} else { |
306 |
$val = $l; |
$val = $l; |
307 |
} |
} |
308 |
|
|
309 |
push @{$rec->{$k}}, $val; |
push @{$rec->{$rec_nr}}, $val; |
310 |
} |
} |
311 |
} |
} |
312 |
|
|