my $param1 = $q->param('param1');
++$param1;
print $param1;
print $q->textfield( -name => 'param1', -default => $param1 ); # 前の値のまま#!/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";
}
# EOFIIS マネージャ
Active Perl は 32bit 版をインストールする。