[Bps-public-commit] Shipwright branch, master, updated. 96a6ed0d91f1bed8c33f6f3c4abf57e8e60c3e79
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Thu Jul 30 21:04:43 EDT 2009
The branch, master has been updated
via 96a6ed0d91f1bed8c33f6f3c4abf57e8e60c3e79 (commit)
via cf7f76cce5e5496a55f8f106b9c08610b103c779 (commit)
via 33468dec5cb65d13bdea4b1448e445f5b326fe43 (commit)
from b16e13d531ab9b09706b006303e99e4a7f29cd1e (commit)
Summary of changes:
README | 7 --
lib/Shipwright/Backend/Base.pm | 28 +++------
lib/Shipwright/Backend/FS.pm | 117 +++++++++++++++++++++-------------
lib/Shipwright/Backend/Git.pm | 5 +-
lib/Shipwright/Backend/SVK.pm | 7 +-
lib/Shipwright/Backend/SVN.pm | 5 +-
lib/Shipwright/Source/Base.pm | 18 +++---
lib/Shipwright/Source/Compressed.pm | 5 +-
lib/Shipwright/Util.pm | 11 +++
lib/Shipwright/Util/CleanINC.pm | 2 +-
t/05.util.t | 16 +++---
t/hello/fs.t | 36 +++++++----
t/hello/git.t | 59 +++++++++++++-----
t/hello/svk.t | 9 +--
t/hello/svn.t | 9 +--
15 files changed, 196 insertions(+), 138 deletions(-)
- Log -----------------------------------------------------------------
commit 33468dec5cb65d13bdea4b1448e445f5b326fe43
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Jul 30 18:50:24 2009 +0800
tiny fix
diff --git a/lib/Shipwright/Util/CleanINC.pm b/lib/Shipwright/Util/CleanINC.pm
index eec9940..ce2d2d9 100644
--- a/lib/Shipwright/Util/CleanINC.pm
+++ b/lib/Shipwright/Util/CleanINC.pm
@@ -14,7 +14,7 @@ sub import {
my @inc_libs = grep {/inc$/} split( /[:;]/,($ENV{'PERL5LIB'} ||''));
# if the libs are explicitly specified, don't pull them from @INC
my @new_base_inc = grep { !$skip_lib_path{$_}++ } ( @explicit_libs, @INC, at inc_libs);
- @INC = map { /(.+)/; $1 } (
+ @INC = map { /(.+)/; $1 } grep { defined } (
@new_base_inc, $Config::Config{archlibexp},
$Config::Config{privlibexp}, $Config::Config{updatesarch},
$Config::Config{updateslib},
commit cf7f76cce5e5496a55f8f106b9c08610b103c779
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Jul 30 18:50:49 2009 +0800
add code type cmd support
diff --git a/lib/Shipwright/Util.pm b/lib/Shipwright/Util.pm
index 3dbcb6d..beef49e 100644
--- a/lib/Shipwright/Util.pm
+++ b/lib/Shipwright/Util.pm
@@ -55,6 +55,17 @@ sub run {
my $cmd = shift;
my $ignore_failure = shift;
+ if ( ref $cmd eq 'CODE' ) {
+ my @returns;
+ if ( $ignore_failure ) {
+ @returns = eval { $cmd->() };
+ }
+ else {
+ @returns = $cmd->();
+ }
+ return wantarray ? @returns : $returns[0];
+ }
+
my $log = Log::Log4perl->get_logger('Shipwright::Util');
my ( $out, $err );
commit 96a6ed0d91f1bed8c33f6f3c4abf57e8e60c3e79
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Jul 30 18:52:31 2009 +0800
replace some system calls( e.g. ls cat cp mv ) with perl's in lib
diff --git a/README b/README
index 5ac1a1c..0d218e6 100644
--- a/README
+++ b/README
@@ -10,13 +10,6 @@ To install this module, run the following commands:
make test
make install
-NOTES FOR USERS ON WINDOWS
-
-Shipwright depends many UNIX shell cmds( e.g. ls, rm, mv ), so if you are
-on Windows, you need to install a UNIX Utility software that supplied those
-cmds, e.g. http://sourceforge.net/projects/unxutils/ can do this.
-
-
COPYRIGHT AND LICENCE
Copyright 2007-2009 Best Practical Solutions.
diff --git a/lib/Shipwright/Backend/Base.pm b/lib/Shipwright/Backend/Base.pm
index ea9aad8..1011564 100644
--- a/lib/Shipwright/Backend/Base.pm
+++ b/lib/Shipwright/Backend/Base.pm
@@ -6,8 +6,7 @@ use Carp;
use File::Spec::Functions qw/catfile catdir splitpath/;
use Shipwright::Util;
use File::Temp qw/tempdir/;
-use File::Copy qw/copy/;
-use File::Copy::Recursive qw/dircopy/;
+use File::Copy::Recursive qw/rcopy/;
use File::Path;
use List::MoreUtils qw/uniq firstidx/;
use Module::Info;
@@ -61,7 +60,7 @@ sub initialize {
my $dir =
tempdir( 'shipwright_backend_base_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
- dircopy( Shipwright::Util->share_root, $dir )
+ rcopy( Shipwright::Util->share_root, $dir )
or confess "copy share_root failed: $!";
$self->_install_yaml_tiny($dir);
@@ -78,18 +77,8 @@ sub initialize {
}
closedir $sw_dh;
- # share_root can't keep empty dirs, we have to create them manually
- for (qw/scripts sources/) {
- my $sub_dir = catdir( $dir, $_ );
- mkdir $sub_dir;
- open my $fh, '>', catfile( $sub_dir, '.exists' ) or confess $!;
- close $fh;
- }
chmod 0644, catfile( $dir, 't', 'test' );
- # hack for share_root living under blib/
- unlink( catfile( $dir, '.exists' ) );
-
return $dir;
}
@@ -98,17 +87,16 @@ sub _install_module_build {
my $dir = shift;
my $module_build_path = catdir( $dir, 'inc', 'Module', );
mkpath catdir( $module_build_path, 'Build' );
- copy( Module::Info->new_from_module('Module::Build')->file,
+ rcopy( Module::Info->new_from_module('Module::Build')->file,
$module_build_path ) or confess "copy Module/Build.pm failed: $!";
- dircopy(
+ rcopy(
catdir(
Module::Info->new_from_module('Module::Build')->inc_dir, 'Module',
'Build'
),
catdir( $module_build_path, 'Build' )
)
- or confess "copy
- Module/Build failed: $!";
+ or confess "copy Module/Build failed: $!";
}
sub _install_yaml_tiny {
@@ -117,7 +105,7 @@ sub _install_yaml_tiny {
my $yaml_tiny_path = catdir( $dir, 'inc', 'YAML' );
mkpath $yaml_tiny_path;
- copy( Module::Info->new_from_module('YAML::Tiny')->file, $yaml_tiny_path )
+ rcopy( Module::Info->new_from_module('YAML::Tiny')->file, $yaml_tiny_path )
or confess "copy YAML/Tiny.pm failed: $!";
}
@@ -127,7 +115,7 @@ sub _install_clean_inc {
my $util_inc_path = catdir( $dir, 'inc', 'Shipwright', 'Util' );
mkpath $util_inc_path;
for my $mod qw(Shipwright::Util::CleanINC Shipwright::Util::PatchModuleBuild) {
- copy( Module::Info->new_from_module($mod)->file, $util_inc_path )
+ rcopy( Module::Info->new_from_module($mod)->file, $util_inc_path )
or confess "copy $mod failed: $!";
}
}
@@ -138,7 +126,7 @@ sub _install_file_compare {
my $path = catdir( $dir, 'inc', 'File' );
mkpath $path;
- copy( Module::Info->new_from_module('File::Compare')->file, $path )
+ rcopy( Module::Info->new_from_module('File::Compare')->file, $path )
or confess "copy File/Compare.pm failed: $!";
}
diff --git a/lib/Shipwright/Backend/FS.pm b/lib/Shipwright/Backend/FS.pm
index 1d64666..fbcd525 100644
--- a/lib/Shipwright/Backend/FS.pm
+++ b/lib/Shipwright/Backend/FS.pm
@@ -5,8 +5,8 @@ use strict;
use Carp;
use File::Spec::Functions qw/catfile splitdir catdir/;
use Shipwright::Util;
-use File::Copy qw/copy/;
-use File::Copy::Recursive qw/dircopy/;
+use File::Copy::Recursive qw/rcopy rmove/;
+use File::Path;
our %REQUIRE_OPTIONS = ( import => [qw/source/] );
@@ -37,7 +37,7 @@ sub initialize {
$self->delete; # clean repository in case it exists
- dircopy( $dir, $self->repository )
+ rcopy( $dir, $self->repository )
or confess "can't copy $dir to " . $self->repository . ": $!";
}
@@ -55,22 +55,23 @@ sub _cmd {
my @cmd;
if ( $type eq 'checkout' || $type eq 'export' ) {
- @cmd = [ 'cp', '-r', $self->repository . $args{path}, $args{target} ];
+ @cmd = sub {
+ rcopy( $self->repository . $args{path}, $args{target} );
+ };
}
elsif ( $type eq 'import' ) {
if ( $args{_extra_tests} ) {
- @cmd = [
- 'cp', '-r',
- $args{source}, catdir( $self->repository, 't', 'extra' )
- ];
+ @cmd = sub {
+ rcopy( $args{source},
+ catdir( $self->repository, 't', 'extra' ) );
+ };
}
else {
if ( my $script_dir = $args{build_script} ) {
- push @cmd,
- [
- 'cp', '-r', catdir($script_dir),
- catdir( $self->repository, 'scripts', $args{name} )
- ];
+ push @cmd, sub {
+ rcopy( catdir($script_dir),
+ catdir( $self->repository, 'scripts', $args{name} ) );
+ };
}
else {
if ( $self->has_branch_support ) {
@@ -82,50 +83,77 @@ sub _cmd {
)
)
{
- push @cmd,
- [
- 'mkdir', '-p',
+ push @cmd, sub {
+ mkpath(
+ catdir(
+ $self->repository,
+ 'sources',
+ $args{name},
+ @dirs[ 0 .. $#dirs - 1 ]
+ )
+ );
+ };
+ }
+
+ push @cmd, sub {
+ rcopy(
+ catdir( $args{source} ),
catdir(
$self->repository, 'sources',
- $args{name}, @dirs[ 0 .. $#dirs - 1 ]
+ $args{name}, $args{as}
)
- ];
- }
-
- push @cmd,
- [
- 'cp', '-r',
- catdir( $args{source} ),
- catdir(
- $self->repository, 'sources',
- $args{name}, $args{as}
- )
- ];
+ );
+ };
}
else {
- push @cmd, [
- 'cp', '-r', catdir( $args{source} ),
- catdir( $self->repository, 'dists', $args{name} )
- ];
+ push @cmd, sub {
+ rcopy( catdir( $args{source} ),
+ catdir( $self->repository, 'dists', $args{name} ) );
+ };
}
}
}
}
elsif ( $type eq 'delete' ) {
- @cmd = [ 'rm', '-rf', $self->repository . $args{path}, ];
+ @cmd = sub { rmtree( $self->repository . $args{path} ) };
}
elsif ( $type eq 'move' ) {
- @cmd = [
- 'mv',
- $self->repository . $args{path},
- $self->repository . $args{new_path}
- ];
+ @cmd = sub {
+ rmove(
+ $self->repository . $args{path},
+ $self->repository . $args{new_path}
+ );
+ };
+ }
+ elsif ( $type eq 'info' ) {
+ @cmd = sub { -e $self->repository . $args{path} };
}
- elsif ( $type eq 'info' || $type eq 'list' ) {
- @cmd = [ 'ls', $self->repository . $args{path} ];
+ elsif ( $type eq 'list' ) {
+ @cmd = sub {
+ my $path = $self->repository . $args{path};
+ return 'No such file or directory' unless -e $path;
+
+ if ( -d $path ) {
+ my $dh;
+ opendir $dh, $path or die $!;
+ my $dirs = join "\t", grep { /^[^.]/ } readdir $dh;
+ return $dirs;
+ }
+ else {
+ return $path;
+ }
+ };
}
elsif ( $type eq 'cat' ) {
- @cmd = [ 'cat', $self->repository . $args{path} ];
+ @cmd = sub {
+ my $path = $self->repository . $args{path};
+ return ( 'No such file or directory' ) unless -e $path;
+ return ( '', 'Is a directory' ) unless -f $path;
+ local $/;
+ open my $fh, '<', $path or die $!;
+ my $c = <$fh>;
+ return $c;
+ };
}
else {
croak "invalid command: $type";
@@ -170,7 +198,6 @@ sub info {
return $info, $err;
}
else {
- return if $info =~ /no such file or directory/i;
return $info;
}
}
@@ -193,7 +220,7 @@ sub _update_file {
my $file = catfile( $self->repository, $path );
unlink $file;
- copy( $latest, $file ) or confess "can't copy $latest to $file: $!";
+ rcopy( $latest, $file ) or confess "can't copy $latest to $file: $!";
}
sub _update_dir {
@@ -202,7 +229,7 @@ sub _update_dir {
my $latest = shift;
my $dir = catfile( $self->repository, $path );
- dircopy( $latest, $dir ) or confess "can't copy $latest to $dir: $!";
+ rcopy( $latest, $dir ) or confess "can't copy $latest to $dir: $!";
}
=item import
diff --git a/lib/Shipwright/Backend/Git.pm b/lib/Shipwright/Backend/Git.pm
index af2c781..38c990f 100644
--- a/lib/Shipwright/Backend/Git.pm
+++ b/lib/Shipwright/Backend/Git.pm
@@ -6,8 +6,7 @@ use Carp;
use File::Spec::Functions qw/catfile catdir/;
use Shipwright::Util;
use File::Temp qw/tempdir/;
-use File::Copy qw/copy/;
-use File::Copy::Recursive qw/dircopy/;
+use File::Copy::Recursive qw/rcopy/;
use Cwd qw/getcwd/;
use Shipwright::Backend::FS;
@@ -48,7 +47,7 @@ sub initialize {
chdir $path;
Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_GIT'}, '--bare', 'init' ] );
- dircopy( $dir, $self->cloned_dir )
+ rcopy( $dir, $self->cloned_dir )
or confess "can't copy $dir to " . $path . ": $!";
$self->commit( comment => 'create project' );
chdir $cwd;
diff --git a/lib/Shipwright/Backend/SVK.pm b/lib/Shipwright/Backend/SVK.pm
index 26aa4b5..0c5af35 100644
--- a/lib/Shipwright/Backend/SVK.pm
+++ b/lib/Shipwright/Backend/SVK.pm
@@ -6,8 +6,7 @@ use Carp;
use File::Spec::Functions qw/catfile/;
use Shipwright::Util;
use File::Temp qw/tempdir/;
-use File::Copy qw/copy/;
-use File::Copy::Recursive qw/dircopy/;
+use File::Copy::Recursive qw/rcopy/;
our %REQUIRE_OPTIONS = ( import => [qw/source/] );
@@ -285,7 +284,7 @@ sub _update_file {
target => $file,
);
- copy( $latest, $file ) or confess "can't copy $latest to $file: $!";
+ rcopy( $latest, $file ) or confess "can't copy $latest to $file: $!";
$self->commit(
path => $file,
comment => "updated $path",
@@ -307,7 +306,7 @@ sub _update_dir {
target => $dir,
);
- dircopy( $latest, $dir ) or confess "can't copy $latest to $dir: $!";
+ rcopy( $latest, $dir ) or confess "can't copy $latest to $dir: $!";
$self->commit(
path => $dir,
comment => "updated $path",
diff --git a/lib/Shipwright/Backend/SVN.pm b/lib/Shipwright/Backend/SVN.pm
index 0dd4052..d1504fd 100644
--- a/lib/Shipwright/Backend/SVN.pm
+++ b/lib/Shipwright/Backend/SVN.pm
@@ -6,8 +6,7 @@ use Carp;
use File::Spec::Functions qw/catfile/;
use Shipwright::Util;
use File::Temp qw/tempdir/;
-use File::Copy qw/copy/;
-use File::Copy::Recursive qw/dircopy/;
+use File::Copy::Recursive qw/rcopy/;
our %REQUIRE_OPTIONS = ( import => [qw/source/] );
@@ -260,7 +259,7 @@ sub _update_file {
target => $dir,
);
- copy( $latest, $file ) or confess "can't copy $latest to $file: $!";
+ rcopy( $latest, $file ) or confess "can't copy $latest to $file: $!";
$self->commit(
path => $file,
comment => "updated $path",
diff --git a/lib/Shipwright/Source/Base.pm b/lib/Shipwright/Source/Base.pm
index ed250f0..f9479c2 100644
--- a/lib/Shipwright/Source/Base.pm
+++ b/lib/Shipwright/Source/Base.pm
@@ -9,6 +9,7 @@ use Module::CoreList;
use Shipwright::Source;
use Shipwright::Util;
use Cwd qw/getcwd/;
+use File::Copy::Recursive qw/rcopy/;
use base qw/Class::Accessor::Fast/;
__PACKAGE__->mk_accessors(
@@ -597,14 +598,15 @@ sub _copy {
my %file = @_;
for ( keys %file ) {
if ( $file{$_} ) {
- my $cmd = [
- 'cp',
- $file{$_},
- catfile(
- $self->directory,
- $self->name || $self->just_name( $self->path ), $_
- )
- ];
+ my $cmd = sub {
+ rcopy(
+ $file{$_},
+ catfile(
+ $self->directory,
+ $self->name || $self->just_name( $self->path ), $_
+ )
+ );
+ };
Shipwright::Util->run($cmd);
}
}
diff --git a/lib/Shipwright/Source/Compressed.pm b/lib/Shipwright/Source/Compressed.pm
index ccdf377..a3b31ba 100644
--- a/lib/Shipwright/Source/Compressed.pm
+++ b/lib/Shipwright/Source/Compressed.pm
@@ -8,6 +8,7 @@ use File::Spec::Functions qw/catfile catdir/;
use base qw/Shipwright::Source::Base/;
use Archive::Extract;
use File::Temp qw/tempdir/;
+use File::Copy::Recursive qw/rmove/;
=head2 run
@@ -87,7 +88,9 @@ sub _cmd {
push @cmds, sub { $ae->extract( to => $self->directory ) };
if ( $from ne $to ) {
- push @cmds, [ 'mv', $from, $to ];
+ push @cmds, sub {
+ rmove( $from, $to );
+ };
}
return @cmds;
diff --git a/t/05.util.t b/t/05.util.t
index 2254271..3506eda 100644
--- a/t/05.util.t
+++ b/t/05.util.t
@@ -37,19 +37,19 @@ for ( 1 .. 2 ) {
}
my ( $out, $err );
-$out = Shipwright::Util->run( [ 'ls', 'lib' ] );
-like( $out, qr/Shipwright/, "run 'ls lib' get right output" );
+$out = Shipwright::Util->run( [ $^X, '-e', 'print "ok"' ] );
+like( $out, qr/ok/, "normal run" );
-eval { Shipwright::Util->run( [ 'ls', 'lalala' ] ) };
-like( $@, qr/something wrong/i, 'run "ls lalala" results in death' );
-
-( undef, $err ) = Shipwright::Util->run( [ 'ls', 'lalala' ], 1 );
+( undef, $err ) = Shipwright::Util->run( [ $^X, '-e', 'die "error"' ], 1 );
like(
$err,
- qr/ls:|no such file/i,
- "run 'ls lalala' get warning if ignore_failure"
+ qr/error/i,
+ "run with error again, also with ignore_failure"
);
+$out = Shipwright::Util->run( sub { 'ok' } );
+like( $out, qr/ok/, "normal code run" );
+
my $hashref = { foo => 'bar' };
my $string = <<EOF;
---
diff --git a/t/hello/fs.t b/t/hello/fs.t
index aaa8179..a58a838 100644
--- a/t/hello/fs.t
+++ b/t/hello/fs.t
@@ -4,10 +4,11 @@ use warnings;
use Shipwright;
use File::Temp qw/tempdir/;
use File::Copy;
-use File::Copy::Recursive qw/dircopy/;
+use File::Copy::Recursive qw/rcopy/;
use File::Spec::Functions qw/catfile catdir updir/;
use File::Path qw/rmtree/;
use Cwd qw/getcwd abs_path/;
+use File::Slurp;
use Test::More tests => 38;
use Shipwright::Test;
@@ -56,7 +57,7 @@ opendir $dh, $repo;
my @dirs = sort grep { !/^\./ } readdir $dh;
is_deeply(
[@dirs],
- [ '__default_builder_options', 'bin', 'etc', 'inc', 'scripts', 'shipwright', 'sources', 't' ],
+ [ '__default_builder_options', 'bin', 'etc', 'inc', 'shipwright', 't' ],
'initialize works'
);
@@ -75,7 +76,8 @@ ok( -e catfile( $source_dir, 'META.yml' ), 'META.yml exists in the source' );
# import
$shipwright->backend->import( name => 'hello', source => $source_dir );
-ok( grep( {/Makefile\.PL/} `ls $repo/sources/Foo-Bar/vendor` ), 'imported ok' );
+ok( -e catfile( $repo, 'sources', 'Foo-Bar', 'vendor', 'Makefile.PL' ),
+ 'imported ok' );
my $script_dir = tempdir( 'shipwright_XXXXXX', CLEANUP => 0, TMPDIR => 1 );
copy( catfile( 't', 'hello', 'scripts', 'build' ), $script_dir );
@@ -86,8 +88,11 @@ $shipwright->backend->import(
source => $source_dir,
build_script => $script_dir,
);
-ok( grep( {/Makefile\.PL/} `cat $repo/scripts/Foo-Bar/build` ),
- 'build script ok' );
+ok(
+ grep( {/Makefile\.PL/}
+ read_file( catfile( $repo, 'scripts', 'Foo-Bar', 'build' ) ) ),
+ 'build script ok'
+);
# import another dist
@@ -104,7 +109,8 @@ $shipwright = Shipwright->new(
$source_dir = $shipwright->source->run();
like( $source_dir, qr/\bhowdy\b/, 'source name looks ok' );
$shipwright->backend->import( name => 'hello', source => $source_dir );
-ok( grep( {/Makefile\.PL/} `ls $repo/sources/howdy/vendor` ), 'imported ok' );
+ok( -e catfile( $repo, 'sources', 'howdy', 'vendor', 'Makefile.PL' ),
+ 'imported ok' );
$script_dir = tempdir( 'shipwright_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
copy( catfile( 't', 'hello', 'scripts', 'build' ), $script_dir );
copy( catfile( 't', 'hello', 'scripts', 'howdy_require.yml' ),
@@ -115,31 +121,37 @@ $shipwright->backend->import(
source => $source_dir,
build_script => $script_dir,
);
-ok( grep( {/Makefile\.PL/} `cat $repo/scripts/howdy/build` ), 'build script ok' );
+ok(
+ grep( {/Makefile\.PL/}
+ read_file( catfile( $repo, 'scripts', 'howdy', 'build' ) ) ),
+ 'build script ok'
+);
my $tempdir = tempdir( 'shipwright_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
-dircopy(
+rcopy(
catfile( 't', 'hello', 'shipwright' ),
catfile( $tempdir, 'shipwright' )
);
# check to see if update_order works
like(
- `cat $repo/shipwright/order.yml`,
+ scalar( read_file( catfile( $repo, 'shipwright', 'order.yml' ) ) ),
qr/Foo-Bar.*howdy/s,
'original order is right'
);
-system( 'cp -r ' . catdir( $tempdir, 'shipwright' ) . " $repo" );
+rcopy( catdir( $tempdir, 'shipwright' ), catdir( $repo, 'shipwright' ) );
+
+
like(
- `cat $repo/shipwright/order.yml`,
+ scalar( read_file( catfile( $repo, 'shipwright', 'order.yml' ) ) ),
qr/howdy.*Foo-Bar/s,
'imported wrong order works'
);
$shipwright->backend->update_order;
like(
- `cat $repo/shipwright/order.yml`,
+ scalar( read_file( catfile( $repo, 'shipwright', 'order.yml' ) ) ),
qr/Foo-Bar.*howdy/s,
'updated order works'
);
diff --git a/t/hello/git.t b/t/hello/git.t
index 9d305ca..c1b9f03 100644
--- a/t/hello/git.t
+++ b/t/hello/git.t
@@ -4,10 +4,11 @@ use warnings;
use Shipwright;
use File::Temp qw/tempdir/;
use File::Copy;
-use File::Copy::Recursive qw/dircopy/;
+use File::Copy::Recursive qw/rcopy/;
use File::Spec::Functions qw/catfile catdir updir/;
use File::Path qw/rmtree/;
use Cwd qw/getcwd abs_path/;
+use File::Slurp;
use Test::More tests => 10;
use Shipwright::Test;
@@ -37,11 +38,13 @@ SKIP: {
my $cloned_dir = $shipwright->backend->cloned_dir;
- my @dirs = sort `ls $cloned_dir`;
+ my $dh;
+ opendir $dh, $cloned_dir or die $!;
+ my @dirs = grep { /^[^.]/ } sort readdir( $dh );
chomp @dirs;
is_deeply(
[@dirs],
- [ '__default_builder_options', 'bin', 'etc', 'inc', 'scripts', 'shipwright', 'sources', 't' ],
+ [ '__default_builder_options', 'bin', 'etc', 'inc', 'shipwright', 't' ],
'initialize works'
);
@@ -51,8 +54,11 @@ SKIP: {
# import
$shipwright->backend->import( name => 'hello', source => $source_dir );
- ok( grep( {/Makefile\.PL/} `ls $cloned_dir/sources/Foo-Bar/vendor` ),
- 'imported ok' );
+ ok(
+ -e catfile( $cloned_dir, 'sources', 'Foo-Bar', 'vendor',
+ 'Makefile.PL' ),
+ 'imported ok'
+ );
my $script_dir = tempdir( 'shipwright_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
copy( catfile( 't', 'hello', 'scripts', 'build' ), $script_dir );
@@ -63,8 +69,14 @@ SKIP: {
source => $source_dir,
build_script => $script_dir,
);
- ok( grep( {/Makefile\.PL/} `cat $cloned_dir/scripts/Foo-Bar/build` ),
- 'build script ok' );
+ ok(
+ grep { /Makefile\.PL/ } read_file(
+ catfile(
+ $cloned_dir, 'scripts', 'Foo-Bar', 'build'
+ )
+ ),
+ 'build script ok'
+ );
# import another dist
@@ -81,8 +93,11 @@ SKIP: {
$source_dir = $shipwright->source->run();
like( $source_dir, qr/\bhowdy\b/, 'source name looks ok' );
$shipwright->backend->import( name => 'hello', source => $source_dir );
- ok( grep( {/Makefile\.PL/} `ls $cloned_dir/sources/howdy/vendor` ),
- 'imported ok' );
+ ok(
+ -e catfile( $cloned_dir, 'sources', 'Foo-Bar', 'vendor',
+ 'Makefile.PL' ),
+ 'imported ok'
+ );
$script_dir = tempdir( 'shipwright_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
copy( catfile( 't', 'hello', 'scripts', 'build' ), $script_dir );
copy( catfile( 't', 'hello', 'scripts', 'howdy_require.yml' ),
@@ -93,33 +108,45 @@ SKIP: {
source => $source_dir,
build_script => $script_dir,
);
- ok( grep( {/Makefile\.PL/} `cat $cloned_dir/scripts/howdy/build` ),
- 'build script ok' );
+ ok(
+ grep( {/Makefile\.PL/}
+ read_file( catfile( $cloned_dir, 'scripts', 'howdy', 'build' ) ),
+ 'build script ok' )
+ );
my $tempdir = tempdir( 'shipwright_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
- dircopy(
+ rcopy(
catfile( 't', 'hello', 'shipwright' ),
catfile( $tempdir, 'shipwright' )
);
# check to see if update_order works
like(
- `cat $cloned_dir/shipwright/order.yml`,
+ scalar(
+ read_file( catfile( $cloned_dir, 'shipwright', 'order.yml' ) )
+ ),
qr/Foo-Bar.*howdy/s,
'original order is right'
);
- system( 'cp -r ' . catfile( $tempdir, 'shipwright' ) . " $cloned_dir/" );
+ rcopy(
+ catdir( $tempdir, 'shipwright' ),
+ catdir( $cloned_dir, 'shipwright' )
+ );
$shipwright->backend->commit( comment => 'update shipwright/' );
like(
- `cat $cloned_dir/shipwright/order.yml`,
+ scalar(
+ read_file( catfile( $cloned_dir, 'shipwright', 'order.yml' ) )
+ ),
qr/howdy.*Foo-Bar/s,
'imported wrong order works'
);
$shipwright->backend->update_order;
like(
- `cat $cloned_dir/shipwright/order.yml`,
+ scalar(
+ read_file( catfile( $cloned_dir, 'shipwright', 'order.yml' ) )
+ ),
qr/Foo-Bar.*howdy/s,
'updated order works'
);
diff --git a/t/hello/svk.t b/t/hello/svk.t
index 96b2c2c..a4ebd8b 100644
--- a/t/hello/svk.t
+++ b/t/hello/svk.t
@@ -4,7 +4,7 @@ use warnings;
use Shipwright;
use File::Temp qw/tempdir/;
use File::Copy;
-use File::Copy::Recursive qw/dircopy/;
+use File::Copy::Recursive qw/rcopy/;
use File::Spec::Functions qw/catfile catdir updir/;
use File::Path qw/rmtree/;
use Cwd qw/getcwd abs_path/;
@@ -34,11 +34,10 @@ SKIP: {
# init
$shipwright->backend->initialize();
- my @dirs = sort `svk ls $repo`;
- chomp @dirs;
+ my @dirs = map { s{/?\s*$}{}; $_ } sort `svk ls $repo`;
is_deeply(
[@dirs],
- [ '__default_builder_options', 'bin', 'etc', 'inc', 'scripts', 'shipwright', 'sources', 't' ],
+ [ '__default_builder_options', 'bin', 'etc', 'inc', 'shipwright', 't' ],
'initialize works'
);
@@ -94,7 +93,7 @@ SKIP: {
'build script ok' );
my $tempdir = tempdir( 'shipwright_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
- dircopy(
+ rcopy(
catfile( 't', 'hello', 'shipwright' ),
catfile( $tempdir, 'shipwright' )
);
diff --git a/t/hello/svn.t b/t/hello/svn.t
index b2d4c58..98b49bf 100644
--- a/t/hello/svn.t
+++ b/t/hello/svn.t
@@ -4,7 +4,7 @@ use warnings;
use Shipwright;
use File::Temp qw/tempdir/;
use File::Copy;
-use File::Copy::Recursive qw/dircopy/;
+use File::Copy::Recursive qw/rcopy/;
use File::Spec::Functions qw/catfile catdir updir/;
use Cwd qw/getcwd abs_path/;
use Test::More tests => 10;
@@ -32,11 +32,10 @@ SKIP: {
# init
$shipwright->backend->initialize();
- my @dirs = sort `svn ls $repo`;
- chomp @dirs;
+ my @dirs = map { s{/?\s*$}{}; $_ } sort `svn ls $repo`;
is_deeply(
[@dirs],
- [ '__default_builder_options', 'bin', 'etc', 'inc', 'scripts', 'shipwright', 'sources', 't' ],
+ [ '__default_builder_options', 'bin', 'etc', 'inc', 'shipwright', 't' ],
'initialize works'
);
@@ -90,7 +89,7 @@ SKIP: {
'build script ok' );
my $tempdir = tempdir( 'shipwright_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
- dircopy(
+ rcopy(
catfile( 't', 'hello', 'shipwright' ),
catfile( $tempdir, 'shipwright' )
);
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list