CTK::Untaint - process CGI input parameters
use CTK::CGI; # or use CGI;
use CTK::Untaint;
my $q = CTK::CGI->new;
my $h = CTK::Untaint->new($q->Vars); # create handler
my $name = $h->extract(-as_printable => 'name'); # John
my $number = $h->extract(-as_digit => 'number'); # 0,1, ... ,9
my $price = $h->extract(-as_digits => 'price'); # 345910
my $int = $h->extract(-as_integer => 'int'); # 23498, -23490
my $pai = $h->extract(-as_float => 'pai'); # 3.14
my $words = $h->extract(-as_chars => 'words'); # sd7D98_j98_ij32
my $passwd = $h->extract(-as_password => 'passwd'); # sdf_345-34
my $postcode = $h->extract(-as_postcode => 'postcode'); # 111-1111
my $telephone = $h->extract(-as_telephone => 'telephone'); # 03-999-9999
my $email = $h->extract(-as_email => 'email'); # yutaka@asmate.net
my $url = $h->extract(-as_url => 'url'); # http://www.asmate.net/
if (my %errors = $h->errors) {
while (my ($errkey, $errstr) = each %errors) {
warn("$errkey: $errstr\n");
}
}
-or-
# 日本語のエラーメッセージを出したいとき
my @required = ('Email', 'Name', 'Address', 'Telephone');
my %name_aliases = (Email => 'E-Mailアドレス', Name => 'お名前', Address => 'ご住所');
my @error_messages = (
'項目名($name)が使われていません。',
'$nameが指定されていません。',
'$nameが不適切です。',
);
my $h = CTK::Untaint->new($q->Vars,
required => \@required,
name_aliases => \%name_aliases,
error_messages => \@error_messages,
);
my $Email = $h->extract(-as_email => 'Email');
my $Name = $h->extract(-as_printable => 'Name');
my $Address = $h->extract(-as_printable => 'Address');
my $Telephone = $h->extract(-as_telephone => 'Telephone');
my $Age = $h->extract(-as_digits => 'Age');
if (my %errors = $h->errors) {
while (my ($errkey, $errstr) = each %errors) {
warn("$errkey: $errstr\n");
}
}
my $q = CTK::CGI->new;
my $h = CTK::Untaint->new($q->Vars);
-or-
my $q = CTK::CGI->new;
my %query = $q->Vars;
my $h = CTK::Untaint->new(\%query);
-or-
my $q = CTK::CGI->new;
my %query = $q->Vars;
my $h = CTK::Untaint->new(\%query,
required => [],
name_aliases => {},
error_messages => [
q{Required name '$name' does not exist.},
q{No parameter for '$name'.},
q{$name ($value) does not untaint with pattern.},
],
);
required: 必須の入力パラメータ名(デフォルト [])
フォームの必須入力パラメータ名を配列のリファレンスで指定します。
あとから required で指定することもできます。
name_aliases: エラーメッセージで表示される入力パラメータ名のエイリアス(デフォルト {})
エラーメッセージの項目名を別の名前にしたい場合に、その対応付けを指定します。
name_aliases => {
Email => 'メールアドレス',
Name => '名前',
Address => '住所',
}
<HTML>
<BODY>
<FORM METHOD="post" ACTION="form.cgi">
メールアドレス: <INPUT TYPE="text" NAME="Email" SIZE="10" VALUE="">
名前: <INPUT TYPE="text" NAME="Name" SIZE="10" VALUE="">
住所: <INPUT TYPE="text" NAME="Address" SIZE="20" VALUE="">
</FORM>
</BODY>
</HTML>
name_aliases を指定しないときのエラーメッセージは、 フォームの入力パラメータ名(Email や Name などの文字)で表示されます。
error_messages: エラーメッセージの設定
何も指定しない場合は英語です。
name_messages => [
q{Required name '$name' does not exist.},
q{No parameter for '$name'.},
q{$name ($value) does not untaint with pattern.},
]
上から順に、
(1)必須入力のパラメータ名がフォームに存在しないときのエラーメッセージ、
(2)必須入力のパラメータの値が undef もしくは '' のときのエラーメッセージ、
(3)入力パラメータの値が extract のチェックに失敗したときのエラーメッセージ、
になります。記述順序は固定です。
エラーメッセージを日本語にしたい場合は、
error_messages => [
'項目名($name)が使われていません。',
'$nameが指定されていません。',
'$nameが不適切です。'
],
のように指定することができます。
$name の部分には、エラーに応じて Email や Name が入りますが、
name_aliases を日本語に設定している場合は、
「メールアドレス」や「名前」に置き換えられたエラーメッセージになります。
$h->required('Name', 'Email');
-or-
@standard_required = ('Name', 'Email');
$h->required(\@standard_required, 'Address', 'Age');
フォームの必須入力のパラメータ名を指定します。 既に値が設定されている場合は、一度破棄して再設定されます。
指定したパラメータ名が未定義の場合や、値が空の場合(undef や '')は、
extract で値を取得するときにエラーが発生します。
発生したエラーは、errors で確認して下さい。
@required_fields = $h->required();
現在設定されている値を返します。
my $name = $h->extract(-as_printable => 'Name'); my $email = $h->extract(-as_email => 'Email'); my $tel = $h->extract(-as_telephone => 'Telephone');
チェック方法と入力パラメータ名を指定して、値の汚染チェックを行います。
成功すると入力した値を返します。チェックに失敗すると undef を返します。
発生したエラーは、errors で確認して下さい。
デフォルトで用意されているチェック方法:
# 表示可能文字 -as_printable # 一文字の数字 -as_digit # 複数の数字 -as_digits # 整数 -as_integer # 小数 -as_float # 複数文字 -as_chars # パスワード使用文字 -as_password # 郵便番号 -as_postcode # 電話番号 -as_telephone # メールアドレス -as_email # URL -as_url # CTK::Session ID -as_sid
独自のチェックに変更したい場合や、新しいチェックを追加したい場合は、 このモジュールを継承して変更して下さい。
追加するメソッドは、is_ から始まるメソッドを定義して、 チェックに成功したときに真(1)を返すように作成する必要があります。
package My::Untaint;
use base qw(CTK::Untaint);
sub is_abc {
my ($self, $value) = @_;
return ($value =~ /^[abc]+$/);
}
package main;
use My::Untaint;
my $q = CGI->new;
my $h = My::Untaint->new($q->Vars);
my $abc = $h->extract(-as_abc => 'ABC');
if (my %errors = $h->errors) {
while (my ($errkey, $errstr) = each %errors) {
warn("$errkey: $errstr\n");
}
}
発生したエラーを取り出します。 %errors のキーは、``error_(フォームの入力パラメータ名)''、値はエラーメッセージになります。
Yutaka Kojima <yutaka@asmate.net>
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.