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 |
my %ex_point1 = ( |
|
7 |
kokugo => 54, |
} |
8 |
suugaku => 55, |
|
9 |
eigo => 57, |
my %ex_point1 = (); |
10 |
sekaishi => 53, |
( |
11 |
nihonshi => 0, |
kokugo => 54, |
12 |
chiri => 0, |
suugaku => 55, |
13 |
butsuri => 54, |
eigo => 57, |
14 |
kagaku => 52, |
sekaishi => 53, |
15 |
seibutsu => 0, |
nihonshi => 0, |
16 |
_OBJECT => 57, |
chiri => 0, |
17 |
); |
butsuri => 54, |
18 |
|
kagaku => 52, |
19 |
my %ex_point2 = ( |
seibutsu => 0, |
20 |
kokugo => 53, |
_OBJECT => 57, |
21 |
suugaku => 55, |
); |
22 |
eigo => 55, |
|
23 |
sekaishi => 52, |
my %ex_point2 = (); |
24 |
nihonshi => 0, |
( |
25 |
chiri => 0, |
kokugo => 53, |
26 |
butsuri => 54, |
suugaku => 55, |
27 |
kagaku => 51, |
eigo => 55, |
28 |
seibutsu => 0, |
sekaishi => 52, |
29 |
_OBJECT => 58, |
nihonshi => 0, |
30 |
); |
chiri => 0, |
31 |
|
butsuri => 54, |
32 |
my %ex_haiten1 = ( |
kagaku => 51, |
33 |
kokugo => 80, |
seibutsu => 0, |
34 |
suugaku => 80, |
_OBJECT => 58, |
35 |
eigo => 80, |
); |
36 |
sekaishi => 40, |
|
37 |
nihonshi => 0, |
my %ex_haiten1 = (); |
38 |
chiri => 0, |
( |
39 |
butsuri => 40, |
kokugo => 80, |
40 |
kagaku => 0, |
suugaku => 80, |
41 |
seibutsu => 0, |
eigo => 80, |
42 |
); |
sekaishi => 40, |
43 |
|
nihonshi => 0, |
44 |
my %ex_haiten2 = ( |
chiri => 0, |
45 |
kokugo => 0, |
butsuri => 40, |
46 |
suugaku => 300, |
kagaku => 0, |
47 |
eigo => 150, |
seibutsu => 0, |
48 |
sekaishi => 0, |
); |
49 |
nihonshi => 0, |
|
50 |
chiri => 0, |
my %ex_haiten2 = (); |
51 |
butsuri => 150, |
( |
52 |
kagaku => 150, |
kokugo => 0, |
53 |
seibutsu => 0, |
suugaku => 300, |
54 |
); |
eigo => 150, |
55 |
|
sekaishi => 0, |
56 |
|
nihonshi => 0, |
57 |
sub kanzan (%%%%) { |
chiri => 0, |
58 |
my ($point1, $full1, $point2, $full2) = @_; |
butsuri => 150, |
59 |
my (%kanzaned1, %kanzaned2); |
kagaku => 150, |
60 |
$$full1{_ALL} = 0; |
seibutsu => 0, |
61 |
for my $subject (keys %$full1) { |
); |
62 |
next if $subject =~ /^_/; |
|
63 |
$kanzaned1{$subject} = $$point1{$subject}*$$full1{$subject}/100; |
|
64 |
$kanzaned1{_ALL} += $kanzaned1{$subject}; |
sub kanzan (%%%%) { |
65 |
$$full1{_ALL} += $$full1{$subject}; |
my ($point1, $full1, $point2, $full2) = @_; |
66 |
} |
my (%kanzaned1, %kanzaned2); |
67 |
$kanzaned1{_PERCENT} = 100*$kanzaned1{_ALL}/$$full1{_ALL}; |
$$full1{_ALL} = 0; |
68 |
$$full2{_ALL} = 0; |
for my $subject (keys %$full1) { |
69 |
for my $subject (keys %$full2) { |
next if $subject =~ /^_/; |
70 |
next if $subject =~ /^_/; |
$kanzaned1{$subject} = $$point1{$subject}*$$full1{$subject}/100; |
71 |
$kanzaned2{$subject} = $$point2{$subject}*$$full2{$subject}/100; |
$kanzaned1{_ALL} += $kanzaned1{$subject}; |
72 |
$kanzaned2{_ALL} += $kanzaned2{$subject}; |
$$full1{_ALL} += $$full1{$subject}; |
73 |
$$full2{_ALL} += $$full2{$subject}; |
} |
74 |
} |
$kanzaned1{_PERCENT} = $$full1{_ALL}==0?0:100*$kanzaned1{_ALL}/$$full1{_ALL}; |
75 |
$kanzaned2{_PERCENT} = 100*$kanzaned2{_ALL}/$$full2{_ALL}; |
$$full2{_ALL} = 0; |
76 |
|
for my $subject (keys %$full2) { |
77 |
my ($percent, $object_percent); |
next if $subject =~ /^_/; |
78 |
$percent = 100*($kanzaned1{_ALL}+$kanzaned2{_ALL}) |
$kanzaned2{$subject} = $$point2{$subject}*$$full2{$subject}/100; |
79 |
/($$full1{_ALL}+$$full2{_ALL}); |
$kanzaned2{_ALL} += $kanzaned2{$subject}; |
80 |
$object_percent = ($$point1{_OBJECT}*$$full1{_ALL} |
$$full2{_ALL} += $$full2{$subject}; |
81 |
+$$point2{_OBJECT}*$$full2{_ALL}) |
} |
82 |
/($$full1{_ALL}+$$full2{_ALL}); |
$kanzaned2{_PERCENT} = $$full2{_ALL}==0?0:100*$kanzaned2{_ALL}/$$full2{_ALL}; |
83 |
($percent, $object_percent, \%kanzaned1, \%kanzaned2); |
|
84 |
} |
my ($percent, $object_percent); |
85 |
|
$percent = ($$full1{_ALL}+$$full2{_ALL})==0?0: |
86 |
my (%mypoint1, %mypoint2, %haiten1, %haiten2); |
100*($kanzaned1{_ALL}+$kanzaned2{_ALL}) |
87 |
if ($Suika::CGI::param{newform} ne 'no') { |
/($$full1{_ALL}+$$full2{_ALL}); |
88 |
%mypoint1 = %ex_point1; |
$object_percent = ($$full1{_ALL}+$$full2{_ALL})==0?0: |
89 |
%mypoint2 = %ex_point2; |
($$point1{_OBJECT}*$$full1{_ALL} |
90 |
%haiten1 = %ex_haiten1; |
+$$point2{_OBJECT}*$$full2{_ALL}) |
91 |
%haiten2 = %ex_haiten2; |
/($$full1{_ALL}+$$full2{_ALL}); |
92 |
} else { |
($percent, $object_percent, \%kanzaned1, \%kanzaned2); |
93 |
for my $s (keys %Suika::CGI::param) { |
} |
94 |
$mypoint1{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+[^H_])1$/; |
|
95 |
$mypoint2{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+[^H_])2$/; |
%Suika::CGI::param = %{__get_parameter ()}; |
96 |
$mypoint1{'_'.$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)_1$/; |
my (%mypoint1, %mypoint2, %haiten1, %haiten2); |
97 |
$mypoint2{'_'.$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)_2$/; |
if ($Suika::CGI::param{newform} ne 'no') { |
98 |
$haiten1{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)H1$/; |
%mypoint1 = %ex_point1; |
99 |
$haiten2{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)H2$/; |
%mypoint2 = %ex_point2; |
100 |
} |
%haiten1 = %ex_haiten1; |
101 |
} |
%haiten2 = %ex_haiten2; |
102 |
my ($percent, $object, $kanzan1, $kanzan2) |
} else { |
103 |
= kanzan ({%mypoint1} => {%haiten1}, {%mypoint2} => {%haiten2}); |
for my $s (keys %Suika::CGI::param) { |
104 |
|
$mypoint1{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+[^H_])1$/; |
105 |
print STDOUT "Content-Type: text/html; charset=euc-jisx0213 |
$mypoint2{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+[^H_])2$/; |
106 |
|
$mypoint1{'_'.$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)_1$/; |
107 |
"; |
$mypoint2{'_'.$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)_2$/; |
108 |
output_html (\%mypoint1 => \%haiten1 => $kanzan1, |
$haiten1{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)H1$/; |
109 |
\%mypoint2 => \%haiten2 => $kanzan2, |
$haiten2{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)H2$/; |
110 |
percent => $percent, object => $object); |
} |
111 |
|
} |
112 |
sub diffmark ($) { |
my ($percent, $object, $kanzan1, $kanzan2) |
113 |
my $diff = shift; |
= kanzan ({%mypoint1} => {%haiten1}, {%mypoint2} => {%haiten2}); |
114 |
return '□' if $diff < -4; |
|
115 |
return '△' if $diff < -2; |
print STDOUT "Content-Type: text/html; charset=euc-jp |
116 |
return '○' if $diff < 0; |
Content-Style-Type: text/css |
117 |
return '◎'; |
Content-Language: ja |
118 |
} |
|
119 |
|
"; |
120 |
sub output_html (%%%%%) { |
output_html (\%mypoint1 => \%haiten1 => $kanzan1, |
121 |
my ($p1 => $h1 => $k1, $p2 => $h2 => $k2, %misc) = @_; |
\%mypoint2 => \%haiten2 => $kanzan2, |
122 |
for my $n ($$k1{_PERCENT}, $$k2{_PERCENT}, $misc{percent}, $misc{object}) { |
percent => $percent, object => $object); |
123 |
$n = int ($n); |
|
124 |
} |
sub diffmark ($) { |
125 |
$$k1{_DIFF} = $$k1{_PERCENT}-$$p1{_OBJECT}; |
my $diff = shift; |
126 |
$$k2{_DIFF} = $$k2{_PERCENT}-$$p2{_OBJECT}; |
return '□' if $diff < -4; |
127 |
$misc{_DIFF} = $misc{percent}-$misc{object}; |
return '△' if $diff < -2; |
128 |
$$k1{_DIFFMARK} = diffmark ($$k1{_DIFF}); |
return '○' if $diff < 0; |
129 |
$$k2{_DIFFMARK} = diffmark ($$k2{_DIFF}); |
return '◎'; |
130 |
$misc{_DIFFMARK} = diffmark ($misc{_DIFF}); |
} |
131 |
print <<EOH; |
|
132 |
<!DOCTYPE html PUBLIC "-//W3D//DTD HTML 4.01//EN"> |
sub output_html (%%%%%) { |
133 |
<html lang="ja"> |
my ($p1 => $h1 => $k1, $p2 => $h2 => $k2, %misc) = @_; |
134 |
<head> |
for my $n ($$k1{_PERCENT}, $$k2{_PERCENT}, $misc{percent}, $misc{object}) { |
135 |
<title>配点換算</title> |
$n = int ($n); |
136 |
<style type="text/css"> |
} |
137 |
input {width: 3em} |
$$k1{_DIFF} = $$k1{_PERCENT}-$$p1{_OBJECT}; |
138 |
</style> |
$$k2{_DIFF} = $$k2{_PERCENT}-$$p2{_OBJECT}; |
139 |
</head> |
$misc{_DIFF} = $misc{percent}-$misc{object}; |
140 |
<body> |
$$k1{_DIFFMARK} = diffmark ($$k1{_DIFF}); |
141 |
<h1>配点換算</h1> |
$$k2{_DIFFMARK} = diffmark ($$k2{_DIFF}); |
142 |
<form action="kanzan" method="post" accept-charset="iso-2022-jp, iso-2022-jp-3"> |
$misc{_DIFFMARK} = diffmark ($misc{_DIFF}); |
143 |
<table> |
print <<EOH; |
144 |
<thead> |
<!DOCTYPE html PUBLIC "-//W3D//DTD HTML 4.01//EN"> |
145 |
<tr> |
<html lang="ja"> |
146 |
<th colspan="2">教科</th> |
<head> |
147 |
<th>国語</th><th>数学</th><th>英語</th> |
<title>配点換算</title> |
148 |
<th>世界史</th><th>日本史</th><th>地理</th> |
<link rev="made" href="mailto:w\@suika.fam.cx"> |
149 |
<th>物理</th><th>化学</th><th>生物</th> |
<link rel="contents" href="http://tomikou.net/tokshuu/kanzan.html" title="換算点算出システム |
150 |
</tr> |
"> |
151 |
</thead> |
<link rel="contents" href="/chuubu/"> |
152 |
<tbody> |
<link rel="stylesheet" href="/s/default/xhtml1" media="all"> |
153 |
<tr> |
<link rel="help" href="intro" title="説明" /> |
154 |
<th rowspan="3">一次</th><th>持ち点</th> |
<style type="text/css" media="all"> |
155 |
<td><input type="text" name="kokugo1" value="$$p1{kokugo}"></td> |
input {width: 3em} |
156 |
<td><input type="text" name="suugaku1" value="$$p1{suugaku}"></td> |
</style> |
157 |
<td><input type="text" name="eigo1" value="$$p1{eigo}"></td> |
</head> |
158 |
<td><input type="text" name="sekaishi1" value="$$p1{sekaishi}"></td> |
<body> |
159 |
<td><input type="text" name="nihonshi1" value="$$p1{nihonshi}"></td> |
<h1>配点換算</h1> |
160 |
<td><input type="text" name="chiri1" value="$$p1{chiri}"></td> |
<form action="kanzan" method="post" accept-charset="iso-2022-jp"> |
161 |
<td><input type="text" name="butsuri1" value="$$p1{butsuri}"></td> |
<table> |
162 |
<td><input type="text" name="kagaku1" value="$$p1{kagaku}"></td> |
<thead> |
163 |
<td><input type="text" name="seibutsu1" value="$$p1{seibutsu}"></td> |
<tr> |
164 |
</tr> |
<th colspan="2">教科</th> |
165 |
<tr> |
<th>国語</th><th>数学</th><th>英語</th> |
166 |
<th>配点</th> |
<th>世界史</th><th>日本史</th><th>地理</th> |
167 |
<td><input type="text" name="kokugoH1" value="$$h1{kokugo}"></td> |
<th>物理</th><th>化学</th><th>生物</th> |
168 |
<td><input type="text" name="suugakuH1" value="$$h1{suugaku}"></td> |
</tr> |
169 |
<td><input type="text" name="eigoH1" value="$$h1{eigo}"></td> |
</thead> |
170 |
<td><input type="text" name="sekaishiH1" value="$$h1{sekaishi}"></td> |
<tbody> |
171 |
<td><input type="text" name="nihonshiH1" value="$$h1{nihonshi}"></td> |
<tr> |
172 |
<td><input type="text" name="chiriH1" value="$$h1{chiri}"></td> |
<th rowspan="3">一次</th><th>持ち点</th> |
173 |
<td><input type="text" name="butsuriH1" value="$$h1{butsuri}"></td> |
<td><input type="text" name="kokugo1" value="$$p1{kokugo}"></td> |
174 |
<td><input type="text" name="kagakuH1" value="$$h1{kagaku}"></td> |
<td><input type="text" name="suugaku1" value="$$p1{suugaku}"></td> |
175 |
<td><input type="text" name="seibutsuH1" value="$$h1{seibutsu}"></td> |
<td><input type="text" name="eigo1" value="$$p1{eigo}"></td> |
176 |
</tr> |
<td><input type="text" name="sekaishi1" value="$$p1{sekaishi}"></td> |
177 |
<tr> |
<td><input type="text" name="nihonshi1" value="$$p1{nihonshi}"></td> |
178 |
<th>換算点</th> |
<td><input type="text" name="chiri1" value="$$p1{chiri}"></td> |
179 |
<td>$$k1{kokugo}</td><td>$$k1{suugaku}</td><td>$$k1{eigo}</td> |
<td><input type="text" name="butsuri1" value="$$p1{butsuri}"></td> |
180 |
<td>$$k1{sekaishi}</td><td>$$k1{nihonshi}</td><td>$$k1{chiri}</td> |
<td><input type="text" name="kagaku1" value="$$p1{kagaku}"></td> |
181 |
<td>$$k1{butsuri}</td><td>$$k1{kagaku}</td><td>$$k1{seibutsu}</td> |
<td><input type="text" name="seibutsu1" value="$$p1{seibutsu}"></td> |
182 |
</tr> |
</tr> |
183 |
|
<tr> |
184 |
<tr> |
<th>配点</th> |
185 |
<th rowspan="3">二次</th><th>持ち点</th> |
<td><input type="text" name="kokugoH1" value="$$h1{kokugo}"></td> |
186 |
<td><input type="text" name="kokugo2" value="$$p2{kokugo}"></td> |
<td><input type="text" name="suugakuH1" value="$$h1{suugaku}"></td> |
187 |
<td><input type="text" name="suugaku2" value="$$p2{suugaku}"></td> |
<td><input type="text" name="eigoH1" value="$$h1{eigo}"></td> |
188 |
<td><input type="text" name="eigo2" value="$$p2{eigo}"></td> |
<td><input type="text" name="sekaishiH1" value="$$h1{sekaishi}"></td> |
189 |
<td><input type="text" name="sekaishi2" value="$$p2{sekaishi}"></td> |
<td><input type="text" name="nihonshiH1" value="$$h1{nihonshi}"></td> |
190 |
<td><input type="text" name="nihonshi2" value="$$p2{nihonshi}"></td> |
<td><input type="text" name="chiriH1" value="$$h1{chiri}"></td> |
191 |
<td><input type="text" name="chiri2" value="$$p2{chiri}"></td> |
<td><input type="text" name="butsuriH1" value="$$h1{butsuri}"></td> |
192 |
<td><input type="text" name="butsuri2" value="$$p2{butsuri}"></td> |
<td><input type="text" name="kagakuH1" value="$$h1{kagaku}"></td> |
193 |
<td><input type="text" name="kagaku2" value="$$p2{kagaku}"></td> |
<td><input type="text" name="seibutsuH1" value="$$h1{seibutsu}"></td> |
194 |
<td><input type="text" name="seibutsu2" value="$$p2{seibutsu}"></td> |
</tr> |
195 |
</tr> |
<tr> |
196 |
<tr> |
<th>換算点</th> |
197 |
<th>配点</th> |
<td>$$k1{kokugo}</td><td>$$k1{suugaku}</td><td>$$k1{eigo}</td> |
198 |
<td><input type="text" name="kokugoH2" value="$$h2{kokugo}"></td> |
<td>$$k1{sekaishi}</td><td>$$k1{nihonshi}</td><td>$$k1{chiri}</td> |
199 |
<td><input type="text" name="suugakuH2" value="$$h2{suugaku}"></td> |
<td>$$k1{butsuri}</td><td>$$k1{kagaku}</td><td>$$k1{seibutsu}</td> |
200 |
<td><input type="text" name="eigoH2" value="$$h2{eigo}"></td> |
</tr> |
201 |
<td><input type="text" name="sekaishiH2" value="$$h2{sekaishi}"></td> |
|
202 |
<td><input type="text" name="nihonshiH2" value="$$h2{nihonshi}"></td> |
<tr> |
203 |
<td><input type="text" name="chiriH2" value="$$h2{chiri}"></td> |
<th rowspan="3">二次</th><th>持ち点</th> |
204 |
<td><input type="text" name="butsuriH2" value="$$h2{butsuri}"></td> |
<td><input type="text" name="kokugo2" value="$$p2{kokugo}"></td> |
205 |
<td><input type="text" name="kagakuH2" value="$$h2{kagaku}"></td> |
<td><input type="text" name="suugaku2" value="$$p2{suugaku}"></td> |
206 |
<td><input type="text" name="seibutsuH2" value="$$h2{seibutsu}"></td> |
<td><input type="text" name="eigo2" value="$$p2{eigo}"></td> |
207 |
</tr> |
<td><input type="text" name="sekaishi2" value="$$p2{sekaishi}"></td> |
208 |
<tr> |
<td><input type="text" name="nihonshi2" value="$$p2{nihonshi}"></td> |
209 |
<th>換算点</th> |
<td><input type="text" name="chiri2" value="$$p2{chiri}"></td> |
210 |
<td>$$k2{kokugo}</td><td>$$k2{suugaku}</td><td>$$k2{eigo}</td> |
<td><input type="text" name="butsuri2" value="$$p2{butsuri}"></td> |
211 |
<td>$$k2{sekaishi}</td><td>$$k2{nihonshi}</td><td>$$k2{chiri}</td> |
<td><input type="text" name="kagaku2" value="$$p2{kagaku}"></td> |
212 |
<td>$$k2{butsuri}</td><td>$$k2{kagaku}</td><td>$$k2{seibutsu}</td> |
<td><input type="text" name="seibutsu2" value="$$p2{seibutsu}"></td> |
213 |
</tr> |
</tr> |
214 |
</tbody> |
<tr> |
215 |
</table> |
<th>配点</th> |
216 |
|
<td><input type="text" name="kokugoH2" value="$$h2{kokugo}"></td> |
217 |
<table> |
<td><input type="text" name="suugakuH2" value="$$h2{suugaku}"></td> |
218 |
<thead> |
<td><input type="text" name="eigoH2" value="$$h2{eigo}"></td> |
219 |
<tr> |
<td><input type="text" name="sekaishiH2" value="$$h2{sekaishi}"></td> |
220 |
<th></th><th>得点率</th><th>目標点</th><th colspan="2">差</th> |
<td><input type="text" name="nihonshiH2" value="$$h2{nihonshi}"></td> |
221 |
</tr> |
<td><input type="text" name="chiriH2" value="$$h2{chiri}"></td> |
222 |
</thead> |
<td><input type="text" name="butsuriH2" value="$$h2{butsuri}"></td> |
223 |
<tbody> |
<td><input type="text" name="kagakuH2" value="$$h2{kagaku}"></td> |
224 |
<tr> |
<td><input type="text" name="seibutsuH2" value="$$h2{seibutsu}"></td> |
225 |
<th>一次</th> |
</tr> |
226 |
<td>$$k1{_PERCENT}</td> |
<tr> |
227 |
<td><input type="text" name="OBJECT_1" value="$$p1{_OBJECT}"></td> |
<th>換算点</th> |
228 |
<td>$$k1{_DIFF}</td> |
<td>$$k2{kokugo}</td><td>$$k2{suugaku}</td><td>$$k2{eigo}</td> |
229 |
<td>$$k1{_DIFFMARK}</td> |
<td>$$k2{sekaishi}</td><td>$$k2{nihonshi}</td><td>$$k2{chiri}</td> |
230 |
</tr> |
<td>$$k2{butsuri}</td><td>$$k2{kagaku}</td><td>$$k2{seibutsu}</td> |
231 |
<tr> |
</tr> |
232 |
<th>二次</th> |
</tbody> |
233 |
<td>$$k2{_PERCENT}</td> |
</table> |
234 |
<td><input type="text" name="OBJECT_2" value="$$p2{_OBJECT}"></td> |
|
235 |
<td>$$k2{_DIFF}</td> |
<table> |
236 |
<td>$$k2{_DIFFMARK}</td> |
<thead> |
237 |
</tr> |
<tr> |
238 |
<tr> |
<th></th><th>得点率</th><th>目標点</th><th colspan="2">差</th> |
239 |
<th>合計</th> |
</tr> |
240 |
<td>$misc{percent}</td> |
</thead> |
241 |
<td>$misc{object}</td> |
<tbody> |
242 |
<td>$misc{_DIFF}</td> |
<tr> |
243 |
<td>$misc{_DIFFMARK}</td> |
<th>一次</th> |
244 |
</tr> |
<td>$$k1{_PERCENT}</td> |
245 |
</tbody> |
<td><input type="text" name="OBJECT_1" value="$$p1{_OBJECT}"></td> |
246 |
</table> |
<td>$$k1{_DIFF}</td> |
247 |
|
<td>$$k1{_DIFFMARK}</td> |
248 |
<p> |
</tr> |
249 |
<input type="hidden" name="newform" value="no"> |
<tr> |
250 |
<input type="submit" value="OK"> |
<th>二次</th> |
251 |
</p> |
<td>$$k2{_PERCENT}</td> |
252 |
</form> |
<td><input type="text" name="OBJECT_2" value="$$p2{_OBJECT}"></td> |
253 |
EOH |
<td>$$k2{_DIFF}</td> |
254 |
} |
<td>$$k2{_DIFFMARK}</td> |
255 |
|
</tr> |
256 |
1; |
<tr> |
257 |
|
<th>合計</th> |
258 |
|
<td>$misc{percent}</td> |
259 |
|
<td>$misc{object}</td> |
260 |
|
<td>$misc{_DIFF}</td> |
261 |
|
<td>$misc{_DIFFMARK}</td> |
262 |
|
</tr> |
263 |
|
</tbody> |
264 |
|
</table> |
265 |
|
|
266 |
|
<p> |
267 |
|
<input type="hidden" name="newform" value="no"> |
268 |
|
<input type="submit" value="OK"> |
269 |
|
</p> |
270 |
|
</form> |
271 |
|
|
272 |
|
<div class="navigation"> |
273 |
|
[<a href="/gate/cvs/perl/kanzan/" lang="en">source</a>] |
274 |
|
[<a href="intro">説明</a>] |
275 |
|
</div> |
276 |
|
</body> |
277 |
|
</html> |
278 |
|
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 |
314 |
|
|
315 |
|
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 |
318 |
|
it under the terms of the GNU General Public License as published by |
319 |
|
the Free Software Foundation; either version 2 of the License, or |
320 |
|
(at your option) any later version. |
321 |
|
|
322 |
|
This program is distributed in the hope that it will be useful, |
323 |
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
324 |
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
325 |
|
GNU General Public License for more details. |
326 |
|
|
327 |
|
You should have received a copy of the GNU General Public License |
328 |
|
along with this program; see the file COPYING. If not, write to |
329 |
|
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
330 |
|
Boston, MA 02111-1307, USA. |
331 |
|
|
332 |
|
=cut |
333 |
|
|
334 |
|
1; # $Date$ |
335 |
|
|