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

   1 package WebPAC::Output::DBI;
   2
   3 use warnings;
   4 use strict;
   5
   6 use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
   7 __PACKAGE__->mk_accessors(qw(
   8         input
   9
  10         dsn
  11         user
  12         passwd
  13
  14         schema
  15
  16         table
  17
  18         no_transaction
  19 ));
  20
  21 use Data::Dump qw/dump/;
  22 use DBI;
  23 use File::Slurp;
  24
  25 =head1 NAME
  26
  27 WebPAC::Output::DBI - feed data into RDBMS via DBI
  28
  29 =head1 FUNCTIONS
  30
  31 =head2 init
  32
  33   $out->init;
  34
  35 =cut
  36
  37 sub init {
  38         my $self = shift;
  39         my $log = $self->_get_logger;
  40
  41         $log->info($self->dsn);
  42
  43         $self->{_sth} = {};
  44
  45         $self->{_dbh} = DBI->connect( $self->dsn, $self->user, $self->passwd, { RaiseError => 1 } );
  46
  47         $self->{_dbh}->begin_work unless $self->no_transaction;
  48
  49         if ( -e $self->schema ) {
  50                 foreach my $sql ( split(/;/, scalar read_file( $self->schema )) ) {
  51                         $log->debug( $sql );
  52                         eval { $self->{_dbh}->do( $sql ); };
  53                 }
  54         }
  55
  56         return 1;
  57 }
  58
  59
  60 =head2 add
  61
  62 Adds one entry to database.
  63
  64   $out->add( 42, $ds );
  65
  66 =cut
  67
  68 sub add {
  69         my $self = shift;
  70
  71         my ( $id, $ds ) = @_;
  72
  73         return unless defined $ds->{_rows};
  74
  75         my $log = $self->_get_logger;
  76
  77         $id = $self->input . '-' . $id if $self->input;
  78
  79         foreach my $table ( keys %{ $ds->{_rows} } ) {
  80
  81                 my @rows = @{ $ds->{_rows}->{$table} };
  82                 foreach my $row ( @rows ) {
  83
  84                         my @cols = sort keys %$row;
  85
  86                         my $sth_id = $table . ':' . join(',',@cols);
  87
  88                         my $sth
  89                                 = $self->{_sth}->{$sth_id}
  90                                 ;
  91
  92                         if ( ! $sth ) {
  93
  94                                 my $sql = join( ''
  95                                         , 'insert into '
  96                                         , $table
  97                                         . ' (' . join(',', @cols), ')'
  98                                         , ' values ('
  99                                         , join(',', map { '?' } 0 .. $#cols )
 100                                         , ')'
 101                                 );
 102
 103                                 $log->debug( "SQL $sth_id: $sql" );
 104
 105                                 $sth
 106                                         = $self->{_sth}->{$sth_id}
 107                                         = $self->{_dbh}->prepare( $sql )
 108                                         ;
 109                         };
 110
 111                         $log->debug( "row $table ", sub { dump( $row ) } );
 112                         $sth->execute( map { $row->{$_} } @cols );
 113
 114                 }
 115         }
 116
 117         return 1;
 118 }
 119
 120 =head2 finish
 121
 122  $out->finish;
 123
 124 =cut
 125
 126 sub finish {
 127         my $self = shift;
 128
 129         my $log = $self->_get_logger();
 130
 131         $log->info('finish');
 132
 133         unless ( $self->no_transaction ) {
 134                 $self->{_dbh}->commit;
 135                 $log->info('commit done');
 136         }
 137
 138         return 1;
 139 }
 140
 141 =head1 AUTHOR
 142
 143 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
 144
 145 =head1 COPYRIGHT & LICENSE
 146
 147 Copyright 2009 Dobrica Pavlinusic, All Rights Reserved.
 148
 149 This program is free software; you can redistribute it and/or modify it
 150 under the same terms as Perl itself.
 151
 152 =cut
 153
 154 1; # End of WebPAC::Output::CouchDB