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

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( "args: ", sub { dump($arg) } );

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

	if ( my $db_encoding = $arg->{encoding} ) {
		$self->debug("encoding $db_encoding");
		my $dsn = $self->dsn;
		if ( $dsn =~ m{Pg} ) {
			$dbh->do( qq{ set client_encoding = '$db_encoding'; } );
			$dbh->{pg_enable_utf8} = 1; # force utf-8 encoding for SQL_ASCII databases
		} elsif ( $dsn =~ m{mysql} ) {
			$dbh->do( qq{ set names '$db_encoding'; } );
		} elsif ( $dsn =~ m{SQLite} ) {
			$dbh->{sqlite_unicode} = 1;
		} else {
			warn "Don't know how to set encoding to $db_encoding for $dsn";
		}
	}

	$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 $log = $self->_get_logger;

	my $rec = { '000' => [ $mfn ] };
	my $row = $self->{_rec}->[$mfn-1] || die "no record $mfn";
	foreach my $c ( keys %$row ) {
		$rec->{$c} = [ $row->{$c} ];
	}
	$log->debug("fetch_rec ",sub { dump($rec) });
	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
