#!/usr/bin/perl -w ############################################################################# # # engine_details.cgi - CGI script for showing details for one engine # # KCEC scripts # # Copyright (C) 2005-2008 by Kirill Kryukov # # This software is provided 'as-is', without any express or implied # warranty. In no event will the author be held liable for any damages # arising from the use of this software. # # Any usage, modification or redistribution of this script requires author's # permission. # ############################################################################# use strict; use sigtrap; use warnings; use CGI qw/:standard/; use URI::Escape; use KCEC_utils; use KCEC_engines; use KCEC_rating_list; use KCEC_tables_2; print header(-charset=>'utf-8'); # Clean up the dump files. unlink(); $verbose = 0; read_options(); read_engine_info(); read_simple_statistics(); my $rating_list_file = "../$options{study_file_tag}.rating_list"; if (!-e $rating_list_file) { print "Rating list file can't be found!\n"; exit; } read_rating_list($rating_list_file,''); foreach my $i (@engines) { $i->{details_link} =~ s#href="cgi/#href="#; if (defined($i->{archive_name}) and $i->{archive_name} ne '') { $i->{archive_name} = '../' . $i->{archive_name}; } $i->{selected} = 0; } my $big_header = read_file_1('generated-engine-details-header.html'); my $big_footer = read_file_1('generated-engine-details-footer.html'); while ($big_header =~ m#href="(.*?)"#g) { my $found = $1; if ($found !~ m#/# and $found !~ m#http#) { $big_header =~ s#$found#../$found#; } } ################################### # # Reading print options. # my %print = (); my $only_best_in_class = 0; my $each_game = 0; my $match_length = int($options{min_games_for_a_pair}); if (!defined($match_length) or $match_length <= 0) { $match_length = 30; } if ($match_length > 1000) { $match_length = 1000; } my $sort_tables = ''; my $sort_tables_tag = "by_rating"; # # Output selection and print options # { if (param('print')) { %print = map { $_ => 1 } param('print'); } my @valid_print_items = ( 'Details','Details (text)' ); my ($num_valid, $num_invalid) = (0, 0); foreach my $item (@valid_print_items) { if ($print{$item}) { $num_valid++; } else { $num_invalid++; } } if ($num_valid <= 0) { %print = ( 'Details' => 1 ); } #foreach (keys %print) { print "Printing: \"$_\"
\n"; } if (param('only_best_in_class')) { $only_best_in_class = 1; } if (param('each_game')) { $each_game = 1; } { my $new_match_length = 0; if (param('match_length')) { $new_match_length = int((param('match_length'))[0]); } if (defined($new_match_length) and $new_match_length > 0 and $new_match_length <= 1000) { $match_length = $new_match_length; } } if (param('sort_tables')) { ($sort_tables) = param('sort_tables'); } if ($sort_tables ne 'by rating' and $sort_tables ne 'by name') { $sort_tables = 'by rating'; } foreach my $sort_tag (keys %engine_order) { if ($engine_order{$sort_tag}->{name} eq $sort_tables) { $sort_tables_tag = $sort_tag; last; } } } $gradient{gamenum} = "0:FFFFFF " . $match_length . ":2CDC4D " . 2*$match_length . ":2FA6DE"; ###################################################### # # Reading selection of engines. # my $num_engines_selected = 0; my $list_of_engines_uri = ''; my $list_of_engines_uri_from_the_class_only = ''; my $comparison_title = ''; my $selection_class = ''; my %selection_families = (); my %selection_engines = (); if (param('class')) { my ($class) = param('class'); $selection_class = $class; if (lc($class) eq 'selected engines' or lc($class) eq 'best selected engines') {} elsif (lc($class) eq 'none' or lc($class) eq 'nothing') {} else { my $class_tag = ''; foreach my $tag (keys %engine_selection) { if (lc($engine_selection{$tag}->{name}) eq lc($class)) { $class_tag = $tag; last; } } if ($class_tag) { my $filter = $engine_selection{$class_tag}->{filter}; foreach my $eng (@engines) { if (&$filter($eng) and !$eng->{selected}) { $eng->{selected} = 1; $num_engines_selected++; } } if ($only_best_in_class) { foreach my $eng (@engines) { if ($eng->{selected} and not engine_is_best_selected($eng)) { $eng->{selected} = 0; $num_engines_selected--; } } } if ($list_of_engines_uri ne '') { $list_of_engines_uri .= '&'; } $list_of_engines_uri .= "class=" . uri_escape($class); $comparison_title = $engine_selection{$class_tag}->{name}; } } } $list_of_engines_uri_from_the_class_only = $list_of_engines_uri; if (param('fam') or param('family')) { my @family_list = (); if (param('fam')) { push @family_list, param('fam'); } if (param('family')) { push @family_list, param('family'); } foreach my $a (@family_list) { $selection_families{$a} = 1; foreach my $b (@engines) { if ($a eq $b->{family}) { if (!$b->{selected}) { $b->{selected} = 1; $num_engines_selected++; } } } if ($list_of_engines_uri ne '') { $list_of_engines_uri .= '&'; } my $a_uri = uri_escape($a); $list_of_engines_uri .= "family=$a_uri"; } } if (param('eng') or param('engine') or param('engines')) { my @engine_list = (); if (param('eng')) { push @engine_list, param('eng'); } if (param('engine')) { push @engine_list, param('engine'); } if (param('engines')) { push @engine_list, param('engines'); } foreach my $a (@engine_list) { $selection_engines{$a} = 1; foreach my $b (@engines) { if ($a eq $b->{signature}) { if (!$b->{selected}) { $b->{selected} = 1; $num_engines_selected++; } } } if ($list_of_engines_uri ne '') { $list_of_engines_uri .= '&'; } my $a_uri = uri_escape($a); $list_of_engines_uri .= "engine=$a_uri"; } } if ($num_engines_selected == 1) { my $first_engine = ''; foreach my $eng (@engines) { if ($eng->{selected}) { $first_engine = $eng->{signature}; last; } } if ($first_engine) { $big_header =~ s##<title>$first_engine in #; } } print $big_header; print "<center>\n"; if ($options{engine_details_show_options}) { print "<form action=\"engine_details.cgi?$list_of_engines_uri\" method=\"get\">\n"; print "<table cellspacing=\"1\" cellpadding=\"1\" border=\"1\"><tr><td style=\"padding: 5pt;\">\n"; print "<div style=\"font-size: 14pt; margin-bottom: 5pt;\">Options</div>\n"; print "<input type=\"hidden\" name=\"print\" value=\"Details\">\n"; print "<input type=\"hidden\" name=\"match_length\" value=\"$match_length\">\n"; if ($selection_class) { print "<input type=\"hidden\" name=\"class\" value=\"$selection_class\">\n"; } foreach my $fam (keys %selection_families) { print "<input type=\"hidden\" name=\"fam\" value=\"$fam\">\n"; } foreach my $eng (keys %selection_engines) { print "<input type=\"hidden\" name=\"eng\" value=\"$eng\">\n"; } print "<input type=\"checkbox\" name=\"each_game\" value=1" . ($each_game ? ' checked' : '') . ">"; print " Show each game results<br>\n"; print "<center><input type=\"submit\" value=\"Show!\"></center>\n"; print "</td></tr></table>\n"; print "</form>\n"; } if ($num_engines_selected > 0) { print_all(); } else { print "No engines selected!\n"; } print "</center>\n"; print $big_footer; sub print_all { if ($print{'Details (text)'}) { print_details_text(); return; } if ($print{'Details'}) { print_details(); } } sub print_details() { my $engine_filter = $engine_selection{'selected'}->{filter}; my $engine_sorter = $engine_order{$sort_tables_tag}->{sorter}; my @index = (); my $INDEX; if (!open ($INDEX,'all_details_html_index')) { print "Can't find index file\n"; return; } while (<$INDEX>) { if (/^(\d+)::(\S+)\s*$/) { $index[$1] = $2; } } close $INDEX; foreach my $k ( sort { $b->{elo} <=> $a->{elo} } @engines) { if (! &$engine_filter($k)) { next; } if ($k->{games_played} <= 0) { next; } #my $details = read_file_1("details/" . $k->{file_name}); my $details = ''; if (!defined $index[$k->{index}]) { print "Can't find index for this engine<br>\n"; next; } if ($index[$k->{index}] !~ /^(\d+)::(\d+)$/) { print "Can't parse index for this engine<br>\n"; next; } my ($pos,$size) = ($1,$2); #print "Reading details at $pos, size = $size<br>\n"; my $DETAILS; if (!open ($DETAILS,'all_details_html')) { print "Can't find details file\n"; next; } binmode $DETAILS; seek $DETAILS, $pos, 0; read $DETAILS, $details, $size; close $DETAILS; $details =~ s/engine_details\.cgi\?/engine_details.cgi?match_length=$match_length&/g; my ($start, $finish) = ('', ''); if ($details =~ /^.*?<\!-- Rows -->\s*/s) { $start = $&; $details = $'; } #else { print "No start!<br>\n"; } if ($details =~ /<\!-- End of rows -->.*$/s) { $finish = $&; $details = $`; } #else { print "No finish!<br>\n"; } print $start; if (!$each_game) { $details =~ s/<tr class="r(e|o)wld">.*?<\/tr>//g; } $details =~ s/&each_game=\d/&each_game=$each_game/g; while ($details =~ /<tr.*?<\/tr>/g) { my $row = $&; # # Fixing color for "Score" column. # my $games_played = 0; if ($row =~ /<td class=\"res\"><b>([\d\.]+) − ([\d\.]+)<\/b>/) { $games_played = int($1 + $2); } if ($games_played > 0) { my $sc_col = ''; if ($row =~ /<td class=\"sc\">.+?<\/td>/) { $sc_col = $&; } if ($sc_col ne '') { if ($games_played < $match_length and $sc_col =~ /background-color/) { $row =~ s/(<td class=\"sc\">)<div[^>]+?>([\d\.\%]*)<\/div>(<\/td>)/$1$2$3/; #$row =~ s/–/Removed!–/; } elsif ($games_played >= $match_length and $sc_col !~ /background-color/) { my $score = ''; if ($sc_col =~ /([\d\.]+)\%/) { $score = $1; } if ($score ne '') { my $col = interpolate_color($score, $gradient{score}); $row =~ s/(<td class=\"sc\">)([\d\.\%]*)(<\/td>)/$1<div style=\"margin: 2pt; background-color:$col\">$2<\/div>$3/; #$row =~ s/–/Added!–/; } } #else { $row =~ s/–/Yo!–/; } } } print $row, "\n"; } print $finish; } } sub print_details_text() { my $engine_filter = $engine_selection{'selected'}->{filter}; my $engine_sorter = $engine_order{$sort_tables_tag}->{sorter}; my @index = (); my $INDEX; if (!open ($INDEX,'all_details_text_index')) { print "Can't find index file\n"; return; } while (<$INDEX>) { if (/^(\d+)::(\S+)\s*$/) { $index[$1] = $2; } } close $INDEX; foreach my $k ( sort { $b->{elo} <=> $a->{elo} } @engines) { if (! &$engine_filter($k)) { next; } if ($k->{games_played} <= 0) { next; } #my $details = read_file_1("details_text/" . $k->{file_name}); my $details = ''; if (!defined $index[$k->{index}]) { print "Can't find index for this engine<br>\n"; next; } if ($index[$k->{index}] !~ /^(\d+)::(\d+)$/) { print "Can't parse index for this engine<br>\n"; next; } my ($pos,$size) = ($1,$2); #print "Reading details at $pos, size = $size<br>\n"; my $DETAILS; if (!open ($DETAILS,'all_details_text')) { print "Can't find details file\n"; next; } binmode $DETAILS; seek $DETAILS, $pos, 0; read $DETAILS, $details, $size; close $DETAILS; print $details; } }