ファイル名: w/m2.cgi

#!/usr/local/bin/perl

#------------------------------------------------------------
$Title = 'm2';
$BODY = '<BODY BGCOLOR="#000000" TEXT="#C0C0C0">';
print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>$Title</TITLE></HEAD>\n";
print "$BODY\n";
$FONT_R = '<font color="#FF0000">';
$FONT_G = '<font color="#00FF00">';
$FONT_C = '</font>';
print "<blockquote>\n";
#------------------------------------------------------------
read(STDIN, $QUERY_DATA, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/,$QUERY_DATA);
foreach $pair (@pairs) {($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/</</g;
$value =~ s/>/>/g;
$value =~ s/\n//g;
$value =~ s/\,//g;
$FORM{$name} = $value;
}

if ($FORM{'action'} eq "true") { &HTML; }
else { print "$FONT_G regular exrression確かめCGI $FONT_C\n";
&INDEX;
}
sub INDEX
{
print "<form action=m2.cgi method=POST>\n";
print "<input type=hidden name=action value=true>\n";
print "regular exrression\n";
print "<BR><BR>\n";
print "<input type=text size=20 name=regular value=$FORM{'regular'}>\n";
print "<BR><BR>\n";
print "答え\n";
print "<BR><BR>\n";
print "<input type=text size=20 name=name value=$FORM{'name'}>\n";
print "<BR><BR>\n";
print "<input type=checkbox checked name=cook value=on>マッチした式を見る。
\n";
print "<input type=submit value=OK>\n";
print "<BR><BR>\n";
print "<HR>\n";
}
sub HTML {
$a = $FORM{'name'};
$b = $FORM{'regular'};
if ($a =~ /$b/) {
&OK($FORM{'regular'},$FORM{'name'});
} else {
print "$FONT_R 失敗! $FONT_C\n";
&INDEX;
}
}

sub OK {
if ($FORM{'cook'} ne "on")
{
print "<BR><BR>\n";
print "$FONT_G マッチしました。!$FONT_C\n";
print "<BR><BR>\n";
print "<a href=\"m2.cgi\">BACK</a>\n";
} else {
print "<BR><BR>\n";
print "<font size = +1>\$a = $_[1];</font>\n";
print "<BR>\n";
print "<font size = +1>\$a=~ /$_[0]/;</font>\n";
print "<BR><BR>\n";

print "$FONT_G マッチしました。!$FONT_C\n";
print "<BR><BR>\n";
&INDEX;
}
}
#------------------------------------------------------------
print "</blockquote>\n";
print "</BODY>\n";
print "</HTML>\n";
exit;