Acrux-DBI

 view release on metacpan or  search on metacpan

lib/Acrux/DBI.pm  view on Meta::CPAN

    # Default attributes
    my %_opts = (%{(DEFAULT_DBI_OPTS)}, %$opts);
    my $autoclean = delete $_opts{autoclean};

    my $self  = bless {
            url     => $url,
            uri     => $uri,
            dsn     => '',
            cachekey=> '',
            driver  => '',
            dbh     => undef,
            error   => "", # Ok
            autoclean => $autoclean ? 1 : 0,
            opts    => {%_opts},
            cache   => Mojo::Cache->new,
        }, $class;
    return $self;
}

# Attributes
sub url {

lib/Acrux/DBI.pm  view on Meta::CPAN

# Database methods
sub connect {
    my $self = shift;
    $self->{error} = '';
    my $dbh = DBI->connect($self->dsn, $self->username, $self->password, $self->options);
    if ($dbh) {
        $self->{dbh} = $dbh;
        printf STDERR "Connected to '%s'\n", $self->dsn if DEBUG;
    } else {
        $self->{error} = $DBI::errstr || "DBI->connect failed";
        $self->{dbh} = undef;
    }
    return $self;
}
sub connect_cached {
    my $self = shift;
    $self->{error} = '';
    my %opts = %{($self->options)};
       $opts{private_cachekey} = $self->cachekey;
    my $dbh = DBI->connect_cached($self->dsn, $self->username, $self->password, {%opts});
    if ($dbh) {
        $self->{dbh} = $dbh;
        printf STDERR "Connected (cached) to '%s'\n", $self->dsn if DEBUG;
    } else {
        $self->{error} = $DBI::errstr || "DBI->connect failed";
        $self->{dbh} = undef;
    }
    return $self;
}
sub disconnect {
    my $self = shift;
    return unless my $dbh = $self->dbh;
    $dbh->disconnect;
    printf STDERR "Disconnected from '%s'\n", $self->dsn if DEBUG;
    $self->cleanup;
}

lib/Acrux/DBI.pm  view on Meta::CPAN

    # Binding params and execute
    my $bind_values = $args->{bind_values} || [];
    unless (is_array_ref($bind_values)) {
        $self->error("Invalid list of binding values. Array ref expected");
        return;
    }
    my $rv;
    my $argb = '';
    if (scalar @$bind_values) {
        $argb = sprintf(" with bind values: %s",
            join(", ", map {defined($_) ? sprintf("'%s\'", $_) : 'undef'} @$bind_values));

        $rv  = $sth->execute(@$bind_values);
    } elsif (my $cb = $args->{bind_callback} || $args->{bind_cb}) {
        unless (is_code_ref($cb)) {
            $self->error("Invalid binding callback function. Code ref expected");
            return;
        }
        $cb->($sth); # Callback! bind params
        $rv = $sth->execute;
    } else {

lib/Acrux/DBI.pm  view on Meta::CPAN

}

# Working with dumps
sub dump {
    my $self = shift;
    return Acrux::DBI::Dump->new(dbi => $self, @_)
}

sub cleanup {
    my $self = shift;
    undef $self->{dbh};
    return $self;
}
sub DESTROY {
    my $self = shift;
    printf STDERR "DESTROY on phase %s\n", ${^GLOBAL_PHASE} if DEBUG;
    return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
    return unless $self->{autoclean};
    $self->disconnect;
    printf STDERR "Auto cleanup on DESTROY completed\n" if DEBUG;
}

lib/Acrux/DBI/Res.pm  view on Meta::CPAN

use Mojo::JSON qw(from_json);
use Mojo::Util qw(tablify);

sub new {
    my $class = shift;
    my $args = scalar(@_) ? scalar(@_) > 1 ? {@_} : {%{$_[0]}} : {};
    my $sth = $args->{sth};
       croak 'Invalid STH' unless ref($sth);
    my $self  = bless {
            sth     => $sth,
            dbi     => undef,
            driver  => '',
            affected_rows => $args->{affected_rows} || 0,
        }, $class;
    $self->dbi($args->{dbi});
    return $self;
}

sub sth {
    my $self = shift;
    if (scalar(@_) >= 1) {

t/02-url.t  view on Meta::CPAN

# This program is distributed under the terms of the Artistic License 2.0
#
#########################################################################
use Test::More;
use Acrux::DBI;

ok(Acrux::DBI->VERSION, 'Version');

# URL: 'postgres://foo:pass@localhost/mydb?PrintError=1&foo=123'
{
    my $dbi = Acrux::DBI->new(undef, bar => 'baz');
    $dbi->url('postgres://foo:pass@localhost/mydb?PrintError=1&foo=123');
	is($dbi->driver, 'postgres', 'Driver (scheme) is postgres');
	is($dbi->host, 'localhost', 'Host is localhost');
	is($dbi->port, '', 'Port is null');
	is($dbi->userinfo, 'foo:pass', 'Userinfo is foo:pass');
	is($dbi->username, 'foo', 'Username is foo');
	is($dbi->password, 'pass', 'Password is pass');
	is($dbi->database, 'mydb', 'Password is mydb');
	is($dbi->dsn, 'DBI:Pg:dbname=mydb;host=localhost', 'DSN is DBI:Pg:dbname=mydb;host=localhost');
	#note explain $dbi->cachekey;