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->{_dbh} = DBI->connect( $self->dsn, $self->user, $self->passwd, { RaiseError => 1 } );

        eval {
        $self->{_dbh}->do( scalar read_file( $self->schema ) ) if -e $self->schema;
        };

        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;

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

                my @cols = sort keys %$row;

                my $sql = join( ''
                        , 'insert into '
                        , ( $self->table || $self->input || 'webpac2' )
                        . ' (' . join(',', @cols), ')'
                        , ' values ('
                        , join(',', map { '?' } 0 .. $#cols )
                        , ')'
                );
                warn "# SQL: $sql\n";
                my $sth = $self->{_dbh}->prepare( $sql );

                warn "# row ",dump( $row );
                $sth->execute( map { $row->{$_} } @cols );
        }

        push @{ $self->{_rows} }, $_ foreach @rows;

        return 1;
}

=head2 finish

 $out->finish;

=cut

sub finish {
        my $self = shift;

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

        $log->info('finish and dump data into database');

        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
43	$self->{_dbh} = DBI->connect( $self->dsn, $self->user, $self->passwd, { RaiseError => 1 } );
44
45	eval {
46	$self->{_dbh}->do( scalar read_file( $self->schema ) ) if -e $self->schema;
47	};
48
49	return 1;
50	}
51
52
53	=head2 add
54
55	Adds one entry to database.
56
57	$out->add( 42, $ds );
58
59	=cut
60
61	sub add {
62	my $self = shift;
63
64	my ( $id, $ds ) = @_;
65
66	return unless defined $ds->{_rows};
67
68	my $log = $self->_get_logger;
69
70	$id = $self->input . '-' . $id if $self->input;
71
72	my @rows = @{ $ds->{_rows} };
73	foreach my $row ( @rows ) {
74
75	my @cols = sort keys %$row;
76
77	my $sql = join( ''
78	, 'insert into '
79	, ( $self->table \|\| $self->input \|\| 'webpac2' )
80	. ' (' . join(',', @cols), ')'
81	, ' values ('
82	, join(',', map { '?' } 0 .. $#cols )
83	, ')'
84	);
85	warn "# SQL: $sql\n";
86	my $sth = $self->{_dbh}->prepare( $sql );
87
88	warn "# row ",dump( $row );
89	$sth->execute( map { $row->{$_} } @cols );
90	}
91
92	push @{ $self->{_rows} }, $_ foreach @rows;
93
94	return 1;
95	}
96
97	=head2 finish
98
99	$out->finish;
100
101	=cut
102
103	sub finish {
104	my $self = shift;
105
106	my $log = $self->_get_logger();
107
108	$log->info('finish and dump data into database');
109
110	warn dump( $self->{_rows} );
111
112	return 1;
113	}
114
115	=head1 AUTHOR
116
117	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
118
119	=head1 COPYRIGHT & LICENSE
120
121	Copyright 2009 Dobrica Pavlinusic, All Rights Reserved.
122
123	This program is free software; you can redistribute it and/or modify it
124	under the same terms as Perl itself.
125
126	=cut
127
128	1; # End of WebPAC::Output::CouchDB