Perl5 掲示板 などの参考資料

安定のperl5 だは、やっていて、さすがとしか言いようがない。
'''''''
#!C:/Perl64/bin/perl

print "Content-type:text/html\n\n";
print <<EOF ;

test decoder

EOF my %in; &decode;

$come = $in{'comment'};
$come =~ s/\r\n/<br>\r\n/g;

&form;
print "end sucuript.
\n";

ここから下へ飛ぶ。終わらせてもいい。

#-------------------------------------------------

form

#-------------------------------------------------
sub form {

print "日本語テスト
$ENV{'SCRIPT_NAME'}
\n";

print <<EOM;

name
email
submit
comment $in{'comment'}
url
password

name=$in{'name'}
$come
It OK?
EOM }

#-------------------------------------------------

デコード処理 Post Get だめ

#-------------------------------------------------
sub decode {
local($buf,$key,$val);
undef(%in);

undef($in{'name'}, $in{'email'}, $in{'subm'}, $in{'comment'}, $in{'url'}, $in{'password'});

print "ローカルに来たよ。$buf
\n";
if ($ENV{'REQUEST_METHOD'} eq "POST") {
$post_flag=1;
if ($ENV{'CONTENT_LENGTH'} > 51200) { &error("投稿量が大きすぎます"); }
read(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
} else {
$post_flag=1;
$buf = $ENV{'QUERY_STRING'};
if($buf > 3){print "GETは受け付けていません。";} #GET受付、アドレスバーしない?
#アドレスバーで改ざんのし放題やんけ、これ効かないとフォームに無い要素も受け入れる。パスワードを一致するまで
#アドレスへjavascriptで
}
print "ここはきたよ$buf
\n";
foreach ( split(/&/, $buf) ) {
($key, $val) = split(/=/);
$key =~ s/\0//g;
$key =~ s/"/"/g; #koko20131029
$key =~ s/</</g;
$key =~ s/>/>/g;
if(!($kye eq '' || $kye eq 'name' || $kye eq 'email' || $kye eq 'subm' || $kye eq 'comment' || $kye eq 'url' || $kye eq 'password')){
print "this cgi not request.
\n"; #動かんのかな?
}
if($key =~ m/;/){$val = "";&error("エラー・GET
戻る");}
$val =~ tr/+/ /;
$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg;
# エスケープ
$val =~ s/\0//g;
$val =~ s/&/&/g;
# $val =~ s/&#/&#/g;
$val =~ s/"/"/g;
$val =~ s/</</g;
$val =~ s/>/>/g;
# $val =~ s/\r\n/
/g;
# $val =~ s/\r/
/g;
# $val =~ s/\n/
/g;
# $val =~ s/[\x00-\x20]+/ /g;
if($key eq 'mode' && $val eq 'admin'){
$ouna_kensa = 1;
$autolink = 1;
}elsif($key eq 'url' && $val !~ m/^<a./ ){
#この項目は何もしない
}else{
if ($val =~ m/https?:[\w.~-/?&+=:()@%;#%]+/){
$val =~ s/https?:[\w.~-/?&+=:()@%;#%]+/ＵＲＬは、禁止されました。<\/b>/g; #ノーテスト
$url_kensa = 1;
}
#&error("ＵＲＬは、禁止されました。");}
}

	$in{$key} .= "\0" if (defined($in{$key}));
	$in{$key} .= $val;

	if($in{'url'} || $in{'comment'} || $in{'name'} || $in{'subm'}){
		$kensa_val = $val;
		$kensa_val =~ s/\s//g;
		$kensa_val =~ s/\　//g;
		foreach $ck_url_p (@ck_url_bad){
			chomp $ck_url_p;
			#hen2023/07/23
			if(($kensa_val =~ m/$ck_url_p/i) && ($in{'kugiri'} eq 'no')){
				&error("書き込みＵＲＬは、禁止されました。1");
				exit;
			}
		}
	}

}

}
#-------　フォーム要素名　---------　入力確認用　後で消すこと
print "

";
print "";

foreach $key (keys %in) {
print "

\n";
}
print "

フォーム要素名	データ
$key	$in{$key}

";
print "";

exit;
#ここでメインは終わり。
sub error {
#return;
if(! $[1]){
print "

ERROR $

[0] ダメやんか。\n"; #ほんとは、html内にあるとは限らない。
}else{
print "Content-type:text/html\n\n";
print "

Error $_[0] !

";
}
print "

test decoder

'."\n";
print "it test1.
\n";

%in_d = (
apple => 'iphon',
banana => '150',
cherry => '200'
);

come = in_d["comment"]

print "りんごは$in_d{'apple'}円
\n";
$in_d{'apple'} = "110"; #要素の値の変更
print "支払いりんごは$in_d{'apple'}円
\n";

&decode();

sub decode{
local($query,$saizu,@array);
print "ローカルに来たよ。
\n";
if($ENV{'REQUEST_METHOD'} eq 'POST') {
read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
} else {
$query = $ENV{'QUERY_STRING'};

if ($get_no ==1 && $query ne ""){&error("エラー・GET 禁止");}

}
 ($saizu)=length $query;

if ($saizu > $max_size){&error("エラー・サイズオーバー");}

@array = split(/&/, $query);
print "it test.2.1
\n";
foreach my $array1(@array){
my($my_key,$my_valu) = split(/=/,$array1);
$my_key =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg; #key
$my_valu =~ tr/+/ /;
$my_valu =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg; #vallu

if ($my_key eq 'name'){
$name=$my_valu;
};
if ($my_key eq 'subm'){
$subm=$my_valu;
};
if ($my_key eq 'comment'){
$come=$my_valu;
};
};
};
print "it test.2
\n";
foreach $key (keys %in_d) {
print "$key $in_d{$key}
\n";
};

print $in_d{'apple'}.' '.$name."ここはきたよ2
\n";

print "it test.3
\n";

form #フォーム書き出しcoll

def form

#print (日本語テスト
ENV "SCRIPT_NAME"
\n);

print qq|

\n|;

print qq|

\n|;
print qq|\n \n \n \n \n

name
submit
comment $come

\n|;

print "name=".$name."
$subm
".$come."
It OK?
\n";

print()内に改行してはいけない(テキスト的に) html コメントを入れてはいけない　{}の文字として書き出しには{}としなければならない ""を使ってはならない"" \nと次の先頭をくつけてはならない。

\n をやると、終わらねばならない。print は機能が高すぎる。変数が変数として区別できるか?

end

@key_array = keys %in_d;

foreach $key (keys %in_d) {
print "$key,$in_d{$key}
\n";
};
print "