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

   1 package WebPAC::Input::DBI;
   2
   3 use warnings;
   4 use strict;
   5
   6 use WebPAC::Input;
   7 use base qw/WebPAC::Common Class::Accessor/;
   8 __PACKAGE__->mk_accessors(qw(
   9         dsn
  10         user
  11         passwd
  12         path
  13 ));
  14
  15 use Encode;
  16 use Data::Dump qw/dump/;
  17 use DBI;
  18 use File::Slurp;
  19
  20 =head1 NAME
  21
  22 WebPAC::Input::DBI - read data from RDBMS using DBI
  23
  24 =cut
  25
  26 =head1 FUNCTIONS
  27
  28 =head2 new
  29
  30   my $input = new WebPAC::Input::DBI(
  31         dsn => 'dbi:SQLite:dbname=/dev/shm/test.sqlite',
  32         user => '',
  33         passwd => '',
  34         path => '/path/to.sql',
  35   );
  36
  37 =back
  38
  39 =cut
  40
  41 sub new {
  42         my $class = shift;
  43         my $self = {@_};
  44         bless($self, $class);
  45
  46         my $arg = {@_};
  47
  48         my $sql = read_file $self->path;
  49
  50         my $log = $self->_get_logger;
  51         $log->debug( "dsn: ", $self->dsn );
  52
  53         my $dbh = DBI->connect( $self->dsn, $self->user, $self->passwd, { RaiseError => 1 } );
  54
  55         $log->debug( "sql ",$self->path, "\n", $sql );
  56
  57         my $sth = $dbh->prepare( $sql );
  58         $sth->execute;
  59
  60         # XXX this should really be in fetch_rec, but DBD::SQLite doesn't return
  61         # $sth->rows correctly, and we really need number of rows...
  62         $self->{size} = 0;
  63
  64         while ( my $row = $sth->fetchrow_hashref ) {
  65                 push @{ $self->{_rec} }, $row;
  66                 $self->{size}++;
  67         }
  68
  69         $log->info( $self->dsn, " query produced ", $self->size, " records");
  70
  71         $self ? return $self : return undef;
  72 }
  73
  74 =head2 fetch_rec
  75
  76 Return record with ID C<$mfn> from database
  77
  78   my $rec = $input->fetch_rec( $mfn, $filter_coderef );
  79
  80 =head3 FIXME
  81
  82 Records are always returned sequentially, ignoring C<$mfn> and filter
  83
  84 =cut
  85
  86 sub fetch_rec {
  87         my ( $self, $mfn, $filter_coderef ) = @_;
  88
  89         my $rec = { '000' => [ $mfn ] };
  90         my $row = $self->{_rec}->[$mfn-1] || die "no record $mfn";
  91         foreach my $c ( keys %$row ) {
  92                 $rec->{$c} = [ $row->{$c} ];
  93         }
  94         return $rec;
  95 }
  96
  97
  98 =head2 size
  99
 100 Return number of records in database
 101
 102   my $size = $input->size;
 103
 104 =cut
 105
 106 sub size {
 107         my $self = shift;
 108         return $self->{size};
 109 }
 110
 111 =head1 AUTHOR
 112
 113 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 114
 115 =head1 COPYRIGHT & LICENSE
 116
 117 Copyright 2011 Dobrica Pavlinusic, All Rights Reserved.
 118
 119 This program is free software; you can redistribute it and/or modify it
 120 under the same terms as Perl itself.
 121
 122 =cut
 123
 124 1; # End of WebPAC::Input::DBI