#!/opt/perl5/bin/perl
############################################################
#
# $Header: E:\\RCS\\E\\Tt\\Ittc\\tools\\Player.pm,v 1.10 2001-11-18 18:50:30+01 gael Exp gael $
#
# $Source: E:\\RCS\\E\\Tt\\Ittc\\tools\\Player.pm,v $
# $Revision: 1.10 $
# $Locker: gael $
#
# Module describing PLAYER class
#
############################################################
package PLAYER;

use strict;
use ITTC;
use Tournament;

use FileHandle;

use Exporter;
use vars qw(@ISA @EXPORT $VERSION);

@ISA = qw (Exporter);

@EXPORT = qw ();

# RCS versioning
$VERSION = '$Revision: 1.10 $';
$VERSION =~ s/\$(Revision): ([0-9\.]*) \$$/$2/;

# number of player photo
my $photos_number = 0;

# number of player personal web sites
my $webs_number = 0;

# char used as field delimiter in file format
my ($delimiter) = ',';

# number of page generated by this module
my $generated_pages = 0;

# Hash table for players
my %players;



#
# ->new
#
# Attributes:
#   name: full name of player (e.g Gael Marziou)
#   country: abbreviated country of player (FRA, GER, ...)
#   class: handicap class of player (1..10)
#   gender: gender of player ('M' or 'F')
#   hand: the hand-side used to play (right or left)
#   photo: a PHOTO object
#   dirname: name of directory where the player is saved
#   alias: array of other names used by this player, it could be 
#          due to a woman getting married or to nick names.
#   dirname: name of directory where the player is saved
#   last_tournament: year of last tournament entered
#   web: personal website URL
#   record_int: array of RECORD objects to store international
#                 results
#   record_nat: array of RECORD objects to store national
#                 results
#
sub new {
    my ($self) = bless {}, shift;
    my ($name, $country, $class, $gender, $hand, $web) = @_;
    $self->{'name'} = $name;
    $self->{'country'} = $country;
    $self->{'class'} = $class;
    $self->{'gender'} = $gender;
    $self->{'hand'} = $hand;
    $self->{'web'} = $web;
    $self->{'dirname'} = $self->_dir_name;
    $self->{'last_tournament'} = 0;
    $self->{'record_int'} = [];
    $self->{'record_nat'} = [];
    $self->{'alias'} = [];
    return $self;
}


#
# Attribute access routines
#
sub name	 { $_[0]->{'name'} }
sub country    	 { $_[0]->{'country'} }
sub class    	 { $_[0]->{'class'} }
sub gender     	 { $_[0]->{'gender'} }
sub hand    	 { $_[0]->{'hand'} }
sub alias    	 { @{$_[0]->{'alias'}} }
sub photo    	 { $_[0]->{'photo'} }
sub record_int   { @{$_[0]->{'record_int'}} }
sub record_nat   { @{$_[0]->{'record_nat'}} }
sub dirname      { $_[0]->{'dirname'} }
sub last_tournament { $_[0]->{'last_tournament'} }
sub web          { $_[0]->{'web'} }

#
# Attribute set routines
#
sub set_name	         { $_[0]->{'name'} = $_[1] }
sub set_country    	 { $_[0]->{'country'} = $_[1] }
sub set_class    	 { $_[0]->{'class'} = $_[1] }
sub set_hand     	 { $_[0]->{'hand'} = $_[1] }
sub set_alias     	 {
  my ($self) = shift;
  push @{$self->{'alias'}}, @_;
}
sub set_photo     	 { $_[0]->{'photo'} = $_[1] }
sub set_web     	 { $_[0]->{'web'} = $_[1] }
sub set_dirname          { $_[0]->{'dirname'} = $_[1] }
sub set_last_tournament  { $_[0]->{'last_tournament'} = $_[1]}
sub set_gender     	 {
    my ($self) = shift;
    my ($gender) = @_;
    $self->{'gender'} = $gender;
    $self->{'dirname'} = $self->_dir_name;
}

#
# ->add_record 
#
# Add a RECORD object according to the scope of the event
# ('National' or 'International')
#
sub add_record {
    my ($self) = shift;
    my ($record, $scope) = @_;

    if ($scope =~ /International/i) {
	push @{$self->{'record_int'}}, $record;
	if ($record->tournament->year > $self->last_tournament) {
	    # update year of last tournament entered
	    $self->set_last_tournament ($record->tournament->year);
	}
    } else {
	push @{$self->{'record_nat'}}, $record;
    }
}

#
# Number of years allowed without results in tournaments
#
my ($recent_limit) = 2;

#
# ->recent
#
# Returns 1 if PLAYER has played recent tournaments 0 otherwise
#
sub recent {
    my ($self) = shift;

    if ($self->last_tournament > TOURNAMENT->last_tournament_year - $recent_limit ) {
	return (1);
    } else {
	return (0);
    }
}

#
# ->class_ok
#
# check class sanity
# returns 1 if class is OK
# returns 0 otherwise
#
sub class_ok {
    shift;
    my ($class) = @_;

    if ($class =~ /^([1-9]|1[01])$/) {
	return 1;
    } else {
	print "Unknown class $class,(expected a number between 1 and 10, or M char.";
	return 0;
    }
}


#
# ->save
#
# parameters
#   name: name of player
#   country: abbreviated country of player (FRA, GER, ...)
#   class: handicap class of player (1..10)
#   gender: gender of player ('M' or 'F')
#
sub save {
  my $self = shift;
  my ($name, $country, $e_class, $gender, $hand);
  
  if (@_) {
    ($name, $country, $e_class, $gender, $hand) = @_;
    $country = COUNTRY->check_abbrev($country);
    my $class;
    
    # If event class is simple we can deduct the player's class from it
    if ($e_class =~ /-/) {
      $class = '';
    } elsif ($e_class =~ /^[a-z]+/i) {
      $class = '';
    } else {
      $class = $e_class;
    }
    
    $self = PLAYER->new ($name, $country, $class, $gender, $hand);
    
    print "Here is a new player:\n";
    
    print "Name: $name\n";
    print "Gender: $gender\n";
    print "Country: $country\n";
    print "Class: $e_class\n";
    
    print "\nOk to save it? (Y/N)\n";
    my $answer = uc <STDIN>;
    chop $answer;
    return if ($answer ne 'Y');
    
    while (not $self->gender) {
      print "Enter the player gender (M or F):\n";
      chop ($answer = <STDIN>);
      if (not ($answer =~ /^[MF]/i)) {
	print "Unknown gender $answer";
      } else {
	$self->set_gender ($answer);
      }
    }
    
    # validate country
    COUNTRY->valid($country,
		   "Unknown country $country for player $name");
    
    while (not $self->class) {
      print "Enter the player class:\n";
      chop ($answer = <STDIN>);
      if (PLAYER->class_ok ($answer)) {
	$self->set_class ($answer);
      }
    }
    
    if (! $self->hand) {
      print "Enter the player hand (R for Right, L for Left, anything else to skip):\n";
      chop ($answer = uc <STDIN>);
      if ($answer eq 'R') {
	$self->set_hand ('right');
      } elsif ($answer eq 'R') {
	$self->set_hand ('left');
      }
    }
  }

  my $dir = $ittc_root.$self->dirname;
  my $filename = $dir.'/index.txt';
  mkdir $dir, 0755;

  open (REF, ">$filename") or die ("Could not open $filename: $!\n");
  print REF 'Name'.$delimiter.$self->name."\n";
  print REF 'Country'.$delimiter.$self->country."\n";
  print REF 'Gender'.$delimiter.$self->gender."\n";
  print REF 'Class'.$delimiter.$self->class."\n";
  if ($self->hand) {
    print REF 'Hand'.$delimiter.$self->hand."\n";
  }
  close (REF);

  # store the new player
  $players{$self->dirname} = $self;

  return $self;
}


#
# ->_dir_name
#
# returns the directory name of a PLAYER object
#
sub _dir_name {
    my ($self) = shift;
    my ($name) = $_[0] || $self->name;
    my $dir = '';

    if ($name ne '') {
	$name =~ s/[\s\-']/_/g;

	my $gender_dir;
	if ($self->gender eq 'M') {
	    $gender_dir = 'men/';
	} else {
	    $gender_dir = 'women/';
	}
	$name=$self->html_lc($name);
	$dir = 'players/'.$gender_dir.$name;
    }
    return $dir;
}

#
# ->known
#
# Search a PLAYER among all those loaded
# Returns a PLAYER object if found
#
sub known {
    shift;
    my ($name, $gender, $country) = @_;
    my $self;
    if ($gender eq '') {
	# gender of the player is unknown, this can happen in mixed doubles
	# so let's try with man first
	$self = PLAYER->new ($name, $country, '', 'M');
	if (not $players{$self->dirname}) {
	    # could not find this player as a man, let's try as a woman
	    $self = PLAYER->new ($name, $country, '', 'F');
	}
    } else {
	$self = PLAYER->new ($name, $country, '', $gender);
    }
    return $players{$self->dirname};
}

#
# ->total_number
#
# 
#
sub total_number {
    shift;
    my ($men, $women) = (0, 0);
    my $player;
    foreach $player (values %players) {

	# skip players who have never got international medals
	next if ($player->record_int == 0);

	if ($player->gender eq 'F') {
	    $women++;
	} else {
	    $men++;
	}
    }
    return ($men, $women);
}

#
# ->print_html
#
# print in HTML a PLAYER object
#
sub print_html {
    my ($self) = shift;

    return $self->html_accents ($self->name);
}

#
# ->load_all
#
# load all PLAYER objects 
#
sub load_all {
  File::Find::find(\&read_player, $ittc_root.'players');
}


sub read_player {
    # skip directories
    return if (-d $_);
    # skip FrontPage file references
    return if ($File::Find::name =~ /_vti_/io);

    if (/^index\.txt$/io) {
	PLAYER->load ($File::Find::name);
    }

    # PLAYER->write_database();
}

#
# ->load
#
# load a PLAYER object from the filename given
#
sub load {
    my ($self) = shift;
    my ($filename) = @_;

    my ($tag, @value);
    my ($name, $country, $class, $gender, $hand, $photo, $web);
    my ($line) = 0;
    my (@alias, $alias_player);

    open (REF, "<$filename") or die ("Could not open $filename: $!\n");

    while (<REF>) {
	$line++;
	next if ((/^\#/) or (/^[\s\t]*$/));
	die ("No \'$delimiter\' char found in $filename") if (not /$delimiter/o);
	s/\xD$//;
	chop;
	($tag, @value) = split /$delimiter/o;

	if ($tag eq 'Name') {
	    $name = $value[0];
	    next;
	}
	if ($tag eq 'Country') {
	    if (COUNTRY->valid($value[0],
			       "Unknown country $value[0] at line $line in $filename")) {
		$country = $value[0];
	    }
	    next;
	}
	if ($tag eq 'Gender') {
	    $gender = $value[0];
	    if (($gender ne 'F') and ($gender ne 'M')) {
		die ("Unknown gender $gender at line $line in $filename");
	    }
	    next;
	}
	if ($tag eq 'Class') {
	    $class = $value[0];
	    if (not PLAYER->class_ok ($class)) {
		die ("Unknown class $class at line $line in $filename");
	    }
	    next;
	}
	if ($tag eq 'Hand') {
	    $hand = $value[0];
	    next;
	}
	if ($tag eq 'Web') {
	    $web = $value[0];
	    $webs_number++;
	    next;
	}
	if ($tag eq 'Photo') {
	    $photo = PHOTO->new($value[0], $value[1], $value[2], $value[3], $name);
	    $photos_number++;
	    next;
	}
	if ($tag eq 'Alias') {
	  # Store an alias for this player
	  push @alias, $value[0];
	  next;
	}
    }
    close (REF);
    $self = PLAYER->new ($name, $country, $class, $gender, $hand, $web);

    if ($photo) {
	$self->set_photo ($photo);
    }

    # store the new player
    $players{$self->dirname} = $self;

    # Add the player to its country
    COUNTRY->add_player($self);

    foreach $alias_player (@alias) {
      # store the alias player but make it point to $self
      $players{$self->_dir_name($alias_player)} = $self;
    }
    $self->set_alias (@alias);
}

#
# ->html_accents
#
#
#
sub html_accents {
    my ($self) = shift;
    my $str=$_[0];

    if ( $str =~ /[àáäéèëñöüùïçß]/ ) {
	$str =~ s/à/&agrave;/g;
	$str =~ s/á/&aacute;/g;
	$str =~ s/ä/&auml;/g;
	$str =~ s/é/&eacute;/g;
	$str =~ s/è/&egrave;/g;
	$str =~ s/ë/&euml;/g;
	$str =~ s/ñ/&ntilde;/g;
	$str =~ s/ö/&ouml;/g;
	$str =~ s/ó/&oacute;/g;
	$str =~ s/ü/&uuml;/g;
	$str =~ s/ù/&ugrave;/g;
	$str =~ s/ï/&iuml;/g;
	$str =~ s/î/&icirc;/g;
	$str =~ s/ç/&ccedil;/g;
	$str =~ s/ß/&szlig;/g;
    }
    return $str;
}

#
# ->html_uc
#
# 
#
sub html_uc {
    my ($self) = shift;
    my $str = uc $_[0];

    if ( $str =~ /[àáäéèëñöóüùïçß]/) {
	$str =~ s/[àáä]/A/g;
	$str =~ s/[éèë]/E/g;
	$str =~ s/ñ/n/g;
	$str =~ s/[öó]/O/g;
	$str =~ s/[üù]/U/g;
	$str =~ s/ï/I/g;
	$str =~ s/ç/C/g;
	$str =~ s/ß/SS/g;
    }
    return $self->html_accents($str);
}

#
# ->html_lc
#
# 
#
sub html_lc {
    my ($self) = shift;
    my $str =  $_[0];

    if ( $str =~ /[àáäéèëñöóüùïçß]/) {
	$str =~ s/[àáä]/A/g;
	$str =~ s/[éèë]/E/g;
	$str =~ s/ñ/N/g;
	$str =~ s/[öó]/O/g;
	$str =~ s/[üù]/U/g;
	$str =~ s/ï/I/g;
	$str =~ s/ç/C/g;
	$str =~ s/ß/SS/g;
    }
    return (lc $str);
}

#
# ->sort_by_class_and_name
#
# Sort a list of players according to their classes
#
sub sort_by_class_and_name {
    shift;
    return ( sort {($a->class <=> $b->class) or 
		       ($a->name cmp $b->name)} @_);
}

#
# ->print_html_profile
#
# Print the profile of a player
#
sub print_html_profile {
    my ($self) = shift;
    if ($self->_dir_name eq $self->dirname) { 
	my $dir = $ittc_root.$self->dirname;
	my $filename = $dir.'/index.htm';

	my $INDEX = new FileHandle;
	open ($INDEX, ">$filename") or die ("Could not open $filename: $!\n");
	$INDEX->autoflush;

	my $name = $self->html_accents($self->name);

	print $INDEX page_head ($name, '../../..', '../../..');
	print $INDEX navigation_bar ('../../../index.htm', 'Home', 
				     '../../index.htm', 'Players\' profiles',
				     '../../../results/international/index.htm', 'Results',
				     '../../../ranking/index.htm', 'Ranking list',
				     mail_to_web_master('Update profile of '.$self->name), 'Update profile');
	print $INDEX '<CENTER><H1><SPAN class="Title">'.$name.'</SPAN></H1><br>'."\n";

	my $photo = $self->photo;
	if (defined $photo) {
	    my ($img, $legend) = $photo->print_html($dir);
	    print $INDEX "$img\n";
	    print $INDEX '<BR><DIV Class="Copyright">'.$legend."</DIV>\n";
	}

	print $INDEX '<p><TABLE BORDER=1 cellspacing="0" cellpadding="2" ';
	print $INDEX 'bgcolor="'.$ittc_bgcolor.'" ALIGN="CENTER">'."\n";
	if ($self->alias) {
	  print $INDEX '<TR><TD>Also known as</TD><TD>';
	  print $INDEX join(',', $self->alias);
	  print $INDEX '</TD></TR>'."\n";
	}
	print $INDEX '<TR><TD>Gender</TD><TD>'.$self->gender.'</TD></TR>'."\n";

	my ($event_file);
	if ($self->gender eq 'M') {
	    $event_file = 'men';
	} else {
	    $event_file = 'women';
	}
	$event_file = '/'.$event_file.'.htm#';

	my ($class) = $self->class;
	if ($class eq '11') {
	    $class = 'Mentally handicapped';
	}
	print $INDEX '<TR><TD>Handicap class</TD><TD>'.$class.'</TD></TR>'."\n";
	print $INDEX '<TR><TD>Country</TD><TD>'.COUNTRY->full_name($self->country).'</TD></TR>'."\n";
	if (uc $self->hand eq 'RIGHT') {
	    print $INDEX '<TR><TD COLSPAN=2 ALIGN="CENTER">Right-handed</TD></TR>'."\n";
	} elsif (uc $self->hand eq 'LEFT') {
	    print $INDEX '<TR><TD COLSPAN=2 ALIGN="CENTER">Left-handed</TD></TR>'."\n";
	}
	if ($self->web) {
	  print $INDEX '<TR><TD>Personal web site</TD><TD><A HREF="'.$self->web.'">'.$self->web.'</a></TD></TR>'."\n";
	}
	print $INDEX '</TABLE><BR>'."\n";

	if ($self->record_int) {
	    RECORD->print_html ($INDEX, $event_file, 'International records', $self->record_int);
	}
	if ($self->record_nat) {
	    print $INDEX '<BR>'."\n";
	    RECORD->print_html ($INDEX, $event_file, 'National records', $self->record_nat);
	}

	close ($INDEX) or die ("Could not close $filename: $!\n");

	$generated_pages++;
    }
}

#
# ->print_list
#
# Print a list of players
#
sub print_list {
  my $self = shift;
  my ($INDEX, $title, $list_ref) = @_;
  my %list = %$list_ref;

  # print on several columns
  my $columns = 3;
  my $limit = scalar(keys %list)/$columns;
  if ($title ne '') {
    print $INDEX '<h2>'.$title.'</h2>'."\n";
  }
  print $INDEX '<TABLE BORDER=0 CELLPADDING="10" NOWRAP bgcolor="'.$ittc_bgcolor.'"><TR>'."\n";
  for my $i (1..$columns) {
    print $INDEX '<TD VALIGN="TOP">'."\n";
    my $j = 0;
    foreach my $key (sort keys %list) {
      print $INDEX $list{$key},"<br>\n";
      delete $list{$key};
      $j++;
      last if ($j > $limit);
    }
    $i++;
    print $INDEX '</TD>'."\n";
  }
  print $INDEX '</TR></TABLE>';
}

#
# ->print_photos_list
#
# Print the list of players who have a photography available
#
sub print_photos_list {
  my $self = shift;

  my (%men, %women);
  foreach my $player (values %players) {
    # skip players who have no photo
    next unless ($player->photo);
    my $dirname = $player->dirname;
    $dirname =~ s/^players\///i;
    my $key = $dirname;
    $key =~ s/^(men|women)\///i;
    my $name = $player->html_accents($player->name);

    if ($player->gender eq 'M') {
      $men{$key} = '<A HREF="'.$dirname.'/index.htm">'.$name.'</a>';
    }
    else {
      $women{$key} = '<A HREF="'.$dirname.'/index.htm">'.$name.'</a>';
    }
  }

  my $title = 'Players with a photography';

  my $filename = $ittc_root.'players/photos_list.htm';

  my $INDEX = $self->create_list_page($filename, $title);

  $self->print_list($INDEX, scalar(keys %men).' men', \%men);
  $self->print_list($INDEX, scalar(keys %women).' women', \%women);

  print $INDEX '</CENTER></BODY></HTML>';

  $INDEX->close;
  $generated_pages++;

}

#
# ->create_list_page
#
# Create a pag
#
sub create_list_page {

  my $self = shift;
  my ($filename, $title) = @_;
  my $INDEX = new FileHandle;
  open ($INDEX, ">$filename") or die ("Could not open $filename: $!\n");
  $INDEX->autoflush;

  print $INDEX page_head ($title, '..', '..');
  print $INDEX navigation_bar ('../index.htm', 'Home', 
			       'index.htm', 'Players\' profiles',
			       '../results/international/index.htm', 'Results',
			       '../ranking/index.htm', 'Ranking list');

  print $INDEX '<CENTER><H1><SPAN class="Title">'.$title.'</SPAN></H1><br>'."\n";

  return $INDEX;
}

#
# ->print_webs_list
#
# Print the list of players who have a personal web site available
#
sub print_webs_list {
  my $self = shift;

  my %line;
  foreach my $player (values %players) {
    # skip players who have no web
    next unless ($player->web);
    my $dirname = $player->dirname;
    $dirname =~ s/^players\///i;
    my $key = $dirname;
    $key =~ s/^(men|women)\///i;
    my $name = $player->html_accents($player->name);

    $line{$key} = '<A HREF="'.$dirname.'/index.htm">'.$name.'</a>';
  }

  my $title = 'Players with a personal web site';

  my $filename = $ittc_root.'players/webs_list.htm';

  my $INDEX = $self->create_list_page($filename, $title);

  $self->print_list($INDEX, '', \%line);

  print $INDEX '</CENTER></BODY></HTML>';

  $INDEX->close;
  $generated_pages++;
}


sub generated_pages {
  return $generated_pages;
}


sub write_database {
   # write players database
    my $filename="$ittc_root/players/players.csv";
    open (TABLE, ">$filename") or die ("Could not open $filename: $!\n");
    my $player;
    foreach $player (values %players) {
	print TABLE $player->name.';'.$player->dirname."\n";
    }
    close TABLE;
}

#
# write_profiles
#
sub write_profiles {
    my $player;
    foreach $player (values %players) {
	$player->print_html_profile;
    }
}

sub find {
  my $self = shift;
  return $players{$self->dirname};
}

sub photos_number {
  return $photos_number;
}

sub webs_number {
  return $webs_number;
}

1;