File Coverage

blib/lib/WWW/GoKGS/Scraper/TournEntrants.pm

Criterion	Covered	Total	%
statement	23	88	26.1
branch	0	22	0.0
condition	0	5	0.0
subroutine	8	12	66.6
pod	2	2	100.0
total	33	129	25.5

package WWW::GoKGS::Scraper::TournEntrants;
use strict;
use warnings;
use parent qw/WWW::GoKGS::Scraper/;
use WWW::GoKGS::Scraper::Declare;
use WWW::GoKGS::Scraper::Filters qw/datetime/;
use WWW::GoKGS::Scraper::TournLinks;

sub base_uri { 'http://www.gokgs.com/tournEntrants.jsp' }

sub __build_scraper {
    my $self = shift;
    my $links = $self->__build_tourn_links;

    my %user = (
        name => [ 'TEXT', sub { s/ \[[^\]]+\]$// } ],
        rank => [ 'TEXT', sub { m/ \[([^\]]+)\]$/ && $1 } ],
    );

    scraper {
        process '//h1', 'name' => [ 'TEXT', sub { s/ Players$// } ];
        process '//a[@href="tzList.jsp"]', 'time_zone' => 'TEXT';
        process '//table[tr/th[3]/text()="Score"]//following-sibling::tr',
                'entrants[]' => scraper { # Swiss or McMahon
                    process '//td[1]', 'position' => 'TEXT';
                    process '//td[2]', %user;
                    process '//td[3]', 'score' => 'TEXT';
                    process '//td[4]', 'sos' => 'TEXT';
                    process '//td[5]', 'sodos' => 'TEXT';
                    process '//td[6]', 'notes' => 'TEXT'; };
        process '//table[tr/th[1]/text()="Name"]//following-sibling::tr',
                'entrants[]' => scraper { # Single or Double Elimination
                    process '//td[1]', %user;
                    process '//td[2]', 'standing' => 'TEXT'; };
        process '//table[tr/th[3]/text()="#"]//following-sibling::tr',
                'entrants[]' => scraper { # Round Robin
                    process '//td', 'columns[]' => 'TEXT';
                    result 'columns'; };
        process '//div[@class="tournData"]', 'links' => $links;
    };
}

sub scrape {
    my ( $self, @args ) = @_;
    my $result = $self->SUPER::scrape( @args );

    return $result unless $result->{entrants};

    if ( !$result->{entrants}->[0] ) { # Round Robin
        shift @{$result->{entrants}};

        my @entrants;
        my $size = @{$result->{entrants}->[0]};
        for my $entrant ( @{$result->{entrants}} ) {
            $entrant->[0] =~ s/\(tie\)$//;

            push @entrants, {
                position => @$entrant == $size ? int shift @$entrant : $entrants[-1]{position},
                name     => shift @$entrant,
                number   => shift @$entrant,
                notes    => pop @$entrant,
                score    => pop @$entrant,
                results  => $entrant,
            };
        }

        for my $entrant ( @entrants ) {
            $entrant->{name} =~ /^([a-zA-Z0-9]+)(?: \[([^\]]+)\])?$/;
            $entrant->{name} = $1;
            $entrant->{rank} = $2;
        }

        my %results;
        for my $a ( @entrants ) {
            next unless $a->{number};
            for my $b ( @entrants ) {
                next if $b == $a;
                next unless $b->{number};
                $results{$a->{name}}{$b->{name}}
                    = $a->{results}->[$b->{number}-1] || q{};
            }
        }

        delete @{$_}{qw/number results/} for @entrants;

        $result->{entrants} = \@entrants;
        $result->{results}  = \%results if %results;
    }
    elsif ( exists $result->{entrants}->[0]->{score} ) { # Swiss or McMahon
        my $preceding;
        for my $entrant ( @{$result->{entrants}} ) {
            $entrant->{position} =~ s/\(tie\)$//;
            next if !$preceding or exists $entrant->{notes};
            $entrant->{notes}    = $entrant->{sodos};
            $entrant->{sodos}    = $entrant->{sos};
            $entrant->{sos}      = $entrant->{score};
            $entrant->{score}    = $entrant->{name};
            $entrant->{position} =~ /^([a-zA-Z0-9]+)(?: \[([^\]]+)\])?$/;
            $entrant->{name}     = $1;
            $entrant->{rank}     = $2;
            $entrant->{position} = $preceding->{position};
        }
        continue {
            $preceding = $entrant;
        }
    }
    else { # Single or Double Elimination
    }

    for my $entrant ( @{$result->{entrants}} ) {
        delete $entrant->{rank} unless $entrant->{rank};
    }

    $result;
}

1;

__END__