Perl5 掲示板 などの参考資料

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

print "Content-type:text/html\n\n";
print <<EOF ;
<!DOCTYPE html>
<html lang="ja">
<head>
 <meta charset="UTF-8">
<title></title>
</head>
<BODY BGCOLOR="#ffffff">
<h1>test decoder</h1>
EOF
my %in;
&decode;

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

&form;
print "end sucuript.<br>\n";

# ここから下へ飛ぶ。終わらせてもいい。
#-------------------------------------------------
#  form
#-------------------------------------------------
sub form {

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

	print <<EOM;
<form action="$ENV{'SCRIPT_NAME'}" method="POST">
<!--<form action="http://localhost/my_test/cgi_test/perl_test.cgi" method="POST">-->
<table border=0 cellspacing=1>
<tr><td><b>name</b></td><td><input type=text name=name size=28 value="$in{'name'}" maxlength="12" class=f></td></tr>
<tr><td><b>email</b></td><td><input type=text name=email size=28 value="$in{'email'}" maxlength="36" class=f></td></tr>
<tr><td><b>submit</b></td><td><input type=text name=subm size=36 value="$in{'subm'}"  maxlength="36"class=f></td></tr>
<tr><td colspan=2><b>comment</b><br><textarea cols=70 rows=7 name=comment wrap="soft" class=f>$in{'comment'}</textarea></td></tr>
<tr><td><b>url</b></td><td><input type=text size=52 name=url value="$in{'url'}" maxlength="60" class=f></td></tr>
<tr><td><b>password</b></td><td><input type=password size=28 name=password value="$in{'password'}" maxlength="12" class=f></td></tr>
<tr><td><input type=submit value="submit"></td><td><input type=reset value="reset"></td></tr>
<!-- <input type="hidden" name="url" value=""> -->
</form></table>
<br>
name=$in{'name'}<br>
$come<br>
It OK?
<br>
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<br>\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<br>\n";
	foreach ( split(/&/, $buf) ) {
		($key, $val) = split(/=/);
		$key =~ s/\0//g;
		$key =~ s/\"/&quot;/g; #koko20131029
 		$key =~ s/</&lt;/g;
 		$key =~ s/>/&gt;/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.<br>\n";   #動かんのかな?
		}		
		if($key =~ m/\;/){$val = "";&error("エラー・GET<br><a href=\"$script\">戻る</a>");}
		$val =~ tr/+/ /;
		$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg;
		# エスケープ
		$val =~ s/\0//g;
		$val =~ s/&/&amp;/g;
	#	$val =~ s/&amp;\#/&#/g;
		$val =~ s/"/&quot;/g;
		$val =~ s/</&lt;/g;
		$val =~ s/>/&gt;/g;
	#	$val =~ s/\r\n/<br>/g;
	#	$val =~ s/\r/<br>/g;
	#	$val =~ s/\n/<br>/g;
	#	$val =~ s/[\x00-\x20]+/ /g;
		if($key eq 'mode' && $val eq 'admin'){
			$ouna_kensa = 1;
			$autolink = 1;
		}elsif($key eq 'url' && $val !~ m/^&lt;a./ ){
			#この項目は何もしない
		}else{
			if ($val =~ m/https?\:[\w\.\~\-\/\?\&\+\=\:\(\)\@\%\;\#\%]+/){
				$val =~ s/https?\:[\w\.\~\-\/\?\&\+\=\:\(\)\@\%\;\#\%]+/<b>ＵＲＬは、禁止されました。<\/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 "<table border='1'>";
print "<tr><th>フォーム要素名</th><th>データ</th></tr>";
#
foreach $key (keys %in) {
print "<tr><th>$key</th><td>$in{$key}</td></tr>\n";
}
print "</table>";
print "</BODY></html>";

exit;
#ここでメインは終わり。
sub error {
	#return;
	if(! $_[1]){
print	"<h1>ERROR $_[0] ダメやんか。</h1>\n";	#ほんとは、html内にあるとは限らない。
	}else{
print "Content-type:text/html\n\n";		
print "<!DOCTYPE html><head><title></title></head><BODY><h1>Error $_[0] !</h1>";
	}
print "</BODY></html>";
exit;
}
__END__
 ここからはメモ書きなに書いてもやらん。

'''''''
短いの
'''''''
#!C:/XAMPP/xampp/perl/bin/perl5.32.1
#!C:/Perl64/bin/perl
print "Content-type:text/html\n\n";

print '<!DOCTYPE html><html lang="ja"><head><meta charset="UTF-8"><title></title></head><BODY BGCOLOR="#ffffff"><h1>test decoder</h1>'."\n";
   print "it test1.<br>\n";


%in_d = (
    apple => 'iphon',
    banana => '150',
    cherry => '200'
);
# come = in_d["comment"]

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

sub decode{
	local($query,$saizu,@array);
print "ローカルに来たよ。<br>\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<br>\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<br>\n";
foreach $key (keys %in_d) {
print "$key $in_d{$key}<br>\n";
};


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

 print "it test.3<br>\n";
# form    #フォーム書き出しcoll


# def form

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

# print qq|<form action="$ENV{'SCRIPT_NAME'}" method="POST">\n|;
print qq|<form action="http://127.0.0.1/my_perl/perl_xampp5_test.cgi" method="GET">\n|;
print qq|<table border=0 cellspacing=1>\n
<tr><td><b>name</b></td><td><input type=text name=name size=28 value="$name" maxlength="12" class=f></td></tr>\n
<tr><td><b>submit</b></td><td><input type=text name=subm size=36 value="$subm" maxlength="36"class=f></td></tr>\n
<tr><td colspan=2><b>comment</b><br><textarea cols=70 rows=7 name=comment wrap="soft" class=f>$come</textarea></td></tr>\n
<tr><td><input type=submit value="submit"></td><td><input type=reset value="reset"></td></tr>\n
</form></table><br>\n|;

print "name=".$name."<br>$subm<br>".$come."<br>It OK?<br>\n";
# print()内に改行してはいけない(テキスト的に) html <!-- -->コメントを入れてはいけない　{}の文字として書き出しには\{\}としなければならない ""を使ってはならない\"\" \nと次の先頭をくつけてはならない。
# \n をやると、終わらねばならない。print は機能が高すぎる。変数が変数として区別できるか?

# end

# @key_array = keys %in_d;
foreach $key (keys %in_d) {
print "$key,$in_d{$key}<br>\n";
};
print "</body></html>\n";
exit;
'''''''
職人は作品で勝負や、口は達者ない、聞かれれば答えるが。