|
|
|
1 |
package MARC::Fast; |
package MARC::Fast; |
2 |
|
|
3 |
use strict; |
use strict; |
4 |
use Carp; |
use Carp; |
5 |
use Data::Dumper; |
use Data::Dumper; |
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.07; |
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 |
|
|
313 |
return $rec; |
return $rec; |
314 |
} |
} |
315 |
|
|
316 |
|
=head2 to_ascii |
317 |
|
|
318 |
1; |
print $marc->to_ascii( 42 ); |
319 |
__END__ |
|
320 |
|
=cut |
321 |
|
|
322 |
=head1 BUGS |
sub to_ascii { |
323 |
|
my $self = shift; |
324 |
|
|
325 |
|
my $mfn = shift || confess "need mfn"; |
326 |
|
my $row = $self->fetch($mfn) || return; |
327 |
|
|
328 |
|
my $out; |
329 |
|
|
330 |
=head1 SUPPORT |
foreach my $f (sort keys %{$row}) { |
331 |
|
my $dump = join('', @{ $row->{$f} }); |
332 |
|
$dump =~ s/\x1e$//; |
333 |
|
$dump =~ s/\x1f/\$/g; |
334 |
|
$out .= "$f\t$dump\n"; |
335 |
|
} |
336 |
|
|
337 |
|
return $out; |
338 |
|
} |
339 |
|
|
340 |
|
1; |
341 |
|
__END__ |
342 |
|
|
343 |
=head1 AUTHOR |
=head1 AUTHOR |
344 |
|
|
358 |
|
|
359 |
=head1 SEE ALSO |
=head1 SEE ALSO |
360 |
|
|
361 |
perl(1). |
L<Biblio::Isis>, perl(1). |
362 |
|
|
363 |
=cut |
=cut |