Skip to content
Browse files

added ping test and skip if no network

  • Loading branch information...
1 parent 216d0b4 commit 97f6a636c6526e48354787097a6d881bcbd582ce @barbie barbie committed Apr 6, 2012
Showing with 49 additions and 30 deletions.
  1. +3 −0 Changes
  2. +2 −2 META.json
  3. +2 −2 META.yml
  4. +1 −1 lib/CPAN/Testers/WWW/Reports/Query/Reports.pm
  5. +41 −25 t/10query.t
View
3 Changes
@@ -1,5 +1,8 @@
Revision history for CPAN-Testers-WWW-Reports-Query-Reports
+0.04 06/04/2012
+ - added ping test & skip if no network.
+
0.03 05/04/2012
- missed JSON::XS from prereq lists :(
- added META.json (and test script)
View
4 META.json
@@ -1,6 +1,6 @@
{
"name": "CPAN-Testers-WWW-Reports-Query-Reports",
- "version": "0.03",
+ "version": "0.04",
"abstract": "Retrieve CPAN Testers metadata direct from the CPAN Testers website",
"author": [
"Barbie (BARBIE) <barbie@cpan.org>"
@@ -44,7 +44,7 @@
"provides": {
"CPAN::Testers::WWW::Reports::Query::Reports": {
"file": "lib/CPAN/Testers/WWW/Reports/Query/Reports.pm",
- "version": "0.03"
+ "version": "0.04"
}
},
"no_index": {
View
4 META.yml
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CPAN::Testers::WWW::Reports::Query::Reports
-version: 0.03
+version: 0.04
abstract: Retrieve CPAN Testers metadata direct from the CPAN Testers website.
author:
- Barbie <barbie@cpan.org>
@@ -24,7 +24,7 @@ build_requires:
provides:
CPAN::Testers::WWW::Reports::Query::Reports:
file: lib/CPAN/Testers/WWW/Reports/Query/Reports.pm
- version: 0.03
+ version: 0.04
resources:
repository: http://github.com/barbie/cpan-testers-www-reports-query-reports
View
2 lib/CPAN/Testers/WWW/Reports/Query/Reports.pm
@@ -3,7 +3,7 @@ package CPAN::Testers::WWW::Reports::Query::Reports;
use strict;
use warnings;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
#----------------------------------------------------------------------------
View
66 t/10query.t
@@ -85,33 +85,49 @@ my @args = (
my $query = CPAN::Testers::WWW::Reports::Query::Reports->new();
isa_ok($query,'CPAN::Testers::WWW::Reports::Query::Reports','.. got response');
-for my $args (@args) {
- if(defined $args->{date}) {
- my $data = $query->date( $args->{date} );
- if($args->{results}) {
- is($data->{$_},$args->{results}{$_},".. got '$_' in date hash [$args->{date}]") for(keys %{$args->{results}});
+SKIP: {
+ skip "Network unavailable", 12 if(pingtest());
+
+ for my $args (@args) {
+ if(defined $args->{date}) {
+ my $data = $query->date( $args->{date} );
+ if($args->{results}) {
+ is($data->{$_},$args->{results}{$_},".. got '$_' in date hash [$args->{date}]") for(keys %{$args->{results}});
+ } else {
+ is($data, undef,".. got no results, as expected [$args->{date}]");
+ }
+ } elsif(defined $args->{range}) {
+ my $data = $query->range( $args->{range} );
+ if($args->{results}) {
+ #diag(Dumper( $data ));
+ is_deeply($data->{$_},$args->{results}{$_},".. got '$_' in range hash [$args->{range}]")
+ for(keys %{$args->{results}});
+ }
+ my @keys = sort { $a <=> $b } keys %$data;
+ if($args->{start}) {
+ is($keys[0], $args->{start},".. got start value [$args->{range}]");
+ }
+ if($args->{stop}) {
+ is($keys[-1], $args->{stop},".. got stop value [$args->{range}]");
+ }
+ if($args->{count}) {
+ cmp_ok(scalar @keys, '<=', $args->{count},".. counted number of records [$args->{range}]");
+ }
} else {
- is($data, undef,".. got no results, as expected [$args->{date}]");
- }
- } elsif(defined $args->{range}) {
- my $data = $query->range( $args->{range} );
- if($args->{results}) {
- #diag(Dumper( $data ));
- is_deeply($data->{$_},$args->{results}{$_},".. got '$_' in range hash [$args->{range}]")
- for(keys %{$args->{results}});
- }
- my @keys = sort { $a <=> $b } keys %$data;
- if($args->{start}) {
- is($keys[0], $args->{start},".. got start value [$args->{range}]");
- }
- if($args->{stop}) {
- is($keys[-1], $args->{stop},".. got stop value [$args->{range}]");
+ ok(0,'missing date or range test');
}
- if($args->{count}) {
- cmp_ok(scalar @keys, '<=', $args->{count},".. counted number of records [$args->{range}]");
- }
- } else {
- ok(0,'missing date or range test');
}
}
+# 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;
+}

0 comments on commit 97f6a63

Please sign in to comment.
Something went wrong with that request. Please try again.