Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

This script acts as a handy interface to the CPAN testers service, allowing you to quickly check pass/fail rates for a particular release.

It fetches YAMLJSON and performs HTTP caching, so probably puts less stress on the CPAN testers servers than a hit from a browser.

Usage:
	cpan-testers Example-Distribution
	cpan-testers -v0.001 Example-Distribution
	cpan-testers -ov0.001 Example-Distribution
	cpan-testers -s Example-Distribution

Options:
	--version=V, -vV   Show results for particular release version.
	--os, -o           Break down by operating system.
	--summary, -s      Show summary for all versions
	                   (excludes "--version" and "--os" options).
	--stable, -S       Hide dev versions (excludes "--version").

Requires:

#!/usr/bin/env perl use 5.010; use strict; use utf8; { package App::CpanTesters; use Any::Moose 0; use File::Path 0 qw< make_path >; use File::Spec 0 qw< >; use Getopt::Long 0 qw< GetOptionsFromArray :config permute bundling no_ignore_case no_auto_abbrev >; use JSON 0 qw< from_json >; use LWP::Simple 0 qw< mirror is_success >; use List::Util 0 qw< maxstr >; use PerlX::Maybe 0 qw< maybe >; sub show_help { my $exit_status = shift || 0; print <<"HELP"; Usage: $0 Example-Distribution $0 -v0.001 Example-Distribution $0 -ov0.001 Example-Distribution $0 -s Example-Distribution Options: --version=V, -vV Show results for particular release version. --os, -o Break down by operating system. --summary, -s Show summary for all versions (excludes "--version" and "--os" options). --stable, -S Hide dev versions (excludes "--version"). HELP exit($exit_status); } use namespace::clean; has cache_dir => ( is => 'ro', isa => 'Str', lazy => 1, builder => '_build_cache_dir', ); has distro => ( is => 'ro', isa => 'Str', required => 1, ); has results => ( is => 'ro', isa => 'ArrayRef', lazy => 1, builder => '_build_results', ); has version => ( is => 'ro', isa => 'Str', lazy => 1, builder => '_build_version', ); has os_data => ( is => 'ro', isa => 'Bool', default => 0, ); has stable => ( is => 'ro', isa => 'Bool', default => 0, ); sub run { my ($class, @argv) = @_; my ($version, $summary, $os_data, $stable) = (undef, 0, 0, 0); GetOptionsFromArray( \@argv, 'version|v=s' => \$version, 'summary|s' => \$summary, 'os|o' => \$os_data, 'stable|S' => \$stable, 'help|usage|h' => \&show_help, ); show_help(1) if $summary && ($os_data or length $version); show_help(1) if $stable && length $version; my $distro = shift @argv or show_help(1); $distro =~ s{::}{-}g; my $self = $class->new( distro => $distro, os_data => !!$os_data, stable => !!$stable, maybe version => $version, ); if ($summary) { exit ! print $self->summary_report; } exit ! print $self->version_report; } sub version_data { my ($self) = @_; my %data; foreach (@{$self->results}) { next unless $_->{version} eq $self->version; my ($pv) = ($_->{perl} =~ /^5\.(\d+)/) or next; next if $pv ~~ [9, 11, 13, 15]; my $key = $self->os_data ? sprintf("Perl 5.%03d, %s", $pv, $_->{ostext}) : sprintf("Perl 5.%03d", $pv); my $num = { PASS => 0, FAIL => 1 }->{$_->{status}} // 2; $data{$key}[$num]++; } return \%data; } sub summary_data { my ($self) = @_; my %data; foreach (@{$self->results}) { my $key = $_->{version}; my $num = { PASS => 0, FAIL => 1 }->{$_->{status}} // 2; $data{$key}[$num]++; } return \%data; } sub format_report { my ($self, $title, $data) = @_; no warnings; join "\n" => ( $title, q(), sprintf("%-32s%6s%6s%6s", q(), qw(PASS FAIL ETC)), ( map { sprintf "%-32s% 6d% 6d% 6d", $_, @{$data->{$_}} +} sort keys %$data ), q(), ); } sub version_report { my ($self) = @_; $self->format_report( sprintf("CPAN Testers results for %s version %s", $self->d +istro, $self->version), $self->version_data, ); } sub summary_report { my ($self, $os_data) = @_; $self->format_report( sprintf("CPAN Testers results for %s", $self->distro), $self->summary_data, ); } sub _build_version { maxstr map { $_->{version} } @{ shift->results } } sub _build_results { my $self = shift; my $results_uri = sprintf( 'http://www.cpantesters.org/distro/%s/%s.json', substr($self->distro, 0, 1), $self->distro, ); my $results_file = File::Spec->catfile( $self->cache_dir, sprintf('%s.json', $self->distro), ); is_success mirror($results_uri => $results_file) or do { unlink $results_file; die "Failed to retrieve URI $results_uri\n"; }; my $results = from_json do { open my $fh, '<', $results_file or die "Could not open $results_file: $!"; local $/ = <$fh>; }; die "Unexpected non-ARRAY content from $results_uri\n" unless ref $results eq 'ARRAY'; $self->stable ? [ grep { $_->{version} !~ /_/ } @$results ] : $results; } sub _build_cache_dir { my $dir = File::Spec->catdir( File::Spec->tmpdir, 'CpanTesters', ); make_path $dir unless -d $dir; return $dir; } } App::CpanTesters->run(@ARGV) unless scalar caller(0);

Update: switched from retrieving YAML to retrieving JSON. The YAML files seem a bit smaller, but JSON parsing seems more reliable, and the JSON files served by the CPAN Testers site seem to have more cache-friendly headers.

perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'

In reply to CPAN Testers command-line viewer by tobyink

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others learning in the Monastery: (4)
As of 2024-03-29 00:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found