#!/usr/bin/perl -w
use strict;
use lib qw(./lib);
use Test::More tests => 94;
use CPAN::Testers::WWW::Reports::Query::AJAX;
#----------------------------------------------------------------------------
# Test Data
my ($RAW,$nomock,$mock1);
my @args = (
{ args => {
dist => 'App-Maisha',
version => '0.15', # optional, will default to latest version
format => 'txt'
},
raw => q{0.15,243,240,2,0,1},
results => {
all => 243,
pass => 240,
fail => 2,
na => 0,
unknown => 1,
pc_pass => 98.7654320987654,
pc_fail => 0.823045267489712,
pc_na => 0,
pc_unknown => 0.411522633744856
}
},
{ args => {
dist => 'App-Maisha',
version => '0.15', # optional, will default to latest version
format => 'xml'
},
raw => q{0.15 },
results => {
all => 243,
pass => 240,
fail => 2,
na => 0,
unknown => 1,
pc_pass => 98.7654320987654,
pc_fail => 0.823045267489712,
pc_na => 0,
pc_unknown => 0.411522633744856
}
},
{ args => {
dist => 'App-Maisha',
version => '0.15', # optional, will default to latest version
format => 'html'
},
raw => q{}
},
{ args => {
dist => 'App-Maisha',
version => '0.15', # optional, will default to latest version
# default format = xml
},
raw => q{0.15 },
results => {
all => 243,
pass => 240,
fail => 2,
na => 0,
unknown => 1,
pc_pass => 98.7654320987654,
pc_fail => 0.823045267489712,
pc_na => 0,
pc_unknown => 0.411522633744856
}
},
{ args => {
dist => 'App-Maisha',
format => 'txt'
},
raw => q{0.18,139,139,0,0,0
0.17,123,123,0,0,0
0.16,113,113,0,0,0
0.15,243,240,2,0,1
0.14,56,56,0,0,0
0.13,96,96,0,0,0
0.12,106,103,3,0,0
0.11,38,38,0,0,0
0.10,36,36,0,0,0
0.09,23,23,0,0,0
0.08,26,26,0,0,0
0.07,23,23,0,0,0
0.06,35,15,20,0,0
0.05,29,4,25,0,0
0.04,39,11,28,0,0
0.03,32,6,26,0,0
0.02,33,4,29,0,0
0.01,39,3,36,0,0},
results => {
all => 139,
pass => 139,
fail => 0,
na => 0,
unknown => 0,
pc_pass => 100,
pc_fail => 0,
pc_na => 0,
pc_unknown => 0
}
},
{ args => {
dist => 'App-Maisha',
format => 'xml'
},
raw => q{
0.18
0.17
0.16
0.15
0.14
0.13
0.12
0.11
0.10
0.09
0.08
0.07
0.06
0.05
0.04
0.03
0.02
0.01 },
results => {
all => 139,
pass => 139,
fail => 0,
na => 0,
unknown => 0,
pc_pass => 100,
pc_fail => 0,
pc_na => 0,
pc_unknown => 0
}
},
{ args => {
dist => 'App-Maisha',
format => 'html'
},
raw => q{}
},
{ args => {
dist => 'App-Maisha',
# default format = xml
},
raw => q{
0.18
0.17
0.16
0.15
0.14
0.13
0.12
0.11
0.10
0.09
0.08
0.07
0.06
0.05
0.04
0.03
0.02
0.01 },
results => {
all => 139,
pass => 139,
fail => 0,
na => 0,
unknown => 0,
pc_pass => 100,
pc_fail => 0,
pc_na => 0,
pc_unknown => 0
}
}
);
#----------------------------------------------------------------------------
# Test Conditions
BEGIN {
eval "use Test::MockObject";
$nomock = $@;
unless($nomock) {
$mock1 = Test::MockObject->new();
$mock1->fake_module( 'WWW::Mechanize',
'agent_alias' => \&fake_alias,
'get' => \&fake_get,
'success' => \&fake_success,
'content' => \&fake_content );
$mock1->fake_new( 'WWW::Mechanize' );
$mock1->mock( 'agent_alias', \&fake_alias );
$mock1->mock( 'get', \&fake_get );
$mock1->mock( 'success', \&fake_success );
$mock1->mock( 'content', \&fake_content );
}
}
#----------------------------------------------------------------------------
# Test Main
SKIP: {
skip "Test::MockObject required for testing", 94 if $nomock;
for my $args (@args) {
$RAW = $args->{raw};
my $query = CPAN::Testers::WWW::Reports::Query::AJAX->new( %{$args->{args}} );
ok($query,'.. got response');
my $raw = $query->raw();
my $data = $query->data();
#diag( join(', ', map {"$_ => $args->{args}{$_}"} keys %{$args->{args}} ) );
#diag( "raw=$raw" );
is($query->is_success, 1, '.. returned successfully');
is($query->error, '', '.. no errors');
if($args->{results}) {
is($query->all, $args->{results}{all}, '.. counted all reports');
is($query->pass, $args->{results}{pass}, '.. counted pass reports');
is($query->fail, $args->{results}{fail}, '.. counted fail reports');
is($query->na, $args->{results}{na}, '.. counted na reports');
is($query->unknown, $args->{results}{unknown}, '.. counted unknown reports');
is($query->pc_pass, $args->{results}{pc_pass}, '.. percentage pass reports');
is($query->pc_fail, $args->{results}{pc_fail}, '.. percentage fail reports');
is($query->pc_na, $args->{results}{pc_na}, '.. percentage na reports');
is($query->pc_unknown, $args->{results}{pc_unknown}, '.. percentage unknown reports');
}
if($raw) {
my $version = $args->{args}{version} || '0.15';
if($args->{args}{format} && $args->{args}{format} eq 'html') {
like($raw,qr{| $version | },'.. got version statement in raw');
ok(1,".. we don't parse html format");
} elsif($args->{args}{format} && $args->{args}{format} eq 'txt') {
like($raw,qr{$version,\d+},'.. got version statement in raw');
ok($data->{$version},'.. got version in hash');
} else { # xml
like($raw,qr{$version},'.. got version statement in raw');
ok($data->{$version},'.. got version in hash');
}
} else {
diag($query->error());
ok($query->error());
ok(1,'..skipped, request did not succeed');
}
}
}
# crude, but it'll hopefully do ;)
sub pingtest {
my $domain = 'www.cpantesters.org';
my $cmd = $^O =~ /solaris/i ? "ping -s $domain 56 1" :
$^O =~ /dos|os2|mswin32|netware|cygwin/i ? "ping -n 1 $domain "
: "ping -c 1 $domain >/dev/null 2>&1";
system($cmd);
my $retcode = $? >> 8;
# ping returns 1 if unable to connect
return $retcode;
}
sub fake_alias {}
sub fake_get {}
sub fake_success { return 1; }
sub fake_content { return $RAW; }