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 (); |
70 |
my $isis = new IsisDB( |
my $isis = new IsisDB( |
71 |
isisdb => './cds/cds', |
isisdb => './cds/cds', |
72 |
read_fdt => 1, |
read_fdt => 1, |
|
debug => 1, |
|
73 |
include_deleted => 1, |
include_deleted => 1, |
74 |
|
hash_filter => sub { |
75 |
|
my $v = shift; |
76 |
|
$v =~ s#foo#bar#g; |
77 |
|
}, |
78 |
|
debug => 1, |
79 |
); |
); |
80 |
|
|
81 |
Options are described below: |
Options are described below: |
92 |
Boolean flag to specify if field definition table should be read. It's off |
Boolean flag to specify if field definition table should be read. It's off |
93 |
by default. |
by default. |
94 |
|
|
|
=item debug |
|
|
|
|
|
Dump a C<lot> of debugging output. |
|
|
|
|
95 |
=item include_deleted |
=item include_deleted |
96 |
|
|
97 |
Don't skip logically deleted records in ISIS. |
Don't skip logically deleted records in ISIS. |
98 |
|
|
99 |
|
=item hash_filter |
100 |
|
|
101 |
|
Filter code ref which will be used before data is converted to hash. |
102 |
|
|
103 |
|
=item debug |
104 |
|
|
105 |
|
Dump a B<lot> of debugging output. |
106 |
|
|
107 |
=back |
=back |
108 |
|
|
109 |
It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database. |
It will also set C<$isis-E<gt>{'maxmfn'}> which is maximum MFN stored in database. |
117 |
|
|
118 |
croak "new needs database name (isisdb) as argument!" unless ({@_}->{isisdb}); |
croak "new needs database name (isisdb) as argument!" unless ({@_}->{isisdb}); |
119 |
|
|
120 |
foreach my $v (qw{isisdb debug include_deleted}) { |
foreach my $v (qw{isisdb debug include_deleted hash_filter}) { |
121 |
$self->{$v} = {@_}->{$v}; |
$self->{$v} = {@_}->{$v}; |
122 |
} |
} |
123 |
|
|
231 |
my $rec = $isis->fetch(55); |
my $rec = $isis->fetch(55); |
232 |
|
|
233 |
Returns hash with keys which are field names and values are unpacked values |
Returns hash with keys which are field names and values are unpacked values |
234 |
for that field. |
for that field (like C<^asometing^bsomething else>) |
235 |
|
|
236 |
=cut |
=cut |
237 |
|
|
386 |
return $out; |
return $out; |
387 |
} |
} |
388 |
|
|
389 |
|
=head2 to_hash |
390 |
|
|
391 |
|
Read mfn and convert it to hash |
392 |
|
|
393 |
|
my $hash = $isis->to_hash($mfn); |
394 |
|
|
395 |
|
It has ability to convert characters (using C<hash_filter> from ISIS |
396 |
|
database before creating structures enabling character remapping or quick |
397 |
|
fixup of data. |
398 |
|
|
399 |
|
This function returns hash which is like this: |
400 |
|
|
401 |
|
$hash = { |
402 |
|
'210' => [ |
403 |
|
{ |
404 |
|
'c' => 'New York University press', |
405 |
|
'a' => 'New York', |
406 |
|
'd' => 'cop. 1988' |
407 |
|
} |
408 |
|
], |
409 |
|
'990' => [ |
410 |
|
'2140', |
411 |
|
'88', |
412 |
|
'HAY' |
413 |
|
], |
414 |
|
}; |
415 |
|
|
416 |
|
You can later use that has to produce any output from ISIS data. |
417 |
|
|
418 |
|
=cut |
419 |
|
|
420 |
|
sub to_hash { |
421 |
|
my $self = shift; |
422 |
|
|
423 |
|
my $mfn = shift || confess "need mfn!"; |
424 |
|
|
425 |
|
my $rec; |
426 |
|
my $row = $self->fetch($mfn); |
427 |
|
|
428 |
|
foreach my $k (keys %{$row}) { |
429 |
|
foreach my $l (@{$row->{$k}}) { |
430 |
|
|
431 |
|
# filter output |
432 |
|
$l = $self->{'hash_filter'}->($l) if ($self->{'hash_filter'}); |
433 |
|
|
434 |
|
# has subfields? |
435 |
|
my $val; |
436 |
|
if ($l =~ m/\^/) { |
437 |
|
foreach my $t (split(/\^/,$l)) { |
438 |
|
next if (! $t); |
439 |
|
$val->{substr($t,0,1)} = substr($t,1); |
440 |
|
} |
441 |
|
} else { |
442 |
|
$val = $l; |
443 |
|
} |
444 |
|
|
445 |
|
push @{$rec->{$k}}, $val; |
446 |
|
} |
447 |
|
} |
448 |
|
|
449 |
|
return $rec; |
450 |
|
} |
451 |
|
|
452 |
# |
# |
453 |
# XXX porting from php left-over: |
# XXX porting from php left-over: |
454 |
# |
# |