File Coverage

blib/lib/Chess/FIDE.pm

Criterion	Covered	Total	%
statement	126	130	96.9
branch	29	36	80.5
condition	1	3	33.3
subroutine	17	17	100.0
pod	1	6	16.6
total	174	192	90.6

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 qw(@FIDE_field);

our @ISA = qw(Exporter);

our $VERSION = '1.12';

my $data_offsets = [
	[qw(title 45)],
	[qw(federation 49)],
	[qw(rating   54)],
	[qw(games   59)],
	[qw(year  65)],
	[qw(flags  70)],
];

our $DATA_URL = 'http://ratings.fide.com/download/players_list.zip';

sub new ($;@) {

    my $self  = shift;
    my $class = ref($self) || $self;
    my %param = @_;

    my $fide = [];
    my $line;

    bless $fide,$class;
    if ($param{-file}) {
		my $fh = IO::File->new($param{-file},'r');
		if (defined $fh) {
			$fide->parseFile($fh);
		}
		else {
			warn "$!: $param{-file}\n";
			return {};
		}
    }
    elsif ($param{-www}) {
        my $ua = LWP::UserAgent->new();
        $ua->proxy(['http'],$param{-proxy}) if $param{-proxy};
		my $response = $ua->get($DATA_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();
    }
	else {
		warn "No source (-file or -www) given";
	}
    return $fide;
}

sub parseFile ($$) {

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

	my $line;
	while (defined($line = $fh->getline())) {
		next unless $line =~ /^\s*\d/;
		my $player = $fide->parseLine($line);
		push(@{$fide}, $player) if $player;
	}
	$fh->close();
}

sub parseIdAndName ($$) {

	my $self = shift;
	my $id_and_name = shift;

	my ($id, $givenname, $surname) =
		($id_and_name =~ /^\s*(\d+)\s+(.*?)\,?\s+(\S+|\S+\s+\S+)/);

    if ($id_and_name =~ /\S\,\s*\S/) {
		my $tmp = $surname;
		$surname = $givenname;
		$givenname = $tmp;
    }
    $givenname =~ s/^\s+//;
    $givenname =~ s/\s+$//;
    $surname =~ s/^\s+//;
    $surname =~ s/\s+$//;
	my $name =
		!$givenname ? $surname : !$surname ? $givenname : "$givenname $surname";

	return ($id, $name, $givenname, $surname);
}

sub parseRest ($$){

	my $self = shift;
	my $rest = shift;

	my %data = ();

	my $start_offset = $data_offsets->[0][1];
	for my $i (0..$#{$data_offsets}) {
		my $offset = $data_offsets->[$i][1] - $start_offset;
		my $d_offset = $i == $#{$data_offsets} ?
			"" : $data_offsets->[$i+1][1] - $data_offsets->[$i][1];
		last if $offset > length($rest);
		if ($i == $#{$data_offsets}) {
			$data{$data_offsets->[$i][0]} = substr($rest, $offset);
		}
		else {
			$data{$data_offsets->[$i][0]} =	substr(
				$rest, $offset,
				$data_offsets->[$i+1][1] - $data_offsets->[$i][1]
			);
		}
		$data{$data_offsets->[$i][0]} =~ s/\s//g;
	}
	return %data;
}

sub parseLine ($$) {

    my $self = shift;
    my $line = shift;

	chomp $line;
	$line =~ s/\s+$//;
	my $id_and_name = substr($line, 0, $data_offsets->[0][1] - 1);
	my $rest = substr($line, $data_offsets->[0][1] - 1);
	my ($id, $name, $givenname, $surname) = $self->parseIdAndName($id_and_name);
	my $player = Chess::FIDE::Player->new(
		id => $id,
		name => $name,
		givenname => $givenname,
		surname => $surname,
	);
	my %rest = $self->parseRest($rest);
	for my $field (keys %rest) {
		$player->$field($rest{$field});
	}

    return $player;
}

sub fideSearch {

    my $fide = shift;
    my $criteria = shift;

	my $found = 0;
    for my $field (@FIDE_field) {
		if ($criteria =~ /^$field /) {
			$criteria =~ s/^($field)/'$_->{'.$field.'}'/ge;
			$found = 1;
			last;
		}
    }
	die "Invalid criteria supplied" unless $found;
    my @player = grep(eval $criteria, @{$fide});
    return @player;
}

1;
__END__