Table of Contents

概要

  • CPAN:DBIx-Custom を使用して MS SQL Server に対してクエリを実行するサンプル。
  • Where 句に「:UserID{=}」とか付け加えたいとこだけど、「$dbi->not_exists」がうまく働いてなくて値無しだとハングアップするみたいだ。
  • というか MS SQL Server の ODBC はハングアップし過ぎ。ちゃんとエラー出して止まってくれ。

ソース

summarize.pl

#!/usr/bin/perl
# DBIx::Custom サンプル
# 注文履歴集計 MS SQL Server 用

use strict;
use warnings;
use utf8;
use Encode;
use YAML::Syck;
use DBIx::Custom;
use DateTime;
use Text::xSV::Slurp qw( xsv_slurp );

$YAML::Syck::ImplicitUnicode = 1;

my $charsetConsole	= 'CP932';
#my $charsetFile		= 'UTF-8';
my $charsetFile		= 'CP932';

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

my $DB_Connect_yaml = './DB_Connect.yaml';
my $fnOders = './DB/Orders.txt';

my $start_date = '2012-08-20';
my $end_date   = '2012-09-01';

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

my $dbi = DBIx::Custom->connect(
	dsn			=> 'DBI:' . $DB_Connect->{'DSN'},
	user		=> $DB_Connect->{'User'},
	password	=> $DB_Connect->{'Password'},
	option		=> $DB_Connect->{'Options'}
);

#insertOrderRandom();
#insertOrderFromFile();

my $Orders = getOrders( $start_date, $end_date );
print Dump( $Orders );
exit;

sub getOrders
{
	my( $start_date, $end_date ) = @_;

	my $where = $dbi->where;
	$where->clause( [ 'and', ':OrderDateTime{>=}', ':OrderDateTime{<}' ] );
	$where->param({
		OrderDateTime => [
			$start_date ? $start_date : '1900-01-01', # $dbi->not_exists だとハングアップする？
			$end_date   ? $end_date   : '9999-12-31', # $dbi->not_exists だとハングアップする？
		], 
	});

	my $sortOrder = $dbi->order;
	$sortOrder->prepend( 'UserID', 'OrderDateTime' );

	my $Orders = $dbi->select(
		table => 'Orders',
		column => [
			'[Orders].[OrderDateTime]', '[Orders].[OrderQuantity]',						# Orders
			'[Users].[UserID]', '[Users].[UserName]',									# Users
			'[Items].[ItemName]', '[Items].[ItemUnitPrice]',							# Items
			'[Items].[ItemUnitPrice] * [Orders].[OrderQuantity] as [SubTotalPrice]',	# 追加計算
		], 
		join => [
			'JOIN [Users] ON [Orders].[OrderUser] = [Users].[UserID]', 
			'JOIN [Items] ON [Orders].[OrderItem] = [Items].[ItemID]', 
		],
		where => $where, 
		append => $sortOrder->to_string, 
	)->all;

	return $Orders;
}

sub insertOrderRandom
{
	my $userMax = 5;
	my $itemMax = 7;
	my $quantityMax = 30;
	for( my $orderNum = 20; $orderNum > 0; --$orderNum ){
		my $datetime = DateTime->new(
			time_zone => 'local', 
			year => 2012, 
			month => int( rand( 4 ) + 7 ), 
			day => int( rand( 31 ) + 1 ), 
			hour => int( rand( 10 ) + 9 ), 
			minute => int( rand( 60 ) ), 
		);
		$dbi->insert(
			{
				OrderDateTime	=> $datetime->ymd('-') . ' ' . $datetime->hms(':'), 
				OrderUser		=> int( rand( $userMax ) + 1 ), 
				OrderItem		=> int( rand( $itemMax ) + 1 ), 
				OrderQuantity	=> int( rand( $quantityMax ) + 1 ), 
			}, 
			table  => 'Orders', 
		);
	}
}

sub insertOrderFromFile
{
	my @orders = readXSV( $fnOders, { sep_char => "\t" } );
	foreach my $order ( @orders ){
		delete $order->{'OrderID'};		# IDENTITY 列を追加しようとするとハングアップする。
		$dbi->insert(
			$order, 
			table  => 'Orders', 
		);
	}
}

sub readXSV
{
	my( $fname, $opt ) = @_;
	$opt = { binary => 1, %{$opt} };
	open( my $fhin, "<:encoding($charsetFile)", encode( $charsetConsole, $fname ) )
		or die( "$fname: $!" );
	my @body = <$fhin>;
	close( $fhin );
	my $ret = xsv_slurp( 
		string => join( "", @body ), 
		text_csv => $opt, 
	);
	return ( ref( $ret ) eq 'ARRAY' ) 
		? @{ $ret } 
		: $ret ;
}

# EOF

DB_Connect.yaml

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

リンク

Perl