view release on metacpan or  search on metacpan

lib/DBIx/QueryByName.pm  view on Meta::CPAN

use DBIx::QueryByName::DbhPool;
use DBIx::QueryByName::SthPool;
use DBIx::QueryByName::FromXML;
use DBIx::QueryByName::Result::HashIterator;
use DBIx::QueryByName::Result::ScalarIterator;

use accessors::chained qw(_query_pool _dbh_pool _sth_pool);

our $VERSION = '0.18';

our $AUTOLOAD;

# TODO: add ->dbh($session_name) and remove query, quote, begin_work,
# TODO: rollback and commit?

# Return an instance of self
sub new {
    my $self = bless( {}, $_[0] );

    $self->_dbh_pool(   new DBIx::QueryByName::DbhPool($self) );
    $self->_sth_pool(   new DBIx::QueryByName::SthPool($self) );
    $self->_query_pool( new DBIx::QueryByName::QueryPool()    );

    # Unfortunately, we are forced to have circular references, in
    # order to get DESTROY to work in the proper order.
    $self->_sth_pool->parent($self);
    $self->_dbh_pool->parent($self);

    return $self;
}

# Start a transaction on the session's connection
sub begin_work {
    my ($self,$session) = @_;
	my $log = get_logger();
    $log->logcroak("undefined session argument in begin_work") if (!defined $session);
    return $self->_dbh_pool()->connect($session)->begin_work;
}

# Rollback on the session's connection
sub rollback {
    my ($self,$session) = @_;
	my $log = get_logger();
    $log->logcroak("undefined session argument in rollback") if (!defined $session);
    return $self->_dbh_pool()->connect($session)->rollback;
}

# Commit on the session's connection
sub commit {
    my ($self,$session) = @_;
	my $log = get_logger();
    $log->logcroak("undefined session argument in commit") if (!defined $session);
    return $self->_dbh_pool()->connect($session)->commit;
}

# Store information on how to open a database session
sub connect {
    my ($self,$session,@params) = @_;
    my $log = get_logger();
    $log->logcroak("undefined session argument in connect") if (!defined $session);
    $self->_dbh_pool()->add_credentials($session,@params);
    return $self;
}

# Call dbi's quote()
sub quote {
    my ($self,$session,$str) = @_;
    my $log = get_logger();

    $log->logcroak("undefined session argument in quote") if (!defined $session);
    $log->logcroak("undefined string argument in quote")  if (!defined $str);

    return $self->_dbh_pool()->connect($session)->quote($str);
}

# Execute a sql query directly
sub query {
    my ($self,$session,$sql) = @_;
    my $log = get_logger();

    $log->logcroak("undefined session argument in query")    if (!defined $session);
    $log->logcroak("undefined sql string argument in query") if (!defined $sql);

    # TODO: shouldn't we get arguments here? @_ passed to execute()?
    my $sth = $self->_dbh_pool()->connect($session)->prepare($sql);
    $sth->execute() or $log->logcroak("Query $sql failed, Error string " . $sth->errstr . "\nTrace: ".cluck);
    return $sth;
}

# Load from a xml file the description of sql queries to proxy
sub load {
    my ($self, %args) = @_;
    my $log = get_logger();
    my $session = delete $args{session} || $log->logcroak("undefined session name in load()");

    if (exists $args{from_xml_file}) {
        my $file = delete $args{from_xml_file};
        $log->logcroak("undefined xml file")    if (!defined $file);
        $log->logcroak("no such file: [$file]") if (! -f $file);

        open FP, "< $file" or $log->logcroak("failed to open [$file]: $!");
        my $xml = do { local $/; <FP> };
        close FP;

        DBIx::QueryByName::FromXML::load( $self->_query_pool, $session, $xml );

    } elsif (exists $args{from_xml}) {
        my $xml = delete $args{from_xml};
        DBIx::QueryByName::FromXML::load( $self->_query_pool, $session, $xml );

    } elsif (exists $args{from_postgres}) {
        delete $args{from_postgres};
        $log->logcroak('not implemented yet');

    } else {
        $log->logcroak('unknown or undefined load source');
    }

    $log->logcroak('unexpected arguments:'.Dumper(%args))
        if (scalar keys %args);