WebPAC/Input/DBI.pm

package WebPAC::Input::DBI;

use warnings;
use strict;

use WebPAC::Input;
use base qw/WebPAC::Common Class::Accessor/;
__PACKAGE__->mk_accessors(qw(
        dsn
        user
        passwd
        path
));

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

=head1 NAME

WebPAC::Input::DBI - read data from RDBMS using DBI

=cut

=head1 FUNCTIONS

=head2 new

  my $input = new WebPAC::Input::DBI(
        dsn => 'dbi:SQLite:dbname=/dev/shm/test.sqlite',
        user => '',
        passwd => '',
        path => '/path/to.sql',
  );

=back

=cut

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        my $arg = {@_};

        my $sql = read_file $self->path;

        my $log = $self->_get_logger;
        $log->debug( "dsn: ", $self->dsn );

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

        $dbh->{sqlite_unicode} = 1;

        $log->debug( "sql ",$self->path, "\n", $sql );

        my $sth = $dbh->prepare( $sql );
        $sth->execute;

        # XXX this should really be in fetch_rec, but DBD::SQLite doesn't return
        # $sth->rows correctly, and we really need number of rows...
        $self->{size} = 0;

        while ( my $row = $sth->fetchrow_hashref ) {
                push @{ $self->{_rec} }, $row;
                $self->{size}++;
        }

        $log->info( $self->dsn, " query produced ", $self->size, " records");

        $self ? return $self : return undef;
}

=head2 fetch_rec

Return record with ID C<$mfn> from database

  my $rec = $input->fetch_rec( $mfn, $filter_coderef );

=cut

sub fetch_rec {
        my ( $self, $mfn, $filter_coderef ) = @_;

        my $rec = { '000' => [ $mfn ] };
        my $row = $self->{_rec}->[$mfn-1] || die "no record $mfn";
        foreach my $c ( keys %$row ) {
                $rec->{$c} = [ $row->{$c} ];
        }
        return $rec;
}


=head2 size

Return number of records in database

  my $size = $input->size;

=cut

sub size {
        my $self = shift;
        return $self->{size};
}

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2011 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::Input::DBI
1	package WebPAC::Input::DBI;
2
3	use warnings;
4	use strict;
5
6	use WebPAC::Input;
7	use base qw/WebPAC::Common Class::Accessor/;
8	__PACKAGE__->mk_accessors(qw(
9	dsn
10	user
11	passwd
12	path
13	));
14
15	use Encode;
16	use Data::Dump qw/dump/;
17	use DBI;
18	use File::Slurp;
19
20	=head1 NAME
21
22	WebPAC::Input::DBI - read data from RDBMS using DBI
23
24	=cut
25
26	=head1 FUNCTIONS
27
28	=head2 new
29
30	my $input = new WebPAC::Input::DBI(
31	dsn => 'dbi:SQLite:dbname=/dev/shm/test.sqlite',
32	user => '',
33	passwd => '',
34	path => '/path/to.sql',
35	);
36
37	=back
38
39	=cut
40
41	sub new {
42	my $class = shift;
43	my $self = {@_};
44	bless($self, $class);
45
46	my $arg = {@_};
47
48	my $sql = read_file $self->path;
49
50	my $log = $self->_get_logger;
51	$log->debug( "dsn: ", $self->dsn );
52
53	my $dbh = DBI->connect( $self->dsn, $self->user, $self->passwd, { RaiseError => 1 } );
54
55	$dbh->{sqlite_unicode} = 1;
56
57	$log->debug( "sql ",$self->path, "\n", $sql );
58
59	my $sth = $dbh->prepare( $sql );
60	$sth->execute;
61
62	# XXX this should really be in fetch_rec, but DBD::SQLite doesn't return
63	# $sth->rows correctly, and we really need number of rows...
64	$self->{size} = 0;
65
66	while ( my $row = $sth->fetchrow_hashref ) {
67	push @{ $self->{_rec} }, $row;
68	$self->{size}++;
69	}
70
71	$log->info( $self->dsn, " query produced ", $self->size, " records");
72
73	$self ? return $self : return undef;
74	}
75
76	=head2 fetch_rec
77
78	Return record with ID C<$mfn> from database
79
80	my $rec = $input->fetch_rec( $mfn, $filter_coderef );
81
82	=cut
83
84	sub fetch_rec {
85	my ( $self, $mfn, $filter_coderef ) = @_;
86
87	my $rec = { '000' => [ $mfn ] };
88	my $row = $self->{_rec}->[$mfn-1] \|\| die "no record $mfn";
89	foreach my $c ( keys %$row ) {
90	$rec->{$c} = [ $row->{$c} ];
91	}
92	return $rec;
93	}
94
95
96	=head2 size
97
98	Return number of records in database
99
100	my $size = $input->size;
101
102	=cut
103
104	sub size {
105	my $self = shift;
106	return $self->{size};
107	}
108
109	=head1 AUTHOR
110
111	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
112
113	=head1 COPYRIGHT & LICENSE
114
115	Copyright 2011 Dobrica Pavlinusic, All Rights Reserved.
116
117	This program is free software; you can redistribute it and/or modify it
118	under the same terms as Perl itself.
119
120	=cut
121
122	1; # End of WebPAC::Input::DBI