#!/usr/bin/perl
# Copyright (C) by Dmitry E. Oboukhov 2006, 2007
# 
#   This package is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#   
#   This package is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#   
#   You should have received a copy of the GNU General Public License
#   along with this package; if not, write to the Free Software
#   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA

use strict;
use warnings;

our $VERSION=0.33;

eval {

# use encoding 'utf8';
# binmode(STDOUT=>'encoding(utf8)');
require HTML::Template;
require CGI::Simple;
require POSIX;
require IPC::Open2;
require Sys::CPU;

# количество процессов для симуляции
my $forks_count=eval { Sys::CPU::cpu_count(); };
$forks_count or $forks_count=1;

# максимальное время счета симулятором
# 0 = no limits
my $max_simulation_time=15;

# имя скрипта
my $script_name;

# урл скрипта
my $script_url;

# доступные языки (и кодировки к ним)
my %langs=
( 
  ru => [ 'utf-8', 'Russian', 'small_ru.gif' ], 
  en => [ 'utf-8', 'English', 'small_en.gif' ],  
  sp => [ 'utf-8', 'Spanish', 'small_es.gif' ],  
  ca => [ 'utf-8', 'Catalan', 'small_es-catal.gif' ],
  fr => [ 'utf-8', 'French',  'small_fr.gif' ],
  de => [ 'utf-8', 'Deutsch', 'small_de.gif' ],
  cz => [ 'utf-8', 'Czech',   'cz-flag.gif' ],
  cn => [ 'utf-8', 'Chinese', 'cn-flag.gif' ],
  pl => [ 'utf-8', 'Polish',  'small_pl.gif' ],
);

# дефолтный путь к фаблону html
my $template_name='template/sim.en.html';

# конфиг юнитов
my $units_conf='csim/units.conf';

# дефолтный язык
my $lang='en';

# заголовок
my $title=sprintf "GPL Ogame Simulator GUI v%1.2f", $VERSION;

# путь к симулятору
my $simulator='./csim/csim';

# включить отладку
my $debug=0;

# количество симуляций по умолчанию
my $simulations=100;

# максимальное количество симуляций
my $max_simulations=200;

# данные из CGI и данные по всем юнитам и названия ресурсов
# в шпионских докладах
my (%cgi, @units, %info);

# счетчик посещений
my $counter_file='spool/counter.txt';

# лимит на количество юнитов
my $units_limit=1000000;


# возвращает номер версии csim
sub get_version_csim()
{
  open my $csim, "-|", $simulator, "-V";
  my $version=<$csim>;
  chomp($version);
  close $csim;

  $? or return $version;
  return;
}

# делает из длинного целого числа число с разделенными точками
# то есть например из 123456789 сделает 123.456.789
sub longint_to_str($)
{
  my ($num)=@_;
  $num or return $num;

  my @letters=unpack('c*', "$num");
  $_=pack('c', $_) for @letters;

  my @result; my $i=0;
  for (my $i=1; @letters; $i++)
  {
    unshift @result, pop @letters;
    $i<3 and next;
    $i=0;
    unshift @result, '.';
  }

  $result[0] eq '.' and shift @result;
  return join("", @result);
}

# читает конфиг, возвращает массив юнитов
sub get_hash_info()
{
  -e $units_conf or die "Can not find $units_conf: $!";

  open my $conf, "<", $units_conf;
  my @lines=<$conf>;
  close $conf;

  s/^\s+//, s/#.*$//, s/\s+$// for @lines;

  # выбираем по очереди юнит за юнитом
  for (my $uno=1; my @unit=grep /^unit$uno\./i, @lines; $uno++)
  {
    my %unifo;
    ($unifo{name_default})=grep /^unit$uno\.name[\s=]/i, @unit;
    $unifo{name_default}=~s/^unit$uno\.name\s*=\s*//i;
    defined $unifo{name_default} or die "option 'unit$uno.name' not defined!";

    for my $lang (keys %langs)
    {
      $unifo{"name_$lang"}=$unifo{name_default};
      my ($name)=grep /^unit$uno\.name\.$lang(?:[\s=])/i, @unit;
      $name=~s/^unit$uno\.name\.$lang\s*=\s*//i;

      defined $name or die "option 'unit$uno.name.$lang' not defined!";
      $unifo{"name_$lang"}=$name;

    }

    my ($order)=grep /^unit$uno\.order[\s=]/i, @unit;
    defined $order and $order=~s/^unit$uno\.order\s*=\s*//i;
    defined $order or die "Can not find unit$uno.order";
    $unifo{order}=$order;

    my ($ground)=grep /^unit$uno\.ground[\s=]/i, @unit;
    defined $ground and $ground=~s/^unit$uno\.ground\s*=\s*//;
    defined $ground or $ground=0;
    $unifo{ground}=$ground;

    my ($capacity)=grep /^unit$uno\.capacity[\s=]/i, @unit;
    defined $capacity and $capacity=~s/^unit$uno\.capacity\s*=\s*//i;
    defined $capacity or $capacity=0;
    $unifo{capacity}=$capacity;

    push @units, \%unifo;
  }
  @units = sort { $a->{order} <=> $b->{order} } @units;


  # информация о названиях ресурсов и технологий
  # в шпионских докладах (для парсинга)
  # всякие переводы
  for my $par (qw(metal crystal deut attack shield
    armory attacker defender debris),
    'debris.loss', 'debris.max_loss', 'debris.min_loss',
    'debris.min', 'debris.max',
  )
  {
    for (grep(/^$par\./i, @lines))
    {
      /^([\w\-_\.]+) ?= ?(.*)/ and $info{$1}=$2;
    }

    for (keys %langs)
    {
      exists $info{"$par.$_"} or
        die "Option '$par.$_' not defined!";
    }
  }
}


# запускает симуляцию (в форке)
sub start_sim($)
{
  my ($task)=@_;
  my ($reader, $writer);

  my $pid=IPC::Open2::open2($reader, $writer, 
    $simulator, 
      "-s", $simulations, 
      "-t", $max_simulation_time,
      "-f", $forks_count,
    ) or die "Can not start '$simulator': $!";

  print $writer $task;
  close $writer;
  
  my @lines=<$reader>;
  waitpid $pid, 0;

#   $? or 
  return @lines;
}

# парсит результаты симуляции
sub parse_result(@)
{
  my (@lines)=@_;

  my ($section, %sections)=('begin',);
  for (@lines)
  {
    s/^\s+//; s/\s+$//; s/\s+/ /g;
    /^\s*$/ and next;
    /\[(.*)\]/ and $section=$1, next;
    exists $sections{$section} or $sections{$section}=[];
    push @{$sections{$section}}, $_;
  }

  # проверяем все ли секции на месте
  for ('begin', 'Simulate task', 'Simulate info', 'Best attacker',
      'Worst attacker', 'Best defender', 'Worst defender',
      'Average debris', 'Minimum debris', 'Maximum debris',
      'Average simulation', 'Average capacity after combat',
      'Attacker plunder')
  {
    # ошибочный файл
    exists $sections{$_} or 
    return (  result          =>  join("\n", @lines), );
  }

  # парсим все выводы результатов боя
  for my $cmb ('Simulate task', 'Best attacker',  'Worst attacker',
          'Best defender', 'Worst defender', 'Average simulation')
  {
    my %result; my $what='attacker';
    for (@{$sections{$cmb}})
    {
      $what='attacker', next if /^Attacker/i;
      $what='defender', next if /^Defender/i;

      /^(.*?)\s*:\s*(\d+.*)/ or next;
      $result{$what}{$1}=$2;
    }
    $sections{$cmb}=\%result;
  }

  # добытые ресурсы
  my ($metal, $crystal, $deut, $nsmall, $nlarge)=(0, 0, 0, 0, 0);

  for (@{$sections{"Attacker plunder"}})
  {
    /^Metal\s*:\s*(\d+)/i and $metal=longint_to_str $1;
    /^Crystal\s*:\s*(\d+)/i and $crystal=longint_to_str $1;
    /^Deut\s*:\s*(\d+)/i and $deut=longint_to_str $1;
    /^Needed Small chargo: (\d+)/i and $nsmall=$1;
    /^Needed Large chargo: (\d+)/i and $nlarge=$1;
  }
  $sections{resource}=[ $metal, $crystal, $deut, $nsmall, $nlarge];

  for my $debris ('Minimum debris', 'Maximum debris', 'Average debris')
  {
    my %result;
    for (@{$sections{$debris}})
    {
      /^Attacker loss: metal=(\d+) crystal=(\d+) deuterium=(\d+)/i
        and $result{attacker}=[$1, $2, $3];
      /^Defender loss: metal=(\d+) crystal=(\d+) deuterium=(\d+)/i
        and $result{defender}=[$1, $2, $3];
      /^Common loss: metal=(\d+) crystal=(\d+) deuterium=(\d+)/i
        and $result{both}=[$1, $2, $3];

      /^Debris with ground: metal=(\d+) crystal=(\d+)/i
        and $result{debris_with_ground}=[$1, $2, $1+$2];
      /^Debris without ground: metal=(\d+) crystal=(\d+)/i
        and $result{debris}=[int $1, int $2, $1+$2];

      /^Recyclers with ground: (\d+)/i and $result{recyclers_with_ground}=$1;
      
      /^Recyclers without ground: (\d+)/i and $result{recyclers}=$1;

      /^Chance moon without ground: (\d+%)/i and $result{moon}=$1;

      /^Chance moon with ground: (\d+%)/i and $result{moon_with_ground}=$1;
    }

    for my $ary ($result{attacker}, $result{defender}, $result{both},
      $result{debris_with_ground}, $result{debris})
    {
      $ary->[0]=longint_to_str $ary->[0];
      $ary->[1]=longint_to_str $ary->[1];
      $ary->[2]=longint_to_str $ary->[2];
    }

    $sections{$debris}=\%result;
  }

  # количество раундов
  my ($rounds)=grep /^Rounds:/, @{$sections{"Simulate info"}};
  $sections{rounds}=['', '', ''];
  $rounds and $rounds=~/^Rounds: (\d+\.\d+) \((\d), (\d)\)/
    and  $sections{rounds}=[$1, $2, $3];


  for my $who ('attacker', 'defender')
  {
    $sections{$who."_win"}=['', ''];
    my ($win)=grep /^$who win: \d+\/\d+/i, @{$sections{"Simulate info"}};
    $win and $win=~/^$who win: (\d+)\/(\d+)/i
      and $sections{$who."_win"}=[$1, $2];
  }

  return
  (
    result          =>  join("\n", @lines),
    %sections,
  );
}

# делает симуляцию
sub simulate()
{
  $cgi{'no_count'} and return ();

  my @task=("\ndefender\n",);

  # составляем задание для симулятора
  for (my $uno=0; $uno < scalar @units; $uno++)
  {
    my $name=$units[$uno]->{name_default};
    $cgi{"a$uno"} and unshift @task, "$name=" . $cgi{"a$uno"};
    $cgi{"d$uno"} and push @task, "$name=" . $cgi{"d$uno"};
  }

  # если в задании нет атакера или дефендера - не считаем ничего
  $task[0] =~  /defender/si and 
    $task[-1] =~ /defender/si and return ();


  # параметры атакера и дефендера
  push @task, ''; unshift @task, '';
  for (qw(attack shield armory))
  {
    exists $cgi{"a$_"} and unshift @task, "$_=" . $cgi{"a$_"};
    exists $cgi{"d$_"} and push @task, "$_=" . $cgi{"d$_"};
  }

  unshift @task, "attacker\n";

  # ресурсы у дефендера
  $cgi{dmetal} and push @task, "\nmetal=$cgi{dmetal}";
  $cgi{dcrystal} and push @task, "crystal=$cgi{dcrystal}";
  $cgi{ddeut} and push @task, "deut=$cgi{ddeut}";

  my $task=join("\n", @task);

  my %sim=parse_result(start_sim $task);

  return
  (
    task            =>  $task,
    %sim
  );
}

# определяем путь к скрипту (URL)
if (exists $ENV{SCRIPT_NAME})
{
  # имя скрипта
  $script_name=$ENV{SCRIPT_NAME};

  # урл скрипта
  exists $ENV{HTTP_HOST} and
    $script_url="http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}";
}
else
{
  $script_name="$0";
  $script_name=~s/.*[\/\\]//;
  $script_url=$script_name;
}

%cgi=CGI::Simple->new()->Vars;
{
  my $reload=0;
  my $request='';
  for (keys %cgi)
  {
    defined $cgi{$_} or $reload=1, next;
    length $cgi{$_} or $reload=1, next;
    length $request and $request .= '&';
    $request .= "$_=$cgi{$_}";
  }
  if ($reload)
  {
    print "location: $script_url?$request\n\n";
    exit 0;
  }
}

get_hash_info();
# определяем язык на котором выдавать интерфейс
if (defined $cgi{lang})
{
  my $form_lang=$cgi{lang};
  exists $langs{$form_lang} and $lang=$form_lang;
} 
elsif (defined $ENV{HTTP_ACCEPT_LANGUAGE})
{
  my $accept_langs=$ENV{HTTP_ACCEPT_LANGUAGE};
  $accept_langs=~s/;.*$//;
  $accept_langs=~s/\s+//g;
  for (split /,/, $accept_langs)
  {
    if (exists $langs{$_})
    {
      $lang=$_;
      last;
    }
  }
}

{
  my $tname=$template_name;
  $tname=~s/\.\w\w\.htm(l)?$/.$lang.htm$1/;
  -e $tname and $template_name=$tname;
}
my $template=HTML::Template->new(filename => $template_name);

# все параметры или целые числа
# или undef (кроме lang)
for (keys %cgi)
{
  s/\s+//g;
  $_ eq 'lang' and next;
  $_ eq 'report' and next;
  defined $cgi{$_} or next;
  length $cgi{$_} or next;
  $cgi{$_} = abs int $cgi{$_};

  $units_limit and /^[ad]\d+/ and
    $cgi{$_}>$units_limit and $cgi{$_}=$units_limit;
}

$template->param(script_name    =>  $script_name);


$cgi{simulations} and $cgi{simulations}<=$max_simulations
  and $simulations=$cgi{simulations};
$template->param(simulations  => $simulations);

# получить репорт
if ($cgi{get_report})
{
  $template->param(get_report => 1);
  # язык
  $template->param(lang => $lang);

  if ($cgi{report})
  {
    my $report=$cgi{report};
    $report=~s/\s+/ /sg;
    $report=~s/\.//g;


    my @defender;

    # юниты
    for (my $uno=0; $uno<scalar @units; $uno++)
    {
      push @defender, [ "d$uno", '' ];
      my $unit=$units[$uno];

      my @names;

      # собираем все возможные названия данного юнита
      push @names, $unit->{name_default};
      push @names, $unit->{"name_$_"} for keys %langs;

      for my $name (@names)
      {
        if ($report=~/$name\s*:?\s*(\d+)/i)
        {
          $defender[-1]->[1]=$1;
          last;
        }
      }
    }

    for (@defender)
    {
      my %res;
      $res{item}=$$_[0];
      $res{value}=$$_[1];
      $_=\%res;
    }

    # технологии и ресурсы
    for my $item (qw(metal crystal deut attack shield armory))
    {
      # собираем всевозможные имена для ресурса/технологии
      my @names;
      push @names, $info{"$item.$_"} for keys %langs;

      my %res=(item=>"d$item", value=>'');
      for my $name (@names)
      {
        if ($report=~/$name\s*:?\s*(\d+)/i)
        {
          $res{value}=$1;
          last;
        }
      }

      push @defender, \%res;
    }

    $template->param(FromRep  =>  \@defender);
    $template->param(report_parsed  =>  1);
  }
}
# вывести основной репорт
else
{
  my %sim;
  %sim=simulate() unless ($cgi{no_count});

  # массив флотов и защитных сооруужений
  my (@fleet, @ground);

  my $uno=0;
  # выводим флот и защиту
  for (my $uno=0; $uno < scalar @units; $uno++)
  {
    my $unit=$units[$uno];

    my ($acount, $dcount)=('', '');
    $cgi{"a$uno"} and $acount=$cgi{"a$uno"};
    $cgi{"d$uno"} and $dcount=$cgi{"d$uno"};

    my $array=\@fleet;
    $unit->{ground} and $array=\@ground;

    my ($average_attacker, $average_defender,
        $best_attacker, $worst_attacker,
        $best_defender, $worst_defender)=(0, 0, 0, 0, 0, 0);

    $acount or
      $best_attacker=$worst_attacker=$average_attacker='-';
    $dcount or
      $best_defender=$worst_defender=$average_defender='-';
    $unit->{ground} and
      $best_attacker=$worst_attacker=$average_attacker='';

    for my $item  ( [\$average_attacker =>
                      attacker  => 'Average simulation'],
                    [\$average_defender  =>
                      defender  => 'Average simulation'],
                    [\$best_attacker  =>
                      attacker  => 'Best attacker'],
                    [\$best_defender  =>
                      defender  => 'Best defender'],
                    [\$worst_attacker =>
                      attacker  => 'Worst attacker'],
                    [\$worst_defender =>
                      defender  => 'Worst defender'])
    {
      my ($link_value, $who, $section)=@{$item};

      exists $sim{$section}->{$who}{$unit->{name_default}} and
        $$link_value=$sim{$section}->{$who}{$unit->{name_default}};
    }

    push @{$array},
    {
      unit                =>  $unit->{"name_$lang"},
      present_attacker    =>  ($unit->{ground} or $uno==10)?0:1,
      no                  =>  $uno,
      acount              =>  $acount,
      dcount              =>  $dcount,
      average_attacker    =>  $average_attacker,
      average_defender    =>  $average_defender,
      best_attacker       =>  $best_attacker,
      worst_attacker      =>  $worst_attacker,
      best_defender       =>  $best_defender,
      worst_defender      =>  $worst_defender,
    };
  }

  $template->param(Fleet    => \@fleet);
  $template->param(Ground   => \@ground);

  for (qw(aattack dattack ashield dshield
          aarmory darmory dmetal dcrystal ddeut))
  {
    exists $cgi{$_} and $template->param($_ => $cgi{$_});
  }

  if ($sim{task})
  {
    $template->param(show_statistic => 1);
    my @losses;
    # выводим потери/обломки
    for (
      ["debris.loss"        => 'Average debris'],
      ["debris.min_loss"    => 'Minimum debris'],
      ["debris.max_loss"    => 'Maximum debris'],
    )
    {
      my ($name, $section)=($info{"$$_[0].$lang"}, $$_[1]);

      my %lss=(
        loss_name             => $name,
        attacker_loss_metal   => $sim{$section}->{attacker}->[0],
        attacker_loss_crystal => $sim{$section}->{attacker}->[1],
        attacker_loss_deut    => $sim{$section}->{attacker}->[2],

        defender_loss_metal   => $sim{$section}->{defender}->[0],
        defender_loss_crystal => $sim{$section}->{defender}->[1],
        defender_loss_deut    => $sim{$section}->{defender}->[2],
      );
      push @losses, \%lss;
    }
    $template->param(Losses => \@losses);


    # обломки
    my @debris;
    for (
      ["debris"             => 'Average debris'],
      ["debris.min"         => 'Minimum debris'],
      ["debris.max"         => 'Maximum debris'],
    )
    {
      my ($name, $section)=($info{"$$_[0].$lang"}, $$_[1]);
      my %dbr=(
        dbr_name              => $name,
        debris_metal          => 
          $sim{$section}->{debris}->[0],
        debris_crystal        => 
          $sim{$section}->{debris}->[1],
        with_ground_debris_metal    => 
          $sim{$section}->{debris_with_ground}->[0],
        with_ground_debris_crystal  => 
          $sim{$section}->{debris_with_ground}->[1],
        debris_total                => 
          $sim{$section}->{debris}->[2],
        with_ground_debris_total    =>
          $sim{$section}->{debris_with_ground}->[2],
      );
      push @debris, \%dbr;
    }
    $template->param(Debris =>  \@debris);

    # переработчики
    for (
      [ 'Average debris'  => 'recyclers' =>  'wg_recyclers' ],
      [ 'Minimum debris'  => 'min_recyclers'  =>  'wg_min_recyclers' ],
      [ 'Maximum debris'  => 'max_recyclers'  =>  'wg_max_recyclers' ],
    )
    {
      my ($section, $var, $wgvar)=@{$_};
      $template->param($var =>  $sim{$section}->{recyclers});
      $template->param($wgvar => $sim{$section}->{recyclers_with_ground});
    }

    # шанс луны
    $sim{'Average debris'}{moon} and
      $template->param(without_ground_chance_moon =>
        $sim{'Average debris'}{moon});
    $sim{'Average debris'}{moon_with_ground} and
      $template->param(with_ground_chance_moon =>
        $sim{'Average debris'}{moon_with_ground});


    $template->param(rounds => $sim{rounds}->[0]);
    $template->param(min_rounds => $sim{rounds}->[1]);
    $template->param(max_rounds => $sim{rounds}->[2]);

    # ресурсы
    $template->param(ametal   => $sim{resource}->[0]);
    $template->param(acrystal => $sim{resource}->[1]);
    $template->param(adeut    => $sim{resource}->[2]);
    $template->param(small_chargos  => $sim{resource}->[3]);
    $template->param(large_chargos  => $sim{resource}->[4]);
    
    # количество побед
    $template->param(attacker_win  =>  $sim{attacker_win}->[0]);
    $template->param(defender_win  =>  $sim{defender_win}->[0]);
    $template->param(asimulations  =>  $sim{attacker_win}->[1]);
    $template->param(dsimulations  =>  $sim{defender_win}->[1]);
  }

  # язык
  $template->param(lang => $lang);

  # имена технологий
  $template->param(attack_name  => $info{"attack.$lang"});
  $template->param(shield_name  => $info{"shield.$lang"});
  $template->param(armory_name  => $info{"armory.$lang"});

  # путь к урлу скрипта
  $template->param(script_url   =>  $script_url);
  
  # языковые ссылки
  my (@lang_urls);

  for (sort keys %langs)
  {
    my %linfo=
    (
      langurl   => "$script_url?lang=$_",
      langname  => $langs{$_}->[1],
      langid    => $_,
      langflag  => $langs{$_}->[2],
    );
    for my $par(keys %cgi)
    {
      defined $cgi{$par} or next;
      length $cgi{$par} or next;
      $par eq 'lang' and next;
      $linfo{langurl}.="&$par=$cgi{$par}";
    }
    push @lang_urls, \%linfo;
  }
  $template->param(Langs  => \@lang_urls);

  # счетчик
  if (defined $counter_file and length $counter_file)
  {
    require CGI::Counter;
    my $counter=CGI::Counter->new($counter_file);
    $counter->inc;
    $template->param(counter  => $counter->value);
  }

  # отладочная информация
  $debug and $template->param(debug    => $sim{result});
}

$title .= " (csim v" . get_version_csim() . ")";

$template->param(cpu      => $forks_count);
$template->param(title    => $title);
my $output=$template->output;
$debug or $output=~s/\s+/ /sg;


print "Content-Type: text/html; charset=$langs{$lang}->[0]\n\n$output";

}; $@ and print qq(Content-Type: text/html; charset=UTF-8\n\n
<html>
<head>
  <title>Critical Error</title>
</head>
<body>
<font color="red">
  <b>
    <big>
      $@
    </big>
  </b>
</font>
</body>
</html>);
