view release on metacpan or  search on metacpan

lib/AnyEvent/MySQL.pm  view on Meta::CPAN

package AnyEvent::MySQL;

use 5.006;
use strict;
use warnings;

=encoding utf8

=head1 NAME

AnyEvent::MySQL - Pure Perl AnyEvent socket implementation of MySQL client

=head1 VERSION

Version 1.2.1

=cut

our $VERSION = '1.002001';

use AnyEvent::MySQL::Imp;


=head1 SYNOPSIS

This package is used in my company since 2012 to today (2017). I think it should be stable.
(though some data type fetching through prepared command are not implemented)

Please read the test.pl file as a usage example. >w<

    #!/usr/bin/perl

    use strict;
    use warnings;

    BEGIN {
        eval {
            require AE;
            require Data::Dumper;
            require Devel::StackTrace;
            require EV;
        };
        if( $@ ) {
            warn "require module fail: $@";
            exit;
        }
    }

    $EV::DIED = sub {
        print "EV::DIED: $@\n";
        print Devel::StackTrace->new->as_string;
    };

    use lib 'lib';
    use AnyEvent::MySQL;

    my $end = AE::cv;

    my $dbh = AnyEvent::MySQL->connect("DBI:mysql:database=test;host=127.0.0.1;port=3306", "ptest", "pass", { PrintError => 1 }, sub {
        my($dbh) = @_;
        if( $dbh ) {
            warn "Connect success!";
            $dbh->pre_do("set names latin1");
            $dbh->pre_do("set names utf8");
        }
        else {
            warn "Connect fail: $AnyEvent::MySQL::errstr ($AnyEvent::MySQL::err)";
            $end->send;
        }
    });

    $dbh->do("select * from t1 where a<=?", {}, 15, sub {
        my $rv = shift;
        if( defined($rv) ) {
            warn "Do success: $rv";
        }
        else {
            warn "Do fail: $AnyEvent::MySQL::errstr ($AnyEvent::MySQL::err)";
        }
        $end->send;
    });

    #$end->recv;
    my $end2 = AE::cv;

    #$dbh->prepare("update t1 set a=1 where b=1", sub {
    #$dbh->prepare("select * from t1", sub {
    my $sth = $dbh->prepare("select b, a aaa from t1 where a>?", sub {
    #$dbh->prepare("select * from type_all", sub {
        warn "prepared!";
        $end2->send;
    });

    #$end2->recv;

    my $end3 = AE::cv;

    $sth->execute(1, sub {
        warn "executed! $_[0]";
        $end3->send($_[0]);
    });

    my $fth = $end3->recv;

    my $end4 = AE::cv;

    $fth->bind_col(2, \my $a, sub {
        warn $_[0];
    });
    my $fetch; $fetch = sub {
        $fth->fetch(sub {
            if( $_[0] ) {
                warn "Get! $a";
                $fetch->();
            }
            else {
                warn "Get End!";
                undef $fetch;
                $end4->send;
            }
        });
    }; $fetch->();

    #$fth->bind_columns(\my($a, $b), sub {

lib/AnyEvent/MySQL.pm  view on Meta::CPAN

    elsif( $task->[0]==TXN_COMMIT ) {
        if( $dbh->{_}[TXN_STATEi]==DEAD_TXN ) {
            _report_error($dbh, 'process_task', 1402, 'Transaction branch dead');
            $dbh->{_}[TXN_STATEi] = NO_TXN;
            $task->[2]();
            _process_task($dbh);
        }
        elsif( $dbh->{_}[TXN_STATEi]==NO_TXN ) {
            $task->[2]();
            _process_task($dbh);
        }
        else {
            $dbh->{_}[CONN_STATEi] = BUSY_CONN;
            $task->[1]($next);
        }
    }
    elsif( $task->[0]==TXN_ROLLBACK ) {
        if( $dbh->{_}[TXN_STATEi]==DEAD_TXN ) {
            $dbh->{_}[TXN_STATEi] = NO_TXN;
            $task->[2](1);
            _process_task($dbh);
        }
        elsif( $dbh->{_}[TXN_STATEi]==NO_TXN ) {
            $task->[2]();
            _process_task($dbh);
        }
        else {
            $dbh->{_}[CONN_STATEi] = BUSY_CONN;
            $task->[1]($next);
        }
    }
    else {
        warn "Never be here";
    }
}

sub _text_prepare {
    my $statement = shift;
    $statement =~ s(\?){
        my $value = shift;
        if( defined($value) ) {
            $value =~ s/\\/\\\\/g;
            $value =~ s/'/\\'/g;
            "'$value'";
        }
        else {
            'NULL';
        }
    }ge;
    return $statement;
}

=head2 $dbh = AnyEvent::MySQL::db->new($dsn, $username, [$auth, [\%attr,]] [$cb->($dbh, $next_guard)])

    $cb will be called when each time the db connection is connected, reconnected,
    or tried but failed.

    If failed, the $dbh in the $cb's args will be undef.

    You can do some connection initialization here, such as
     set names utf8;

    But you should NOT rely on this for work flow control,
    cause the reconnection can occur anytime.

=cut
sub new {
    my $cb = ref($_[-1]) eq 'CODE' ? pop : \&AnyEvent::MySQL::_empty_cb;
    my($class, $dsn, $username, $auth, $attr) = @_;

    my $dbh = bless { _ => [] }, $class;
    if( $dsn =~ /^DBI:mysql:(.*)$/ ) {
        $dbh->{Name} = $1;
    }
    else {
        die "invalid dsn format";
    }
    $dbh->{Username} = $username;
    $dbh->{_}[AUTHi] = $auth;
    $dbh->{_}[ATTRi] = +{ Verbose => 1, %{ $attr || {} } };
    $dbh->{_}[CONN_STATEi] = BUSY_CONN;
    $dbh->{_}[TXN_STATEi] = NO_TXN;
    $dbh->{_}[TASKi] = [];
    $dbh->{_}[ON_CONNi] = $cb;

    _connect($dbh);

    return $dbh;
}

=head2 $error_num = $dbh->err

=cut
sub err {
    return $_[0]{_}[ERRi];
}

=head2 $error_str = $dbh->errstr

=cut
sub errstr {
    return $_[0]{_}[ERRSTRi];
}

=head2 $rv = $dbh->last_insert_id

    Non-blocking get the value immediately

=cut
sub last_insert_id {
    $_[0]{mysql_insertid};
}

sub _do {
    my $cb = ref($_[-1]) eq 'CODE' ? pop : \&AnyEvent::MySQL::_empty_cb;
    my($rev_dir, $dbh, $statement, $attr, @bind_values) = @_;

    if( $dbh->{_}[ATTRi]{ReadOnly} && $statement !~ /^\s*(?:show|select|set\s+names)\s+/i ){
        _report_error($dbh, 'do', 1227, 'unable to perform write queries on a ReadOnly handle');
        $cb->();
        return;