概要

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

注意点

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

すべてを展開すべてを収束
  1
  2
  3
  4
 
 
 
 
my $param1 = $q->param('param1');
++$param1;
print $param1;
print $q->textfield( -name => 'param1', -default => $param1 );    # 前の値のまま
  • 対応方法
    1. タグを表示する前に param で値をセットする。
      すべてを展開すべてを収束
        1
      
       
      
      $q->param( 'param1', $somevalue );    # $q->param( -name => 'param1', -values => [ $somevalue ] );
      
    2. override を指定すると強制的に上書きできる。
      すべてを展開すべてを収束
        1
      
       
      
      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

ソース

  • filetestCGI.zip
    すべてを展開すべてを収束
      1
      2
      3
      4
      5
      6
      7
      8
      9
     10
     11
     12
     13
     14
     15
     16
     17
     18
     19
     20
     21
     22
     23
     24
     25
     26
     27
     28
     29
     30
     31
     32
     33
     34
     35
     36
     37
     38
     39
     40
     41
     42
     43
     44
     45
     46
     47
     48
     49
     50
     51
     52
     53
     54
     55
     56
     57
     58
     59
     60
     61
     62
     63
     64
     65
     66
     67
     68
     69
     70
     71
     72
     73
     74
     75
     76
     77
     78
     79
     80
     81
     82
     83
     84
     85
     86
     87
     88
     89
     90
     91
     92
     93
     94
     95
     96
     97
     98
     99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
    -
    |
    |
    -
    |
    |
    !
     
     
     
    -
    |
    |
    -
    -
    |
    |
    |
    |
    |
    -
    |
    |
    |
    |
    |
    !
    !
    |
    |
    |
    -
    |
    |
    |
    |
    !
    |
    -
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    !
     
     
     
     
     
     
    -
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    |
    !
     
     
    -
    |
    !
     
     
    
    #!/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弱。
  • Active Perl は 32bit 版をインストールする。
    • 64bit 版は、「perlis.dll」が含まれていない。
    • CGI.pm でのアップロードサイズ制限設定は $CGI::POST_MAX で行う。

添付ファイル: filetestCGI.zip 328件 [詳細]

リロード   新規 下位ページ作成 編集 凍結 差分 添付 コピー 名前変更   ホーム 一覧 検索 最終更新 バックアップ リンク元   ヘルプ   最終更新のRSS
Last-modified: Tue, 30 Aug 2016 21:42:48 JST (657d)