#!/opt/perl5/bin/perl
############################################################
#
# $Header: E:\\RCS\\E\\Tt\\Ittc\\tools\\Event.pm,v 1.4 2001-11-11 00:33:38+01 gael Exp gael $
#
# $Source: E:\\RCS\\E\\Tt\\Ittc\\tools\\Event.pm,v $
# $Revision: 1.4 $
# $Locker: gael $
#
# Module describing EVENT class
#
############################################################

package EVENT;

use strict;
use ITTC;
use Medal;

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

@ISA = qw (Exporter);

@EXPORT = qw ();

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

#
# ->new
#
# Attributes:
#   name: name of event ('OF1-5', 'SM4', ...)
#   medals: hash list of MEDAL objects
#
sub new {
    my ($self) = bless {}, shift;
    my ($name) = @_;
    if ($name =~ /^[STDO][WFMX][0-9\-]*$/i) {
        $name =~ s/W/F/;
	$self->{'name'} = $name;
	$self->{'medals'} = {};
	$self->{'score'} = ();
	return $self;
    } else {
	Carp::confess ("Unknown event name \"$name\"\n");
    }
}

#
# Attribute access routines
#

sub name	{ $_[0]->{'name'} }
sub medals	{ $_[0]->{'medals'} }
sub score	{ $_[0]->{'score'} }

#
# ->add_medals
#
# Add list of MEDAL objects.
#
sub add_medals {
    my ($self) = shift;
    my (@medals) = @_;

    my $medal_added;
    foreach $medal_added (@medals) {
	%{$self->medals}->{$medal_added->color} = $medal_added;
    }
}

#
# ->set_score
#
# Set final score
#
sub set_score {
    my ($self) = shift;

    @{$self->{'score'}} = @_;
}


#
# ->class
#
# Returns the class of an EVENT object
#
sub class {
    my ($self) = shift;

    my ($class) = $self->name;
    if ($class =~ /^O/i) {
	# open event
	if ($class =~ /10$/i) {
	    $class = 'Standing';
	} else {
	    $class = 'Wheelchair';
	}
    } else {
	$class =~ s/^[DOST][FMX]//i;
    }
    return ($class);
}

#
# ->gender
#
# Returns the gender (F, M or X) of an EVENT object
# Converts 'W' to 'F' for compatibility with countries
# that use 'Woman' instead of 'Female' in result forms
#
sub gender{
    my ($self) = shift;

    my ($gender) = substr($self->name,1,1);
    if ($gender eq 'W') {
	$gender = 'F';
    }
    return ($gender);
}

#
# ->anchor
#
# Returns an anchor label associated to an EVENT object
#
sub anchor {
    my ($self) = shift;

    return ($self->name);
}


#
# hash table used to decode event codes
#
my %event_code = ('DF' => 'Women\'s doubles',
		  'DM' => 'Men\'s doubles',
		  'DX' => 'Mixed doubles',
		  'OF' => 'Women\'s open',
		  'OM' => 'Men\'s open',
		  'SF' => 'Women\'s singles',
		  'SM' => 'Men\'s singles',
		  'TF' => 'Women\'s teams',
		  'TM' => 'Men\'s teams');

#
# ->full_name
#
# return full decoded name of an EVENT object
#
sub full_name {
    my ($self) = shift;
    my ($name) = $event_code{substr($self->name, 0, 2)};
    if ($self->class eq '11') {
	$name = $name.' mentally handicapped';
    } else {
	$name = $name.' class '.$self->class;
    }
    return $name;
}

#
# ->print_html
#
# print in HTML an EVENT object to the file handles given
#
sub print_html {
    my ($self) = shift;
    my ($MEN, $WOMEN) = @_;
    my ($file_handle);
    my ($name) = $self->name;

    if ($name =~ /^[DOST][FX]/i) {
	$file_handle = $WOMEN;
    } else {
	$file_handle = $MEN;
    }
    my ($anchor) = $self->anchor;

    print $file_handle '<p></p><A NAME="'.$anchor.'"><STRONG><SPAN class="event">';
    print $file_handle $self->full_name.'</SPAN></STRONG></A>'."\n";
    print $file_handle '<TABLE BORDER="1" CELLPADDING="2" bgcolor="'.$ittc_bgcolor.'">';

    if ($self->medals) {
	my $medal;
	my $score_rowspan = 0;
	foreach $medal (values %{$self->medals}) {
	    if (($self->score) && 
		(($medal->color eq 'Gold') || ($medal->color eq 'Silver'))) {
		$score_rowspan += $medal->number_players;
	    }
	}
	foreach $medal (sort {MEDAL->color_name($a->color) <=> MEDAL->color_name($b->color)} (values %{$self->medals})) {
	    # print sorted list of medals
	    if ($score_rowspan > 0) {
		$medal->print_html ($file_handle, $score_rowspan, @{$self->score});
	    } else {
		$medal->print_html ($file_handle);
	    }
	}
    }
    print $file_handle '</TABLE>'."\n";
}


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

    if ($self->medals) {
	my $event_kind;
	# count of medals is different if it is
	# team conpetition
	if ($self->name =~ /^T/i) {
	    $event_kind = 'team';
	} elsif ($self->name =~ /^D/i) {
	    $event_kind = 'double';
	} else {
	    $event_kind = 'single';
	}
	my $medal;
	foreach $medal (values %{$self->medals}) {
	    # count number of medals per country
	    $medal->country_medals ($count, $event_kind);
	}
    }
}

1;