/[suikacvs]/perl/kanzan/kanzan.cgi
Suika

Contents of /perl/kanzan/kanzan.cgi

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.4 - (hide annotations) (download)
Wed Sep 4 09:02:38 2002 UTC (22 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +8 -6 lines 
2002-09-04  Wakaba <w@suika.fam.cx>

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