WebPAC/Input/MARC.pm

package WebPAC::Input::MARC;

use warnings;
use strict;

use MARC::Fast;
use base qw/WebPAC::Common/;
use Carp qw/confess/;

=head1 NAME

WebPAC::Input::MARC - support for MARC database files

=head1 VERSION

Version 0.09

=cut

our $VERSION = '0.09';


=head1 SYNOPSIS

Open USMARC, Unimarc or any other file format that has same internal
structure using C<MARC::Fast>.

 my $marc = new WebPAC::Input::MARC(
        path => '/path/to/marc.iso'
 );

=head1 FUNCTIONS

=head2 new

Returns new low-level input API object

  my $marc = new WebPAC::Input::MARC(
        path => '/path/to/marc.iso',
  }

=cut

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        my $arg = {@_};

        my $log = $self->_get_logger();

        $log->info("opening MARC database '$arg->{path}'");

        die "no filter support any more!" if $arg->{filter};

        my $db = new MARC::Fast(
                marcdb => $arg->{path},
                hash_filter => sub {
                        my ( $l, $nr ) = @_;
                        Encode::decode( 'utf-8', $l );
                },
        );
        my $db_size = $db->count - 1;   # FIXME

        $self->{_marc_size} = $db_size;
        $self->{_marc_db} = $db;

        $self ? return $self : return undef;
}

=head2 fetch_rec

Return record with ID C<$mfn> from database

  my $rec = $self->fetch_rec( $mfn );

=cut

sub fetch_rec {
        my $self = shift;

        my $mfn = shift;

        if ($mfn > $self->{_marc_size}) {
                $self->_get_logger()->warn("seek beyond database size $self->{_marc_size} to $mfn");
        } else {
                my $marc = $self->{_marc_db} || confess "no _marc_db?";
                my $row = $marc->to_hash($mfn, include_subfields => 1);
                push @{$row->{'000'}}, $mfn;
                push @{$row->{'leader'}}, $marc->last_leader;
                return $row;
        }
}

=head2 dump_ascii

Return ASCII dump of record with ID C<$mfn> from database

  print $self->dump_ascii( $mfn );

=cut

sub dump_ascii {
        my $self = shift;

        my $mfn = shift;
        return $self->{_marc_db}->to_ascii($mfn);
}

=head2 size

Return number of records in database

  my $size = $isis->size;

=cut

sub size {
        my $self = shift;
        return $self->{_marc_size};
}


=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of WebPAC::Input::MARC
1	dpavlin	289	package WebPAC::Input::MARC;
2
3			use warnings;
4			use strict;
5
6	dpavlin	1110	use MARC::Fast;
7	dpavlin	726	use base qw/WebPAC::Common/;
8	dpavlin	908	use Carp qw/confess/;
9	dpavlin	289
10			=head1 NAME
11
12			WebPAC::Input::MARC - support for MARC database files
13
14			=head1 VERSION
15
16	dpavlin	908	Version 0.09
17	dpavlin	289
18			=cut
19
20	dpavlin	908	our $VERSION = '0.09';
21	dpavlin	289
22
23			=head1 SYNOPSIS
24
25			Open USMARC, Unimarc or any other file format that has same internal
26			structure using C<MARC::Fast>.
27
28	dpavlin	726	my $marc = new WebPAC::Input::MARC(
29			path => '/path/to/marc.iso'
30			);
31	dpavlin	289
32			=head1 FUNCTIONS
33
34	dpavlin	726	=head2 new
35	dpavlin	289
36	dpavlin	726	Returns new low-level input API object
37	dpavlin	289
38	dpavlin	726	my $marc = new WebPAC::Input::MARC(
39	dpavlin	416	path => '/path/to/marc.iso',
40	dpavlin	289	}
41
42			=cut
43
44	dpavlin	726	sub new {
45			my $class = shift;
46			my $self = {@_};
47			bless($self, $class);
48	dpavlin	289
49			my $arg = {@_};
50
51			my $log = $self->_get_logger();
52
53			$log->info("opening MARC database '$arg->{path}'");
54
55	dpavlin	1327	die "no filter support any more!" if $arg->{filter};
56
57	dpavlin	416	my $db = new MARC::Fast(
58			marcdb => $arg->{path},
59	dpavlin	1327	hash_filter => sub {
60			my ( $l, $nr ) = @_;
61			Encode::decode( 'utf-8', $l );
62			},
63	dpavlin	416	);
64	dpavlin	290	my $db_size = $db->count - 1; # FIXME
65	dpavlin	289
66	dpavlin	337	$self->{_marc_size} = $db_size;
67	dpavlin	652	$self->{_marc_db} = $db;
68	dpavlin	290
69	dpavlin	726	$self ? return $self : return undef;
70	dpavlin	289	}
71
72			=head2 fetch_rec
73
74			Return record with ID C<$mfn> from database
75
76	dpavlin	652	my $rec = $self->fetch_rec( $mfn );
77	dpavlin	289
78			=cut
79
80			sub fetch_rec {
81			my $self = shift;
82
83	dpavlin	652	my $mfn = shift;
84	dpavlin	289
85	dpavlin	337	if ($mfn > $self->{_marc_size}) {
86			$self->_get_logger()->warn("seek beyond database size $self->{_marc_size} to $mfn");
87	dpavlin	290	} else {
88	dpavlin	908	my $marc = $self->{_marc_db} \|\| confess "no _marc_db?";
89	dpavlin	1110	my $row = $marc->to_hash($mfn, include_subfields => 1);
90	dpavlin	291	push @{$row->{'000'}}, $mfn;
91	dpavlin	908	push @{$row->{'leader'}}, $marc->last_leader;
92	dpavlin	290	return $row;
93			}
94	dpavlin	289	}
95
96	dpavlin	774	=head2 dump_ascii
97	dpavlin	772
98	dpavlin	774	Return ASCII dump of record with ID C<$mfn> from database
99	dpavlin	772
100	dpavlin	774	print $self->dump_ascii( $mfn );
101	dpavlin	772
102			=cut
103
104	dpavlin	774	sub dump_ascii {
105	dpavlin	772	my $self = shift;
106
107			my $mfn = shift;
108			return $self->{_marc_db}->to_ascii($mfn);
109			}
110
111	dpavlin	726	=head2 size
112	dpavlin	337
113	dpavlin	726	Return number of records in database
114	dpavlin	337
115	dpavlin	726	my $size = $isis->size;
116	dpavlin	337
117	dpavlin	726	=cut
118	dpavlin	337
119	dpavlin	726	sub size {
120			my $self = shift;
121			return $self->{_marc_size};
122			}
123	dpavlin	337
124
125	dpavlin	289	=head1 AUTHOR
126
127			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
128
129			=head1 COPYRIGHT & LICENSE
130
131			Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
132
133			This program is free software; you can redistribute it and/or modify it
134			under the same terms as Perl itself.
135
136			=cut
137
138			1; # End of WebPAC::Input::MARC