File Coverage

blib/lib/Chess/FIDE.pm

Criterion	Covered	Total	%
statement	136	179	75.9
branch	34	60	56.6
condition	7	19	36.8
subroutine	19	21	90.4
pod	10	10	100.0
total	206	289	71.2

package Chess::FIDE;

use 5.008;
use strict;
use warnings FATAL => 'all';

use Exporter;
use Carp;
use LWP::UserAgent;
use IO::File;
use IO::String;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Archive::Zip::MemberRead;

use Chess::FIDE::Player;

our @ISA = qw(Exporter);

our $VERSION = '1.20';

our $DEFAULT_FIDE_URL = 'http://ratings.fide.com/download/players_list.zip';
our @FIDE_SEARCH_KEYS = sort keys %FIDE_defaults;

our @EXPORT = qw($DEFAULT_FIDE_URL @FIDE_SEARCH_KEYS);

sub new ($;@) {

    my $class  = shift;
    my %param  = @_;

    my $fide = {
		meta    => {},
		players => [],
	};
    my $line;

    bless $fide, $class;
    if ($param{-file} || $param{-www}) {
		my $result = $fide->load(%param);
		return 0 unless $result;
    }
	else {
		warn "No source (-file or -www) given, empty object initialized" if $ENV{CHESS_FIDE_VERBOSE};
	}
    return $fide;
}

sub load ($%) {

	my $fide  = shift;
	my %param = @_;
    if ($param{-file}) {
		my $fh = IO::File->new($param{-file}, 'r');
		if (defined $fh) {
			print "Loading $param{-file}...\n" if $ENV{CHESS_FIDE_VERBOSE};
			$fide->parseFile($fh);
		}
		else {
			warn "Couldn't read file $param{-file} $!: $param{-file}\n";
			return {};
		}
    }
    elsif ($param{-www}) {
        my $ua = LWP::UserAgent->new();
        $ua->proxy(['http'], $param{-proxy}) if $param{-proxy};
		my $url = $param{-url} || $DEFAULT_FIDE_URL;
		print "Trying to get $url...\n" if $ENV{CHESS_FIDE_VERBOSE};
		my $response = $ua->get($url);
		my $webcontent;
		if ($response->is_success) {
			$webcontent = $response->content();
		}
		else {
			warn "Cannot download playerfile: Check your network connection\n";
			return 0;
		}
        my $fh = IO::String->new(\$webcontent) or die "BLAAAH\n";
        my $zip = Archive::Zip->new();
        my $status = $zip->readFromFileHandle($fh);
		unless ($status == AZ_OK) {
			warn "Problems unzipping the downloaded file";
			return 0;
		}
        my $membername;
        for $membername ($zip->memberNames()) {
            my $fh2 = Archive::Zip::MemberRead->new($zip, $membername);
			return 0 unless defined $fh2;
			$fide->parseFile($fh2);
        }
		$fh->close();
    }
}

sub convertOldHeaderNames ($) {

	my $fide = shift;

	$fide->{meta}{sgm}  = delete $fide->{meta}{game} if $fide->{meta}{game};
	$fide->{meta}{bday} = delete $fide->{meta}{born} || delete $fide->{meta}{'b-day'};
}

sub parseHeader ($$) {

	my $fide   = shift;
	my $header = shift;

	chomp $header;
	$header = lc $header;
	$header =~ s/id number/id_number/;
	$header =~ s/titlfed/tit fed/;
	$header =~ s/gamesborn/game born/;
	my $last_field;
	my $last_start;
	while($header =~ /(\S+)/gc) {
		my $field = lc $1;
		my $lf = length($field);
		if ($field =~ /^\D\D\D\d\d$/) {
			$field = 'srtng';
		}
		my $pos = pos($header);
		my $start = $pos - $lf;
		if ($start) {
			$fide->{meta}{$last_field} = [ $last_start, $start - $last_start ];
		}
		$last_field = $field;
		$last_start = $start;
	}
	$fide->{meta}{$last_field} = [ $last_start, length($header) - $last_start ];
	$fide->{meta}{id} = delete $fide->{meta}{id_number};
	$fide->convertOldHeaderNames();
}

sub parseName ($$) {

	my $fide = shift;
	my $info = shift;
	return unless $info->{name};
	$info->{fidename} = $info->{name};
	$info->{name} =~ s/^\W+//;
	$info->{name} =~ s/\, Dr\.//;
	if ($info->{name} =~ /^(\S.*)\s*\,\s*(\S.*)/) {
		$info->{givenname} = $2;
		$info->{surname}   = $1;
		$info->{name} = "$info->{givenname} $info->{surname}";
	}
	elsif ($info->{name} =~ /^(\S.*\S)\s+(\S+)$/) {
		$info->{givenname} = $1;
		$info->{surname} = $2;
		$info->{name} = "$info->{givenname} $info->{surname}";
	}
	else {
		warn "Strange name $info->{name}, assuming both given and sur" if $ENV{CHESS_FIDE_VERBOSE};
		$info->{givenname} = $info->{surname} = $info->{name};
	}
}

sub parseLine ($$) {

    my $fide = shift;
    my $line = shift;

	chomp $line;
	my %info = ();
	my $orig_line = $line;
	for my $field (keys %{$fide->{meta}}) {
		$line = $orig_line;
		if (length($line) <= $fide->{meta}{$field}[0]-1) {
			$info{$field} = '';
			next;
		}
		my $value = $fide->{meta}{$field}[0] ?
			substr($line, $fide->{meta}{$field}[0]-1, $fide->{meta}{$field}[1]) :
			substr($line, $fide->{meta}{$field}[0], $fide->{meta}{$field}[1]-1);
		$value =~ s/^\s+//;
		$value =~ s/\s+$//;
		$value =~ s/\s+/ /g;
		$info{$field} = $value;
	}
	$fide->parseName(\%info);
	return %info;
}

sub parseFile ($$) {

	my $fide = shift;
	my $fh   = shift;

	my $line;
	my $l = 0;
	while (defined($line = $fh->getline())) {
		$l++;
		if ($line =~ /^id/i) {
			$fide->parseHeader($line);
		}
		elsif ($line =~ /Mr., Jonathan Rose/) {
			# bogus entry in the rating list
			next;
		}
		elsif ($line =~ /^\s*\d/) {
			my %info = $fide->parseLine($line);
			if ($info{name} &&$info{name} =~ /\S/) {
				my $player = Chess::FIDE::Player->new(%info);
				push(@{$fide->{players}}, $player) if $player;
			}
		}
		else {
			warn "Line $l: $line - format not recognized, ignoring" if $ENV{CHESS_FIDE_VERBOSE};
		}
	}
	$fh->close();
}

sub fideSearch ($$;$) {

    my $fide     = shift;
    my $criteria = shift;
	my $players  = shift || $fide->{players};

	my $found = 0;
    for my $field (keys %FIDE_defaults) {
		if ($criteria =~ /^$field /i) {
			$criteria =~ s/^($field)/'$_->{'.lc($field).'}'/gei;
			$found = 1;
			last;
		}
    }
	die "Invalid criteria $criteria supplied" unless $found;
    my @found_players = grep {
		eval $criteria
	} @{$players};
	@found_players;
}

sub dumpHeader ($) {

	my $fide = shift;

	my $header = '';
	for my $field (sort { $fide->{meta}{$a}[0] <=> $fide->{meta}{$b}[0]}  keys %{$fide->{meta}}) {
		$header .= $field . (' ' x ($fide->{meta}{$field}->[1] - length($field)));
	}
	$header .= "\n";
	$header;
}

sub dumpPlayer ($$) {

	my $fide   = shift;
	my $player = shift;

	my $dump = '';
	for my $field (sort { $fide->{meta}{$a}[0] <=> $fide->{meta}{$b}[0]}  keys %{$fide->{meta}}) {
		$dump .= ($player->$field || '') . (' ' x ($fide->{meta}{$field}->[1] - length($player->$field || '')));
	}
	$dump .= "\n";
	$dump;
}
1;

__END__