#!/usr/local/bin/perl use strict; require Suika::CGI; my %ex_point1 = ( kokugo => 54, suugaku => 55, eigo => 57, sekaishi => 53, nihonshi => 0, chiri => 0, butsuri => 54, kagaku => 52, seibutsu => 0, _OBJECT => 57, ); my %ex_point2 = ( kokugo => 53, suugaku => 55, eigo => 55, sekaishi => 52, nihonshi => 0, chiri => 0, butsuri => 54, kagaku => 51, seibutsu => 0, _OBJECT => 58, ); my %ex_haiten1 = ( kokugo => 80, suugaku => 80, eigo => 80, sekaishi => 40, nihonshi => 0, chiri => 0, butsuri => 40, kagaku => 0, seibutsu => 0, ); my %ex_haiten2 = ( kokugo => 0, suugaku => 300, eigo => 150, sekaishi => 0, nihonshi => 0, chiri => 0, butsuri => 150, kagaku => 150, seibutsu => 0, ); sub kanzan (%%%%) { my ($point1, $full1, $point2, $full2) = @_; my (%kanzaned1, %kanzaned2); $$full1{_ALL} = 0; for my $subject (keys %$full1) { next if $subject =~ /^_/; $kanzaned1{$subject} = $$point1{$subject}*$$full1{$subject}/100; $kanzaned1{_ALL} += $kanzaned1{$subject}; $$full1{_ALL} += $$full1{$subject}; } $kanzaned1{_PERCENT} = 100*$kanzaned1{_ALL}/$$full1{_ALL}; $$full2{_ALL} = 0; for my $subject (keys %$full2) { next if $subject =~ /^_/; $kanzaned2{$subject} = $$point2{$subject}*$$full2{$subject}/100; $kanzaned2{_ALL} += $kanzaned2{$subject}; $$full2{_ALL} += $$full2{$subject}; } $kanzaned2{_PERCENT} = 100*$kanzaned2{_ALL}/$$full2{_ALL}; my ($percent, $object_percent); $percent = 100*($kanzaned1{_ALL}+$kanzaned2{_ALL}) /($$full1{_ALL}+$$full2{_ALL}); $object_percent = ($$point1{_OBJECT}*$$full1{_ALL} +$$point2{_OBJECT}*$$full2{_ALL}) /($$full1{_ALL}+$$full2{_ALL}); ($percent, $object_percent, \%kanzaned1, \%kanzaned2); } my (%mypoint1, %mypoint2, %haiten1, %haiten2); if ($Suika::CGI::param{newform} ne 'no') { %mypoint1 = %ex_point1; %mypoint2 = %ex_point2; %haiten1 = %ex_haiten1; %haiten2 = %ex_haiten2; } else { for my $s (keys %Suika::CGI::param) { $mypoint1{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+[^H_])1$/; $mypoint2{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+[^H_])2$/; $mypoint1{'_'.$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)_1$/; $mypoint2{'_'.$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)_2$/; $haiten1{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)H1$/; $haiten2{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)H2$/; } } my ($percent, $object, $kanzan1, $kanzan2) = kanzan ({%mypoint1} => {%haiten1}, {%mypoint2} => {%haiten2}); print STDOUT "Content-Type: text/html; charset=euc-jisx0213 "; output_html (\%mypoint1 => \%haiten1 => $kanzan1, \%mypoint2 => \%haiten2 => $kanzan2, percent => $percent, object => $object); sub diffmark ($) { my $diff = shift; return '□' if $diff < -4; return '△' if $diff < -2; return '○' if $diff < 0; return '◎'; } sub output_html (%%%%%) { my ($p1 => $h1 => $k1, $p2 => $h2 => $k2, %misc) = @_; for my $n ($$k1{_PERCENT}, $$k2{_PERCENT}, $misc{percent}, $misc{object}) { $n = int ($n); } $$k1{_DIFF} = $$k1{_PERCENT}-$$p1{_OBJECT}; $$k2{_DIFF} = $$k2{_PERCENT}-$$p2{_OBJECT}; $misc{_DIFF} = $misc{percent}-$misc{object}; $$k1{_DIFFMARK} = diffmark ($$k1{_DIFF}); $$k2{_DIFFMARK} = diffmark ($$k2{_DIFF}); $misc{_DIFFMARK} = diffmark ($misc{_DIFF}); print < 配点換算

配点換算

教科		国語	数学	英語	世界史	日本史	地理	物理	化学	生物
一次	持ち点
	配点
	換算点	$$k1{kokugo}	$$k1{suugaku}	$$k1{eigo}	$$k1{sekaishi}	$$k1{nihonshi}	$$k1{chiri}	$$k1{butsuri}	$$k1{kagaku}	$$k1{seibutsu}
二次	持ち点
	配点
	換算点	$$k2{kokugo}	$$k2{suugaku}	$$k2{eigo}	$$k2{sekaishi}	$$k2{nihonshi}	$$k2{chiri}	$$k2{butsuri}	$$k2{kagaku}	$$k2{seibutsu}

	得点率	目標点	差
一次	$$k1{_PERCENT}		$$k1{_DIFF}	$$k1{_DIFFMARK}
二次	$$k2{_PERCENT}		$$k2{_DIFF}	$$k2{_DIFFMARK}
合計	$misc{percent}	$misc{object}	$misc{_DIFF}	$misc{_DIFFMARK}

EOH } 1;