WebPAC/Input/Koha.pm

package WebPAC::Input::Koha;

use warnings;
use strict;

use DBI;
use MARC::Fast;
use base qw/WebPAC::Common/;
use Carp qw/confess/;
use Data::Dump qw/dump/;

=head1 NAME

WebPAC::Input::Koha - read MARC records from Koha

=cut

our $VERSION = '0.01';

=head1 FUNCTIONS

=head2 new

  my $input = new WebPAC::Input::Koha(
        dsn => '',
        filter => \&code_ref,
  }

=cut

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

        my $arg = {@_};

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

        if ( -e $arg->{path} ) {
                $log->info("Koha marc dump ", $arg->{path}, " exists");
                $self->{_koha_size} = 0;
        } else {

                $arg->{dsn}    ||= 'dbi:mysql:database=koha';
                $arg->{user}   ||= $ENV{KOHA_USER};
                $arg->{passwd} ||= $ENV{KOHA_PASSWD},
                $arg->{sql}    ||= 'select biblioitemnumber as mfn, marc from biblioitems';

                $log->info("opening Koha database '$arg->{dsn}'");

                $self->{_dbh} = DBI->connect( $arg->{dsn}, $arg->{user}, $arg->{passwd}, { RaiseError => 1 } );
                $self->{_sth} = $self->{_dbh}->prepare( $arg->{sql} );
                $self->{_sth}->execute;
                $self->{_koha_size} = $self->{_sth}->rows;

                warn "got ", $self->{_koha_size}, " rows for ", $arg->{sql};

                open( $self->{_koha_fh}, '>', $arg->{path} ) || die "can't create $arg->{path}: $!";

        }

        $self ? return $self : return undef;
}

=head2 fetch_rec

Return record with ID C<$mfn> from database

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

=cut

sub fetch_rec {
        my $self = shift;

        my $mfn = shift;

        my $row = $self->{_sth}->fetchrow_hashref;

        if ( my $fh = $self->{_koha_fh} ) {
                if ( my $marc = $row->{marc} ) {
                        print $fh $marc;
                } else {
                        warn "MFN $mfn no marc in ",dump($row);
                }
        }

        push @{$row->{'000'}}, $mfn;
        return $row;
}

=head2 size

Return number of records in database

  my $size = $isis->size;

=cut

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


=head1 AUTHOR

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

=head1 COPYRIGHT & LICENSE

Copyright 2009 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;
1	dpavlin	1231	package WebPAC::Input::Koha;
2
3			use warnings;
4			use strict;
5
6			use DBI;
7			use MARC::Fast;
8			use base qw/WebPAC::Common/;
9			use Carp qw/confess/;
10	dpavlin	1232	use Data::Dump qw/dump/;
11	dpavlin	1231
12			=head1 NAME
13
14			WebPAC::Input::Koha - read MARC records from Koha
15
16			=cut
17
18			our $VERSION = '0.01';
19
20			=head1 FUNCTIONS
21
22			=head2 new
23
24			my $input = new WebPAC::Input::Koha(
25			dsn => '',
26			filter => \&code_ref,
27			}
28
29			=cut
30
31			sub new {
32			my $class = shift;
33			my $self = {@_};
34			bless($self, $class);
35
36			my $arg = {@_};
37
38			my $log = $self->_get_logger();
39
40	dpavlin	1234	if ( -e $arg->{path} ) {
41			$log->info("Koha marc dump ", $arg->{path}, " exists");
42			$self->{_koha_size} = 0;
43			} else {
44	dpavlin	1231
45	dpavlin	1276	$arg->{dsn} \|\|= 'dbi:mysql:database=koha';
46			$arg->{user} \|\|= $ENV{KOHA_USER};
47			$arg->{passwd} \|\|= $ENV{KOHA_PASSWD},
48			$arg->{sql} \|\|= 'select biblioitemnumber as mfn, marc from biblioitems';
49
50	dpavlin	1234	$log->info("opening Koha database '$arg->{dsn}'");
51	dpavlin	1231
52	dpavlin	1234	$self->{_dbh} = DBI->connect( $arg->{dsn}, $arg->{user}, $arg->{passwd}, { RaiseError => 1 } );
53			$self->{_sth} = $self->{_dbh}->prepare( $arg->{sql} );
54			$self->{_sth}->execute;
55			$self->{_koha_size} = $self->{_sth}->rows;
56	dpavlin	1231
57	dpavlin	1234	warn "got ", $self->{_koha_size}, " rows for ", $arg->{sql};
58	dpavlin	1231
59	dpavlin	1234	open( $self->{_koha_fh}, '>', $arg->{path} ) \|\| die "can't create $arg->{path}: $!";
60
61			}
62
63	dpavlin	1231	$self ? return $self : return undef;
64			}
65
66			=head2 fetch_rec
67
68			Return record with ID C<$mfn> from database
69
70			my $rec = $input->fetch_rec( $mfn );
71
72			=cut
73
74			sub fetch_rec {
75			my $self = shift;
76
77			my $mfn = shift;
78
79			my $row = $self->{_sth}->fetchrow_hashref;
80
81			if ( my $fh = $self->{_koha_fh} ) {
82	dpavlin	1232	if ( my $marc = $row->{marc} ) {
83			print $fh $marc;
84			} else {
85			warn "MFN $mfn no marc in ",dump($row);
86			}
87	dpavlin	1231	}
88
89			push @{$row->{'000'}}, $mfn;
90			return $row;
91			}
92
93			=head2 size
94
95			Return number of records in database
96
97			my $size = $isis->size;
98
99			=cut
100
101			sub size {
102			my $self = shift;
103	dpavlin	1234	return $self->{_koha_size};
104	dpavlin	1231	}
105
106
107			=head1 AUTHOR
108
109			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
110
111			=head1 COPYRIGHT & LICENSE
112
113			Copyright 2009 Dobrica Pavlinusic, All Rights Reserved.
114
115			This program is free software; you can redistribute it and/or modify it
116			under the same terms as Perl itself.
117
118			=cut
119
120			1;