view release on metacpan or  search on metacpan

lib/MPMinus/Store/DBI.pm  view on Meta::CPAN

package MPMinus::Store::DBI; # $Id$
use strict;
use utf8;

=encoding utf-8

=head1 NAME

MPMinus::Store::DBI - Simple database interface based on CTK::DBI

=head1 VERSION

Version 1.01

=head1 SYNOPSIS

    use MPMinus::Store::DBI;

    # MySQL connect
    my $mysql = new MPMinus::Store::DBI (
        -dsn        => 'DBI:mysql:database=TEST;host=192.168.1.1',
        -user       => 'login',
        -pass       => 'password',
        -connect_to => 5,
        -request_to => 60
        -attr       => {
                mysql_enable_utf8 => 1,
                RaiseError => 0,
                PrintError => 0,
            },
    ); # See CTK::DBI

    # MySQL connect (old style, without DSN)
    my $mysql = new MPMinus::Store::DBI (
        -m          => $m, # OPTIONAL
        -driver     => 'mysql', # Driver name. See DBI module
            # Available drivers:
            #  CSV, DBM, ExampleP, File, Gofer, ODBC, Oracle,
            #  Pg, Proxy, SQLite, Sponge, mysql
        -host       => '192.168.1.1',
        -port       => '3306', # default
        -database   => 'TEST',
        -user       => 'login',
        -pass       => 'password',
        -attr       => {
                mysql_enable_utf8 => 1,
                RaiseError => 0,
                PrintError => 0,
            },
    );

    my $dbh = $mysql->connect;

    my $pingstat = $mysql->ping if $mysql;

    $mysql->reconnect() unless $pingstat;

    # Table select (as array)
    my @result = $mysql->table($sql, @inargs);

    # Table select (as hash)
    my %result = $mysql->tableh($key, $sql, @inargs); # $key - primary index field name

    # Record (as array)
    my @result = $mysql->record($sql, @inargs);

    # Record (as hash)
    my %result = $mysql->recordh($sql, @inargs);

    # Fiels (as scalar)
    my $result = $mysql->field($sql, @inargs);

    # SQL/PL-SQL
    my $sth = $mysql->execute($sql, @inargs);
    ...
    $sth->finish;

=head1 DESCRIPTION

Simple database interface based on CTK::DBI

=head2 DEBUG

You can set $MPMinus::Store::DBI::DEBUG_FORCE = 1 to enable forced debugging

=head1 METHODS

=over 8

=item B<new>

    my $mysql = new MPMinus::Store::DBI (
        -m          => $m, # OPTIONAL
        -driver     => 'mysql', # Driver name. See DBI module
            # Available drivers:
            #  CSV, DBM, ExampleP, File, Gofer, ODBC, Oracle,
            #  Pg, Proxy, SQLite, Sponge, mysql
        -host       => '192.168.1.1',
        -port       => '3306', # default
        -database   => 'TEST',
        -user       => 'login',
        -pass       => 'password',
        -attr       => {
                mysql_enable_utf8 => 1,
                RaiseError => 0,
                PrintError => 0,
            },
    );

Returns MPMinus::Store::DBI object. See also L<CTK::DBI>

=item B<ping>

    my $status = $mysql->ping();

Returns connection's life status

=item B<reconnect>

    $mysql->reconnect unless $mysql->ping();

=item B<err, errstr, state>

    my $err = $mysql->err;
    my $errstr = $mysql->errstr;
    my $state = $mysql->state;

Methods returns DBI values: err, errstr and state.

See L<DBI/"METHODS_COMMON_TO_ALL_HANDLES">

=back

=head1 EXAMPLES

=over 8

=item B<Handler example>

    package MPM::Foo::Handlers;
    use strict;

    use MPMinus::Store::DBI;

    sub handler {
        my $r = shift;
        my $m = MPMinus->m;

        ...

        # MySQL connect
        $m->set_node(
            mysql => new MPMinus::Store::DBI (
                -dsn    => 'DBI:mysql:database=NAME;host=HOST',
                -user   => 'USER',
                -pass   => 'PASSWORD',
                -attr   => {
                    mysql_enable_utf8 => 1,
                    RaiseError => 0,
                    PrintError => 0,
                    HandleError => sub { $m->log_error(shift || '') },
                },
            )
        ) unless $m->mysql;

        ...

    }

    package MPM::Foo::Test;
    use strict;

    sub response {
        my $m = shift;

        my @data = $m->mysql->table('select * from table');

        ...

        return Apache2::Const::OK;
    }

=item B<Handler example with reconnection>

    package MPM::Foo::Handlers;
    use strict;

    use MPMinus::Store::DBI;

    sub handler {
        my $r = shift;
        my $m = MPMinus->m;

        ...

        # MySQL connect/reconnect
        if ($m->mysql) {
            $m->mysql->reconnect unless $m->mysql->ping;
        } else {
            # eval 'sub CTK::DBI::_error {1}'; # For supressing CTK::DBI errors
            $m->set_node(
                mysql => new MPMinus::Store::DBI (
                    -dsn    => 'DBI:mysql:database=NAME;host=HOST',
                    -user   => 'USER',
                    -pass   => 'PASSWORD',
                    -attr   => {
                        mysql_enable_utf8 => 1,
                        RaiseError => 0,
                        PrintError => 0,
                        HandleError => sub { $m->log_error(shift || '') },
                    },
                )
            );
        }

        ...

    }

    package MPM::Foo::Test;
    use strict;

    sub response {
        my $m = shift;

        my @data = $m->mysql->table('select * from table');

        ...

        return Apache2::Const::OK;
    }

=item B<Simple example>

    use MPMinus::Store::DBI;

    $MPMinus::Store::DBI::DEBUG_FORCE = 1;
    my $dbi = new MPMinus::Store::DBI (
            -driver   => 'mysql',
            -name     => 'mylocaldb',
            -user     => 'user',
            -password => 'password'
      );
    ...
    my @table = $dbi->table("select * from tablename where date = ?", "01.01.2000");

=item B<Sponge example>

    use MPMinus::Store::DBI;
    use Data::Dumper;

    $MPMinus::Store::DBI::DEBUG_FORCE = 1;
    my $o = new MPMinus::Store::DBI(
        -driver => 'Sponge',
        -attr   => { RaiseError => 1 },
    );
    my $dbh = $o->connect();
    my $sth = $dbh->prepare("select * from table", {
        rows => [
            [qw/foo bar baz/],
            [qw/qux quux corge/],
            [qw/grault garply waldo/],
        ],
        NAME => [qw/h1 h2 h3/],
    });

    $sth->execute();