Permalink
Browse files

Add a malformed tarball (per guidance from dagolden++) to test visit(…

…). Add

tests.  Modify MANIFST.SKIP to permit various archive types in this
distribution.
  • Loading branch information...
1 parent 486b1f2 commit 23783383b62c784c625130dbceaac1aa34b02546 @jkeenan committed Feb 27, 2010
Showing with 44 additions and 12 deletions.
  1. +1 −0 MANIFEST
  2. +0 −4 MANIFEST.SKIP
  3. +1 −0 Makefile.PL
  4. +8 −6 lib/CPAN/Mini/Visit/Simple.pm
  5. +34 −2 t/008_visit.t
  6. BIN t/data/mydistro.tar.gz
View
1 MANIFEST
@@ -15,4 +15,5 @@ t/005_get_list.t
t/006_refresh_list.t
t/007_get_lookup_table.t
t/008_visit.t
+t/data/mydistro.tar.gz
Todo
View
4 MANIFEST.SKIP
@@ -12,10 +12,6 @@ CVS/.*
~$
^#
\.shar$
-\.tar$
-\.tgz$
-\.tar\.gz$
-\.zip$
\.DS_Store$
_uu$
\.svn
View
1 Makefile.PL
@@ -12,6 +12,7 @@ WriteMakefile(
'File::Find' => 0,
'File::Spec' => 0,
'File::Temp' => 0.14,
+ 'Path::Class' => 0.15,
'Scalar::Util' => 0,
},
BUILD_REQUIRES => {
View
14 lib/CPAN/Mini/Visit/Simple.pm
@@ -13,6 +13,7 @@ use File::Basename qw/ dirname basename /;
use File::Find;
use File::Spec;
use File::Temp qw/ tempdir /;
+use Path::Class;
use Scalar::Util qw/ reftype /;
use CPAN::Mini::Visit::Simple::Auxiliary qw(
$ARCHIVE_REGEX
@@ -238,12 +239,13 @@ sub visit {
carp "Couldn't extract '$distro'";
return;
}
-# # most distributions unpack a single directory that we must enter
-# # but some behave poorly and unpack to the current directory
-# my @children = dir()->children;
-# if ( ( @children == 1 ) and ( -d $children[0] ) ) {
-# chdir $children[0];
-# }
+ # most distributions unpack a single directory that we must enter
+ # but some behave poorly and unpack to the current directory
+ my $dir = Path::Class::Dir->new();
+ my @children = $dir->children;
+ if ( ( @children == 1 ) and ( -d $children[0] ) ) {
+ chdir $children[0];
+ }
&{$args->{action}}($proper_distro, @action_args);# execute command
}
View
36 t/008_visit.t
@@ -5,12 +5,20 @@
use 5.010;
use CPAN::Mini::Visit::Simple;
use Carp;
+use Cwd;
+use File::Basename;
+use File::Copy;
+use File::Path qw( make_path );
use File::Spec;
+use File::Temp qw( tempdir );
use IO::CaptureOutput qw( capture );
-use Test::More tests => 14;
+use Test::More qw(no_plan); # tests => 14;
my ( $self, $rv );
-my ( $real_id_dir, $start_dir );
+my ( $real_id_dir, $start_dir, $cwd );
+my ( $id_dir );
+
+$cwd = cwd();
$self = CPAN::Mini::Visit::Simple->new();
isa_ok ($self, 'CPAN::Mini::Visit::Simple');
@@ -190,3 +198,27 @@ eval {
like($@, qr/$pattern/,
"Got expected error message: 'action_args' must be an array reference" );
+# Case 10: Badly formatted archive
+my $archive = qq|$cwd/t/data/mydistro.tar.gz|;
+ok( -f $archive, "Able to locate archive prior to testing" );
+my $tdir = tempdir(CLEANUP => 1);
+chdir $tdir or croak "Unable to change to tempdir";
+
+$id_dir = File::Spec->catdir($tdir, qw/authors id/);
+make_path($id_dir, { mode => 0711 });
+ok( -d $id_dir, "'authors/id' directory created for testing" );
+
+my $thisauthor_dir = File::Spec->catdir($id_dir, qw/ Z /);
+make_path($thisauthor_dir, { mode => 0711 });
+ok( -d $thisauthor_dir, "directory created for testing" );
+my $copy_archive = File::Spec->catfile($thisauthor_dir, basename($archive));
+copy $archive => $copy_archive or croak "Unable to copy archive";
+
+$self = CPAN::Mini::Visit::Simple->new({
+ minicpan => $tdir,
+});
+isa_ok ($self, 'CPAN::Mini::Visit::Simple');
+$rv = $self->identify_distros( {
+ start_dir => $thisauthor_dir,
+} );
+ok( $rv, "'identify_distros() returned true value" );
View
BIN t/data/mydistro.tar.gz
Binary file not shown.

0 comments on commit 2378338

Please sign in to comment.