File Coverage

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

Criterion	Covered	Total	%
statement	26	93	27.9
branch	0	26	0.0
condition	0	6	0.0
subroutine	7	14	50.0
pod	2	2	100.0
total	35	141	24.8

package WWW::GoKGS::Scraper::GameArchives;
use strict;
use warnings;
use parent qw/WWW::GoKGS::Scraper/;
use WWW::GoKGS::Scraper::Declare;
use WWW::GoKGS::Scraper::Filters qw/game_result datetime/;

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

sub __build_scraper {
    my $self = shift;

    my $month2num = do {
        my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
        my %month2num; @month2num{ @months } = ( 1..12 );
        sub { $month2num{$_[0]} };
    };

    my %user = (
        name => [ 'TEXT', sub { s/ \[[^\]]+\]$// } ],
        rank => [ 'TEXT', sub { m/ \[([^\]]+)\]$/ ? $1 : undef } ],
        uri  => '@href',
    );

    my $game = scraper {
        process '//td[1]/a', 'sgf_uri' => '@href';
        process '//td[2]/a', 'white[]' => \%user;
        process '//td[3]/a', 'black[]' => \%user;
        process '//td[3]', 'maybe_setup' => 'TEXT';
        process '//td[4]', 'setup' => 'TEXT';
        process '//td[5]', 'start_time' => 'TEXT';
        process '//td[6]', 'type' => 'TEXT';
        process '//td[7]', 'result' => 'TEXT';
        process '//td[8]', 'tag' => 'TEXT';
    };

    my $calendar = scraper {
        process 'td', 'year' => 'TEXT';
        process '//following-sibling::td[not(@colspan)]',
                'month[]' => scraper {
                    process '.', 'month' => [ 'TEXT', $month2num ];
                    process 'a', 'uri' => '@href'; };
    };

    scraper {
        process '//a[@href="tzList.jsp"]', 'time_zone' => 'TEXT';
        process '//table[tr/th/text()="Viewable?"]//following-sibling::tr',
                'games[]' => $game;
        process '//a[contains(@href, ".zip")]', 'zip_uri' => '@href';
        process '//a[contains(@href, ".tar.gz")]', 'tgz_uri' => '@href';
        process '//table[colgroup]//following-sibling::tr',
                'calendar[]' => $calendar;
    };
}

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

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

    my @calendar;
    for my $calendar ( @{$result->{calendar}} ) {
        for my $month ( @{$calendar->{month}} ) {
            $month->{year} = $calendar->{year};
            push @calendar, $month;
        }
    }

    if ( @calendar == 1 and $calendar[0]{year} == 1970 ) { # KGS's bug
        delete $result->{calendar};
    }
    else {
        $result->{calendar} = \@calendar;
    }

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

    for my $game ( @{$result->{games}} ) {
        next if exists $game->{black};

        #
        my $users = $game->{white};
        if ( @$users == 1 ) { # Type: Demonstration
            $game->{owner} = $users->[0];
        }
        elsif ( @$users == 3 ) { # Type: Review
            $game->{owner} = $users->[0];
            $game->{white} = [ $users->[1] ];
            $game->{black} = [ $users->[2] ];
        }
        elsif ( @$users == 5 ) { # Type: Rengo Review
            $game->{owner} = $users->[0];
            $game->{white} = [ @{$users}[1,2] ];
            $game->{black} = [ @{$users}[3,4] ];
        }
        else {
            die 'Oops! Something went wrong';
        }

        $game->{tag}        = $game->{result} if exists $game->{result};
        $game->{result}     = $game->{type};
        $game->{type}       = $game->{start_time};
        $game->{start_time} = $game->{setup};
        $game->{setup}      = $game->{maybe_setup};
    }
    continue {
        $game->{start_time} = datetime( $game->{start_time} );
        $game->{result}     = game_result( $game->{result} );
        $game->{setup}      =~ /^(\d+)\x{d7}\d+ (?:H(\d+))?$/;
        $game->{board_size} = $1;
        $game->{handicap}   = $2 if defined $2;

        for my $user (
            $game->{owner} || (),
            @{ $game->{black} || [] },
            @{ $game->{white} || [] },
        ) {
            delete $user->{rank} unless $user->{rank};
        }

        delete $game->{setup};
        delete $game->{maybe_setup};
    }

    $result;
}

1;

__END__