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