概要

CGI.pm のテストサンプル
動作サンプル
フォームタグが閉じていなかったのを修正。(2012/10/02)

注意点

textfield や hidden などの値を加工してセットしても前の値が表示される

my $param1 = $q->param('param1');
++$param1;
print $param1;
print $q->textfield( -name => 'param1', -default => $param1 );	# 前の値のまま

対応方法

タグを表示する前に param で値をセットする。

$q->param( 'param1', $somevalue );	# $q->param( -name => 'param1', -values => [ $somevalue ] );

つかのぺ / CGI.pm

override を指定すると強制的に上書きできる。

print $q->textfield( -name => 'param1', -default => $somevalue, -override => 1 );

リストコンテキストでのパラメータ読み出し

セキュリティ上の問題のため、リストコンテキストで「$q->param('name')」を使うと警告が表示される。
リストコンテキストが必要な場合は代わりに「$q->multi_param('name')」を使う。
Fetching the value or values of a single named parameter

ソース

testCGI.zip

#!/usr/bin/perl
#
# CGI.pm のテスト

use strict;
use warnings;
use utf8;
use Encode;
use YAML::Syck;
use CGI::Pretty qw( -no_xhtml *table );	# //HTML 4.01 Transitional//EN
#use CGI::Carp qw/fatalsToBrowser warningsToBrowser/;

$YAML::Syck::ImplicitUnicode = 1;

binmode( STDIN,  ":utf8" );
binmode( STDOUT, ":utf8" );
binmode( STDERR, ":utf8" );

my $cginame = 'testCGI';
my $cookiename = 'クッキー';
my $charset = 'utf-8';

# フォームのエンコーディングタイプ。
# CGI.pm Version 3.48 の param メソッドに影響する。
# 1: application/x-www-form-urlencoded, param メソッドでバイナリ文字列が返る。
# 0: multipart/form-data, param メソッドで utf8 フラグ付き文字列が返る。
my $enctype = 1;

my $q = new CGI;
$q->charset( $charset );

my %popupgroup = ( 
	'popup1' => 'ポップアップ1',	'popup2' => 'ポップアップ2', 
	'popup3' => 'ポップアップ3',	'popup4' => 'ポップアップ4', 
);
my %scrollgroup = ( 
	'scroll1' => 'スクロール1',	'scroll2' => 'スクロール2', 
	'scroll3' => 'スクロール3',	'scroll4' => 'スクロール4', 
	'scroll5' => 'スクロール5',	
);
my %checkgroup = ( 
	'check1'=>'チェック1',	'check2'=>'チェック2',	
	'check3'=>'チェック3',	
);
my %radiogroup = ( 
	'radio1'=>'ラジオ1',	'radio2'=>'ラジオ2',	
	'radio3'=>'ラジオ3',	
);

my @names;
if ( $enctype ){
	# 'application/x-www-form-urlencoded'
	@names = map{ decode( 'utf8', $_ ) } $q->param();
} else {
	# 'multipart/form-data'
	@names = $q->param();
}

printHeader();

if ( @names ){
	print $q->h2('Param');
	print $q->start_table( { '-summary' => 'Parameters', '-border' => 1 } );
	foreach my $name ( @names ){
		if ( $enctype ){
			# 'application/x-www-form-urlencoded'
			print $q->Tr( 
				$q->th( $name ), 
				$q->td( join( $q->br(), map{ decode( 'utf8', $_ ) } $q->param( encode( 'utf8', $name ) ) ) ) 
			);
		} else {
			# 'multipart/form-data'
			print $q->Tr( 
				$q->th( $name ), 
				$q->td( join( $q->br(), $q->param( $name ) ) ) 
			);
		}
	}
	print $q->end_table();
	print $q->h2('Cookie');
	print $q->start_table( { '-summary' => 'Cookie', '-border' => 1 } );
	foreach my $cookiename ( $q->cookie() ){
		print $q->Tr( 
			$q->th( decode( 'utf8', $cookiename ) ), 
			$q->td( join( $q->br(), map{ decode( 'utf8', $_ ) } $q->cookie( $cookiename ) ) ) 
		);
	}
	print $q->end_table();
} else {
	print $q->start_form( 
		'-action' => $q->url, 
		'-enctype' => ( 
			( $enctype ) 
			? 'application/x-www-form-urlencoded'
			: 'multipart/form-data' 
		), 
	);
	print $q->start_table( { '-summary' => 'Parameters', '-border' => 1 } );
	print $q->Tr( 
		$q->th( 'テキスト' ), 
		$q->td( $q->textfield(
			'-name'		=> 'テキスト', 
			'-value'	=> 'あいうえお漢字' 
		) )
	);
	print $q->Tr( 
		$q->th( 'テキストエリア' ), 
		$q->td( $q->textarea( 
			'-name'		=> 'テキストエリア', 
			'-default'	=> "予定表\n\x{20B9F}", 
			'-rows'		=> 3, 
			'-columns'	=> 20 
		) )
	);
	print $q->Tr( 
		$q->th( 'ポップアップ' ), 
		$q->td( $q->popup_menu( 
			'-name'		=> 'ポップアップ', 
			'-values'	=> [ sort( keys( %popupgroup ) ) ], 
			'-default'	=> ( sort( keys( %popupgroup ) ) )[0], 
			'-labels'	=> \%popupgroup,
		) )
	);
	print $q->Tr( 
		$q->th( 'スクロール' ), 
		$q->td( $q->scrolling_list( 
			'-name'		=> 'スクロール', 
			'-values'	=> [ sort( keys( %scrollgroup ) ) ], 
			'-default'	=> ( sort( keys( %scrollgroup ) ) )[0], 
			'-size'		=> 3,
			'-multiple'	=> 'true',
			'-labels'	=> \%scrollgroup,
		) )
	);
	print $q->Tr( 
		$q->th( 'チェックボックス' ), 
		$q->td( $q->checkbox_group( 
			'-name'		=> 'チェックボックス', 
			'-values'	=> [ sort( keys( %checkgroup ) ) ], 
			'-default'	=> ( sort( keys( %checkgroup ) ) )[0], 
			'-linebreak' => 'true',
			'-labels'	=> \%checkgroup,
		) )
	);
	print $q->Tr( 
		$q->th( 'ラジオボタン' ), 
		$q->td( $q->radio_group( 
			'-name'		=> 'ラジオボタン', 
			'-values'	=> [ sort( keys( %radiogroup ) ) ], 
			'-default'	=> ( sort( keys( %radiogroup ) ) )[0], 
			'-linebreak' => 'true',
			'-labels'	=> \%radiogroup,
		) )
	);
	print $q->Tr( $q->td( 
		{ '-colspan' => 2, '-align' => 'center' }, 
		$q->submit . ' ' . $q->reset 
	) );
	print $q->end_table();
	print $q->end_form;
}

printFooter();

exit;

sub printHeader
{
	my $cookieval = decode( 'utf8', 
		$q->cookie( encode( 'utf8', $cookiename ) ) || '' 
	);
	$cookieval .= 'あ';
	my $cookie = $q->cookie( 
		'-name'		=> encode( 'utf8', $cookiename ), 
		'-value'	=> encode( 'utf8', $cookieval ),
	);
	print $q->header( '-cookie' => [ $cookie ] );
	print $q->start_html( 
		'-title'	=> $cginame, 
		'-lang'		=> 'ja-JP', 
		'-head'		=> [ 
			$q->meta( { '-http_equiv'	=> 'Content-style-type',	'-content'	=> 'text/css' } ),
			$q->meta( { '-http_equiv'	=> 'Content-script-type',	'-content'	=> 'text/javascript' } ), 
		], 
		'-style'	=> [ { 'src' => '/take.css' }, ], 
	);
	print $q->h1( $cginame );
}

sub printFooter
{
	print $q->end_html . "\n";
}

# EOF

システム設定

Windows Server 2012(IIS8)

IIS インストール時に、「CGI」「ISAPI 拡張」「要求フィルター」を有効にする。
- IPアドレスによるアクセス制限を行う場合は「IPおよびドメインの制限」も有効にする。
IIS マネージャ
- 「アプリケーションプール - DefaultAppPool - 詳細設定 - 32ビットアプリケーションの有効化」を「True」に設定する。
- 「Default Web Site」または該当フォルダ
  - 「ハンドラーマッピング」を開き、「スクリプトマップ」を追加する。 | 要求パス | *.cgi | | --- | --- | | 実行可能ファイル | C:\Perl\bin\perlis.dll | | 名前 | Perl CGI |
- 「既定のドキュメント」を開き、「index.cgi」を追加する。
- 「要求フィルター」のアップロード許可最大サイズの既定値は30MB弱。
  - 最大値を変更する場合は、「要求フィルター」から、「機能設定の編集」を開き、「許可されたコンテンツ最大長」を変更する。
  - IIS で要求フィルタリングを構成する
  - 要求フィルターの使用方法
  - 要求制限
Active Perl は 32bit 版をインストールする。
- 64bit 版は、「perlis.dll」が含まれていない。
- CGI.pm でのアップロードサイズ制限設定は $CGI::POST_MAX で行う。

CGI.pm

概要

注意点

textfield や hidden などの値を加工してセットしても前の値が表示される

リストコンテキストでのパラメータ読み出し

ソース

システム設定

Windows Server 2012(IIS8)

リンク

Perl