4 |
use Carp; |
use Carp; |
5 |
use File::Glob qw(:globally :nocase); |
use File::Glob qw(:globally :nocase); |
6 |
|
|
|
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.13; |
$VERSION = 0.20; |
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 (); |
117 |
|
|
118 |
=item debug |
=item debug |
119 |
|
|
120 |
Dump a B<lot> of debugging output. |
Dump a B<lot> of debugging output even at level 1. For even more increase level. |
121 |
|
|
122 |
=back |
=back |
123 |
|
|
151 |
} |
} |
152 |
} |
} |
153 |
|
|
154 |
print STDERR "## using files: ",join(" ",@isis_files),"\n" if ($self->{debug}); |
if ($self->{debug}) { |
155 |
|
print STDERR "## using files: ",join(" ",@isis_files),"\n"; |
156 |
|
eval "use Data::Dump"; |
157 |
|
|
158 |
|
if (! $@) { |
159 |
|
*Dumper = *Data::Dump::dump; |
160 |
|
} else { |
161 |
|
use Data::Dumper; |
162 |
|
} |
163 |
|
} |
164 |
|
|
165 |
# if you want to read .FDT file use read_fdt argument when creating class! |
# if you want to read .FDT file use read_fdt argument when creating class! |
166 |
if ($self->{read_fdt} && -e $self->{fdt_file}) { |
if ($self->{read_fdt} && -e $self->{fdt_file}) { |
209 |
read($self->{'fileMST'}, $buff, 4) || croak "can't read NXTMFN from MST: $!"; |
read($self->{'fileMST'}, $buff, 4) || croak "can't read NXTMFN from MST: $!"; |
210 |
$self->{'NXTMFN'}=unpack("V",$buff) || croak "NXTNFN is zero"; |
$self->{'NXTMFN'}=unpack("V",$buff) || croak "NXTNFN is zero"; |
211 |
|
|
212 |
print STDERR Dumper($self),"\n" if ($self->{debug}); |
print STDERR "## self ",Dumper($self),"\n" if ($self->{debug}); |
213 |
|
|
214 |
# open files for later |
# open files for later |
215 |
open($self->{'fileXRF'}, $self->{xrf_file}) || croak "can't open '$self->{xrf_file}': $!"; |
open($self->{'fileXRF'}, $self->{xrf_file}) || croak "can't open '$self->{xrf_file}': $!"; |
385 |
return $self->{'record'}; |
return $self->{'record'}; |
386 |
} |
} |
387 |
|
|
388 |
|
=head2 mfn |
389 |
|
|
390 |
|
Returns current MFN position |
391 |
|
|
392 |
|
my $mfn = $isis->mfn; |
393 |
|
|
394 |
|
=cut |
395 |
|
|
396 |
|
# This function should be simple return $self->{current_mfn}, |
397 |
|
# but if new is called with _hack_mfn it becomes setter. |
398 |
|
# It's useful in tests when setting $isis->{record} directly |
399 |
|
|
400 |
|
sub mfn { |
401 |
|
my $self = shift; |
402 |
|
return $self->{current_mfn}; |
403 |
|
}; |
404 |
|
|
405 |
|
|
406 |
=head2 to_ascii |
=head2 to_ascii |
407 |
|
|
408 |
Returns ASCII output of record with specified MFN |
Returns ASCII output of record with specified MFN |
482 |
} |
} |
483 |
], |
], |
484 |
|
|
485 |
|
In case there are repeatable subfields in record, this will create |
486 |
|
following structure: |
487 |
|
|
488 |
|
'900' => [ { |
489 |
|
'a' => [ 'foo', 'bar', 'baz' ], |
490 |
|
}] |
491 |
|
|
492 |
This method will also create additional field C<000> with MFN. |
This method will also create additional field C<000> with MFN. |
493 |
|
|
494 |
=cut |
=cut |
507 |
foreach my $l (@{$row->{$k}}) { |
foreach my $l (@{$row->{$k}}) { |
508 |
|
|
509 |
# filter output |
# filter output |
510 |
$l = $self->{'hash_filter'}->($l) if ($self->{'hash_filter'}); |
if ($self->{'hash_filter'}) { |
511 |
|
$l = $self->{'hash_filter'}->($l); |
512 |
|
next unless defined($l); |
513 |
|
} |
514 |
|
|
515 |
my $val; |
my $val; |
516 |
|
|
521 |
if ($l =~ m/\^/) { |
if ($l =~ m/\^/) { |
522 |
foreach my $t (split(/\^/,$l)) { |
foreach my $t (split(/\^/,$l)) { |
523 |
next if (! $t); |
next if (! $t); |
524 |
$val->{substr($t,0,1)} = substr($t,1); |
my ($sf,$v) = (substr($t,0,1), substr($t,1)); |
525 |
|
# FIXME make this option ! |
526 |
|
next unless ($v); |
527 |
|
# warn "### $k^$sf:$v",$/ if ($self->{debug} > 1); |
528 |
|
|
529 |
|
# FIXME array return optional, by default unroll to ' ; ' |
530 |
|
if (ref( $val->{$sf} ) eq 'ARRAY') { |
531 |
|
|
532 |
|
push @{ $val->{$sf} }, $v; |
533 |
|
} elsif (defined( $val->{$sf} )) { |
534 |
|
# convert scalar field to array |
535 |
|
$val->{$sf} = [ $val->{$sf}, $v ]; |
536 |
|
} else { |
537 |
|
$val->{$sf} = $v; |
538 |
|
} |
539 |
} |
} |
540 |
} else { |
} else { |
541 |
$val = $l; |
$val = $l; |
654 |
tested this against ouput of one C<isis.dll>-based application, but I don't |
tested this against ouput of one C<isis.dll>-based application, but I don't |
655 |
know any details about it's version. |
know any details about it's version. |
656 |
|
|
657 |
|
=head1 VERSIONS |
658 |
|
|
659 |
|
You can find version dependencies documented here |
660 |
|
|
661 |
|
=over 8 |
662 |
|
|
663 |
|
=item 0.20 |
664 |
|
|
665 |
|
Added C<< $isis->mfn >> and support for repeatable subfields |
666 |
|
|
667 |
|
=back |
668 |
|
|
669 |
=head1 AUTHOR |
=head1 AUTHOR |
670 |
|
|
671 |
Dobrica Pavlinusic |
Dobrica Pavlinusic |