File Coverage

blib/lib/MySQL/Easy.pm

Criterion	Covered	Total	%
statement	21	198	10.6
branch	0	104	0.0
condition	0	24	0.0
subroutine	7	37	18.9
pod	15	21	71.4
total	43	384	11.2

package MySQL::Easy::sth;

use Carp;
use common::sense;

our $AUTOLOAD;

# new {{{
sub new {
    my ($class, $mysql_e, $statement) = @_;
    my $this  = bless { s=>$statement, dbo=>$mysql_e }, $class;

    $this->{sth} = $this->{dbo}->handle->prepare( $statement );

    return $this;
}
# }}}
# bind_execute {{{
sub bind_execute {
    my $this = shift;

    $this->{sth}->execute;
    $this->{sth}->bind_columns( @_ );

    return $this;
}
# }}}
# AUTOLOAD {{{
sub AUTOLOAD {
    my $this = shift;
    my $sub  = $AUTOLOAD;

    return unless $this->{sth};
    # croak "this sth is defunct.  please don't call things on it." unless $this->{sth};

    $sub = $1 if $sub =~ m/::(\w+)$/;

    my $tries = 2;
    if( $this->{sth}->can($sub) ) {
        my $wa = wantarray;
        my ($err, $warn, $ret, @ret);

        # warn "DEBUG: FYI, $$-$this is loading $sub()";

        EVAL_IT: eval {
            no strict 'refs';
            local $SIG{__WARN__} = sub { $warn = "@_"; };

            if( $wa ) {
                @ret = $this->{sth}->$sub( @_ );

            } else {
                $ret = $this->{sth}->$sub( @_ );
            }
        };

        $err = $@;

        if( $warn and not $err ) {
            $err = $warn;
            chomp $err;
        }

        if( $err ) {
          # my @c = caller;
          # my $p = "at $c[1] line $c[2], prepared at $this->{_ready_caller}[1] line $this->{_ready_caller}[2]\n";
            my $p = "(prepared at $this->{_ready_caller}[1] line $this->{_ready_caller}[2])";

            1 while $err =~ s/\s+at(?:\s+\S+)?\s+line\s+\d+\.?$//;

            # ERROR executing execute(): DBD::mysql::st execute failed: You have an error in your SQL syntax; check the manual
            $err =~ s/DBD::mysql::sth? execute failed:\s*//;

            if( $err =~ m/MySQL server has gone away/ ) {
                if( $sub eq "execute" ) {
                    $this->{sth} = $this->{dbo}->handle->prepare( $this->{s} );
                    $warn = undef;

                    goto EVAL_IT if ((--$tries) > 0);

                } else {
                    croak "MySQL::Easy::sth can only recover from connection problems during execute(): $err $p";
                }
            }

            croak "ERROR executing $sub(): $err $p";
        }

        return ($wa ? @ret : $ret);

    } else {
        croak "$sub is not a member of " . ref($this->{sth});
    }
}
# }}}
# DESTROY {{{
sub DESTROY {
    my $this = shift;

    # warn "MySQL::Easy::sth is dying"; # This is here to make sure we don't normally die during global destruction.
                                        # Once it appeared to function correctly, it was removed.
                                        # Lastly, we would die during global dest iff: our circular ref from new() were not removed.
                                        # Although, to be truely circular, the MySQL::Easy would need to point to this ::sth also
                                        # and it probably doesn't.  So, is this delete paranoid?  Yeah...  meh.
    delete $this->{dbo};
}
# }}}

package MySQL::Easy;

use Carp;
use common::sense;

use DBI;

our $AUTOLOAD;
our $VERSION = "2.1012";
our $CNF_ENV = "ME_CNF";
our $USER_ENV = "ME_USER";
our $PASS_ENV = "ME_PASS";
our $HOME_ENV = "HOME";
our @MY_CNF_LOCATIONS = (
    $ENV{$CNF_ENV}, "$ENV{$HOME_ENV}/.my.cnf", "/etc/mysql-easy.cnf", "/etc/mysql/my.cnf"
);

# AUTOLOAD {{{
sub AUTOLOAD {
    my $this = shift;
    my $sub  = $AUTOLOAD;

    $sub = $1 if $sub =~ m/::(\w+)$/;

    my $handle = $this->handle;

    if( $handle->can($sub) ) {
        my $wa = wantarray;
        my ($err, $warn, $ret, @ret);

        EVAL_IT: eval {
            no strict 'refs';
            local $SIG{__WARN__} = sub { $warn = "@_"; };

            if( wantarray ) {
                @ret = $handle->$sub(
                    (ref($_[0]) eq "MySQL::Easy::sth" ? $_[0]->{sth} : $_[0]), # cheap and not "gone away" recoverable
                    @_[1 .. $#_],
                );
            } else {
                $ret = $handle->$sub(
                    (ref($_[0]) eq "MySQL::Easy::sth" ? $_[0]->{sth} : $_[0]), # cheap and not "gone away" recoverable
                    @_[1 .. $#_],
                );
            }
        };

        $err = $@;

        if( $warn and not $err ) {
            $err = $warn;
            chomp $err;
        }

        if( $err ) {
            1 while $err =~ s/\s+at(?:\s+\S+)?\s+line\s+\d+\.?$//;

            # DBD::mysql::db selectall_hashref failed: You have an error in your SQL syntax; check the manual that corresponds to your MySQL serve
            $err =~ s/DBD::mysql::dbh? \S+ failed:\s*//;

            croak "ERROR executing $sub(): $err";
        }

        return ($wa ? @ret : $ret);

    } else {
        croak "$sub is not a member of " . ref($handle);
    }
}
# }}}

# check_warnings {{{
sub check_warnings {
    my $this = shift;
    my $sth  = $this->ready("show warnings");

    # mysql> show warnings;
    # +---------+------+------------------------------------------+
    # | Level   | Code | Message                                  |
    # +---------+------+------------------------------------------+
    # | Warning | 1265 | Data truncated for column 'var' at row 1 |
    # +---------+------+------------------------------------------+

    my @warnings;

    execute $sth or die $this->errstr;
    while( my $a = fetchrow_arrayref $sth ) {
        push @warnings, $a;
    }
    finish $sth;

    if( @warnings ) {
        $@ = join("\n", map("$_->[0]($_->[1]): $_->[2]", @warnings)) . "\n";

        return 0;
    }

    return 1;
}
# }}}
# new {{{
sub new {
    my $this = shift;

    $this = bless {}, $this;

    $this->{dbase} = shift; croak "dbase = '$this->{dbase}'?" unless $this->{dbase};
    $this->{dbh} = $this->{dbase} if ref($this->{dbase}) and $this->{dbase}->isa("DBI::db");

    my $args = shift;
    my $tr   = ref($args) ? delete $args->{trace} : $args;

    $this->trace($tr) if $tr and $this->{dbh};

    if( ref $args ) {
        for my $k (keys %$args) {
            my $f;

            if( $this->can($f = "set_$k") ) {
                $this->$f($args->{$k});

            } else {
                croak "unrecognized attribute: $k"
            }
        }
    }

    return $this;
}
# }}}
# do {{{
sub do {
    my $this = shift; return unless @_;

    my $r; eval { $r = $this->ready(shift)->execute(@_) }; croak $this->errstr if $@;
    return $r;
}
# }}}
# light_lock {{{
sub light_lock {
    my $this   = shift; return unless @_;
    my $tolock = join(", ", map("$_ read", @_));

    $this->handle->do("lock tables $tolock");
}
# }}}
# lock {{{
sub lock {
    my $this   = shift; return unless @_;
    my $tolock = join(", ", map("$_ write", @_));

    $this->handle->do("lock tables $tolock");
}
# }}}
# unlock {{{
sub unlock {
    my $this = shift;

    $this->handle->do("unlock tables");
}
# }}}
# ready {{{
sub ready {
    my $this = shift;

    my $sth = MySQL::Easy::sth->new( $this, @_ );
       $sth->{_ready_caller} = [ caller ];

    return $sth;
}
# }}}
# firstcol {{{
sub firstcol {
    my $this = shift;
    my $query = shift;

    my $r = eval { $this->handle->selectcol_arrayref($query, undef, @_) };
    croak $@ unless $r;

    return wantarray ? @$r : $r;
}
# }}}
# firstval {{{
sub firstval {
    my $this = shift;
    my $query = shift;

    my $r = eval { $this->handle->selectcol_arrayref($query, undef, @_) };
    croak $@ unless $r;

    return $r->[0];
}
# }}}
# thread_id {{{
sub thread_id {
    my $this = shift;

    return $this->handle->{mysql_thread_id};
}
# }}}
# last_insert_id {{{
sub last_insert_id {
    my $this = shift;

    # return $this->firstcol("select last_insert_id()")->[0];
    # return $this->handle->{mysql_insertid};
    return $this->handle->last_insert_id(undef,undef,undef,undef);
}
# }}}
# errstr (needs to be here, called from AUTOLOAD) {{{
sub errstr {
    my $this = shift;

    return $this->handle->errstr;
}
# }}}
# trace (needs to be here, called from AUTOLOAD) {{{
sub trace {
    my $this = shift;

    $this->handle->trace( @_ );
}
# }}}
# DESTROY {{{
sub DESTROY {
    my $this = shift;

    $this->{dbh}->disconnect if $this->{dbh};
}
# }}}
# handle {{{
sub handle {
    my $this = shift;

    return $this->{dbh} if defined($this->{dbh}) and $this->{dbh}->ping;
    # warn "WARNING: MySQL::Easy is trying to reconnect (if possible)" if defined $this->{dbh};

    ($this->{user}, $this->{pass}) = $this->unp unless $this->{user} and $this->{pass};

    $this->{host}  = "localhost" unless $this->{host};
    $this->{port}  =      "3306" unless $this->{port};
    $this->{dbase} =      "test" unless $this->{dbase};
    $this->{trace} =           0 unless $this->{trace};

    if( $this->{dbh} ) {
        eval {
            local $SIG{__WARN__} = sub {};  # Curiously, sometimes we do have a handle, but the ping doesn't work.
                                            # If we replace the handle, DBI complains about not disconnecting.
                                            # If we disconnect, it complains about not desting statement handles.
                                            # Heh.  It's gone dude, let it go.
            $this->{dbh}->disconnect;
        };
    }

    $this->{dbh} =
    DBI->connect("DBI:mysql:$this->{dbase}:host=$this->{host}:port=$this->{port}",
        $this->{user}, $this->{pass}, {

            RaiseError => ($this->{raise} ? 1:0),
            PrintError => ($this->{raise} ? 0:1),

            AutoCommit => 0,

            mysql_enable_utf8    => 1,
            mysql_compression    => 1,
            mysql_ssl            => 1,
            mysql_auto_reconnect => 1,

        });

    croak "failed to generate connection: " . DBI->errstr unless $this->{dbh};

    $this->{dbh}->trace($this->{trace});

    return $this->{dbh};
}
# }}}
# unp {{{
sub unp {
    my $this = shift;

    return ($ENV{$USER_ENV}, $ENV{$PASS_ENV}) if $ENV{$USER_ENV} and $ENV{$PASS_ENV};

    my ($user, $pass, $file, $fh);

    for $file (@MY_CNF_LOCATIONS) {
        next unless -f $file;
        next unless open $fh, $file;

        while(<$fh>) {
            $user = $1 if m/user\s*=\s*(.+)/;
            $pass = $1 if m/password\s*=\s*(.+)/;

            return ($user, $pass) if $user and $pass;
        }
    }

    die "unable to locate a username and password\n";
    return;
}
# }}}
# set_host set_user set_pass {{{
sub set_host {
    my $this = shift;

    $this->{host} = shift;
}

sub set_port {
    my $this = shift;

    $this->{port} = shift;
}

sub set_user {
    my $this = shift;

    $this->{user} = shift;
}

sub set_pass {
    my $this = shift;

    $this->{pass} = shift;
}

sub set_raise {
    my $this = shift;

    $this->{raise} = shift;
}
# }}}
# bind_execute {{{
sub bind_execute {
    my $this = shift;
    my $sql  = shift;

    my $sth = $this->ready($sql);

    $sth->execute            or return;
    $sth->bind_columns( @_ ) or return;

    return $sth;
}
# }}}

1;