File Coverage

blib/lib/WWW/AUR/Iterator.pm

Criterion	Covered	Total	%
statement	80	80	100.0
branch	13	18	72.2
condition			n/a
subroutine	15	15	100.0
pod	4	6	66.6
total	112	119	94.1

package WWW::AUR::Iterator;

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

use WWW::AUR::Package   qw();
use WWW::AUR::URI       qw( pkg_uri );
use WWW::AUR            qw( _path_params _category_name _useragent );

sub new
{
    my $class = shift;
    my $self  = bless {}, $class;
    $self->init( @_ );
}

sub init
{
    my $self = shift;

    my $startidx;
    $startidx = shift if @_ % 2 == 1;

    %$self = ( %$self, _path_params( @_ ));
    $self->reset();
    $self->set_pos( $startidx ) if $startidx;

    return $self;
}

sub set_pos
{
    my ($self, $startidx) = @_;
    Carp::croak 'Argument to set_pos() must an integer'
        unless $startidx =~ /\A\d+\z/;

    $self->{'curridx'}  = $startidx;
    $self->{'finished'} = 0;
    $self->{'packages'} = [];

    return;
}

sub reset
{
    my ($self) = @_;
    $self->{'curridx'}   = 0;
    $self->{'finished'}  = 0;
    $self->{'packages'}  = [];
    $self->{'useragent'} = _useragent();
    return;
}

#---HELPER FUNCTION---
sub _pkglist_uri
{
    my ($startidx) = @_;
    return pkg_uri( q{SB} => q{n}, q{O}  => $startidx,
                    q{SO} => q{a}, q{PP} => 100 );
}

#---PRIVATE METHOD---
sub _scrape_pkglist
{
    my ($self) = @_;

    my $uri  = _pkglist_uri( $self->{'curridx'} );
    my $resp = $self->{'useragent'}->get( $uri );

    Carp::croak 'Failed to GET package list webpage: ' . $resp->status_line
        unless $resp->is_success;

    my @pkginfos;
    my @rows = _splitrows( $resp->content );
    shift @rows; # remove the header column

    for my $rowhtml ( @rows ) {
        my @cols = _splitcols( $rowhtml );

        # cat, name, version, votes, desc, maintainer
        push @pkginfos, @cols;
    }

    return \@pkginfos;
}

sub _splitrows
{
    my ($html) = @_;
    my @rows = $html =~ m{ ]*> ( .*? )
    return @rows;
}

sub _splitcols
{
    my ($rowhtml) = @_;
    my @cols = $rowhtml =~ m{ ]*> ( .*? )
    for ( @cols ) {
        s/<[^>]+>//g; # delete tags
        s/\A\s+//; s/\s+\z//; # trim whitespace
    }
    return @cols;
}

sub next
{
    my ($self) = @_;

    # There are no more packages to iterate over...
    return undef if $self->{'finished'};

    my @pkginfo = splice @{ $self->{'packages'} }, 0, 6;
    if ( @pkginfo ) {
        my $pkg;
        my @k = qw/name version votes popularity desc/;
        for my $i (0 .. $#k) {
            $pkg->{$k[$i]} = $pkginfo[$i];
        }

        my $maint = $pkginfo[5];
        $pkg->{'maint'} = ($maint eq 'orphan' ? undef : $maint);
        return $pkg;
    }

    # Load a new batch of packages if our internal list is empty...
    my $newpkgs = $self->_scrape_pkglist;

    $self->{'curridx'} += 100;
    $self->{'packages'} = $newpkgs;
    $self->{'finished'} = 1 if scalar @$newpkgs == 0;

    # Recurse, just avoids code copy/pasting...
    return $self->next();
}

sub next_obj
{
    my ($self) = @_;

    my $next = $self->next;
    return ( $next
             ? WWW::AUR::Package->new( $next->{'name'}, %$self )
             : undef );
}

1;

__END__