概要

• DBIx::NamedParams - metacpan.org
• p-DBIx-NamedParams - GitHub
• mysql でも prepare でプレースホルダとして ? じゃなく名前で指定できるようにする。
• 同じ名前を繰り返し使ってもエラーにならない。
• こっちより CPAN:DBIx-Custom の方が柔軟で高機能だなー。どうしたもんか。
• CPAN:DBIx-NamedBinding に比べると、bind_param_ex の１回でバインドできるのと型指定できる点が勝ってるかな。

使用法

スカラーのバインド

• 「:名前-型」でスカラー値を bind する。

  my $sql_insert = qq{
  	INSERT INTO `Users` ( `ID`, `Name`, `Status`, `RegDate` )
  	VALUES ( NULL, :Name-VARCHAR, :State-INTEGER, :RegDate-DATETIME );
  };
  $sth_insert = $dbh->prepare_ex( $sql_insert ) or die( "$DBI::errstr\n" );
  $sth_insert->bind_param_ex( { 'Name' => 'リオ', 'State' => 1, 'RegDate' => '2011-02-21 10:00' } );
  $sth_insert->execute() or die( "$DBI::errstr\n" );

配列(個数指定あり)のバインド

• 「:名前{個数}-型」で配列値を個数個分 bind する。

  my $sql_select = qq{
  	SELECT `ID`, `Name`, `Status`, `RegDate`
  	FROM `Users`
  	WHERE `Status` in ( :State{4}-INTEGER );
  };
  $sth_select = $dbh->prepare_ex( $sql_select ) or die( "$DBI::errstr\n" );
  $sth_select->bind_param_ex( { 'State' => [ 1,2,4,8 ] } );
  $sth_select->execute() or die( "$DBI::errstr\n" );

配列(個数指定なし)のバインド

• 「:名前+-型」で配列値を配列要素個分 bind する。
  prepare_exの引数としてSQL文と共に割り当てるハッシュを指定する必要がある。

  my $sql_select = qq{
  	SELECT `ID`, `Name`, `Status`, `RegDate`
  	FROM `Users`
  	WHERE `Status` in ( :State+-INTEGER );
  };
  $sth_select = $dbh->prepare_ex( $sql_select, { 'State' => [ 1,2,4,8 ] } ) 
  	or die( "$DBI::errstr\n" );
  $sth_select->execute() or die( "$DBI::errstr\n" );

デバッグログの採取

• プレースホルダの解析結果、解析後の SQL 文、バインドされる値をログファイルに書き出します。
• ファイル名を省略すると、ホームディレクトリ(Linux: 環境変数 HOME, Windows: 環境変数 USERPROFILE)にログファイル(DBIx-NamedParams.log)が作られます。

  DBIx::NamedParams::debug_log( 'testNamedParams.log' );

DBD のデータタイプに対応する SQL タイプのハッシュ

my %DrvTypeToSQLType = $dbh->driver_typename_map();

• MySQL の例
• MS SQL Server の例

変更履歴

0.0.5 / 2011/09/28

• driver_typename_map メソッドが返すハッシュを調整。DB が MS SQL Server の場合、datetime および smalldatetime に対して DATE ではなく WVARCHAR を割り当てるようにした。

0.0.4 / 2011/09/17

• driver_typename_map メソッド追加。その DBD で使用できるデータタイプに対応する SQL タイプ名のハッシュを返す。
• デバッグログのファイル名を指定できるようにした。ログの体裁の調整。
• MS SQL Server 版のサンプルを作成。datetime 型にバインドするのに DATETIME じゃなくて WVARCHAR(VARCHAR) 使わなくちゃいけないなんて、そんなん考慮しとらんよ…。

0.0.3 / 2011/04/17

• 機能面での追加・変更はなし。
• 「use base;」を「use parent;」に変更。
• import にて、継承元である DBI の import を呼び出すようにしたけど、不要かも？
• ソース内の関数の順序を呼び出し元と呼び出し先が近くになるように変更。
• _parse_ex にて、$repeat の既定値を '' から 0 に変更。
• bind_param_ex にて、「no warnings;」を「no warnings 'uninitialized';」に変更。
• bind_param_ex にて、$ref_hash が HASH であることを確認するようにした。

0.0.2 / 2011/03/07

• prepare_ex のときに @_NamedParams をクリアするようにした。

ソース

testNamedParams_MySQL.pl

#!/usr/bin/perl
# DBIx::NamedParams のテスト

use strict;
use warnings;
use utf8;
use Encode;
use YAML::Syck;
use POSIX qw( strftime );
use FindBin::libs;
use lib qw( /home/Shared/lib );
use DBIx::NamedParams;

( $ENV{'LANG'} || '' ) =~ /\.(.*)$/;	# ja_JP.UTF-8
my $charsetConsole	= $1 || 'CP932';
my $charsetFile		= 'UTF-8';

binmode( STDIN,  ":encoding($charsetConsole)" );
binmode( STDOUT, ":encoding($charsetConsole)" );
binmode( STDERR, ":encoding($charsetConsole)" );

$YAML::Syck::ImplicitUnicode = 1;

my $path = $FindBin::RealBin . '/';
my $yaml = $path . 'DB_Connect_MySQL.yml';
my $input = $path . 'InputData.yml';

my $DB_Info = YAML::Syck::LoadFile( $yaml ) or die( "$yaml: $!\n" );
foreach( keys( %{$DB_Info} ) ){
	$DB_Info->{'DSN'} =~ s/_${_}_/$DB_Info->{$_}/;
}

my $dbh = DBI->connect( 
	'DBI:' . $DB_Info->{'DSN'}, 
	$DB_Info->{'User'}, 
	$DB_Info->{'Password'}, 
	$DB_Info->{'Options'}
) or die( "$DBI::errstr\n" );

#DBIx::NamedParams::debug_log( 'testNamedParams.log' );

#my %DrvTypeToSQLType = $dbh->driver_typename_map();
#print Dump( \%DrvTypeToSQLType );

my $sql_insert = qq{
	INSERT INTO 
		`Users` 
		( `Name`, `Status`, `RegDate` ) 
	VALUES 
		( :Name-VARCHAR, :State-INTEGER, :Now-DATETIME );
};

my $sth_insert = $dbh->prepare_ex( $sql_insert ) or die( "$DBI::errstr\n" );

my $users = YAML::Syck::LoadFile( $input ) or die( "$input: $!\n" );
#print Dump( $users );
#exit;

foreach( @{$users} ){
	$_->{'Now'} = strftime( "%Y-%m-%d %H:%M:%S", localtime );
	print Dump( $_ );
	$sth_insert->bind_param_ex( $_ );
	$sth_insert->execute() or die( "$DBI::errstr\n" );
	sleep( 1 );
}
$sth_insert->finish;

my $sql_select = qq{
	SELECT
		`ID`, `Name`, `Status`, `RegDate` 
	FROM
		`Users` 
	WHERE
		`Status` in ( :State+-INTEGER );
};

my $sth_select = $dbh->prepare_ex( $sql_select, { 'State' => [ 1,2,5 ] } ) 
	or die( "$DBI::errstr\n" );
$sth_select->execute() or die( "$DBI::errstr\n" );
do {
	no warnings 'uninitialized';
	while( my @a = $sth_select->fetchrow_array ){
		printf( "%s\n", join( "\t", @a ) );
	}
}while( $sth_select->{odbc_more_results} );
$sth_select->finish;

$dbh->disconnect;

exit;

# EOF

DB_Connect_MySQL.yml

# DB接続情報
Driver:   mysql
Server:   localhost
Port:     3306
User:     TestUser
Password: "Test"  # 記号を含む場合は""で括る
DB:       TestDB
Options:
    mysql_enable_utf8: 1
DSN:      "_Driver_:database=_DB_; host=_Server_; port=_Port_;"  # Linux
#DSN:      "_Driver_:database=_DB_:host=_Server_"                 # Windows

createUsers_MySQL.sql

SET SQL_MODE="NO_AUTO_VALUE_ON_ZERO";

CREATE TABLE `Users` (
  `ID` int(11) NOT NULL AUTO_INCREMENT,
  `Name` varchar(40) NOT NULL,
  `Status` int(11) NOT NULL DEFAULT '0',
  `RegDate` timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP,
  PRIMARY KEY (`ID`)
) ENGINE=MyISAM DEFAULT CHARSET=utf8 AUTO_INCREMENT=1 ;

InputData.yml (MySQL/MSSQL 共通)

--- 
- { Name: リオ,     State: 1 }
- { Name: ミント,   State: 2 }
- { Name: ローザ,   State: 3 }
- { Name: リンダ,   State: 4 }
- { Name: リナ,     State: 5 }
- { Name: アーニャ, State: 6 }

testNamedParams_MSSQL.pl

#!/usr/bin/perl
# DBIx::NamedParams のテスト

use strict;
use warnings;
use utf8;
use Encode;
use YAML::Syck;
use POSIX qw( strftime );
use FindBin::libs;
use lib qw( /home/Shared/lib );
use DBIx::NamedParams;

( $ENV{'LANG'} || '' ) =~ /\.(.*)$/;	# ja_JP.UTF-8
my $charsetConsole	= $1 || 'CP932';
my $charsetFile		= 'UTF-8';

binmode( STDIN,  ":encoding($charsetConsole)" );
binmode( STDOUT, ":encoding($charsetConsole)" );
binmode( STDERR, ":encoding($charsetConsole)" );

$YAML::Syck::ImplicitUnicode = 1;

my $path = $FindBin::RealBin . '/';
my $yaml = $path . 'DB_Connect_MSSQL.yml';
my $input = $path . 'InputData.yml';

my $DB_Info = YAML::Syck::LoadFile( $yaml ) or die( "$yaml: $!\n" );
foreach( keys( %{$DB_Info} ) ){
	$DB_Info->{'DSN'} =~ s/_${_}_/$DB_Info->{$_}/;
}

my $dbh = DBI->connect( 
	'DBI:' . $DB_Info->{'DSN'}, 
	$DB_Info->{'User'}, 
	$DB_Info->{'Password'}, 
	$DB_Info->{'Options'}
) or die( "$DBI::errstr\n" );

#DBIx::NamedParams::debug_log( 'testNamedParams.log' );

#my %DrvTypeToSQLType = $dbh->driver_typename_map();
#print Dump( \%DrvTypeToSQLType );

my $sql_insert = qq{
	INSERT INTO 
		[Users] 
		( [Name], [Status], [RegDate] ) 
	VALUES 
		( :Name-WVARCHAR, :State-INTEGER, :Now-WVARCHAR );
};

my $sth_insert = $dbh->prepare_ex( $sql_insert ) or die( "$DBI::errstr\n" );

my $users = YAML::Syck::LoadFile( $input ) or die( "$input: $!\n" );
#print Dump( $users );
#exit;

foreach( @{$users} ){
	$_->{'Now'} = strftime( "%Y-%m-%d %H:%M:%S", localtime );
	print Dump( $_ );
	$sth_insert->bind_param_ex( $_ );
	$sth_insert->execute() or die( "$DBI::errstr\n" );
	sleep( 1 );
}
$sth_insert->finish;

my $sql_select = qq{
	SELECT
		[ID], [Name], [Status], [RegDate] 
	FROM
		[Users] 
	WHERE
		[Status] in ( :State+-INTEGER );
};

my $sth_select = $dbh->prepare_ex( $sql_select, { 'State' => [ 1,2,5 ] } ) 
	or die( "$DBI::errstr\n" );
$sth_select->execute() or die( "$DBI::errstr\n" );
do {
	no warnings 'uninitialized';
	while( my @a = $sth_select->fetchrow_array ){
		printf( "%s\n", join( "\t", @a ) );
	}
}while( $sth_select->{odbc_more_results} );
$sth_select->finish;

$dbh->disconnect;

exit;

# EOF

DB_Connect_MSSQL.yml

# DB接続情報
Driver:   ODBC
Server:   localhost\SQLExress,1433  # <サーバ名>\<インスタンス名>[,<ポート>]
User:     TestUser
Password: "Test"  # 記号を含む場合は""で括る
DB:       TestDB
Options:
    LongTruncOk: 1
    LongReadLen: 8192
DSN:      _Driver_:Driver={SQL Server}; Server={_Server_}; Database=_DB_;

createUsers_MSSQL.sql

USE [TestDB]
GO

SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER ON
GO

CREATE TABLE [dbo].[Users](
	[ID] [int] IDENTITY(1,1) NOT NULL,
	[Name] [nvarchar](40) NOT NULL,
	[Status] [int] NOT NULL,
	[RegDate] [datetime] NULL,
	CONSTRAINT [PK_Users] PRIMARY KEY CLUSTERED 
	(
		[ID] ASC
	) WITH (
		PAD_INDEX  = OFF, 
		STATISTICS_NORECOMPUTE  = OFF, 
		IGNORE_DUP_KEY = OFF, 
		ALLOW_ROW_LOCKS  = ON, 
		ALLOW_PAGE_LOCKS  = ON
	) ON [PRIMARY]
) ON [PRIMARY]
GO

ALTER TABLE [dbo].[Users] 
ADD CONSTRAINT [DF_Users_RegDate] 
DEFAULT (getdate()) FOR [RegDate]
GO

SQLTypes

getSQLTypes.pl

# SQLタイプ一覧

use strict;
use warnings;
use utf8;
use Encode;
use POSIX qw( strftime );
use FindBin::libs;
use lib qw( /home/Shared/lib );
use DBIx::NamedParams;

print "Perl version: " . $] . "\n";
print "DBI version: " . $DBI::VERSION . "\n";
print strftime( "%Y-%m-%d %H:%M:%S\n\n", localtime );
print join( "\n", DBIx::NamedParams::all_sql_types() ) . "\n";

# EOF

出力

Perl version: 5.010001
DBI version: 1.616
2011-06-17 00:37:32

ALL_TYPES
ARRAY
ARRAY_LOCATOR
BIGINT
BINARY
BIT
BLOB
BLOB_LOCATOR
BOOLEAN
CHAR
CLOB
CLOB_LOCATOR
DATE
DATETIME
DECIMAL
DOUBLE
FLOAT
GUID
INTEGER
INTERVAL
INTERVAL_DAY
INTERVAL_DAY_TO_HOUR
INTERVAL_DAY_TO_MINUTE
INTERVAL_DAY_TO_SECOND
INTERVAL_HOUR
INTERVAL_HOUR_TO_MINUTE
INTERVAL_HOUR_TO_SECOND
INTERVAL_MINUTE
INTERVAL_MINUTE_TO_SECOND
INTERVAL_MONTH
INTERVAL_SECOND
INTERVAL_YEAR
INTERVAL_YEAR_TO_MONTH
LONGVARBINARY
LONGVARCHAR
MULTISET
MULTISET_LOCATOR
NUMERIC
REAL
REF
ROW
SMALLINT
TIME
TIMESTAMP
TINYINT
TYPE_DATE
TYPE_TIME
TYPE_TIMESTAMP
TYPE_TIMESTAMP_WITH_TIMEZONE
TYPE_TIME_WITH_TIMEZONE
UDT
UDT_LOCATOR
UNKNOWN_TYPE
VARBINARY
VARCHAR
WCHAR
WLONGVARCHAR
WVARCHAR

MySQLのデータタイプ

--- 
bigint: BIGINT
bigint auto_increment: BIGINT
bigint unsigned: BIGINT
bigint unsigned auto_increment: BIGINT
bit: BIT
bit auto_increment: BIT
blob: LONGVARBINARY
char: CHAR
date: DATE
datetime: TIMESTAMP
decimal: NUMERIC
double: DOUBLE
double auto_increment: DOUBLE
enum: ALL_TYPES
float: FLOAT
float auto_increment: FLOAT
int: INTEGER
int auto_increment: INTEGER
int unsigned: INTEGER
int unsigned auto_increment: INTEGER
integer: INTEGER
integer auto_increment: INTEGER
integer unsigned: INTEGER
integer unsigned auto_increment: INTEGER
long varbinary: LONGVARBINARY
long varchar: LONGVARCHAR
longblob: LONGVARBINARY
mediumblob: LONGVARBINARY
mediumint: INTEGER
mediumint auto_increment: INTEGER
mediumint unsigned: INTEGER
mediumint unsigned auto_increment: INTEGER
mediumtext: LONGVARCHAR
numeric: NUMERIC
set: ALL_TYPES
smallint: SMALLINT
smallint auto_increment: SMALLINT
smallint unsigned: SMALLINT
smallint unsigned auto_increment: SMALLINT
text: LONGVARCHAR
time: TIME
timestamp: TIMESTAMP
tinyblob: VARBINARY
tinyint: TINYINT
tinyint auto_increment: TINYINT
tinyint unsigned: TINYINT
tinyint unsigned auto_increment: TINYINT
varchar: VARCHAR
year: SMALLINT

MS SQL Server のデータタイプ

--- 
bigint: BIGINT
bigint identity: BIGINT
binary: BINARY
bit: BIT
char: CHAR
date: WVARCHAR
datetime: WVARCHAR
datetime2: WVARCHAR
datetimeoffset: WVARCHAR
decimal: DECIMAL
decimal() identity: DECIMAL
float: FLOAT
image: LONGVARBINARY
int: INTEGER
int identity: INTEGER
money: DECIMAL
nchar: WCHAR
ntext: WLONGVARCHAR
numeric: NUMERIC
numeric() identity: NUMERIC
nvarchar: WVARCHAR
real: REAL
smalldatetime: WVARCHAR
smallint: SMALLINT
smallint identity: SMALLINT
smallmoney: DECIMAL
sql_variant: WVARCHAR
sysname: WVARCHAR
text: LONGVARCHAR
time: WVARCHAR
timestamp: BINARY
tinyint: TINYINT
tinyint identity: TINYINT
uniqueidentifier: GUID
varbinary: VARBINARY
varchar: VARCHAR
xml: WLONGVARCHAR

リンク

• DBIx::Custom

• 安全なウェブサイトの作り方 安全なSQLの呼び出し方

• http://perldoc.jp/

  • perlobj - Perl のオブジェクト
  • perlmod - Perl のモジュール (パッケージとシンボルテーブル)

• ダウンロードたけし（寅年）の日記

  • DBIでbindした後のSQL文を引っ張り出す方法
  • DBI/Executed.pm

• ブログが続かないわけ

  • [Perl][微エロ注意]画像収集のときにいつも同じイディオムを書いているのをやめたい

• 404 Blog Not Found

  • perl - use Carp; # warn() と die() だけじゃなくて
  • perl - no warnings 'unintialized'
  • perl - デフォルト値のperlらしい指定法
  • perl - 継承を使いたいワケ

• サンプルコードによるPerl入門

  • Exporter - 関数のエクスポート / Perlモジュール徹底解説
  • 柔軟なSQL / DBIx::Customの特徴
  • DBIx::Connectorを利用する / DBIx::Custom Tips
  • DBIx::Connectorによるトランザクション処理 / DBIx::Custom Tips
  • 行の挿入 insert / DBIx::Custom Tips
  • 行の更新 update / DBIx::Custom Tips
  • DBIx::Customの紹介(1) - モデル
  • すべての行の更新 update_all / DBIx::Custom Tips
  • 行の削除 delete / DBIx::Custom Tips
  • すべての行の削除 delete_all / DBIx::Custom Tips
  • Where句で日付の範囲を指定する / DBIx::Custom Tips
  • 予約語を使用している列やテーブルに対応する / DBIx::Custom Tips
  • DBIx::Customの特徴(2) SQLの知識がそのまま利用できる

• Islands in the byte stream

  • Don't use base.pm, use parent.pm instead!

• Perl-users.jp

  • Perl 5 今昔
  • 使っちゃいけない標準モジュール - JPerl advent calendar 2010 casual Track

• Part1 正しいPerl/CGIの書き方 - Webプログラミング実力アップ：ITpro Module::Starter::PBP によるモジュール開発例

• 楽：技林ブログ

  • はじめてのPerlモジュール開発メモ/楽

• 個人的なメモのページ

  • Perl_Modules

• CPAN:DBI

• CPAN:DBD-mysql

• CPAN:DBD-ODBC

• CPAN:DBIx-Custom

  • CPAN:DBIx-Custom/lib/DBIx/Custom/Guide/Ja.pod
  • DBIx::Custom Wiki - GitHub
• CPAN:DBIx-NamedBinding
• CPAN:DBIx-Simple

• CPAN:DBIx-InsertHash

• CPAN:perl/lib/Carp.pm

• CPAN:parent
• CPAN:base

• CPAN:Log-Dispatch

• CPAN:perl POSIX strftime

• CPAN:FindBin-libs