| 1 |
#!/usr/local/bin/perl |
#!/usr/bin/perl |
| 2 |
|
|
| 3 |
use strict; |
use strict; |
| 4 |
require Suika::CGI; |
|
| 5 |
|
for (split /[&;]/, $main::ENV{QUERY_STRING}) { |
| 6 |
|
|
| 7 |
|
} |
| 8 |
|
|
| 9 |
my %ex_point1 = (); |
my %ex_point1 = (); |
| 10 |
( |
( |
| 92 |
($percent, $object_percent, \%kanzaned1, \%kanzaned2); |
($percent, $object_percent, \%kanzaned1, \%kanzaned2); |
| 93 |
} |
} |
| 94 |
|
|
| 95 |
|
%Suika::CGI::param = %{__get_parameter ()}; |
| 96 |
my (%mypoint1, %mypoint2, %haiten1, %haiten2); |
my (%mypoint1, %mypoint2, %haiten1, %haiten2); |
| 97 |
if ($Suika::CGI::param{newform} ne 'no') { |
if ($Suika::CGI::param{newform} ne 'no') { |
| 98 |
%mypoint1 = %ex_point1; |
%mypoint1 = %ex_point1; |
| 146 |
<head> |
<head> |
| 147 |
<title>配点換算</title> |
<title>配点換算</title> |
| 148 |
<link rev="made" href="mailto:w\@suika.fam.cx"> |
<link rev="made" href="mailto:w\@suika.fam.cx"> |
| 149 |
<link rel="contents" href="http://tomikou.net/"> |
<link rel="contents" href="http://tomikou.net/tokshuu/kanzan.html" title="換算点算出システム |
| 150 |
|
"> |
| 151 |
<link rel="contents" href="/chuubu/"> |
<link rel="contents" href="/chuubu/"> |
| 152 |
<style type="text/css"> |
<link rel="stylesheet" href="/s/default/xhtml1" media="all"> |
| 153 |
|
<link rel="help" href="intro" title="説明" /> |
| 154 |
|
<style type="text/css" media="all"> |
| 155 |
input {width: 3em} |
input {width: 3em} |
| 156 |
</style> |
</style> |
| 157 |
</head> |
</head> |
| 158 |
<body> |
<body> |
| 159 |
<h1>配点換算</h1> |
<h1>配点換算</h1> |
| 160 |
<form action="kanzan" method="post" accept-charset="iso-2022-jp, iso-2022-jp-3"> |
<form action="kanzan" method="post" accept-charset="iso-2022-jp"> |
| 161 |
<table> |
<table> |
| 162 |
<thead> |
<thead> |
| 163 |
<tr> |
<tr> |
| 270 |
</form> |
</form> |
| 271 |
|
|
| 272 |
<div class="navigation"> |
<div class="navigation"> |
| 273 |
[<a href="/gate/cvs/perl/kanzan/" xml:lang="en">source</a>] |
[<a href="/gate/cvs/perl/kanzan/" lang="en">source</a>] |
| 274 |
|
[<a href="intro">説明</a>] |
| 275 |
</div> |
</div> |
| 276 |
</body> |
</body> |
| 277 |
</html> |
</html> |
| 278 |
EOH |
EOH |
| 279 |
} |
} |
| 280 |
|
|
| 281 |
|
sub __get_parameter () { |
| 282 |
|
my @src; |
| 283 |
|
|
| 284 |
|
## Query-string of Request-URI |
| 285 |
|
my $qs = $main::ENV{QUERY_STRING}; |
| 286 |
|
push @src, $qs if (index ($qs, '=') > -1); |
| 287 |
|
|
| 288 |
|
## Entity-body |
| 289 |
|
if ($main::ENV{REQUEST_METHOD} eq 'POST') { |
| 290 |
|
my $mt = $main::ENV{CONTENT_TYPE}; |
| 291 |
|
if ($mt =~ m<^application/(?:x-www|sgml)-form-urlencoded\b>) { |
| 292 |
|
my $body; |
| 293 |
|
read STDIN, $body, $main::ENV{CONTENT_LENGTH}; |
| 294 |
|
push @src, $body; |
| 295 |
|
} |
| 296 |
|
} |
| 297 |
|
|
| 298 |
|
my %temp_params; |
| 299 |
|
for my $src (@src) { |
| 300 |
|
for (split /[;&]/, $src) { |
| 301 |
|
my ($name, $val) = split '=', $_, 2; |
| 302 |
|
for ($name, $val) { |
| 303 |
|
tr/+/ /; |
| 304 |
|
s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge; |
| 305 |
|
} |
| 306 |
|
$temp_params{$name} = $val; |
| 307 |
|
} |
| 308 |
|
} |
| 309 |
|
\%temp_params; |
| 310 |
|
} |
| 311 |
|
|
| 312 |
|
|
| 313 |
=head1 LICENSE |
=head1 LICENSE |
| 314 |
|
|
| 315 |
Copyright 2001-2002 wakaba E<lt>w@suika.fam.cxE<gt>. |
Copyright 2001-2004 Wakaba E<lt>w@suika.fam.cxE<gt>. |
| 316 |
|
|
| 317 |
This program is free software; you can redistribute it and/or modify |
This program is free software; you can redistribute it and/or modify |
| 318 |
it under the terms of the GNU General Public License as published by |
it under the terms of the GNU General Public License as published by |
| 332 |
=cut |
=cut |
| 333 |
|
|
| 334 |
1; # $Date$ |
1; # $Date$ |
| 335 |
### kanzan.cgi ends here |
|
Parent Directory
| 
Revision Log
| 
Patch