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
));

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->{_rows} = {};
        $self->{_sth} = {};

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

        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 );
        
                        push @{ $self->{_rows}->{$table} }, $_ foreach @rows;

                }
        }

        return 1;
}

=head2 finish

 $out->finish;

=cut

sub finish {
        my $self = shift;

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

        $log->info('finish');

#       warn dump( $self->{_rows} );

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