クエリーを受け取る1 - Perl,CGI

CGIモジュールは非常に巨大なため、引数を受け取るときには軽量・コンパクトなプログラムを書きたい場合がある。

サンプル

サンプル

#--------------------------------------------------#
#             クエリーをデコードし取得             #
#--------------------------------------------------#
util::getQuery(\%form);

package util;
#-------------------------------------------------#
#■クエリーを取得する
#    内容：GET/POST判定をしクエリーを取得する。
#          URLデコード後、指定のハッシュへ格納する。
#
#    引数：(1)格納先ハッシュ：リファレンス
#  戻り値：なし
#-------------------------------------------------#
sub getQuery{
    my $form = shift;     #クエリーをセットするハッシュ(リファレンス)
    my $buff;
    my @pairs;
    my $pair;

    #-- クエリー文字列取得 --#
    if ($ENV{'REQUEST_METHOD'} eq "POST"){
        read(STDIN, $buff, $ENV{'CONTENT_LENGTH'});
    }
    else{
        $buff = $ENV{'QUERY_STRING'};
    }

    #-- name=valueの組み合わせに分ける --#
    @pairs = split(/&/, $buff);
    # $buffは
    #     name1=value1&name2=value2& ... &nameN=valueN
    # となっているハズ

    #-- デコードしつつハッシュにセット --#
    foreach $pair ( @pairs ){
        my( $name, $value ) = split(/=/, $pair);
         #$pairは name=value となっているハズ

        #-- URLデコード --#
        $value =~ tr/+/ /;    #“+”を空白に
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        # %XX を本来の文字コードに

        #-- ハッシュにセットする --#
        if( exists( $form->{$name} ) ) {
            $form->{$name} .= "," . $value;  #同名の場合は','で連結する
        }
        else{
            $form->{$name} = $value;
        }
    }

}