package Check;
use Tool;
use Jcode;
use strict;
sub form_check{
my($form, $file) = @_;
my(@error, %error);
my(%seen, @key);
my $file2;
unless ($file){
$file = $0;
$file =~ s/.cgi$/.chk/ or Tool::error("$file: 不正なファイル名");
}
# chkディレクトリ内のファイル名
$file2 = $file;
$file2 =~ s#([^/]+)$#chk/$1#;
open(FILE, $file) or open(FILE, $file2) or Tool::error("$file or $file2: オープン不可");
while(<FILE>){
chomp; tr/\r\n//;
next if /^\s*#/; # コメント行
next if /^\s*$/; # 空行
# ルールの読み込み($keyが$valueでなければ、$msgを出力)
my($key, $value, $msg) = split;
# ルール1行分のチェック
my $error = check_one($form, $key, $value);
if($error){
# エラーメッセージ保存
$msg = jcode($msg)->euc;
push(@key, $key) unless $seen{$key}++; # 現れた順番を保持
$error{$key} = $msg;
}
}
@error = @error{@key};
\@error;
}
sub check{
my $check = shift;
my $form = shift;
my @return;
$form || Tool::error("\$formが空");
foreach my $key (sort keys %$check){
my $error = check_one($form, $key, $check->{$key});
push(@return, $error) if $error;
}
@return;
}
sub check_one{
my($form, $key, $statement) = @_;
# チェックするキーごとのループ
my($success, $error);
my($ors, $ands);
foreach $ors (split('/', $statement)){
my @error;
# OR条件ごとのループ
foreach $ands (split('\|', $ors)){
# AND条件ごとのループ
my($how, $opt) = split('=', $ands); # オプションを切り分け
my $not = ($how =~ s/^!//); # 先頭に!があれば条件反転
my $result = _check($form, $how, $form->{$key}, $opt); # チェック
$result = !$result if $not; # 条件反転
push(@error, $how) unless $result; # エラーがあれば保存
}
$success = 1 unless @error; # 一回でも成功すれば成功
$error = join(":", $key, @error) if @error && !$error;
}
$success ? undef : $error;
}
sub _check{
my($form, $type, $value, $opt) = @_;
&Jcode::convert(\$value, 'euc');
my($fail);
for($type){
if (/^BLANK$/){
# ブランクチェック
return 0 if $value =~ /\S/;
}elsif(/^IS$/){
return 0 if $value ne Jcode::convert($form->{$opt}, 'euc');
}elsif(/^IS_NUM$/){
# ０以上の整数チェック
return 0 if $value =~ /[^0-9]/;
}elsif(/^IS_ALPHA$/){
# 英文字チェック(アンダースコア含まず)
return 0 if $value =~ /[^a-zA-Z]/;
}elsif(/^IS_ALPHA_$/){
# 英文字チェック(アンダースコア含む)
return 0 if $value =~ /[^a-zA-Z_]/;
}elsif(/^IS_ALPHANUM$/){
# 英数字チェック(アンダースコア含まず)
return 0 if $value =~ /[^a-zA-Z0-9]/;
}elsif(/^IS_ALPHA_NUM$/){
# 英数字チェック(アンダースコア含む)
return 0 if $value =~ /[^a-zA-Z_0-9]/;
}elsif(/^IS_ZENKAKU$/){
return 0 if $value=~ /[\x00-\x7F]/;
}elsif(/^IS_KATAKANA$/){
my $katakana = '(?:\xA5[\xA1-\xF6]|\xA1[\xA1|\xBC])'; # EUC-JP
return 0 unless $value =~ /^$katakana*$/o;
}elsif(/^IS_ASCII$/){
return 0 if $value=~ /[^\x01-\x7E]/;
}elsif(/^IS_HANKAKU$/){
return 0 if $value=~ /[^\x20-\x7E]/;
}elsif(/^TR$/){
return 0 if !(eval "\$value =~ tr/$opt//"); # tr///に失敗したら返る
}elsif(/^TRC$/){
return 0 if !(eval "\$value =~ tr/$opt//c"); # tr///cに失敗したら返る
}elsif(/^LENGTH$/){
# 長さチェック(1-100/-100/100-/100)
$opt ||= '--オプションが空--'; # オプション不正でエラー扱いにする
my @opt = split(/-/, $opt, -1);
if (@opt == 1){
return 0 if (length($value) != $opt);
}elsif(@opt == 2){
my($from, $to) = @opt;
return 0 if ($from ne '' && $from > length($value));
return 0 if ($to ne '' && $to < length($value));
}else{
&Tool::error("LENGTHのオプション不正 $opt");
}
}elsif(/^VALUE$/){
# 値チェック(記法は長さチェックと同じ)
return 0 if $value =~ /[^0-9]/;
$opt ||= '--オプションが空--'; # オプション不正でエラー扱いにする
my @opt = split(/-/, $opt, -1);
if (@opt == 1){
return 0 if ($value != $opt);
}elsif(@opt == 2){
my($from, $to) = @opt;
return 0 if ($from ne '' && $from > $value);
return 0 if ($to ne '' && $to < $value);
}else{
&Tool::error("VALUEのオプション不正 $opt");
}
}elsif(/^IS_VALIDDATE$/){
#妥当日付チェック
my( $yy, $mm, $dd ) = $value =~ /^(\d{4,4})(\d{2,2})(\d{2,2})$/;
return 0 unless( isValidDate( $yy, $mm, $dd ) );
}else{
&Tool::error("存在しないチェック型 $_");
}
}
return 1; # チェック終了
# VALUE
}
# 日付チェック用関数
sub isValidDate{
my($year, $mon, $day) =@_;
# $year 4桁の西暦
# $mon 月を表す1〜12の整数
# $day 日付
# 簡単なチェック
return 0 if $year < 1701 # 英では1700年は閏年。
|| $year > 2500 # まあここは適当に。
|| $day < 1
|| $day > 31;
# $monは間違っていたら以下の$lastdayが0になるのでチェック不要。
# その月の末日を計算(2行目は閏年の計算)
my($lastday) = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)[$mon - 1]
+ ($mon == 2 && ($year % 4 == 0 && $year % 100 != 0 || $year % 400 == 0
));
# $day が $lastday 以下ならOK。
($day <= $lastday) ? 1 : 0;
}
1;
__END__
=head1 NAME
Check.pm - フォーム文字列のチェックを行う
=head1 METHODS
Check::form_check(\%form [, $file]);
Check::check(\%check, \%form);
Check::check(\%check);
=head1 METHODS
一般的には、次のようにして呼びます。
@errors = Check::check(\%check, \%form);
%checkには、チェックしたいパラメタと規則の対の連想配列
%formには、分解したフォーム文字列を指定します。
@errors = Param::form_check(\%form);
と呼ぶこともできます。この場合、.cgiを.chkに変更したファイルを、
.cgiがあるディレクトリか、もしなければその直下のchk/ディレクトリに探しに
行きます。.chkファイルの構文はCheck::checkと同じで、
項目名 条件文字列 エラーメッセージ
の空白区切りで1行1条件で記述します。行頭に#があるとコメントです。
=head2 構文
第一引数にある%checkは、例えば
$check{USERNAME} = "!BLANK|IS_ALPHA|LENGTH=-20";
のようにして作成します。「IS_ALPHA」の部分を条件文字列と呼びます。
この場合、USERNAMEという名前のパラメタをチェックし、
「空でない」
「アルファベットでのみ構成されている」
「長さが20バイト以下である」
場合に成功を返します。
上記のように、各AND条件間は「|」文字で区切ります。
空白文字は許されません。
文字「|」は通常ORを表すので一見矛盾していますが、
これはCのビット演算子に由来します。
条件文字列の先頭に「!」文字を付加することで、
条件を反転させることができます。
複数のAND条件(および単一条件)を、OR条件で連結することができます。
OR条件の区切りには「/」文字を使います。例えば、
$check{USERNAME} = "LENGTH=4-8|IS_ALPHA/LENGTH=2-8|IS_NUM/BLANK";
は、4文字〜8文字の英字か、2文字〜8文字の数字の場合、
あるいは空文字列(BLANK)の場合のみ真を返します。
2文字の数字は真ですが、2文字の英字は偽になります。
条件文字列には、以下のものがつかえます
=over
=item BLANK
空文字列です。必須入力にしたい場合は、!BLANKとします。
空白文字のみの場合もBLANKは真になります(2バイト空白を除く)
=item IS=STRING
STRINGというパラメタ名の値と同じであれば真です。
パスワードの入力チェック等に使います。
「is equal (to) STRING」と読めるように命名しています。
=item IS_ALPHA
a〜z、A〜Z「のみ」で構成されている場合、真です。
アンダースコアは含まれません。
!IS_ALPHAとした場合「英字以外の文字を含む文字列」を表すことに注意してください。
「英字を含まない文字列」を指定したい場合は、!ALPHAを使用してください。
=item IS_ALPHA_
IS_ALPHAと同じですが、アンダースコアを含みます。
=item IS_NUM
数字のみで構成されている場合、真です。
=item IS_ALPHANUM
英数字のみで構成されている場合、真です。
アンダースコアは含まれません。
=item IS_ALPHA_NUM
IS_ALPHANUMと同じですが、アンダースコアを含みます。
=item IS_ZENKAKU
すべて全角文字であれば真です。
=item IS_ASCII
ASCII文字であれば真です。0x00(NULL)と0x7F(DEL)を除き、全ての7bit文字をB<含みます>。
=item IS_HANKAKU
すべて半角文字であれば真です。改行コードやタブなどの制御文字をB<含みません>。スペースは含みます。
=item TR=TR_STRING
Perlのtr///構文を実行し、TR_STRINGで指定した文字列が含まれれば真を返します。
また、=や&、|など、パーサが解釈してしまう文字列は今のところ使用できません(BU...仕様です)
=item TRC=TR_STRING
Perlのtr///c構文を実行し、TR_STRINGで指定した文字列B<以外の>文字列がが含まれれば真を返します。
!TRC=a-zA-Z_ は、「a-zA-Z_以外の文字列が含まれれば、偽」となるので、結果的にIS_ALPHA_と同じになります。
TRと同様、=や&、|など、パーサが解釈してしまう文字列は今のところ使用できません(仕様...です)
=item LENGH=n-m
長さがn以上m以下の場合に真です。n,mともに省略可能です。省略された場合、最小値・最大値のチェックをそれぞれ行いません。
=item VALUE=n-m
パラメタを数値と見なし、値がn以上m以下の場合に真です。n,mともに省略可能です。省略された場合、最小値・最大値のチェックをそれぞれ行いません。
=item IS_VALIDDATE
有効な日付かどうか調べます(isValidDateを使用)。YYYYMMDDの形式の日付を対象としています。
=head1 EXSAMPLES
サンプルです。
# フォーム文字列をパースする
my %form = get_param($ENV{QUERY_STRING});
# チェックする項目と内容を決める
my %check = qw(
USR_ID !BLANK|IS_ALPHANUM|LENGTH=2-9
USR_PASS !BLANK|IS_ALPHA_NUM|LENGTH=1-8
USR_PASS_AGAIN IS=USR_PASS
USR_ZOKUSEI !BLANK|VALUE=1-3
USR_NAME !BLANK|IS_ZENKAKU|LENGTH=1-30
);
# チェックする
@errors = &Check::check(\%check, \%form);
# エラーがあれば表示して終了
print join("<BR>\n", @errors) and exit if @error;
=head1 BUGS
IS_VALIDDATEを追加しました。外部の関数に依存しています。(y.imamura)
=cut