File Coverage

blib/lib/CPAN/Testers/WWW/Reports/Parser.pm

Criterion	Covered	Total	%
statement	136	138	98.5
branch	31	36	86.1
condition	5	9	55.5
subroutine	36	37	97.3
pod	25	25	100.0
total	233	245	95.1

package CPAN::Testers::WWW::Reports::Parser;

use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '0.05';

#----------------------------------------------------------------------------
# Library Modules

use Carp;

#----------------------------------------------------------------------------
# Variables

my $WEB = 'http://www.cpantesters.org/cpan/report/';
my @valid_fields = qw(  id distribution dist distname version distversion perl
                        state status grade action osname ostext osvers platform
                        archname url csspatch cssperl guid );
my %valid_fields = map {$_ => 1} @valid_fields;

#----------------------------------------------------------------------------
# The Application Programming Interface

sub new {
    my $class = shift;
    my %hash  = @_;

    croak "No data format specified\n"                      unless($hash{format});
    croak "Unknown data format specified\n"                 unless($hash{format} =~ /^(yaml|json)$/i);
    croak "Must specify a file or data block to parse\n"    unless($hash{data} || $hash{file});
    croak "Cannot access file [$hash{file}]\n"              if(defined $hash{file} && ! -f $hash{file});

    my $self = {
        'format'    => uc $hash{'format'},
        'data'      =>    $hash{'data'},
        'file'      =>    $hash{'file'},
        'objects'   =>    $hash{'objects'},
    };
    bless $self, $class;

    if($self->{objects}) {
        eval "use CPAN::Testers::WWW::Reports::Report";
    }

    my $parser = 'CPAN::Testers::WWW::Reports::Parser::' . $self->{'format'};
    eval "use $parser";
    croak "Cannot access $self->{'format'} parser, have you installed the necessary support modules?\n"
        if($@);

    $self->{parser} = $parser->new();
    $self->{parser}->register( file => $self->{file}, data => $self->{data} );
    $self->{current} = {};

    return $self;
}

sub DESTROY {
    my $self = shift;
}

sub filter {
    my $self = shift;

    if(@_) {
        $self->{all} = $_[0] =~ /^ALL$/i ? shift : 0;
        $self->{fields}{$_} = 1 for(grep {$valid_fields{$_}} @_);

    # if no arguments, reset to default
    } else {
        $self->{all} = 1;
        $self->{fields} = {};
    }
}

# full data set methods

sub reports {
    my $self = shift;

    $self->filter(@_)  if(@_);

#use Data::Dumper;
#print STDERR (Dumper($self->{fields}));

    my $data = $self->{parser}->raw_data();
    return $data    unless(defined $self->{fields});

    no strict 'refs';

    for my $report (@$data) {
        $self->{current} = $report;
        for my $field (keys %{ $self->{fields} }) {
            #print STDERR "field=$field\n";
            eval { $report->{$field} = $self->$field(); };
        }

        next    if($self->{all});

        for my $key (keys %$report) {
            delete $report->{$key}  unless($self->{fields}{$key});
        }
    }

    return $data;
}


# iterate through data set

sub report {
    my $self = shift;

    unless($self->{loaded}) {
        $self->{reports} = $self->{parser}->raw_data();
        $self->{loaded} = 1;
    }

    return  unless(scalar(@{ $self->{reports} }));

    $self->{current} = shift @{ $self->{reports} };
    my %report = map {$_ => $self->{current}{$_}} keys %{$self->{current}};

    if(scalar(keys %{ $self->{fields} })) {
        no strict 'refs';

        for my $field (keys %{ $self->{fields} }) {
            eval { $report{$field} = $self->$field(); };
        }

        unless($self->{all}) {
            for my $key (keys %report) {
                delete $report{$key}  unless($self->{fields}{$key});
            }
        }
    }

    if($self->{objects}) {
        my $rep = CPAN::Testers::WWW::Reports::Report->new(\%report);
        return $rep;
    }

    return \%report;
}

sub reload {
    my $self = shift;
    $self->{loaded} = 0;
}


# transpose legacy field names to current field names

sub guid         { my $self = shift; return $self->{current}->{guid}         }
sub id           { my $self = shift; return $self->{current}->{id}           }
sub distribution { my $self = shift; return $self->{current}->{distribution} }
sub dist         { my $self = shift; return $self->{current}->{distribution} }
sub distname     { my $self = shift; return $self->{current}->{distribution} }
sub version      { my $self = shift; return $self->{current}->{version}      }
sub distversion  { my $self = shift; return $self->{current}->{distversion}  }
sub perl         { my $self = shift; return $self->{current}->{perl}         }

sub state        { my $self = shift; return $self->{current}->{state}        }
sub status       { my $self = shift; return $self->{current}->{status}       }
sub grade        { my $self = shift; return $self->{current}->{status}       }
sub action       { my $self = shift; return $self->{current}->{status}       }

sub osname       { my $self = shift; return $self->{current}->{osname}       }
sub ostext       { my $self = shift; return $self->{current}->{ostext}       }
sub osvers       { my $self = shift; return $self->{current}->{osvers}       }
sub platform     { my $self = shift; return $self->{current}->{platform}     }
sub archname     { my $self = shift; return $self->{current}->{platform}     }

sub url          { my $self = shift; return $WEB . ($self->{current}->{guid} || $self->{current}->{id}) }

sub csspatch     { my $self = shift; return $self->{current}->{csspatch}     }
sub cssperl      { my $self = shift; return $self->{current}->{cssperl}      }


q{ another hope, another dream, another truth ... installed by the machine };

__END__