日向夏特殊応援部隊

俺様向けメモ

生 DBI ユーザーのための DBI Cookbook (5)

まさかの続編ですよwww

HandleError を使ってより詳しいエラーを得る

今日、帰りに @myfinder さんと話していて、syslog-ng に吐かれるエラーで Too many connection とかをちゃんと監視しつつも、エラーメールボムによって大事な思い出が消えたりしないようにしたいねー的なことを話していて、その場合はエラーナンバーをきちんと記録するだの、エラーが起こった DB の host 名だとかで良しなにエラー通知間隔を制御したいよねと。
そういう際にやっぱり DB のホスト名だとか追加情報がエラー文字列に入ってると便利だろうなということでこんなソリューションはどうかと。

#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Exception;

use Carp;
use Data::Dump qw(dump);
use DBI;
use Try::Tiny;

sub create_dbh {
    my ( $dsn, $user, $credential, $attrs ) = @_;

    $attrs ||= +{
        RaiseError         => 1,
        PrintError         => 0,
        PrintWarn          => 0,
        ShowErrorStatement => 1,
        AutoCommit         => 0,
    };

    $attrs->{HandleError} = sub {
        my $e     = shift;
        my $lasth = $DBI::lasth;
        unless ( ref $lasth ) {
            croak $e;
        }
        elsif ( $lasth->isa('DBI::dr') ) {
            croak sprintf( '%s (errno: %d)', $DBI::errstr, $DBI::err );
        }
        else {
            my $dbh =
                $lasth->isa('DBI::db')
              ? $lasth
              : $lasth->{Database};
            my %dsn = map { split '=' => $_ } split( ';', $dbh->{Name} );
            my %err_report = (
                errno => $dbh->err,
                user  => $dbh->{Username},
            );
            for (qw/host db dbname/) {
                $err_report{$_} = $dsn{$_} if ( exists $dsn{$_} );
            }

            croak sprintf(
                '%s (%s)',
                $dbh->errstr,
                join( ", ",
                    map  { $_ . ": " . $err_report{$_} }
                    sort { $a cmp $b } keys %err_report )
            );
        }
    };
    DBI->connect( $dsn, $user, $credential, $attrs );
}

lives_ok {
    create_dbh( "dbi:mysql:dbname=test;host=localhost", "root", "" );
}
'database test is exists';

throws_ok {
    try {
        create_dbh( "dbi:mysql:dbname=hidek;host=localhost", "root", "" );
    }
    catch {
        note $_;
        croak $_;
    };
}
qr/Unknown database 'hidek' \(errno: 1049\)/ => 'database hidek is not exists';

throws_ok {
    try {
        my $dbh =
          create_dbh( "dbi:mysql:dbname=test;host=localhost", "root", "" );
        $dbh->selectall_arrayref("SELECT * FROM hidek");
    }
    catch {
        note $_;
        croak $_;
    }
}
qr/Table 'test\.hidek' doesn't exist/ => 'table hidek is not exists';

throws_ok {
    try {
        my $dbh =
          create_dbh( "dbi:mysql:dbname=test;host=localhost", "root", "" );
        my $sth = $dbh->prepare('SHOW TABLES');
        $sth->execute( 1, 2, 3 );
    }
    catch {
        note $_;
        croak $_;
    }
}
qr/called with 3 bind variables when 0 are needed/ => 'invalid bind params';

done_testing;

これを実行すると次のようになります。

ok 1 - database test is exists
# Unknown database 'hidek' (errno: 1049) at /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi/DBI.pm line 667
ok 2 - database hidek is not exists
# Table 'test.hidek' doesn't exist (dbname: test, errno: 1146, host: localhost, user: root) at handle_error.pl line 86
ok 3 - table hidek is not exists
# called with 3 bind variables when 0 are needed (dbname: test, errno: -1, host: localhost, user: root) at handle_error.pl line 100
ok 4 - invalid bind params
1..4

という訳で、dbname だとか host がめでたく取れましたとさ。ひょっとしたら HandleSetError とかでやった方が良いかもしれませぬ。