配牌スクリプト

割とお気に入り
sqliteドライバが必要なので
# aptitude install libdbd-sqlite3-perl
perl使いにあるまじきコマンドだな。CPAN使えよと怒られそうだ。

#!/usr/bin/perl

# 配牌スクリプトver0.001
# 出力はこんなの。
# E m7m7s4s5s5s6s6s7p1p8p9j2
# S s2s3s4s8p2p3p5p6p7p7j3
# W m1m3m5m7m9s2s3s9p4p7j5
# N m1m3m4p5p8p8j1j3j4j4j7

use strict;
use warnings;
use DBI;

&main();

sub main
{
	
	my $dbh;
	
	&initlize(\$dbh);

	my @list = ('E', 'S', 'W', 'N');
	&set_hai(\$dbh, \@list);
	
	#my $sth = $dbh->prepare("SELECT key,type,num,same,has FROM hai WHERE has=?");
	#$sth->execute('E');
	#while(my $item = $sth->fetchrow_arrayref) {
	#  &log_out("a @$item");
	#}
	#$sth->finish; $sth = undef;
	
	&show_tehai(\$dbh, 'E');
	&show_tehai(\$dbh, 'S');
	&show_tehai(\$dbh, 'W');
	&show_tehai(\$dbh, 'N');
	
	$dbh->disconnect();
	exit(0);
}

sub set_hai
{
	my ($dbh, $r_list) = @_;

	#my $sth = $$dbh->prepare("SELECT key FROM hai WHERE has = '-'");
	#$sth->execute();
		
	# has - の key を取得
	my $array_ref = $$dbh->selectcol_arrayref("SELECT key FROM hai WHERE has = '-'");
	&fisher_yates_shuffle( $array_ref ); # array shuffle
	#print "@$array_ref\n";
	
	foreach my $cnt (1..11) {
		foreach my $home (@$r_list) {
			my $random_key = pop @$array_ref;
			$$dbh->do("UPDATE hai SET has='$home' WHERE key = $random_key");
		}
	}
	
	# parent
	my $random_key = pop @$array_ref;
	$$dbh->do("UPDATE hai SET has='E' WHERE key = $random_key");
	
	# saigo ni tsumotte kita hai
	#my $sth1 = $$dbh->prepare("SELECT key,type,num,has FROM hai WHERE key = $random_key");
	#$sth1->execute();
	#while (my $item = $sth1->fetchrow_arrayref) {
	#	print "item=@$item\n";
	#}

	$$dbh->commit();
	return;
}

sub show_tehai
{
	my ($dbh, $home) = @_;
	my $sth = $$dbh->prepare("SELECT key,type,num,same,has FROM hai WHERE has=?");
	$sth->execute($home);
	
	my $tehai = "";
	while(my $item = $sth->fetchrow_arrayref) {
		#&log_out("a @$item");
		my ($type, $num) = ($item->[1], $item->[2]);
		$tehai .= "$type$num";
	}
	&log_out("$home $tehai");
	
	
	$sth->finish; $sth = undef;
}

sub initlize
{
	my ($dbh) = @_;

	#$$dbh = DBI->connect("dbi:SQLite:dbname=mydb.db", "", "");
	$$dbh = DBI->connect("dbi:SQLite:", "", "");
	$$dbh->do("PRAGMA case_sensitive_like=on");
	$$dbh->{AutoCommit} = 0;
	
	$$dbh->do("CREATE TABLE hai ( key INTEGER PRAIMARY KEY, type TEXT, num INTEGER, same INTEGER, has TEXT )");
	#$$dbh->do("CREATE INDEX idx_flg ON hai(key)");
	
	my $cnt=0;
  	foreach my $type ('m','s','p','j') {
		my @list = ($type eq 'j')? (1..7) : (1..9);
		foreach my $num (@list) {
			foreach my $same (0..3) {
				my $q_cnt  = $$dbh->quote($cnt);
				my $q_type = $$dbh->quote($type);
				my $q_num  = $$dbh->quote($num);
				my $q_same = $$dbh->quote($same);
				my $q_has  = $$dbh->quote('-');
				$$dbh->do("INSERT INTO hai (key,type,num,same,has) VALUES($q_cnt,$q_type,$q_num,$q_same,$q_has)");
				$cnt++;
			}
		}
	}
	$$dbh->commit();
	return ;
}


# 配列のシャッフル
# cookbook p.123
# &fisher_yates_shuffle( \@array );
sub fisher_yates_shuffle
{
	my $array = shift;
	my $i;
	for ($i = @$array; --$i; ) {
		my $j = int rand ($i+1);
		next if $i == $j;
		@$array[$i,$j] = @$array[$j,$i];
	}
}

sub log_out
{
	print "@_\n";
}

すべてのクラス - ActionScript 3.0 コンポーネントリファレンスガイド
http://livedocs.adobe.com/flash/9.0_jp/ActionScriptLangRefV3/index.html?all-index-Symbols.html&index-list.html