Hatena::ブログ(Diary)

Yet Another Hackadelic

2011-01-05

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

さて、今日は selectcol_arrayref です。昨日、会社のグルメな同僚に教えて貰いました。

ちょうど 生 DBI ユーザーのための DBI Cookbook (1) - Yet Another Hackadelic にて selectall_arrayref + Slice, selectall_hashref などの使い方を書きましたが、こちらもかなり便利。

CREATE TABLE `application` (
  `id` int(10) unsigned NOT NULL,
  `title` varchar(32) CHARACTER SET sjis NOT NULL,
  `created_on` timestamp NOT NULL DEFAULT '0000-00-00 00:00:00',
  `updated_on` timestamp NOT NULL DEFAULT '0000-00-00 00:00:00'
) ENGINE=InnoDB DEFAULT CHARSET=utf8;

INSERT INTO application(id, title, created_on, updated_on) VALUES(1, 'AKB48', NOW(), NOW()), (2, 'tomochin dokidoki panic', NOW(), NOW()), (3, 'Tactics Ogre', NOW(), NOW()), (4, 'hidek kanreki', NOW(), NOW());

みたいな感じで適当にレコードを入れておきます。

selectcol_arrayref で id 一覧を取得

まずはサンプルを。

#!/usr/bin/perl

use strict;
use warnings;

use DBI;
use Data::Dump qw(dump);

my $dbh = DBI->connect('dbi:mysql:dbname=test', 'root', '', +{ RaiseError => 1 });
my $app_ids = $dbh->selectcol_arrayref( 'SELECT id FROM application' );
warn dump($app_ids);

これは次のようになります。

[1, 2, 3, 4]

指定したカラムの配列リファレンスとして取得出来るのが selectcol_arrayref なんですな。便利です。

Columns attribute でさらに自在にデータ整形

Columns と言う attribute を指定すると、指定したインデックス(1から始まります)のカラムを平坦にした配列リファレンスを取得する事が出来ます。

#!/usr/bin/perl

use strict;
use warnings;

use DBI;
use Data::Dump qw(dump);

my $dbh = DBI->connect('dbi:mysql:dbname=test', 'root', '', +{ RaiseError => 1 });
my %app_title_map = @{$dbh->selectcol_arrayref( 'SELECT id, title FROM application', +{ Columns => [ 1, 2 ] } )};

warn dump(\%app_title_map);

これは、

{
  1 => "AKB48",
  2 => "tomochin dokidoki panic",
  3 => "Tactics Ogre",
  4 => "hidek kanreki",
} 

のようになります。つまり、selectcol_arrayref($stmt, +{ Columns => [1, 2] }); は、

[ 
  "1レコード目のid", "1レコード目のtitle",
  "2レコード目のid", "2レコード目のtitle",
  "3レコード目のid", "3レコード目のtitle",
  "4レコード目のid", "4レコード目のtitle",
  "5レコード目のid", "5レコード目のtitle"
 ]

みたいに取得出来る訳ですね。

ここで出したサンプルはドキュメントに思いっきり書いてありますw ドキュメント嫁って話ですな。

2010-08-09

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

SEE ALSO

2010-01-29 小池あっつん♡

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

さてと、モバゲーオープンプラットフォームが先日やっと始まりました^^

みなさん是非遊んで下さいです。

d:id:ZIGOROu:20091125:1259163476 のさらに続編です。

ShowErrorStatement でエラー時に発行されていたクエリを表示する

#!/usr/bin/perl

use Carp;
use DBI;

my $dbh;

eval {
  $dbh = DBI->connect("dbi:mysql:db=test;host=localhost", "root", "", +{
      RaiseError => 1, AutoCommit => 0,
      ShowErrorStatement => 1, PrintWarn => 0,
      PrintError => 0,
  }) or croak($DBI::errstr);
  $dbh->selectall_arrayref("SELECT id, name, town FROM hidek WHERE id = ? AND name = ?", undef, "over", "reaction") or croak($dbh->errstr);
};
if ($@) {
    confess($@);
}

ってやると、

DBD::mysql::db selectall_arrayref failed: Unknown column 'town' in 'field list' [for Statement "SELECT id, name, town FROM hidek WHERE id = ? AND name = ?"] at - line 14.
 at - line 17

こんな感じのエラーになります。PrintError => 0, PrintWarn => 0 とかになってないと STDERR にメッセージが出ちゃうのでそれは消しておきました。

ちなみに $dbh->{Statement}, $sth->{Statement} で直近のクエリ自体を取得する事が出来ます。

SEE ALSO

2009-11-25

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

d:id:ZIGOROu:20090814:1250262134 のさらに続編です。

現在接続している dbh 全てを disconnect したい場合

use strict;
use warnings;
use DBI;

### なんかいっぱい接続したりとかする

my %drhs = DBI->installed_drivers;
for my $drh ( values %drhs ) {
  for my $dbh (@{$drh->{ChildHandles}}) {
    eval { $dbh->disconnect; };
  }
}

こんな感じ。永続環境で1リクエストをさばく間は DBI->connect_cached() で接続するとして、それらを最後に明示的に disconnect するとかで使えると思う。

SEE ALSO

2009-08-14

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

さて、まさか続編書くと思わなかったけど、d:id:ZIGOROu:20090731:1249050735 の続きです。

追記 (2009-08-15T00:30:56+09:00)

ちなみに、下記で紹介してる方法は一般的には DBI の資産がたくさん合ってモゴモゴな状況をどうするか…みたいな状況の人向けです。

一般的には宜しくないです、と言うことを踏まえてどうぞ。

DBI の拡張をサブクラスを用いて行う

Subclassing the DBI にちゃんと書いてあるんですが、DBI はサブクラスを作る為の環境が整っています。

論より証拠、実際の例です。

#!/usr/bin/perl

use strict;
use warnings;

use DBI;
use YAML;

{
    package DBIx::Hideki;

    use base qw(DBI);

    package DBIx::Hideki::db;

    use base qw(DBI::db);

    package DBIx::Hideki::st;

    use base qw(DBI::st);
    use Time::HiRes qw(time);

    sub execute {
        my ($self, @bind_params) = @_;

        my $start = time();
        my $rv = $self->SUPER::execute(@bind_params);
        my $elapse = time() - $start;

        print STDERR sprintf('[Hideki Kimura] sql: %s, elapse: %f', $self->{Statement}, $elapse);

        return $rv;
    }
}

my $dbh = DBI->connect('dbi:mysql:dbname=test', 'root', '', +{ RootClass => 'DBIx::Hideki' });
my $sth = $dbh->prepare('SHOW TABLES');
$sth->execute;
print Dump($sth->fetchall_arrayref(+{}));
$sth->finish;
$dbh->disconnect;

これを実行すると、

[Hideki Kimura] sql: SHOW TABLES, elapse: 0.000498--- []

素晴らしいですね。

解説

DBIx::Hideki クラスは DBI を継承してますから、

DBIx::Hideki->connect();

みたいなのは当然動くんですが、いちいち書き換えたくないですよね。その場合には connect 時のオプションで RootClass を指定すると、DBI 側が良しなにサブクラス化してくれます。*1

このようにするとソース自体の書き換えは、接続時のパラメータのみいじれば良く、設定ファイルなんかに書いてある場合はちょっと書き換えるだけで色んな拡張が出来ますね。

注意する点としては、

をそれぞれ継承したモジュールを作らないと駄目って所です。

それと connect 系のメソッドですが、connect 時に RootClass の解決をするため connect 自体を差し替える事は出来ません。

但し connect 後であれば、connected と言うメソッドをコールする事になっているので、

package DBIx::Hideki::db;

use base qw(DBI::db);
use YAML;

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

    print STDERR "[Hideki Kimura] connected\n";
    print STDERR Dump(+{
        dsn        => $dsn,
        user       => $user,
        credential => $credential,
        attrs      => $attrs,
    });
}

みたいな感じで接続直後のデータを受け取りホゲホゲする事が出来ます。

まとめ

今さっき、性質の悪い酔っ払い共から電話が掛かってきました!w

自宅に居るって言ったら「KY」呼ばわりされました。ひどい!

SEE ALSO

*1: bless しなおしてるだけですが