#!/opt/perl5/bin/perl
############################################################
#
# $Header: E:\\RCS\\E\\Tt\\Ittc\\tools\\Country.pm,v 1.8 2001-11-01 23:47:18+01 gael Exp gael $
#
# $Source: E:\\RCS\\E\\Tt\\Ittc\\tools\\Country.pm,v $
# $Revision: 1.8 $
# $Locker: gael $
#
# Module describing COUNTRY class
#
############################################################

package COUNTRY;

use strict;
use FileHandle;
use ITTC;
use Player;

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

@ISA = qw (Exporter);

@EXPORT = qw (generated_pages);

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

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

my (%country);

my (%country_abbrevs) = (
			 'ARG' => 'Argentina',
			 'AUS' => 'Australia',
			 'AUT' => 'Austria',
			 'BEL' => 'Belgium',
			 'BUL' => 'Bulgaria',
			 'BRA' => 'Brazil',
			 'CAN' => 'Canada',
			 'CHI' => 'Chile',
			 'CHN' => 'People\'s Republic of China',
			 'CRC' => 'Costa Rica',
			 'CRO' => 'Croetia',
			 'CUB' => 'Cuba',
			 'CZE' => 'Czech Republic',
			 'DEN' => 'Denmark',
			 'EGY' => 'Egypt',
			 'ESP' => 'Spain',
			 'EUN' => 'Unified Team',
			 'FAR' => 'Faroe Islands',
			 'FIN' => 'Finland',
			 'FRA' => 'France',
			 'GBR' => 'Great Britain',
			 'GER' => 'Germany',
			 'GRE' => 'Greece',
			 'HKG' => 'Hong Kong',
			 'HUN' => 'Hungary',
			 'IPP' => 'Independent Paralympic Participants',
			 'IRN' => 'Islamic Republic of Iran',
			 'IRL' => 'Ireland',
			 'IRQ' => 'Iraq',
			 'ISL' => 'Iceland',
			 'ISR' => 'Israel',
			 'ITA' => 'Italy',
			 'JOR' => 'Jordania',
			 'JPN' => 'Japan',
			 'KSA' => 'Saudi Arabia',
			 'KAZ' => 'Kazakstan',
			 'KOR' => 'Korea',
			 'LIE' => 'Liechtenstein',
			 'MAR' => 'Morocco',
			 'MEX' => 'Mexico',
			 'MCD' => 'Republic of Macedonia',
			 'MLD' => 'Moldavia',
			 'MLT' => 'Malta',
			 'NCD' => 'New Caledonia (France)',
			 'NED' => 'Netherlands',
			 'NGR' => 'Nigeria',
			 'NOR' => 'Norway',
			 'NZL' => 'New Zealand',
			 'PAL' => 'Palestine',
			 'PAK' => 'Pakistan',
			 'POR' => 'Portugal',
			 'POL' => 'Poland',
			 'PUR' => 'Puerto Rico',
			 'RSA' => 'South Africa',
			 'RUS' => 'Russia',
			 'SLO' => 'Slovenia',
			 'SUI' => 'Switzerland',
			 'SVK' => 'Slovakia',
			 'SWE' => 'Sweden',
			 'SYR' => 'Syria',
			 'TAN' => 'Tanzania',
			 'THA' => 'Thailand',
			 'TPE' => 'Chinese Taipei',
			 'UKR' => 'Ukraina',
			 'USA' => 'United States of America',
			 'VEN' => 'Venezuela',
			 'VIE' => 'Vietnam',
			 'YEM' => 'Yemen',
			 'YUG' => 'Yugoslavia'
			);

#
# ->new
#
# Attributes:
#   name: name of the country
#   players: hash list of PLAYER objects
#
sub new {
    my ($self) = bless {}, shift;
    my ($abbrev) = @_;
    $self->{'abbrev'} = $abbrev;
    $self->{'name'} = $country_abbrevs{$abbrev};
    $self->{'players'} = {};
    return $self;
}

#
# Attribute access routines
#
sub abbrev      { $_[0]->{'abbrev'} }
sub name        { $_[0]->{'name'} }
sub players     { $_[0]->{'players'} }

#
# ->check_abbrev
#
# Attributes:
#   abbrev: abbreviated name of the country
#
sub check_abbrev {
    shift;
    my ($abbrev) = @_;
    my ($ret_abbrev) = $abbrev;

    if ($abbrev eq 'NCD') {
	$ret_abbrev = 'FRA';
    }

    return  $ret_abbrev;
}

#
# ->full_name
#
# Attributes:
#   abbrev: abbreviated name of the country
#
sub full_name {
    shift;
    my ($abbrev) = @_;

    Carp::confess ("Unkown country abbreviation: $abbrev\n") if (not defined $country_abbrevs{$abbrev});

    return  $country_abbrevs{$abbrev};
}

#
# ->add_player
#
# Add a PLAYER object.
#
sub add_player {
    shift;
    my ($player) = @_;
    my ($self) = $country{$player->country};

    ${$self->players}{$player->name} = $player;
}

#
# ->valid
#
# arguments:
#    - a country abbreviation to validate
#    - an error message to display in case of failure
#
# returns 1 if country is known
#         otherwise Carp::confess
#
sub valid {
    shift;
    my ($ctry, $msg) = @_;

    if ($country{$ctry}) {
	return 1;
    } else {
	Carp::confess ($msg);
    }
}

#
# ->print_html
#
# print in HTML a COUNTRY object to the file handle given
#
sub print_html {
    my ($self) = shift;
    my ($index_handle) = @_;
    my ($player, $player_link, $filename);
    my ($recent_men, $recent_women) = (0,0);
    my ($previous_men, $previous_women) = (0,0);
    my (%recent_players,%previous_players);

    my $extension = '.htm';

    foreach $player (values %{$self->players}) {
	# skip players who have never got international medals
	next if ($player->record_int == 0);

	if ($player->recent) {
	    $recent_players {$player->name} = $player;
	    if ($player->gender eq 'F') {
		$recent_women++;
	    } else {
		$recent_men++;
	    }
	} else {
	    $previous_players {$player->name} = $player;
	    if ($player->gender eq 'F') {
		$previous_women++;
	    } else {
		$previous_men++;
	    }
	}
    }

    my ($men, $women) = ($recent_men + $previous_men, $recent_women + $previous_women);
    if (( $men + $women ) > 0) {
	print $index_handle '<LI><B>'.$self->name.'</B> (';
    }

    # common items of navigation bar
    my @nav_items = ('../../index.htm', 'Home', 
		    '../../players/index.htm', 'Players',
		    '../../results/international/index.htm', 'Results',
		    '../../ranking/index.htm', 'Ranking list');

    my ($men_title, $women_title);
    $men_title = 'Men playing for '.$self->name;
    $women_title = 'Women playing for '.$self->name;

    if ($men > 0) {
	$filename = $ittc_root.'players/men/'.lc $self->abbrev.$extension;
	open (MEN, ">$filename") or die ("Could not open $filename: $!\n");
	$generated_pages++;
	print MEN page_head ($men_title, '../..', '../..');

	my @men_nav = @nav_items;
	if ($women) {
	  push @men_nav, '../../players/women/'.lc $self->abbrev.$extension;
	  push @men_nav, 'Women of '.$self->name;
	}

	print MEN navigation_bar(@men_nav);
	print MEN '<CENTER><H1><SPAN class="Title">'.$men_title.'</SPAN></H1><br>'."\n";

	print $index_handle $men.' <A HREF="men/'.lc $self->abbrev.$extension.'">';
	if ($men > 1) {
	    print $index_handle 'men';
	} else {
	    print $index_handle 'man';
	}
	print $index_handle '</A>';
    }

    if ($women > 0) {
	$filename = $ittc_root.'players/women/'.lc $self->abbrev.$extension;
	open (WOMEN, ">$filename") or die ("Could not open $filename: $!\n");
	$generated_pages++;
	print WOMEN page_head ($women_title, '../..', '../..');
	my @women_nav = @nav_items;
	if ($men) {
	  push @women_nav, '../../players/men/'.lc $self->abbrev.$extension;
	  push @women_nav, 'Men of '.$self->name;
	}
	print WOMEN navigation_bar (@women_nav);
	print WOMEN '<CENTER><H1><SPAN class="Title">'.$women_title.'</SPAN></H1><br>'."\n";


	if ($men > 0) {
	    print $index_handle ', ';
	}
	print $index_handle $women.' <A HREF="women/'.lc $self->abbrev.$extension.'">';
	if ($women > 1) {
	    print $index_handle 'women';
	} else {
	    print $index_handle 'woman';
	}
	print $index_handle '</A>';
    }

    if (($men + $women > 0)) {
	print $index_handle ')'."\n";
    }

    my ($recent_title) = '<H2>Players who were medalists in recent tournaments</H2>';   
    my ($table_header) = '<TABLE BORDER=0 NOWRAP bgcolor="'.$ittc_bgcolor.'">';
    $table_header .= '<TR align="left" bgcolor="'.$ittc_th_bgcolor.'">';
    $table_header .= '<TD bgcolor="'.$ittc_bgcolor.'"></TD>';
    $table_header .= '<TH><font color="'.$ittc_th_font_color.'">Name</font></TH>';
    $table_header .= '<TH><font color="'.$ittc_th_font_color.'">Class</font></TH></TR>';

    if ($recent_women > 0) {
	if ($previous_women > 0) {
	    print WOMEN "$recent_title\n";
	}
	print WOMEN "$table_header\n";
    }
    if ($recent_men > 0) {
	if ($previous_men > 0) {
	    print MEN "$recent_title\n";
	}
	print MEN "$table_header\n";
    }

    my ($camera_icon) = '<IMG SRC="../../images/camera.gif" WIDTH="16" HEIGHT="13">';
    my ($photo_icon);
    foreach $player (PLAYER->sort_by_class_and_name (values %recent_players)) {
	# skip players who have never got international medals
	next if ($player->record_int == 0);

	if ($player->photo) {
	    $photo_icon = $camera_icon;
	} else {
	    $photo_icon = '';
	}

	my $dirname = $player->dirname;
	$dirname =~ s/^players\/(men|women)\///i;
	if ($player->gender eq 'F') {
	    print WOMEN '<TR><TD>'.$photo_icon.'</TD>';
	    print WOMEN '<TD><A HREF="'.$dirname.'/index'.$extension.'">';
	    print WOMEN $player->print_html.'</A></TD>';
	    print WOMEN '<TD>'.$player->class.'</TD></TR>'."\n";
	} else {
	    print MEN '<TR><TD>'.$photo_icon.'</TD>';
	    print MEN '<TD><A HREF="'.$dirname.'/index'.$extension.'">';
	    print MEN $player->print_html.'</A></TD>';
	    print MEN '<TD>'.$player->class.'</TD></TR>'."\n";
	}
    }

    if ($recent_men > 0) {
	print MEN '</TABLE>'."\n";
    }
    if ($recent_women > 0) {
	print WOMEN '</TABLE>'."\n";
    }

    my ($previous_title) = '<H2>Players who were medalists in older tournaments</H2>';

    if ($previous_men > 0) {
	if ($recent_men > 0) {
	    print MEN "$previous_title\n";
	}
	print MEN "$table_header\n";
    }
    if ($previous_women > 0) {
	if ($recent_women > 0) {
	    print WOMEN "$previous_title\n";
	}
	print WOMEN "$table_header\n";
    }

    foreach $player (PLAYER->sort_by_class_and_name (values %previous_players)) {
	# skip players who have never got international medals
	next if ($player->record_int == 0);

	if ($player->photo) {
	    $photo_icon = $camera_icon;
	} else {
	    $photo_icon = '';
	}
	if ($player->gender eq 'F') {
	    print WOMEN '<TR><TD>'.$photo_icon.'</TD>';
	    print WOMEN '<TD><A HREF="../../'.$player->dirname.'/index'.$extension.'">';
	    print WOMEN $player->print_html.'</A></TD>';
	    print WOMEN '<TD>'.$player->class.'</TD></TR>'."\n";
	} else {
	    print MEN '<TR><TD>'.$photo_icon.'</TD>';
	    print MEN '<TD><A HREF="../../'.$player->dirname.'/index'.$extension.'">';
	    print MEN $player->print_html.'</A></TD>';
	    print MEN '<TD>'.$player->class.'</TD></TR>'."\n";
	}
    }

    if ($previous_men > 0) {
	print MEN '</TABLE>'."\n";
    }

    if ($previous_women > 0) {
	print WOMEN '</TABLE>'."\n";
    }

    if ($men > 0) {
	print MEN '</CENTER></BODY></HTML>'."\n";
	close(MEN);
    }

    if ($women > 0) {
	print WOMEN '</CENTER></BODY></HTML>'."\n";
	close(WOMEN);
    }
}

sub init_country {
    my ($self) = shift;

    my $country;
    foreach $country (keys %country_abbrevs) {
	$country{$country} = COUNTRY->new($country);
    }
}

sub print_all_html {
    my ($self) = shift;

    my ($men, $women) = PLAYER->total_number();
    my $filename = $ittc_root.'players/index.htm';
    my $INDEX = new FileHandle;
    open ($INDEX, ">$filename") or die ("Could not open $filename: $!\n");
    $INDEX->autoflush;

    my $title = 'List of players by country';

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

    print $INDEX '<CENTER><H1><SPAN class="Title">'.$title.'</SPAN></H1><br>'."\n";
    print $INDEX '<table width="100%" cellpadding="4" bgcolor="'.$ittc_bgcolor.'"><tr><td>'."\n";

    print $INDEX 'Below, you will find '.($men+$women)." players ($men men and $women women)\n";
    print $INDEX ' listed by country, '.PLAYER->photos_number.' of them have a '."\n";
    print $INDEX '<a href="photos_list.htm">photography available</a>. '."\n";
    print $INDEX 'Only players that were once medalists in international tournaments or '."\n";
    print $INDEX 'championships are listed here.';
    print $INDEX '</td></tr></table><br>'."\n";
    print $INDEX '<table cellpadding="4" bgcolor="'.$ittc_bgcolor.'"><tr><td><UL>';

    $generated_pages++;

    my $country;
    foreach $country (sort {$a->name cmp $b->name} values %country) {
	$country->print_html($INDEX);
    }

    print $INDEX '</UL></td></tr></table></CENTER></BODY></HTML>'."\n";
    close($INDEX);
}

sub generated_pages {
  return $generated_pages;
}

1;