#!/usr/bin/perl

# Copyright (C) 2006-2011 John J. Chew, III <jjchew@math.utoronto.ca>
# All Rights Reserved

package TSH::Command::SUBMIT;

use strict;
use warnings;

use TSH::Utility;
use HTTP::Client;
use HTTP::Message;

our (@ISA) = qw(TSH::Command);

=pod

=head1 NAME

TSH::Command::SUBMIT - implement the C<tsh> SUBMIT command

=head1 SYNOPSIS

  my $command = new TSH::Command::SUBMIT;
  my $argsp = $command->ArgumentTypes();
  my $helptext = $command->Help();
  my (@names) = $command->Names();
  $command->Run($tournament, @parsed_arguments);
  
=head1 ABSTRACT

TSH::Command::SUBMIT is a subclass of TSH::Command.

=cut

=head1 DESCRIPTION

=over 4

=cut

sub initialise ($$$$);
sub new ($);
sub Run ($$@);

=item $parserp->initialise()

Used internally to (re)initialise the object.

=cut

sub initialise ($$$$) {
  my $this = shift;
  my $path = shift;
  my $namesp = shift;
  my $argtypesp = shift;

  $this->{'help'} = <<'EOF';
Use this command to submit tournament data for ratings calculation
over the Internet.
EOF
  $this->{'names'} = [qw(submit)];
  $this->{'argtypes'} = [qw()];
# print "names=@$namesp argtypes=@$argtypesp\n";

  return $this;
  }

sub new ($) { return TSH::Utility::new(@_); }

=item $command->Run($tournament, @parsed_args)

Should run the command in the context of the given
tournament with the specified parsed arguments.

=cut

sub Run ($$@) { 
  my $this = shift;
  my $tournament = shift;
  my @nsa;
  my $absp;
  my @nor;
  for my $dp ($tournament->Divisions()) {
    my $rs = $dp->RatingSystemName();
    if ($rs eq 'absp') {
      $tournament->TellUser('esubmitabsp') unless $absp++;
      }
    elsif ($rs eq 'none') {
      $tournament->TellUser('wsubmitnone', $dp->Name());
      }
    elsif ($rs eq 'nor') {
      push(@nor, $dp);
      }
    else {
      push(@nsa, $dp);
      }
    }
  if (@nor) {
    $tournament->TellUser('isubmitnor', join (', ', map { $_->Name() } @nor));
    $this->SubmitNOR($tournament, @nsa);
    }
  if (@nsa) {
    $tournament->TellUser('isubmitnsa', join (', ', map { $_->Name() } @nsa));
    # TODO: \@nsa is being ignored in favour of an alternate test in SubmitNSA
    $this->SubmitNSA($tournament, \@nsa);
    }
  }

=item $command->SubmitNOR($tournament);

Submits ratings data to the Norwegian authority.

=cut

sub SubmitNOR ($$@) { 
  my $this = shift;
  my $tournament = shift;
  my (@dps) = @_;
  my $config = $tournament->Config();
  my $rdata = $config->Render(sub { $_[0]->RatingSystemName() =~ /^nor$/i; });
  if (open my $alltsh, '>:encoding(utf8)', $config->MakeRootPath('all.tsh')) {
    print $alltsh $rdata;
    close $alltsh;
    }
# for my $key (qw(director_id tournament_id)) {
  for my $key (qw()) {
    unless ($config->Value($key)) {
      print "You must specify config $key to use this command.\n";
      return 0;
      }
    }
  my $http = new HTTP::Client('exit_on_error' => 0);
  my $message = new HTTP::Message(
    'method' => 'POST',
    'url' => '/cgi-bin/tsh/submit.py',
    'headers' => {
      'content-type' => 'multipart/form-data',
      'user-agent' => 'tsh.poslfit.com',
#     'host' => 'localhost',
      'host' => 'scrabbeller.scrabbleforbundet.no',
      },
    );
  my $note = $config->Value('ratings_note') || '';
  $note .= " Automatically submitted from tsh $::gkVersion.";
# my $password = $config->Value('director_password');
# unless (defined $password) {
#   $| = 1;
#   print "Password: ";
#   $password = TSH::Utility::ReadPassword();
#   print "\n";
#   }
  $message->FormData({
#   'username' => $config->Value('director_id'),
#   'password' => $password,
#   'poslid_submit_login' => 1,
#   'tournament_id' => $config->Value('tournament_id'),
#   'note' => $note,
    'rdatafile' => { 'type'=>'file', 'filename'=>'all.tsh', 'data'=>$rdata },
#   'Confirm' => 1,
    });
  $http->Connect('scrabbeller.appspot.com') or return;
  $http->Send($message);
  my $response = $http->Receive();
  my $status = $response->StatusCode();
  my $body = $response->Body();
  if ($status ne '200') {
    print "URL-en kan ikke nås ($status).\nEnten har du nettverksproblemer, eller så er sørveren nede.\n";
    }
  elsif ($body =~ s/^ERROR\n//) {
    print <<"EOF";
Rapporteringssiden melder fra om softwareproblemer. Vennligst ta
kontakt med den ratingansvarlige og kopier og lim inn den følgende
meldingen:

$body
EOF
    }
  elsif ($body =~ s/^OK\n//) {
    my $message = "Ratingdataene dine har blitt akseptert.\n";
    $message =~ s/\n$/  Nettsiden rapporterer: \n\n$body\n/ if $body =~ /\S/;
    }
  else {
    print "UVENTET SØRVERRESPONS\n---\n$status\n$body\n";
    }
  $http->Close();
  }

=item $command->SubmitNSA($tournament, \@divsi [,\%options]);

Submits ratings data to the NSA.

=cut

sub SubmitNSA ($$$;$) { 
  my $this = shift;
  my $tournament = shift;
  my $dpsp = shift;
  my $optionsp = shift;

  my $request_uri = $optionsp->{'request_uri'} || '/cgi-bin/submit-rdata.pl';
  my $server_name = $optionsp->{'server_name'} || 'www.scrabbleplayers.org';
  my $want_error = $optionsp->{'want_error'};

  my $rdata = '';
  if (my $profile = $tournament->Profile()) {
    $rdata = $profile->Render();
    }
  my $config = $tournament->Config();
  $rdata .= $config->Render(sub { $_[0]->RatingSystemName() =~ /\b(?:nsa|naspa)/; });
  if (open my $alltsh, '>:encoding(utf8)', $config->MakeRootPath('all.tsh')) {
    print $alltsh $rdata;
    close $alltsh;
    }
  for my $key (qw(director_id tournament_id)) {
    unless ($config->Value($key)) {
      print "You must specify config $key to use this command.\n";
      return 0;
      }
    }
  my $http = new HTTP::Client('exit_on_error' => 0);
  my $message = new HTTP::Message(
    'method' => 'POST',
    'url' => $request_uri,
    'headers' => {
      'content-type' => 'multipart/form-data',
      'user-agent' => 'tsh.poslfit.com',
#     'host' => 'localhost',
      'host' => $server_name,
      },
    );
  my $note = $config->Value('ratings_note') || '';
  $note .= " Automatically submitted from tsh $::gkVersion.";
  my $password = $config->Value('director_password');
  unless (defined $password) {
    $| = 1;
    print "Password: ";
    $password = TSH::Utility::ReadPassword();
    print "\n";
    }
  $message->FormData({
    'username' => $config->Value('director_id'),
    'password' => $password,
    'poslid_submit_login' => 1,
    'tournament_id' => $config->Value('tournament_id'),
    'note' => $note,
    'rdatafile' => { 'type'=>'file', 'filename'=>'all.t', 'data'=>$rdata },
    'Confirm' => 1,
#   @unrated_flags,
    });
  $http->Connect($server_name) or return;
  $http->Send($message);
# print "Sending:\n---\n", $message->ToString(), "\n---\n";
  my $response = $http->Receive();
  my $status = $response->StatusCode();
  my $body = $response->Body();
# print "Received:\n---\n$body\n---\n";
  if ($want_error) {
    if ($status eq '200') {
      if ($body eq 'Ok') { return ''; }
      else { return "Server replied: $body."; }
      }
    else { return "Server returned code $status."; }
    }
  if ($status ne '200') {
    print "The submission URL is unreachable ($status).  Either you are having network\nproblems or the server is down.\n";
    }
  elsif ($body =~ /<h1>Software error|red>Unexpected Error/) {
    print "The submission page is reporting a software error.  Please contact John Chew.\n";
    if ($config->Value('director_id') eq 'CM000003') {
      open my $error, '>:encoding(utf8)', $config->MakeRootPath('error.html');
      print $error $body;
      }
    }
  elsif ($body =~ /<p class=report>\s*([^\0]*?)<\/p>/) {
    my $reply = $1;
    $reply =~ s/<br>/\n/g; 
    $reply =~ s/\n{2,}/\n/g;
    $reply =~ s/^\n//;
    $reply =~ s/\n$//;
    $reply =~ s/Warning: .*\n//g;
    $reply =~ s/<\/?span.*?>//g;
    $reply = TSH::Utility::Wrap(2, $reply);
    print "The submission page replies:\n$reply\n";
    }
  elsif ($body =~ /: Payment Redirect/) {
    my $payment_url = 'http://www.scrabbleplayers.org/cgi-bin/account.pl';
    print "Your ratings submission has been accepted.\nYou should now go online to pay the participation fee:\n$payment_url\nI'll try to open a browser window for you.";
    TSH::Utility::Browse($payment_url);
    }
  elsif ($body =~ /NASPA: Login/) {
    print "Password incorrect.\n";
    }
  else {
    print "UNEXPECTED ERROR\n---\n$status\n$body\n";
    }
  $http->Close();
  }

=back

=cut

1;
