view release on metacpan or  search on metacpan

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

This method just returns C<$DBI::errstr> value

=head2 error

    my $error = $dbi->error;

Returns error string if occurred any errors while working with database

    $dbi = $dbi->error( "error text" );

Sets new error message and returns object

=head2 host

    my $host = $dbi->host;

This is the L<Mojo::URL/host> that will be used for generating the connection DSN

Default: C<localhost>

=head2 options

    my $options = $dbi->options;

This method returns options that will be used for generating the connection DSN

Default: all passed options to constructor merged with system defaults:

    RaiseError  => 0,
    PrintError  => 0,
    PrintWarn   => 0,

=head2 password

    my $password = $dbi->password;

This is the L<Mojo::URL/password> that will be used for generating the connection DSN

default: none

=head2 ping

    $dbi->ping ? 'OK' : 'Database session is expired';

Checks the connection to database

=head2 port

    my $port = $dbi->port;

This is the L<Mojo::URL/port> that will be used for generating the connection DSN

Default: none

=head2 query

    my $res = $dbi->query('select * from test');
    my $res = $dbi->query('insert into test values (?, ?)', @values);

Execute a blocking statement and return a L<Acrux::DBI::Res> object with the results.
You can also append a 'bind_callback' to perform binding value manually:

    my $res = $dbi->query('insert into test values (?, ?)', {
        bind_callback => sub {
            my $sth = shift;
            $sth->bind_param( ... );
          }
      });

=head2 rollback

    $dbi->begin;
    # ...
    $dbi->rollback;

This is a transaction method!

This method discards all changes to the database and marks the end
point for the transaction to complete

See also L</begin>, L</commit>

=head2 transaction

    my $tx = $dbi->transaction;

Begin transaction and return L<Acrux::DBI::Tx> object, which will automatically
roll back the transaction unless L<Acrux::DBI::Tx/commit> has been called before
it is destroyed

    # Insert rows in a transaction
    eval {
      my $tx = $dbi->transaction;
      $dbi->query( ... );
      $dbi->query( ... );
      $tx->commit;
    };
    say $@ if $@;

=head2 url

    my $url = $dbi->url;
    $dbi = $dbi->url('sqlite:///tmp/test.db?sqlite_unicode=1');
    $dbi = $dbi->url('sqlite:///./test.db?sqlite_unicode=1'); # '/./' will be removed
    $dbi = $dbi->url('postgres://foo:pass@localhost/mydb?PrintError=1');
    $dbi = $dbi->url('mysql://foo:pass@localhost/test?mysql_enable_utf8=1');

Database connect url

The database connection URL from which all other attributes can be derived.
C<"url"> must be specified before the first call to C<"connect"> is made,
otherwise it will have no effect on setting the defaults.

For using SQLite databases with files relative to current directory you cat use '/./' prefix:

    # '/./' will be removed automatically
    $dbi = $dbi->url('sqlite:///./test.db?sqlite_unicode=1');

Default: C<"sponge://">

=head2 username

    my $username = $dbi->username;

This is the L<Mojo::URL/username> that will be used for generating the connection DSN

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

    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;
}
sub ping {
    my $self = shift;
    return 0 unless $self->{dsn};
    return 0 unless my $dbh = $self->dbh;
    return 0 unless $dbh->can('ping');
    return $dbh->ping();
}

# Transaction methods
sub transaction {
    my $tx = Acrux::DBI::Tx->new(dbi => shift);
    weaken $tx->{dbi};
    return $tx;
}
sub begin {
    my $self = shift;
    return unless my $dbh = $self->dbh;
    $dbh->begin_work;
    return $self;
}
sub commit {
    my $self = shift;
    return unless my $dbh = $self->dbh;
    $dbh->commit;
    return $self;
}
sub rollback {
    my $self = shift;
    return unless my $dbh = $self->dbh;
    $dbh->rollback;
    return $self;
}

# Request methods
sub query { # SQL, { args }
    my $self = shift;
    my $sql = shift // '';
    my $args = @_
      ? @_ > 1
        ? {bind_values => [@_]}
        : ref($_[0]) eq 'HASH'
          ? {%{$_[0]}}
          : {bind_values => [@_]}
      : {};
    $self->{error} = '';
    return unless my $dbh = $self->dbh;
    unless (length($sql)) {
        $self->error("No statement specified");
        return;
    }

    # Prepare
    my $sth = $dbh->prepare($sql);
    unless ($sth) {
        $self->error(sprintf("Can't prepare statement \"%s\": %s", $sql,
            $dbh->errstr || $DBI::errstr || 'unknown error'));
        return;
    }

    # HandleError
    local $sth->{HandleError} = sub { $_[0] = Carp::shortmess($_[0]); 0 };

    # 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 {
        $rv = $sth->execute; # Without bindings
    }
    unless (defined $rv) {
        $self->error(sprintf("Can't execute statement \"%s\"%s: %s", $sql, $argb,
            $sth->errstr || $dbh->errstr || $DBI::errstr || 'unknown error'));
        return;
    }

    # Result
    return Acrux::DBI::Res->new(
        dbi => $self,
        sth => $sth,
        affected_rows => $rv >= 0 ? 0 + $rv : -1,
    );
}

# 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;
}


1;

__END__