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.03; |
$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 (); |
43 |
debug => 0, |
debug => 0, |
44 |
assert => 0, |
assert => 0, |
45 |
hash_filter => sub { |
hash_filter => sub { |
46 |
my $t = shift; |
my ($t, $record_number) = @_; |
47 |
$t =~ s/foo/bar/; |
$t =~ s/foo/bar/; |
48 |
return $t; |
return $t; |
49 |
}, |
}, |
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 |
|
|
294 |
# of this record. Then, new record with same |
# of this record. Then, new record with same |
295 |
# identifiers will be created. |
# identifiers will be created. |
296 |
if ($val->{$f}) { |
if ($val->{$f}) { |
297 |
push @{$rec->{$k}}, $val; |
push @{$rec->{$rec_nr}}, $val; |
298 |
$val = { |
$val = { |
299 |
i1 => $val->{i1}, |
i1 => $val->{i1}, |
300 |
i2 => $val->{i2}, |
i2 => $val->{i2}, |
306 |
$val = $l; |
$val = $l; |
307 |
} |
} |
308 |
|
|
309 |
push @{$rec->{$k}}, $val; |
push @{$rec->{$rec_nr}}, $val; |
310 |
} |
} |
311 |
} |
} |
312 |
|
|