Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

First commit following use of module in a live program aimed at trave…

…rsing a minicpan.
  • Loading branch information...
commit 7624af3e495c7c157f3080d23b222483e631f87f 1 parent 0da07fe
@jkeenan authored
Showing with 49 additions and 19 deletions.
  1. +3 −0  Changes
  2. +5 −4 Todo
  3. +4 −2 lib/CPAN/Mini/Visit/Simple.pm
  4. +37 −13 t/008_visit.t
View
3  Changes
@@ -1,5 +1,8 @@
Revision history for Perl module CPAN::Mini::Visit::Simple
+0.02 Sat Feb 27 10:56:08 EST 2010
+ - First version with a working visitation method
+
0.01 Thu Feb 18 20:19:30 2010
- original version; created by ExtUtils::ModuleMaker 0.51
View
9 Todo
@@ -1,6 +1,7 @@
TODO list for Perl module CPAN::Mini::Visit::Simple
-1. Testing: Write tests for a few uncovered statements and branches in the
-two .pm files. Explicit tests for get_lookup_table().
-
-2. Development: Write visit method.
+1. When traversing a minicpan, certain distributions cannot be unpacked with
+'tar' (cf.: https://rt.cpan.org/Public/Bug/Display.html?id=55044). This
+causes Archive::Extract->new() to die, which currently causes the traversal
+program to die. We may have to institute a blacklist of distributions which
+should not be visited -- but developing this list will be painful.
View
6 lib/CPAN/Mini/Visit/Simple.pm
@@ -3,7 +3,7 @@ use 5.010;
use strict;
use warnings;
-our $VERSION = '0.001';
+our $VERSION = '0.002';
$VERSION = eval $VERSION; ## no critic
use Archive::Extract;
@@ -224,8 +224,10 @@ sub visit {
open STDERR, ">", File::Spec->devnull;
}
my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir or croak "Unable to change to temporary directory";
my $ae = Archive::Extract->new( archive => $distro );
- my $extract_ok = $ae->extract( to => $tdir );
+ my $extract_ok;
+ eval { $extract_ok = $ae->extract( to => $tdir ); };
# restore stderr if quiet
if ( not $Archive::Extract::WARN ) {
open STDERR, ">&", $olderr;
View
50 t/008_visit.t
@@ -12,7 +12,7 @@ use File::Path qw( make_path );
use File::Spec;
use File::Temp qw( tempdir );
use IO::CaptureOutput qw( capture );
-use Test::More qw(no_plan); # tests => 14;
+use Test::More tests => 21;
my ( $self, $rv );
my ( $real_id_dir, $start_dir, $cwd );
@@ -222,15 +222,39 @@ $rv = $self->identify_distros( {
start_dir => $thisauthor_dir,
} );
ok( $rv, "'identify_distros() returned true value" );
-$rv = $self->visit( {
- action => sub {
- my $distro = shift @_;
- if ( -f 'Makefile.PL' ) {
- say "$distro has Makefile.PL";
- }
- if ( -f 'Build.PL' ) {
- say "$distro has Build.PL";
- }
- },
-} );
-ok( $rv, "'visit()' returned true value" );
+#$rv = $self->visit( {
+# action => sub {
+# my $distro = shift @_;
+# if ( -f 'Makefile.PL' ) {
+# say "$distro has Makefile.PL";
+# }
+# if ( -f 'Build.PL' ) {
+# say "$distro has Build.PL";
+# }
+# },
+#} );
+{
+ my ($stdout, $stderr);
+ capture(
+ sub {
+ $rv = $self->visit( {
+ action => sub {
+ my $distro = shift @_;
+ if ( -f 'Makefile.PL' ) {
+ say "$distro has Makefile.PL";
+ }
+ if ( -f 'Build.PL' ) {
+ say "$distro has Build.PL";
+ }
+ },
+ } );
+ },
+ \$stdout,
+ \$stderr,
+ );
+ ok( $rv, "'visit()' returned true value" );
+ like($stdout,
+ qr/\.tar\.gz has Makefile\.PL/s,
+ "Got expected STDOUT"
+ );
+}
Please sign in to comment.
Something went wrong with that request. Please try again.