git.rot13.org Git - webpac2/blob - lib/WebPAC/Input/Koha.pm

   1 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 use Data::Dump qw/dump/;
  11
  12 =head1 NAME
  13
  14 WebPAC::Input::Koha - read MARC records from Koha
  15
  16 =cut
  17
  18 our $VERSION = '0.02';
  19
  20 =head1 FUNCTIONS
  21
  22 =head2 new
  23
  24   my $input = new WebPAC::Input::Koha(
  25         dsn    => 'dbi:mysql:database=koha',
  26         user   => $ENV{KOHA_USER},
  27         passwd => $ENV{KOHA_PASSWD},
  28   }
  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         $log->debug( 'arg = ', dump($arg) );
  41
  42         if ( -e $arg->{path} ) {
  43                 $log->info("Koha marc dump ", $arg->{path}, " exists");
  44                 $self->{_koha_size} = 0;
  45         } else {
  46
  47                 $arg->{dsn}    ||= 'dbi:mysql:database=koha';
  48                 $arg->{user}   ||= $ENV{KOHA_USER};
  49                 $arg->{passwd} ||= $ENV{KOHA_PASSWD},
  50                 $arg->{sql}    ||= 'select biblionumber, marc from biblioitems order by biblionumber asc';
  51                 $arg->{sql}    .= ' limit ' . $arg->{limit} if $arg->{limit};
  52                 $arg->{sql}    .= ' offset ' . $arg->{offset} if $arg->{offset};
  53
  54                 $log->info("opening Koha database '$arg->{dsn}'");
  55
  56                 $self->{_dbh} = DBI->connect( $arg->{dsn}, $arg->{user}, $arg->{passwd}, {
  57                         RaiseError => 1,
  58                         #mysql_enable_utf8 => 1, # not really needed
  59                 } );
  60                 $self->{_sth} = $self->{_dbh}->prepare( $arg->{sql} );
  61                 $self->{_sth}->execute;
  62                 $self->{_koha_size} = $self->{_sth}->rows;
  63
  64                 warn "got ", $self->{_koha_size}, " rows for ", $arg->{sql};
  65
  66                 open( $self->{_koha_fh}, '>', $arg->{path} ) || die "can't create $arg->{path}: $!";
  67
  68         }
  69
  70         $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         sub _error {
  89                 my ( $mfn, $error, $row ) = @_;
  90                 $self->_get_logger()->error( "MFN $mfn $error ", dump($row) );
  91         }
  92
  93         if ( my $fh = $self->{_koha_fh} ) {
  94                 if ( my $marc = $row->{marc} ) {
  95                         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                 } else {
 103                         _error $mfn => "no marc",$row;
 104                 }
 105         }
 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         return $self->{_koha_size} + $self->{offset};
 122 }
 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;