WebPAC/Output/DBI.pm

package WebPAC::Output::DBI;

use warnings;
use strict;

use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
__PACKAGE__->mk_accessors(qw(
        input

        dsn
        user
        passwd

        schema

        table

        no_transaction
));

use Data::Dump qw/dump/;
use DBI;
use File::Slurp;

=head1 NAME

WebPAC::Output::DBI - feed data into RDBMS via DBI

=head1 FUNCTIONS

=head2 init

  $out->init;

=cut

sub init {
        my $self = shift;
        my $log = $self->_get_logger;

        $log->info($self->dsn);

        $self->{_sth} = {};

        $self->{_dbh} = DBI->connect( $self->dsn, $self->user, $self->passwd, { RaiseError => 1 } );

        $self->{_dbh}->begin_work unless $self->no_transaction;

        if ( -e $self->schema ) {
                foreach my $sql ( split(/;/, scalar read_file( $self->schema )) ) {
                        $log->debug( $sql );
                        eval { $self->{_dbh}->do( $sql ); };
                }
        }

        return 1;
}


=head2 add

Adds one entry to database.

  $out->add( 42, $ds );

=cut

sub add {
        my $self = shift;

        my ( $id, $ds ) = @_;

        return unless defined $ds->{_rows};

        my $log = $self->_get_logger;

        $id = $self->input . '-' . $id if $self->input;

        foreach my $table ( keys %{ $ds->{_rows} } ) {

                my @rows = @{ $ds->{_rows}->{$table} };
                foreach my $row ( @rows ) {

                        my @cols = sort keys %$row;

                        my $sth_id = $table . ':' . join(',',@cols);

                        my $sth
                                = $self->{_sth}->{$sth_id}
                                ;
                        
                        if ( ! $sth ) {

                                my $sql = join( ''
                                        , 'insert into '
                                        , $table
                                        . ' (' . join(',', @cols), ')'
                                        , ' values ('
                                        , join(',', map { '?' } 0 .. $#cols )
                                        , ')'
                                );

                                $log->debug( "SQL $sth_id: $sql" );

                                $sth
                                        = $self->{_sth}->{$sth_id}
                                        = $self->{_dbh}->prepare( $sql )
                                        ;
                        };

                        $log->debug( "row $table ", sub { dump( $row ) } );
                        $sth->execute( map { $row->{$_} } @cols );
        
                }
        }

        return 1;
}

=head2 finish

 $out->finish;

=cut

sub finish {
        my $self = shift;

        my $log = $self->_get_logger();

        $log->info('finish');

        unless ( $self->no_transaction ) {
                $self->{_dbh}->commit;
                $log->info('commit done');
        }

        return 1;
}

=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; # End of WebPAC::Output::CouchDB
1	dpavlin	1207	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	dpavlin	1344
18			no_transaction
19	dpavlin	1207	));
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	dpavlin	1210	$self->{_sth} = {};
44	dpavlin	1207
45			$self->{_dbh} = DBI->connect( $self->dsn, $self->user, $self->passwd, { RaiseError => 1 } );
46
47	dpavlin	1344	$self->{_dbh}->begin_work unless $self->no_transaction;
48	dpavlin	1212
49	dpavlin	1211	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	dpavlin	1207
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	dpavlin	1210	foreach my $table ( keys %{ $ds->{_rows} } ) {
80	dpavlin	1207
81	dpavlin	1210	my @rows = @{ $ds->{_rows}->{$table} };
82			foreach my $row ( @rows ) {
83	dpavlin	1207
84	dpavlin	1210	my @cols = sort keys %$row;
85	dpavlin	1207
86	dpavlin	1210	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	dpavlin	1207	}
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	dpavlin	1211	$log->info('finish');
132	dpavlin	1207
133	dpavlin	1344	unless ( $self->no_transaction ) {
134			$self->{_dbh}->commit;
135			$log->info('commit done');
136			}
137	dpavlin	1207
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