1. Toby Inkster
  2. p5-p5u

Commits

Toby Inkster  committed f98963a

add 'reprove' command - taken from App::Reprove which will be deleted from CPAN once P5U is released

  • Participants
  • Parent commits a7ee9a5
  • Branches default

Comments (0)

Files changed (7)

File lib/P5U/Command/DebianRelease.pm

View file
 
 use constant {
 	abstract    => q[show distribution version in Debian unstable],
-	description => q[],
 	usage_desc  => q[%c debian-release %o Distribution|CPANID],
 };
 
 	qw(
 		debian-release
 		debian
+		dr
 	);
 }
 

File lib/P5U/Command/Reprove.pm

View file
+package P5U::Command::Reprove;
+
+use 5.010;
+use strict;
+use utf8;
+use P5U-command;
+
+use PerlX::Maybe 0 'maybe';
+
+BEGIN {
+	$P5U::Command::Reprove::AUTHORITY = 'cpan:TOBYINK';
+	$P5U::Command::Reprove::VERSION   = '0.001';
+};
+
+use constant {
+	abstract    => q[download a distribution test suite and run it],
+	usage_desc  => q[%c reprove %o],
+};
+
+sub command_names
+{
+	qw(
+		reprove
+		rp
+	);
+}
+
+sub description
+{
+<<'DESCRIPTION'
+This command downloads a distribution's test suite from CPAN, and runs it
+locally.
+
+This command can be called using two different conventions; named arguments:
+
+	p5u reprove --release=JSON --version=2.53
+
+Or positional arguments:
+
+	p5u reprove JSON 2.53
+
+The first argument is the distribution name or module name; the second 
+argument is the version; and the third argument is the CPAN ID of the
+author. The presence of "::" is used to disambiguate between distribution
+and module names; in the case of something like "JSON" which is ambiguous,
+use a leading "::" to force it to be interpreted as a module name.
+
+When given a distribution name, the version is required. When given a
+module name, the version can usually be automatically detected. The author
+can usually be automatically detected.
+DESCRIPTION
+}
+
+sub opt_spec
+{
+	return (
+		["author|a=s",   "author of distribution to test"],
+		["version=s",    "version to test"],
+		["module|m=s",   "identify distribution via a module it provides"],
+		["release|r=s",  "name of distribution to test"],
+		["verbose|v",    "verbose output"],
+	)
+}
+
+sub execute
+{
+	require P5U::Lib::Reprove;
+	
+	my ($self, $opt, $args) = @_;
+
+	foreach my $a (qw< release version author >)
+	{
+		my $val = shift @$args;
+		defined $val or last;
+		$self->usage_error("Do not provide $a as a named and ordinal argument.")
+			if defined $opt->{$a};
+		
+		if ($a eq 'release' and $val =~ /::/)
+		{
+			$val =~ s{^::}{};
+			$opt->{module} = $val;
+			next;
+		}
+		
+		$opt->{$a} = $val;
+	}
+	
+	$self->usage_error("You must provide a distribution or module name.")
+		unless $opt->{release} || $opt->{module};
+		
+	P5U::Lib::Reprove::
+		-> new(
+			maybe author  => $opt->{author},
+			maybe module  => $opt->{module},
+			maybe release => $opt->{release},
+			maybe version => $opt->{version},
+			maybe verbose => $opt->{verbose},
+		)
+		-> run;
+}
+
+1;

File lib/P5U/Command/Testers.pm

View file
 
 use constant {
 	abstract    => q[show CPAN testers statistics for a distribution],
-	description => q[],
 	usage_desc  => q[%c testers %o Distribution],
 };
 
+sub command_names
+{
+	qw(
+		testers
+		cpan-testers
+		ct
+	);
+}
+
 sub opt_spec
 {
 	return (

File lib/P5U/Lib/DebianRelease.pm

View file
 use JSON             2.00  qw< from_json >;
 use LWP::Simple      0     qw< get >;
 use namespace::clean;
+use Object::AUTHORITY qw/AUTHORITY/;
 
 my $cachef = "/tmp/allpackages.cache";
 my $json   = JSON::->new->allow_nonref;

File lib/P5U/Lib/Reprove.pm

View file
+package P5U::Lib::Reprove;
+
+BEGIN {
+	$P5U::Lib::Reprove::AUTHORITY = 'cpan:TOBYINK';
+	$P5U::Lib::Reprove::VERSION   = '0.001';
+};
+
+use 5.010;
+use autodie;
+
+use Any::Moose;
+use App::Prove qw//;
+use Class::Load qw/load_class/;
+use JSON qw/from_json/;
+use File::Basename qw/fileparse/;
+use File::pushd qw/pushd/;
+use File::Path qw/make_path/;
+use File::Spec qw//;
+use File::Temp qw//;
+use LWP::Simple qw/get/;
+use Module::Manifest qw//;
+use Object::AUTHORITY qw/AUTHORITY/;
+
+has author => (
+	is         => 'ro',
+	isa        => 'Str',
+	lazy_build => 1,
+);
+
+has release => (
+	is         => 'ro',
+	isa        => 'Str',
+	required   => 1,
+);
+
+has version => (
+	is         => 'ro',
+	isa        => 'Str',
+	required   => 1,
+);
+
+has manifest => (
+	is         => 'ro',
+	isa        => 'ArrayRef[Str]',
+	lazy_build => 1,
+);
+
+has testdir => (
+	is         => 'ro',
+	isa        => 'File::Temp::Dir',
+	lazy_build => 1,
+);
+
+has verbose => (
+	is         => 'rw',
+	isa        => 'Bool',
+	required   => 1,
+	default    => 0,
+);
+
+sub BUILDARGS
+{
+	my ($class, @args) = @_;
+	
+	my %args;
+	if (@args == 1 and ref $args[0])
+	{
+		%args = %{ $args[0] }
+	}
+	elsif (scalar(@args) % 2 == 0)
+	{
+		%args = @args;
+	}
+	else
+	{
+		confess "Called with the wrong number of arguments.";
+	}
+	
+	if (defined $args{module} and not defined $args{version})
+	{
+		load_class($args{module});
+		$args{version} = $args{module}->VERSION;
+	}
+	
+	if (defined $args{module} and not defined $args{author})
+	{
+		load_class($args{module});
+		if ($args{module}->can('AUTHORITY'))
+		{
+			($args{author}) =
+				map { s/^cpan://; $_ }
+				grep { /^cpan:/ }
+				($args{module}->AUTHORITY);
+		}
+		else
+		{
+			no strict 'refs';
+			my $auth = ${$args{module}.'::AUTHORITY'};
+			if ($auth =~ /^cpan:(.+)$/)
+			{
+				$args{author} = $1;
+			}
+		}
+	}
+	
+	if (defined $args{module} and not defined $args{release})
+	{
+		my $d = from_json(get(sprintf('http://api.metacpan.org/v0/module/%s', $args{module})));
+		$args{release}  = $d->{distribution};
+		$args{author} //= $d->{author};
+	}
+	
+	if (defined $args{release} and not defined $args{author})
+	{
+		my $d = from_json(get(sprintf('http://api.metacpan.org/v0/release/%s', $args{release})));
+		$args{author} //= $d->{author};
+	}
+	
+	delete $args{module};
+	$class->SUPER::BUILDARGS(%args);
+}
+
+sub _url_for
+{
+	my ($self, $file) = @_;
+	sprintf(
+		'http://api.metacpan.org/source/%s/%s-%s/%s',
+		uc $self->author,
+		$self->release,
+		$self->version,
+		$file,
+		);
+}
+
+sub _getfile_to_handle
+{
+	my ($self, $file, $fh) = @_;
+	print $fh get($self->_url_for($file));
+}
+
+sub test_files
+{
+	my $self = shift;
+	grep { m{^t/} } @{ $self->manifest };
+}
+
+sub _build_author
+{
+	my $self = shift;
+	my $d = from_json(get(
+		sprintf('http://api.metacpan.org/v0/release/%s', $self->release)
+		));
+	$d->{author};
+}
+
+sub _build_manifest
+{
+	my $self = shift;
+	my $fh = File::Temp->new;
+	binmode( $fh, ":utf8");
+	$self->_getfile_to_handle('MANIFEST', $fh);
+	close $fh;
+	
+	my $manifest = Module::Manifest->new;
+	$manifest->open(manifest => $fh->filename);
+	return [ $manifest->files ];
+}
+
+sub _build_testdir
+{
+	my $self = shift;
+	my $testdir = File::Temp->newdir;
+	
+	foreach my $file ($self->test_files)
+	{
+		my $dest = File::Spec->catfile($testdir->dirname, $file);
+		
+		my (undef, $d, undef) = fileparse($dest);
+		make_path($d);
+		
+		open my $fh, '>', $dest;
+		$self->_getfile_to_handle($file, $fh);
+		close $fh;
+	}
+	
+	return $testdir;
+}
+
+sub _app_prove_args
+{
+	't';
+}
+
+sub run
+{
+	my $self = shift;
+	printf("Reproving %s/%s (%s)\n", $self->release, $self->version, uc $self->author);
+	printf("Using temp dir '%s'\n", $self->testdir->dirname) if $self->verbose;
+	my $chdir = pushd($self->testdir->dirname);
+	my $app   = App::Prove->new;
+	$app->process_args($self->_app_prove_args);
+	$app->verbose(1) if $self->verbose;
+	$app->run;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+P5U::Lib::Reprove - download a distribution's tests and prove them
+
+=head1 SYNOPSIS
+
+my $test = P5U::Lib::Reprove::->new(
+ author  => 'TOBYINK',
+ release => 'Object-AUTHORITY',
+ version => '0.003',
+ verbose => 1,
+);
+$test->run;
+
+=head1 DESCRIPTION
+
+This module downloads a distribution's test files (the contents of the C<t>
+directory) and runs L<App::Prove> (part of L<Test::Harness>) on them.
+
+It assumes that all the other files necessary for passing the test suite are
+already available on your system, installed into locations where the test suite
+will be able to find them. In particular, the libraries necessary to pass the
+test suite must be installed.
+
+It makes a number of assumptions about how a distribution's test cases are
+structured, but these assumptions do tend to hold in most cases.
+
+=head2 Constructor
+
+=over
+
+=item C<< new(%attributes) >>
+
+Construct an object with given attributes. This is a Moose-based class.
+
+=back
+
+=head2 Attributes
+
+=over
+
+=item C<< release >>
+
+Release name, e.g. "Moose" or "RDF-Trine". Required.
+
+=item C<< version >>
+
+Release version, e.g. "2.0001" or "0.136". Required.
+
+=item C<< author >>
+
+Release author's CPAN ID, e.g. "DOY" or "GWILLIAMS". If this is not provided,
+it can usually be figured out using the MetaCPAN API, but it's a good idea
+to provide it.
+
+=item C<< verbose >>
+
+Boolean indicating whether output should be verbose. Optional, defaults to false.
+
+=item C<< manifest >>
+
+An arrayref of strings, listing all the files in the distribution.
+Don't provide this to the constructor - just allow Module::Reprove
+to build it.
+
+=item C<< testdir >>
+
+A L<File::Temp::Dir> object pointing to a directory which contains
+a subdirectory "t" full of test files. Don't provide this to the
+constructor - just allow Module::Reprove to build it.
+
+=back
+
+There is also a pseudo-attribute C<< module >> which may be provided to the
+constructor, and allows the automatic calculation of C<< release >>,
+C<< version >> and C<< author >>. There is no getter/setter method for
+C<< module >> though; it is not a true attribute.
+
+=head2 Methods
+
+=over
+
+=item C<< test_files >>
+
+Returns a list of test case files, based on the contents of the manifest.
+
+=item C<< run >>
+
+Runs the test using C<< App::Prove::run >> and returns whatever L<App::Prove>
+would have returned, which is undocumented but appears to be false if there
+are test failures, and true if all tests pass.
+
+=begin private
+
+=item C<< BUILDARGS >>
+
+Moose stuff.
+
+=end private
+
+=back
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=P5U>.
+
+=head1 SEE ALSO
+
+L<P5U>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2011-2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

File lib/P5U/Lib/Testers.pm

View file
 use JSON             0 qw< from_json >;
 use LWP::Simple      0 qw< mirror is_success >;
 use List::Util       0 qw< maxstr >;
+use Object::AUTHORITY qw/AUTHORITY/;
 use namespace::clean;
 
 has cache_dir => (

File meta/makefile.ttl

View file
 	:install_script     _:script;
 	:requires           "Any::Moose";
 	:requires           "App::Cmd";
+	:requires           "autodie";
+	:requires           "Class::Load";
 	:requires           "File::Path";
+	:requires           "File::pushd";
 	:requires           "File::Slurp";
 	:requires           "JSON 2.00";
 	:requires           "LWP::Simple";
+	:requires           "Module::Manifest";
 	:requires           "namespace::clean 0.19";
+	:requires           "Object::AUTHORITY";
 	:requires           "PerlX::Maybe";
 	:test_requires      "Test::More 0.61".