package ParadisePoker::Tournament;
use strict;
use warnings;

use ParadisePoker::Tournament::Database;

our $ERROR;

use constant PLACES => qw(1st 2nd 3rd 4th 5th 6th 7th 8th 9th 10th);
my $place_regex = join '|' => PLACES;

{
    no warnings 'once';
    our $REGEX =
        qr/^(.*?Tournament\ Summary
             (?s:.*?)
             ^.*?computer\ generated\ and\ emailed\ to.*?)$/mx;
}

# This is a list of tournament characteristics that can be extracted from
# the email.
my %pieces =
  (qr/^(.*?) Tournament Summary for table \"([^\"]+)\"/m,
   [qw(game table_name)],
   qr/^\$(.*?) Prize Pool, \$(.*?) Buy-In, \$(.*?) Fee, (\d+) players/m,
   [qw(prize_pool buyin fee num_players)],
   qr/^Tournament started\s*(.*?)\s*--\s*Game\s*\#(.*)$/m,
   [qw(start_time start_hand)],
   qr/^Tournament finished\s*(.*?)\s*--\s*Game\s*\#(.*)$/m,
   [qw(finish_time finish_hand)],
   qr/computer generated and emailed to (.*?)$/m,
   [qw(originator)]);

# This is the number of finishers that we expect for each game.
my %games =
  (q(Texas Hold'em)                 => 10, # '), # emacs kludge
   q(7-Card Stud Hi/Lo 8 or better) => 8,
   q(7-Card Stud)                   => 8,
   q(Omaha Hi/Lo 8 or better)       => 10,
   q(No Limit Hold'em)              => 10, # '), # emacs kludge
   );

# so bogus, they have changed names of games
my %game_alias =
    (q(Hold'em) => q(Texas Hold'em));

sub new($) {
  my $invocant = shift;
  my $class    = ref($invocant) || $invocant;
  (my $email = shift) =~ s/^(>\s*)*//mg; # get rid of reply stuff
    
  my $tournament = {};

  while (my ($regex, $slice) = each %pieces) {
    unless (@$tournament{@$slice} = $email =~ /$regex/) {
      $ERROR = "Couldn't find values for @$slice";
      return;
    }
  }

  $tournament->{$_} =~ tr/0-9//cd foreach qw(start_hand finish_hand);
  $tournament->{$_} =~ tr/0-9//cd foreach qw(prize_pool buyin fee);

  foreach (qw(start_time finish_time)) {
    my @pieces = split /\s+@?\s*/ => $tournament->{$_};
    $pieces[0] =~ tr|/|-|;
    $pieces[2] =~ tr/A-Z//cd;
    $tournament->{$_} = join ' ' => @pieces;
  }

  $tournament->{results} = _parse_finishers($email) or return;

  # Normalize game name if needed
  if (defined (my $new_game = $game_alias{$tournament->{game}})) {
      $tournament->{game} = $new_game;
  }

  bless $tournament, $class;
}

sub is_valid {
  my $self = shift;

  # Rule 1: Everything in the pieces keys accounted for.
  foreach my $aryref (values %pieces) {
    foreach (@$aryref) {
      next if defined $self->{$_};
      $ERROR = "missing field $_";
      return 0;
    }
  }
  # Rule 2: Game is valid
  unless (defined $games{$self->{game}}) {
    $ERROR = "unknown game $self->{game}";
    return 0;
  }
  # Rule 3: Correct number of finishers
  unless (@{$self->{results}} == $games{$self->{game}}) {
    $ERROR = "incorrect number of finishers";
    return 0;
  }
  1;
}

sub insert {
  my $self = shift;

  eval { ParadisePoker::Tournament::Database::insert($self); };
  $@ ? ($ERROR = $@, 0) : 1;
}

sub already_present {
  my $self = shift;

  my $result;

  eval { $result =
           ParadisePoker::Tournament::Database::already_present($self); };
  $@ ? ($ERROR = $@, undef) : $result;
}

sub _parse_finishers($) {
  my $email = shift;

  my @finishers;

  while ($email =~
         /^\s*($place_regex): (.*?)(?:,\s*\$(\d+) prize awarded)? \((Level [IVX]+, Game \#\d+)/mg) {
      my %result_node = (place     => $1,
                         name      => $2,
                         prize     => $3,
                         last_hand => $4);
      $result_node{place} =~ tr/0-9//cd;
      $result_node{last_hand_number} = _hand_number($result_node{last_hand});
      push @finishers, \%result_node;
  }

  \@finishers;
}

my %level_offset = (I    => 0,
                    II   => 10,
                    III  => 20,
                    IV   => 30,
                    V    => 40,
                    VI   => 50,
                    VII  => 60,
                    VIII => 70,
                    IX   => 80);

sub _hand_number {
    my ($level, $game) = $_[0] =~ /Level ([IVX]+), Game \#(\d+)/;
    $level_offset{$level} + $game;
}


1;
