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         input_encoding
  14 ));
  15
  16 use Encode;
  17 use Data::Dump qw/dump/;
  18 use DBI;
  19 use File::Slurp;
  20
  21 =head1 NAME
  22
  23 WebPAC::Input::DBI - read data from RDBMS using DBI
  24
  25 =cut
  26
  27 =head1 FUNCTIONS
  28
  29 =head2 new
  30
  31   my $input = new WebPAC::Input::DBI(
  32         dsn => 'dbi:SQLite:dbname=/dev/shm/test.sqlite',
  33         user => '',
  34         passwd => '',
  35         path => '/path/to.sql',
  36   );
  37
  38 =back
  39
  40 =cut
  41
  42 sub new {
  43         my $class = shift;
  44         my $self = {@_};
  45         bless($self, $class);
  46
  47         my $arg = {@_};
  48
  49         my $sql = read_file $self->path;
  50
  51         my $log = $self->_get_logger;
  52         $log->debug( "args: ", sub { dump($arg) } );
  53
  54         my $dbh = DBI->connect( $self->dsn, $self->user, $self->passwd, { RaiseError => 1 } );
  55
  56         if ( my $db_encoding = $arg->{encoding} ) {
  57                 $self->debug("encoding $db_encoding");
  58                 my $dsn = $self->dsn;
  59                 if ( $dsn =~ m{Pg} ) {
  60                         $dbh->do( qq{ set client_encoding = '$db_encoding'; } );
  61                         $dbh->{pg_enable_utf8} = 1; # force utf-8 encoding for SQL_ASCII databases
  62                 } elsif ( $dsn =~ m{mysql} ) {
  63                         $dbh->do( qq{ set names '$db_encoding'; } );
  64                 } elsif ( $dsn =~ m{SQLite} ) {
  65                         $dbh->{sqlite_unicode} = 1;
  66                 } else {
  67                         warn "Don't know how to set encoding to $db_encoding for $dsn";
  68                 }
  69         }
  70
  71         $log->debug( "sql ",$self->path, "\n", $sql );
  72
  73         my $sth = $dbh->prepare( $sql );
  74         $sth->execute;
  75
  76         # XXX this should really be in fetch_rec, but DBD::SQLite doesn't return
  77         # $sth->rows correctly, and we really need number of rows...
  78         $self->{size} = 0;
  79
  80         while ( my $row = $sth->fetchrow_hashref ) {
  81                 push @{ $self->{_rec} }, $row;
  82                 $self->{size}++;
  83         }
  84
  85         $log->info( $self->dsn, " query produced ", $self->size, " records");
  86
  87         $self ? return $self : return undef;
  88 }
  89
  90 =head2 fetch_rec
  91
  92 Return record with ID C<$mfn> from database
  93
  94   my $rec = $input->fetch_rec( $mfn, $filter_coderef );
  95
  96 =cut
  97
  98 sub fetch_rec {
  99         my ( $self, $mfn, $filter_coderef ) = @_;
 100         my $log = $self->_get_logger;
 101
 102         my $rec = { '000' => [ $mfn ] };
 103         my $row = $self->{_rec}->[$mfn-1] || die "no record $mfn";
 104         foreach my $c ( keys %$row ) {
 105                 $rec->{$c} = [ $row->{$c} ];
 106         }
 107         $log->debug("fetch_rec ",sub { dump($rec) });
 108         return $rec;
 109 }
 110
 111
 112 =head2 size
 113
 114 Return number of records in database
 115
 116   my $size = $input->size;
 117
 118 =cut
 119
 120 sub size {
 121         my $self = shift;
 122         return $self->{size};
 123 }
 124
 125 =head1 AUTHOR
 126
 127 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 128
 129 =head1 COPYRIGHT & LICENSE
 130
 131 Copyright 2011 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::DBI