生 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 とかでやった方が良いかもしれませぬ。