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.03';

=head1 FUNCTIONS

=head2 new

  my $input = new WebPAC::Input::Koha(
        dsn    => $ENV{KOHA_DSN}, # 'dbi:mysql:database=koha;host=koha.example.com',
        user   => $ENV{KOHA_USER},
        passwd => $ENV{KOHA_PASSWD},
  }

=cut

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

        my $arg = {@_};

        my $log = $self->_get_logger();
        $log->debug( 'arg = ', dump($arg) );

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

                $arg->{dsn}    ||= $ENV{KOHA_DSN};
                $arg->{user}   ||= $ENV{KOHA_USER};
                $arg->{passwd} ||= $ENV{KOHA_PASSWD};
                $arg->{sql}    ||= 'select biblionumber, marc from biblioitems order by biblionumber asc';
                $arg->{sql}    .= ' limit ' . $arg->{limit} if $arg->{limit};
                $arg->{sql}    .= ' offset ' . $arg->{offset} if $arg->{offset};

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

                $self->{_dbh} = DBI->connect( $arg->{dsn}, $arg->{user}, $arg->{passwd}, {
                        RaiseError => 1,
                        #mysql_enable_utf8 => 1, # not really needed
                } );
                $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;

        sub _error {
                my ( $mfn, $error, $row ) = @_;
                $self->_get_logger()->error( "MFN $mfn $error ", dump($row) );
        }

        if ( my $fh = $self->{_koha_fh} ) {
                if ( my $marc = $row->{marc} ) {
                        if ( length($marc) != substr( $marc, 0, 5 ) ) {
                                _error $mfn => "wrong length " . length($marc), $row;
                        } elsif ( $marc !~ /\x1E\x1D$/ ) {
                                _error $mfn => "wrong end", $row;
                        } else {
                                print $fh $marc;
                        }
                } else {
                        _error $mfn => "no marc",$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} + $self->{offset};
}


=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	dpavlin	1365	our $VERSION = '0.03';
19	dpavlin	1231
20			=head1 FUNCTIONS
21
22			=head2 new
23
24			my $input = new WebPAC::Input::Koha(
25	dpavlin	1365	dsn => $ENV{KOHA_DSN}, # 'dbi:mysql:database=koha;host=koha.example.com',
26	dpavlin	1325	user => $ENV{KOHA_USER},
27			passwd => $ENV{KOHA_PASSWD},
28	dpavlin	1231	}
29
30			=cut
31
32			sub new {
33			my $class = shift;
34			my $self = {@_};
35			bless($self, $class);
36
37			my $arg = {@_};
38
39			my $log = $self->_get_logger();
40	dpavlin	1325	$log->debug( 'arg = ', dump($arg) );
41	dpavlin	1231
42	dpavlin	1234	if ( -e $arg->{path} ) {
43			$log->info("Koha marc dump ", $arg->{path}, " exists");
44			$self->{_koha_size} = 0;
45			} else {
46	dpavlin	1231
47	dpavlin	1365	$arg->{dsn} \|\|= $ENV{KOHA_DSN};
48	dpavlin	1276	$arg->{user} \|\|= $ENV{KOHA_USER};
49	dpavlin	1365	$arg->{passwd} \|\|= $ENV{KOHA_PASSWD};
50	dpavlin	1326	$arg->{sql} \|\|= 'select biblionumber, marc from biblioitems order by biblionumber asc';
51	dpavlin	1325	$arg->{sql} .= ' limit ' . $arg->{limit} if $arg->{limit};
52			$arg->{sql} .= ' offset ' . $arg->{offset} if $arg->{offset};
53	dpavlin	1276
54	dpavlin	1234	$log->info("opening Koha database '$arg->{dsn}'");
55	dpavlin	1231
56	dpavlin	1326	$self->{_dbh} = DBI->connect( $arg->{dsn}, $arg->{user}, $arg->{passwd}, {
57			RaiseError => 1,
58			#mysql_enable_utf8 => 1, # not really needed
59			} );
60	dpavlin	1234	$self->{_sth} = $self->{_dbh}->prepare( $arg->{sql} );
61			$self->{_sth}->execute;
62			$self->{_koha_size} = $self->{_sth}->rows;
63	dpavlin	1231
64	dpavlin	1234	warn "got ", $self->{_koha_size}, " rows for ", $arg->{sql};
65	dpavlin	1231
66	dpavlin	1234	open( $self->{_koha_fh}, '>', $arg->{path} ) \|\| die "can't create $arg->{path}: $!";
67
68			}
69
70	dpavlin	1231	$self ? return $self : return undef;
71			}
72
73			=head2 fetch_rec
74
75			Return record with ID C<$mfn> from database
76
77			my $rec = $input->fetch_rec( $mfn );
78
79			=cut
80
81			sub fetch_rec {
82			my $self = shift;
83
84			my $mfn = shift;
85
86			my $row = $self->{_sth}->fetchrow_hashref;
87
88	dpavlin	1326	sub _error {
89			my ( $mfn, $error, $row ) = @_;
90			$self->_get_logger()->error( "MFN $mfn $error ", dump($row) );
91			}
92
93	dpavlin	1231	if ( my $fh = $self->{_koha_fh} ) {
94	dpavlin	1232	if ( my $marc = $row->{marc} ) {
95	dpavlin	1326	if ( length($marc) != substr( $marc, 0, 5 ) ) {
96			_error $mfn => "wrong length " . length($marc), $row;
97			} elsif ( $marc !~ /\x1E\x1D$/ ) {
98			_error $mfn => "wrong end", $row;
99			} else {
100			print $fh $marc;
101			}
102	dpavlin	1232	} else {
103	dpavlin	1326	_error $mfn => "no marc",$row;
104	dpavlin	1232	}
105	dpavlin	1231	}
106
107			push @{$row->{'000'}}, $mfn;
108			return $row;
109			}
110
111			=head2 size
112
113			Return number of records in database
114
115			my $size = $isis->size;
116
117			=cut
118
119			sub size {
120			my $self = shift;
121	dpavlin	1325	return $self->{_koha_size} + $self->{offset};
122	dpavlin	1231	}
123
124
125			=head1 AUTHOR
126
127			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
128
129			=head1 COPYRIGHT & LICENSE
130
131			Copyright 2009 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;