Jump to content

User:AnomieBOT/source/AnomieBOT/API/TiedDBD.pm

From Wikipedia, the free encyclopedia
package AnomieBOT::API::TiedDBD;

use utf8;
use strict;

use Data::Dumper;
use JSON;
use Carp;
use DBI;

my $json = JSON->new->allow_nonref->utf8->shrink;

sub TIEHASH {
    my $class=shift;
    my ($dbh, $table, $keycol, $valcol, %wherefields) = @_;

    croak "DBI::db instance required" unless $dbh->isa('DBI::db');

    my $self={
        dbh => $dbh,
        error_handler => \&generic_handle_error,
    };
    bless $self, $class;

    $self->{'error_handler'}=\&sqlite_handle_error if $dbh->get_info(17) eq 'SQLite';
    $self->{'error_handler'}=\&mysql_handle_error if $dbh->get_info(17) eq 'MySQL';

    my $tries = 0;
    RETRY: {
        eval {
            $dbh->selectrow_array("SELECT 1 FROM $table LIMIT 1");

            my $where="WHERE ".join(' AND ', map("$_ = ".$dbh->quote($wherefields{$_}), keys(%wherefields)));
            my $wherekey=$where . (%wherefields ? " AND " : "") . "$keycol = ?";
            $self->{'select'}=$dbh->prepare("SELECT $valcol FROM $table $wherekey") || croak("Could not prepare select: ", $dbh->errstr);
            my $q="INSERT INTO $table (".join(',', keys(%wherefields), $keycol, $valcol).") VALUES (".join(',', map($dbh->quote($_), values(%wherefields)), '?', '?').')';
            $self->{'insert'}=$dbh->prepare($q) || croak("Could not prepare insert: ", $dbh->errstr);
            $self->{'update'}=$dbh->prepare("UPDATE $table SET $valcol=? $wherekey") || croak("Could not prepare update: ", $dbh->errstr);
            $self->{'delete'}=$dbh->prepare("DELETE FROM $table $wherekey") || croak("Could not prepare delete: ", $dbh->errstr);
            $self->{'clear'}=$dbh->prepare("DELETE FROM $table $where") || croak("Could not prepare clear: ", $dbh->errstr);
            $self->{'fetchkeys query'}="SELECT $keycol, $valcol FROM $table $where";
        };
        if($@){
            redo if $tries++ < 60 && $self->{'error_handler'}($self->{'dbh'}, $tries);
            confess $@;
        }
    }

    return $self;
}

sub generic_handle_error {
    return 0;
}

sub sqlite_handle_error {
    my $dbh = shift;
    return 0 unless $dbh->err == 5;
    carp "Database locked, retry in 5 seconds...";
    sleep 5;
    return 1;
}

sub mysql_handle_error {
    my $dbh = shift;
    my $tries = shift;
    if(
        # Server has gone away. Probably idle disconnect.
        $dbh->err == 2006 ||
        # Connection lost during query. Worth retrying.
        $dbh->err == 2013 ||
        # Connection killed. ???
        $dbh->err == 1927
    ) {
        carp "Caught MySQL error " . $dbh->err . " (" . $dbh->errstr . "), retrying in ${tries}s";
        sleep $tries; # Linear backoff
        return 1;
    }
    if(
        # Running with read-only option probably means it's rebooting.
        $dbh->err == 1290 && $dbh->errstr =~ /--read-only/ ||
        # Can't connect, probably means it's rebooting.
        $dbh->err == 2002
    ) {
        my $t = $tries < 10 ? 10 : $tries;
        carp "Caught MySQL error " . $dbh->err . " (" . $dbh->errstr . "), retrying in ${t}s";
        sleep $t;
        return 1;
    }
    carp "MySQL error! err=" . $dbh->err . "  errstr=" . $dbh->errstr;
    return 0;
}

sub FETCH {
    my $self=shift;
    my $key=shift;
    my $value;

    my $tries = 0;
    RETRY: {
        eval {
            $self->{'select'}->execute($key) || croak("FETCH: select execution failed: ", $self->{'dbh'}->errstr);
            $value = $self->{'select'}->fetch;
            $self->{'select'}->finish;
        };
        if($@){
            redo if $tries++ < 60 && $self->{'error_handler'}($self->{'dbh'}, $tries);
            confess $@;
        }
    }
    $value=$value->[0] if defined($value);
    return defined($value)?$json->decode($value):undef;
}

sub STORE {
    my $self=shift;
    my $key=shift;
    my $value=shift;

    my $tries = 0;
    RETRY: {
        eval {
            if($self->EXISTS($key)){
                $self->{'update'}->execute($json->encode($value), $key) || croak("STORE: update execution failed: ", $self->{'dbh'}->errstr);
            } else {
                $self->{'insert'}->execute($key, $json->encode($value)) || croak("FETCH: insert execution failed: ", $self->{'dbh'}->errstr);
            }
        };
        if($@){
            redo if $tries++ < 60 && $self->{'error_handler'}($self->{'dbh'}, $tries);
            confess $@;
        }
    }
}

sub DELETE {
    my $self=shift;
    my $key=shift;

    my $tries = 0;
    RETRY: {
        eval {
            $self->{'delete'}->execute($key) || croak("DELETE: delete execution failed: ", $self->{'dbh'}->errstr);
        };
        if($@){
            redo if $tries++ < 60 && $self->{'error_handler'}($self->{'dbh'}, $tries);
            confess $@;
        }
    }
}

sub CLEAR {
    my $self=shift;

    my $tries = 0;
    RETRY: {
        eval {
            $self->{'clear'}->execute() || croak("CLEAR: clear execution failed: ", $self->{'dbh'}->errstr);
        };
        if($@){
            redo if $tries++ < 60 && $self->{'error_handler'}($self->{'dbh'}, $tries);
            confess $@;
        }
    }
}

sub EXISTS {
    my $self=shift;
    my $key=shift;
    my $ret;

    my $tries = 0;
    RETRY: {
        eval {
            $self->{'select'}->execute($key) || croak("EXISTS: select execution failed: ", $self->{'dbh'}->errstr);
            $ret = $self->{'select'}->fetch;
            $self->{'select'}->finish;
        };
        if($@){
            redo if $tries++ < 60 && $self->{'error_handler'}($self->{'dbh'}, $tries);
            confess $@;
        }
    }
    return defined($ret);
}

sub FIRSTKEY {
    my $self=shift;

    my $tries = 0;
    RETRY: {
        eval {
            if(exists($self->{'fetchkeys'})){
                $self->{'fetchkeys'}->finish();
                delete $self->{'fetchkeys'};
            }
            $self->{'fetchkeys'}=$self->{'dbh'}->prepare($self->{'fetchkeys query'}) || croak("Could not prepare FIRSTKEY query: ", $self->{'dbh'}->errstr);
            $self->{'fetchkeys'}->execute() || croak("FIRSTKEY: fetchkeys execution failed: ", $self->{'dbh'}->errstr);
        };
        if($@){
            redo if $tries++ < 60 && $self->{'error_handler'}($self->{'dbh'}, $tries);
            confess $@;
        }
    }
    return $self->NEXTKEY;
}

sub NEXTKEY {
    my $self=shift;
    return wantarray ? () : undef unless exists($self->{'fetchkeys'});

    my $r;
    my $tries = 0;
    RETRY: {
        eval {
            $r = $self->{'fetchkeys'}->fetch;
            unless(defined($r)){
                $self->{'fetchkeys'}->finish();
                delete $self->{'fetchkeys'};
                return undef;
            }
        };
        if($@){
            redo if $tries++ < 60 && $self->{'error_handler'}($self->{'dbh'}, $tries);
            confess $@;
        }
    }
    return wantarray ? ($r->[0], defined($r->[1])?$json->decode($r->[1]):undef) : $r->[0];
}

sub UNTIE {
    my $self=shift;
    $self->DESTROY;
}

sub DESTROY {
    my $self=shift;
    delete $self->{'dbh'};
    delete $self->{'select'};
    delete $self->{'insert'};
    delete $self->{'update'};
    delete $self->{'delete'};
    delete $self->{'clear'};
    if(exists($self->{'fetchkeys'})){
        eval { $self->{'fetchkeys'}->finish(); };
        delete $self->{'fetchkeys'};
    }
}

1;