[Bps-public-commit] Shipwright branch, master, updated. aaec9365f3b34f7e5f968f9c3045fd15fb548d72
? sunnavy
sunnavy at bestpractical.com
Sun Mar 21 00:28:39 EDT 2010
The branch, master has been updated
via aaec9365f3b34f7e5f968f9c3045fd15fb548d72 (commit)
via 2da9d420dab6d8b08e60786bff3ad4ab4fb3de81 (commit)
via 6941056eae88a6cec1017a5dc83073126a454ff7 (commit)
via 3923472405eedf77498d456cbb8fa2f578cfbc93 (commit)
from ae0f8e84c963954e3eb4218fe42c57e9104f3d09 (commit)
Summary of changes:
lib/Shipwright.pm | 1 -
lib/Shipwright/Backend.pm | 11 ++--
lib/Shipwright/Backend/Base.pm | 66 +++++++++---------
lib/Shipwright/Backend/FS.pm | 21 +++---
lib/Shipwright/Backend/Git.pm | 33 ++++-----
lib/Shipwright/Backend/SVK.pm | 23 +++---
lib/Shipwright/Backend/SVN.pm | 17 ++---
lib/Shipwright/Logger.pm | 2 +-
lib/Shipwright/Manual/ENV.pod | 4 +
lib/Shipwright/Script.pm | 6 +-
lib/Shipwright/Script/Create.pm | 1 -
lib/Shipwright/Script/Defaultbranch.pm | 8 +-
lib/Shipwright/Script/Delete.pm | 5 +-
lib/Shipwright/Script/Flags.pm | 6 +-
lib/Shipwright/Script/Import.pm | 39 +++++------
lib/Shipwright/Script/Ktf.pm | 4 +-
lib/Shipwright/Script/List.pm | 14 ++--
lib/Shipwright/Script/Maintain.pm | 2 +-
lib/Shipwright/Script/Relocate.pm | 8 +-
lib/Shipwright/Script/Rename.pm | 9 +--
lib/Shipwright/Script/Requires.pm | 11 ++--
lib/Shipwright/Script/Update.pm | 15 ++--
lib/Shipwright/Source.pm | 11 ++--
lib/Shipwright/Source/Base.pm | 87 ++++++++++++------------
lib/Shipwright/Source/CPAN.pm | 8 +-
lib/Shipwright/Source/Compressed.pm | 4 +-
lib/Shipwright/Source/Directory.pm | 2 +-
lib/Shipwright/Source/FTP.pm | 4 +-
lib/Shipwright/Source/Git.pm | 12 ++--
lib/Shipwright/Source/HTTP.pm | 4 +-
lib/Shipwright/Source/SVK.pm | 6 +-
lib/Shipwright/Source/SVN.pm | 6 +-
lib/Shipwright/Source/Shipwright.pm | 6 +-
lib/Shipwright/Test.pm | 11 ++--
lib/Shipwright/Util.pm | 114 +++++++++++++++++-------------
lib/Shipwright/Util/CleanINC.pm | 6 +-
lib/Shipwright/Util/PatchModuleBuild.pm | 6 +-
t/05.util.t | 26 ++++----
t/08.build.t | 2 +-
t/71.script_cmds.t | 7 +-
xt/env-coverage.t | 2 +-
41 files changed, 318 insertions(+), 312 deletions(-)
- Log -----------------------------------------------------------------
commit 3923472405eedf77498d456cbb8fa2f578cfbc93
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Mar 21 11:51:41 2010 +0800
Shipwright::Util is more like a helper module, let's export the subs
diff --git a/lib/Shipwright.pm b/lib/Shipwright.pm
index 9fc69bc..06aa254 100644
--- a/lib/Shipwright.pm
+++ b/lib/Shipwright.pm
@@ -9,7 +9,6 @@ use base qw/Class::Accessor::Fast/;
__PACKAGE__->mk_accessors(qw/backend source build log_level log_file/);
use Shipwright::Logger;
-use Shipwright::Util;
use File::Spec::Functions qw/catfile tmpdir/;
# strawberry perl's build make is 'dmake'
diff --git a/lib/Shipwright/Backend.pm b/lib/Shipwright/Backend.pm
index 0a034d4..957b129 100644
--- a/lib/Shipwright/Backend.pm
+++ b/lib/Shipwright/Backend.pm
@@ -27,7 +27,7 @@ sub new {
confess "invalid repository, doesn't start from xxx: or xxx+yyy:";
}
- my $module = Shipwright::Util->find_module(__PACKAGE__, $backend);
+ my $module = find_module(__PACKAGE__, $backend);
unless ( $module ) {
confess "Couldn't find backend implementing '$backend'";
}
diff --git a/lib/Shipwright/Backend/Base.pm b/lib/Shipwright/Backend/Base.pm
index d32b242..d1dfb93 100644
--- a/lib/Shipwright/Backend/Base.pm
+++ b/lib/Shipwright/Backend/Base.pm
@@ -67,7 +67,7 @@ sub initialize {
my $dir =
tempdir( 'shipwright_backend_base_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
- rcopy( Shipwright::Util->share_root, $dir )
+ rcopy( share_root(), $dir )
or confess "copy share_root failed: $!";
$self->_install_yaml_tiny($dir);
@@ -123,9 +123,10 @@ sub _install_clean_inc {
my $dir = shift;
my $util_inc_path = catdir( $dir, 'inc', 'Shipwright', 'Util' );
make_path( $util_inc_path );
- for my $mod qw(Shipwright::Util::CleanINC Shipwright::Util::PatchModuleBuild) {
- rcopy( Module::Info->new_from_module($mod)->file, $util_inc_path )
- or confess "copy $mod failed: $!";
+ for my $mod qw(CleanINC PatchModuleBuild) {
+ rcopy( Module::Info->new_from_module("Shipwright::Util::$mod")->file,
+ $util_inc_path )
+ or confess "copy $mod failed: $!";
}
}
@@ -185,7 +186,7 @@ sub import {
$self->log->info( "import extra tests to " . $self->repository );
for my $cmd ( $self->_cmd( import => %args, name => $name ) ) {
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
}
elsif ( $args{build_script} ) {
@@ -202,7 +203,7 @@ sub import {
$self->log->info(
"import $args{source}'s scripts to " . $self->repository );
for my $cmd ( $self->_cmd( import => %args, name => $name ) ) {
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
$self->update_refs;
@@ -251,7 +252,7 @@ sub import {
for
my $cmd ( $self->_cmd( import => %args, name => $name ) )
{
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
}
}
@@ -276,7 +277,7 @@ sub import {
for
my $cmd ( $self->_cmd( import => %args, name => $name ) )
{
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
}
}
@@ -284,7 +285,7 @@ sub import {
}
else {
for my $cmd ( $self->_cmd( import => %args, name => $name ) ) {
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
}
}
@@ -301,7 +302,7 @@ sub export {
$self->log->info(
'export ' . $self->repository . "/$path to $args{target}" );
for my $cmd ( $self->_cmd( export => %args ) ) {
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
}
@@ -316,7 +317,7 @@ sub checkout {
$self->log->info(
'export ' . $self->repository . "/$path to $args{target}" );
for my $cmd ( $self->_cmd( checkout => %args ) ) {
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
}
@@ -331,7 +332,7 @@ sub commit {
my %args = @_;
$self->log->info( 'commit ' . $args{path} );
for my $cmd ( $self->_cmd( commit => @_ ) ) {
- Shipwright::Util->run( $cmd, 1 );
+ run_cmd( $cmd, 1 );
}
}
@@ -461,10 +462,10 @@ sub _yml {
my $file = catfile( $self->repository, $path );
if ($yml) {
- Shipwright::Util::DumpFile( $file, $yml );
+ dump_yaml_file( $file, $yml );
}
else {
- Shipwright::Util::LoadFile($file);
+ load_yaml_file($file);
}
}
@@ -595,7 +596,7 @@ sub delete {
if ( $self->info( path => $path ) ) {
$self->log->info( "delete " . $self->repository . $path );
for my $cmd ( $self->_cmd( delete => path => $path ) ) {
- Shipwright::Util->run( $cmd, 1 );
+ run_cmd( $cmd, 1 );
}
}
}
@@ -610,7 +611,7 @@ sub list {
my %args = @_;
my $path = $args{path} || '';
if ( $self->info( path => $path ) ) {
- my $out = Shipwright::Util->run( $self->_cmd( list => path => $path ) );
+ my $out = run_cmd( $self->_cmd( list => path => $path ) );
return $out;
}
}
@@ -646,7 +647,7 @@ sub move {
)
)
{
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
}
}
@@ -661,7 +662,7 @@ sub info {
my $path = $args{path} || '';
my ( $info, $err ) =
- Shipwright::Util->run( $self->_cmd( info => path => $path ), 1 );
+ run_cmd( $self->_cmd( info => path => $path ), 1 );
$self->log->warn($err) if $err;
if (wantarray) {
@@ -741,10 +742,10 @@ sub update {
else {
confess "$args{path} seems not shipwright's own file"
- unless -e catfile( Shipwright::Util->share_root, $args{path} );
+ unless -e catfile( share_root(), $args{path} );
return $self->_update_file( $args{path},
- catfile( Shipwright::Util->share_root, $args{path} ) );
+ catfile( share_root(), $args{path} ) );
}
}
@@ -896,7 +897,7 @@ sub local_dir {
my $self = shift;
my $need_init = shift;
my $base_dir =
- catdir( Shipwright::Util->shipwright_user_root(), 'backends' );
+ catdir( shipwright_user_root(), 'backends' );
make_path( $base_dir ) unless -e $base_dir;
my $repo = $self->repository;
$repo =~ s/:/-/g;
diff --git a/lib/Shipwright/Backend/FS.pm b/lib/Shipwright/Backend/FS.pm
index 837bff4..b927f19 100644
--- a/lib/Shipwright/Backend/FS.pm
+++ b/lib/Shipwright/Backend/FS.pm
@@ -40,7 +40,7 @@ sub build {
$self->strip_repository;
my $repo = $self->repository;
- $repo =~ s/^~/Shipwright::Util->user_home/e;
+ $repo =~ s/^~/user_home/e;
my $abs_path = rel2abs($repo);
$repo = $abs_path if $abs_path;
$self->repository($repo);
@@ -199,10 +199,10 @@ sub _yml {
my $file = catfile( $self->repository, $path );
if ($yml) {
- Shipwright::Util::DumpFile( $file, $yml );
+ dump_yaml_file( $file, $yml );
}
else {
- Shipwright::Util::LoadFile($file);
+ load_yaml_file($file);
}
}
diff --git a/lib/Shipwright/Backend/Git.pm b/lib/Shipwright/Backend/Git.pm
index 8a8ee70..23bb5f6 100644
--- a/lib/Shipwright/Backend/Git.pm
+++ b/lib/Shipwright/Backend/Git.pm
@@ -70,8 +70,8 @@ sub initialize {
my $path = $self->repository;
$path =~ s!^file://!!;
- Shipwright::Util->run( sub { remove_tree( $path ) } );
- Shipwright::Util->run( sub { make_path( $path ) } );
+ run_cmd( sub { remove_tree( $path ) } );
+ run_cmd( sub { make_path( $path ) } );
$self->_init_new_git_repos( $path );
$self->_initialize_local_dir();
@@ -89,10 +89,10 @@ sub _init_new_git_repos {
# make a new bare repos at the target path
chdir $new_repos_dir;
- Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_GIT'}, '--bare', 'init' ] );
+ run_cmd( [ $ENV{'SHIPWRIGHT_GIT'}, '--bare', 'init' ] );
my ($output) =
- Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_GIT'}, '--version' ] );
+ run_cmd( [ $ENV{'SHIPWRIGHT_GIT'}, '--version' ] );
my ($version) = $output =~ /(\d+\.\d+\.\d+)/;
if ( $version && $version lt '1.6.2' ) {
@@ -103,7 +103,7 @@ sub _init_new_git_repos {
tempdir( 'shipwright_backend_git_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
chdir $dir;
- Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_GIT'}, 'init' ] );
+ run_cmd( [ $ENV{'SHIPWRIGHT_GIT'}, 'init' ] );
# touch a file in the non-bare repos
my $initial_file = '.shipwright_git_initial';
@@ -113,16 +113,16 @@ sub _init_new_git_repos {
or confess "$! writing $dir/$initial_file"
}
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_GIT'}, 'add', $initial_file ] );
- Shipwright::Util->run(
+ run_cmd(
[
$ENV{'SHIPWRIGHT_GIT'},
'commit',
-m => 'initial commit, shipwright creating new git repository'
]
);
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_GIT'}, 'push', $new_repos_dir, 'master' ] );
}
@@ -137,12 +137,12 @@ sub _initialize_local_dir {
my $target = $self->local_dir( 0 );
remove_tree( $target ) if -e $target;
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_GIT'}, 'clone', $self->repository, $target ] );
my $cwd = getcwd;
chdir $target;
# git 1.6.3.3 will warn if we don't specify push.default
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_GIT'}, 'config', 'push.default', 'matching' ] );
chdir $cwd;
return $target;
@@ -154,7 +154,7 @@ sub _sync_local_dir {
my $cwd = getcwd;
chdir $target or return;
- Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_GIT'}, 'pull' ] );
+ run_cmd( [ $ENV{'SHIPWRIGHT_GIT'}, 'pull' ] );
chdir $cwd;
}
@@ -271,12 +271,12 @@ sub commit {
my $cwd = getcwd;
chdir $self->local_dir or return;
- Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_GIT'}, 'add', '-f', '.' ] );
+ run_cmd( [ $ENV{'SHIPWRIGHT_GIT'}, 'add', '-f', '.' ] );
# TODO comment need to be something special
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_GIT'}, 'commit', '-m', $args{comment} ], 1 );
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_GIT'}, 'push', 'origin', 'master' ] );
chdir $cwd;
}
diff --git a/lib/Shipwright/Backend/SVK.pm b/lib/Shipwright/Backend/SVK.pm
index 3fee27f..2c99462 100644
--- a/lib/Shipwright/Backend/SVK.pm
+++ b/lib/Shipwright/Backend/SVK.pm
@@ -71,7 +71,7 @@ sub initialize {
sub _svnroot {
my $self = shift;
return $self->{svnroot} if $self->{svnroot};
- my $depotmap = Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_SVK'} => depotmap => '--list' ] );
+ my $depotmap = run_cmd( [ $ENV{'SHIPWRIGHT_SVK'} => depotmap => '--list' ] );
$depotmap =~ s{\A.*?^(?=/)}{}sm;
while ($depotmap =~ /^(\S*)\s+(.*?)$/gm) {
my ($depot, $svnroot) = ($1, $2);
@@ -229,13 +229,13 @@ sub _yml {
else {
$self->_sync_local_dir($path);
}
- Shipwright::Util::DumpFile( $file, $yml );
+ dump_yaml_file( $file, $yml );
$self->commit( path => $file, comment => "updated $path" );
}
else {
- my ($out) = Shipwright::Util->run(
+ my ($out) = run_cmd(
[ $ENV{'SHIPWRIGHT_SVN'}, 'cat', $self->_svnroot . $path ] );
- return Shipwright::Util::Load($out);
+ return load_yaml($out);
}
}
@@ -327,7 +327,7 @@ sub _initialize_local_dir {
my $target = $self->local_dir( 0 );
remove_tree( $target ) if -e $target;
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_SVK'}, 'checkout', $self->repository, $target ] );
return $target;
}
@@ -336,7 +336,7 @@ sub _sync_local_dir {
my $self = shift;
my $path = shift || '';
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_SVK'}, 'update', $self->local_dir . $path ] );
}
diff --git a/lib/Shipwright/Backend/SVN.pm b/lib/Shipwright/Backend/SVN.pm
index 436c3b9..006c7c4 100644
--- a/lib/Shipwright/Backend/SVN.pm
+++ b/lib/Shipwright/Backend/SVN.pm
@@ -202,13 +202,13 @@ sub _yml {
else {
$self->_sync_local_dir($path);
}
- Shipwright::Util::DumpFile( $file, $yml );
+ dump_yaml_file( $file, $yml );
$self->commit( path => $file, comment => "updated $path" );
}
else {
- my ($out) = Shipwright::Util->run(
+ my ($out) = run_cmd(
[ $ENV{'SHIPWRIGHT_SVN'}, 'cat', $self->repository . $path ] );
- return Shipwright::Util::Load($out);
+ return load_yaml($out);
}
}
@@ -296,7 +296,7 @@ sub _initialize_local_dir {
my $target = $self->local_dir( 0 );
remove_tree( $target ) if -e $target;
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_SVN'}, 'checkout', $self->repository, $target ] );
return $target;
}
@@ -304,7 +304,7 @@ sub _initialize_local_dir {
sub _sync_local_dir {
my $self = shift;
my $path = shift || '';
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_SVN'}, 'update', $self->local_dir . $path ], 1 );
}
diff --git a/lib/Shipwright/Script/Import.pm b/lib/Shipwright/Script/Import.pm
index 92cda79..89db067 100644
--- a/lib/Shipwright/Script/Import.pm
+++ b/lib/Shipwright/Script/Import.pm
@@ -139,12 +139,12 @@ sub run {
);
}
- Shipwright::Util::DumpFile(
+ dump_yaml_file(
$shipwright->source->map_path,
$shipwright->backend->map || {},
);
- Shipwright::Util::DumpFile(
+ dump_yaml_file(
$shipwright->source->url_path,
$shipwright->backend->source || {},
);
@@ -155,10 +155,10 @@ sub run {
next unless $source; # if running the source returned undef, we should skip
$version =
- Shipwright::Util::LoadFile( $shipwright->source->version_path );
+ load_yaml_file( $shipwright->source->version_path );
my $name = ( splitdir( $source ) )[-1];
- my $base = Shipwright::Util->parent_dir($source);
+ my $base = parent_dir($source);
my $script_dir;
if ( -e catdir( $base, '__scripts', $name ) ) {
@@ -201,7 +201,7 @@ sub run {
}
my $branches =
- Shipwright::Util::LoadFile( $shipwright->source->branches_path );
+ load_yaml_file( $shipwright->source->branches_path );
$self->log->fatal( "importing $name" );
$shipwright->backend->import(
@@ -224,13 +224,13 @@ sub run {
# merge new map into map.yml in repo
my $new_map =
- Shipwright::Util::LoadFile( $shipwright->source->map_path )
+ load_yaml_file( $shipwright->source->map_path )
|| {};
$shipwright->backend->map(
{ %{ $shipwright->backend->map || {} }, %$new_map } );
my $new_url =
- Shipwright::Util::LoadFile( $shipwright->source->url_path )
+ load_yaml_file( $shipwright->source->url_path )
|| {};
my $source_url = delete $new_url->{$name};
@@ -259,16 +259,16 @@ sub _import_req {
$require_file = catfile( $script_dir, 'require.yml' )
unless -e catfile( $source, '__require.yml' );
- my $dir = Shipwright::Util->parent_dir($source);
+ my $dir = parent_dir($source);
my $map_file = catfile( $dir, 'map.yml' );
if ( -e $require_file ) {
- my $req = Shipwright::Util::LoadFile($require_file);
+ my $req = load_yaml_file($require_file);
my $map = {};
if ( -e $map_file ) {
- $map = Shipwright::Util::LoadFile($map_file);
+ $map = load_yaml_file($map_file);
}
@@ -316,7 +316,7 @@ sub _import_req {
$self->_import_req( $s, $shipwright, $script_dir );
- my $branches = Shipwright::Util::LoadFile(
+ my $branches = load_yaml_file(
$shipwright->source->branches_path );
$shipwright->backend->import(
comment => 'deps for ' . $source,
diff --git a/lib/Shipwright/Script/List.pm b/lib/Shipwright/Script/List.pm
index 2edc13f..307797f 100644
--- a/lib/Shipwright/Script/List.pm
+++ b/lib/Shipwright/Script/List.pm
@@ -196,7 +196,7 @@ sub _latest_version {
$args{url} =~ s{^svn:(?!//)}{};
$cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'info', $args{url} ];
$cmd = [ $ENV{'SHIPWRIGHT_SVK'}, 'info', $args{url} ];
- ($out) = Shipwright::Util->run( $cmd, 1 ); # ignore failure
+ ($out) = run_cmd( $cmd, 1 ); # ignore failure
if ( $out =~ /^Revision:\s*(\d+)/m ) {
return $1;
}
@@ -204,7 +204,7 @@ sub _latest_version {
elsif ( $args{url} =~ m{^(svk:|//)} ) {
$args{url} =~ s/^svk://;
$cmd = [ $ENV{'SHIPWRIGHT_SVK'}, 'info', $args{url} ];
- ($out) = Shipwright::Util->run( $cmd, 1 ); # ignore failure
+ ($out) = run_cmd( $cmd, 1 ); # ignore failure
if ( $out =~ /^Revision:\s*(\d+)/m ) {
return $1;
}
@@ -222,10 +222,10 @@ sub _latest_version {
TMPDIR => 1
);
my $path = catdir( $dir, 'git' );
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{SHIPWRIGHT_GIT}, 'clone', $args{url}, $path, ] );
chdir $path;
- ($out) = Shipwright::Util->run( [ $ENV{SHIPWRIGHT_GIT}, 'log' ] );
+ ($out) = run_cmd( [ $ENV{SHIPWRIGHT_GIT}, 'log' ] );
chdir $cwd;
if ( $out =~ /^commit\s+(\w+)/m ) {
@@ -240,11 +240,11 @@ sub _latest_version {
require CPAN;
require CPAN::DistnameInfo;
- Shipwright::Util->select('cpan');
+ select_fh('cpan');
my $module = CPAN::Shell->expand( 'Module', $args{name} );
- Shipwright::Util->select('stdout');
+ select_fh('stdout');
my $info = CPAN::DistnameInfo->new( $module->cpan_file );
my $version = $info->version;
diff --git a/lib/Shipwright/Script/Requires.pm b/lib/Shipwright/Script/Requires.pm
index 141ee7e..bec667d 100644
--- a/lib/Shipwright/Script/Requires.pm
+++ b/lib/Shipwright/Script/Requires.pm
@@ -71,7 +71,7 @@ qq{ "$module" [shape = record, fontsize = 18, label = "$module" ];\n};
$out .= "\n};";
}
else {
- $out = Shipwright::Util::Dump($deps);
+ $out = dump_yaml($deps);
}
$self->log->fatal($out);
}
@@ -84,9 +84,9 @@ sub _requires {
my $deps = shift;
my $name = shift;
- my $dir = Shipwright::Util->parent_dir($source);
+ my $dir = parent_dir($source);
my $map_file = catfile( $dir, 'map.yml' );
- my $map = Shipwright::Util::LoadFile($map_file);
+ my $map = load_yaml_file($map_file);
my $reverse_map = { reverse %$map };
opendir my ($d), $dir;
@@ -95,7 +95,7 @@ sub _requires {
my $require_file = catfile( $source, '__require.yml' );
if ( -e $require_file ) {
- my $d = Shipwright::Util::LoadFile($require_file);
+ my $d = load_yaml_file($require_file);
for my $type ( keys %$d ) {
for my $dep ( keys %{ $d->{$type} } ) {
my $dep_source = catdir( $dir, $dep );
diff --git a/lib/Shipwright/Script/Update.pm b/lib/Shipwright/Script/Update.pm
index b4a50a5..f9dbff4 100644
--- a/lib/Shipwright/Script/Update.pm
+++ b/lib/Shipwright/Script/Update.pm
@@ -255,7 +255,7 @@ sub _update {
$shipwright->source->run;
- $version = Shipwright::Util::LoadFile( $shipwright->source->version_path );
+ $version = load_yaml_file( $shipwright->source->version_path );
$shipwright->backend->import(
source => catdir( $shipwright->source->directory, $name ),
diff --git a/lib/Shipwright/Source.pm b/lib/Shipwright/Source.pm
index 58d5e7f..ada4ef3 100644
--- a/lib/Shipwright/Source.pm
+++ b/lib/Shipwright/Source.pm
@@ -41,7 +41,7 @@ sub new {
);
$args{download_directory} ||=
- catdir( Shipwright::Util->shipwright_user_root, 'downloads' );
+ catdir( shipwright_user_root(), 'downloads' );
$args{scripts_directory} ||= catdir( $args{directory}, '__scripts' );
$args{map_path} ||= catfile( $args{directory}, 'map.yml' );
@@ -116,7 +116,7 @@ sub _translate_source {
if ( $$source =~ /^(file|dir(ectory)?|shipwright):~/i ) {
# replace prefix ~ with real home dir
- $$source =~ s/~/Shipwright::Util->user_home/e;
+ $$source =~ s/~/user_home/e;
}
}
diff --git a/lib/Shipwright/Source/Base.pm b/lib/Shipwright/Source/Base.pm
index 4758b58..a157a25 100644
--- a/lib/Shipwright/Source/Base.pm
+++ b/lib/Shipwright/Source/Base.pm
@@ -51,7 +51,7 @@ sub run {
$_->();
}
else {
- Shipwright::Util->run($_);
+ run_cmd($_);
}
}
$self->_copy( %{ $args{copy} } ) if $args{copy};
@@ -78,11 +78,11 @@ sub _follow {
}
if ( -e $self->map_path ) {
- $map = Shipwright::Util::LoadFile( $self->map_path );
+ $map = load_yaml_file( $self->map_path );
}
if ( -e $self->url_path ) {
- $url = Shipwright::Util::LoadFile( $self->url_path );
+ $url = load_yaml_file( $self->url_path );
}
my @types = qw/requires build_requires/;
@@ -148,15 +148,15 @@ sub _follow {
elsif ( -e 'Build.PL' ) {
$self->log->info("is a Module::Build based dist");
- Shipwright::Util->run(
+ run_cmd(
[
$^X, '-Mversion',
- '-MModule::Build', '-MShipwright::Util::CleanINC',
+ '-MModule::Build', '-MCleanINC',
'Build.PL'
],
1, # don't die if this fails
);
- Shipwright::Util->run( [ $^X, 'Build.PL' ] ) if $? || !-e 'Build';
+ run_cmd( [ $^X, 'Build.PL' ] ) if $? || !-e 'Build';
my $source = read_file( catfile( '_build', 'prereqs' ) )
or confess "can't read _build/prereqs: $!";
my $eval = '$require = ' . $source;
@@ -165,7 +165,7 @@ sub _follow {
$source = read_file( catfile('Build.PL') )
or confess "can't read Build.PL: $!";
- Shipwright::Util->run(
+ run_cmd(
[ $^X, 'Build', 'realclean', '--allow_mb_mismatch', 1 ] );
}
elsif ( -e 'Makefile.PL' ) {
@@ -326,16 +326,16 @@ EOF
$shipwright_makefile .= $makefile;
write_file( 'shipwright_makefile.pl', $shipwright_makefile );
- Shipwright::Util->run(
+ run_cmd(
[
$^X,
'-Mversion',
- '-MShipwright::Util::CleanINC',
+ '-MCleanINC',
'shipwright_makefile.pl'
],
1, # don't die if this fails
);
- Shipwright::Util->run( [ $^X, 'shipwright_makefile.pl' ] )
+ run_cmd( [ $^X, 'shipwright_makefile.pl' ] )
if $? || !-e 'Makefile';
my $prereqs = read_file( catfile('shipwright_prereqs') )
or confess "can't read prereqs: $!";
@@ -344,7 +344,7 @@ EOF
if ( -e 'META.yml' ) {
# if there's META.yml, let's find more about it
- my $meta = Shipwright::Util::LoadFile('META.yml')
+ my $meta = load_yaml_file('META.yml')
or confess "can't read META.yml: $!";
$require ||= {};
$require->{requires} = {
@@ -368,15 +368,15 @@ EOF
else {
# we extract the deps from Makefile
- Shipwright::Util->run(
+ run_cmd(
[
$^X,
- '-MShipwright::Util::CleanINC',
+ '-MCleanINC',
'Makefile.PL'
],
1, # don't die if this fails
);
- Shipwright::Util->run( [ $^X, 'Makefile.PL' ] )
+ run_cmd( [ $^X, 'Makefile.PL' ] )
if $? || !-e 'Makefile';
my ($source) = grep { /PREREQ_PM/ } read_file('Makefile');
@@ -391,7 +391,7 @@ EOF
}
}
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{SHIPWRIGHT_MAKE}, 'clean' ] );
unlink 'Makefile.old';
}
@@ -403,11 +403,11 @@ EOF
}
}
- Shipwright::Util::DumpFile( $require_path, $require )
+ dump_yaml_file( $require_path, $require )
or confess "can't dump __require.yml: $!";
}
- if ( my $require = Shipwright::Util::LoadFile($require_path) ) {
+ if ( my $require = load_yaml_file($require_path) ) {
# if not have 'requires' key, all the keys in $require are supposed to be
# requires type
@@ -463,7 +463,7 @@ EOF
#reload map
if ( -e $self->map_path ) {
- $map = Shipwright::Util::LoadFile( $self->map_path );
+ $map = load_yaml_file( $self->map_path );
}
if ( $map->{$module} && $map->{$module} =~ /^cpan-/ ) {
@@ -513,7 +513,7 @@ EOF
# reload map
if ( -e $self->map_path ) {
- $map = Shipwright::Util::LoadFile( $self->map_path );
+ $map = load_yaml_file( $self->map_path );
}
}
@@ -533,7 +533,7 @@ EOF
# them when update later
$require->{recommends} = {} if $skip_recommends;
- Shipwright::Util::DumpFile( $require_path, $require );
+ dump_yaml_file( $require_path, $require );
}
else {
confess "invalid __require.yml in $path";
@@ -550,12 +550,12 @@ sub _update_map {
my $map = {};
if ( -e $self->map_path ) {
- $map = Shipwright::Util::LoadFile( $self->map_path );
+ $map = load_yaml_file( $self->map_path );
}
return if $map->{$module};
$map->{$module} = $dist;
- Shipwright::Util::DumpFile( $self->map_path, $map );
+ dump_yaml_file( $self->map_path, $map );
}
sub _update_url {
@@ -565,10 +565,10 @@ sub _update_url {
my $map = {};
if ( -e $self->url_path && !-z $self->url_path ) {
- $map = Shipwright::Util::LoadFile( $self->url_path );
+ $map = load_yaml_file( $self->url_path );
}
$map->{$name} = $url;
- Shipwright::Util::DumpFile( $self->url_path, $map );
+ dump_yaml_file( $self->url_path, $map );
}
sub _update_version {
@@ -578,10 +578,10 @@ sub _update_version {
my $map = {};
if ( -e $self->version_path && !-z $self->version_path ) {
- $map = Shipwright::Util::LoadFile( $self->version_path );
+ $map = load_yaml_file( $self->version_path );
}
$map->{$name} = $version;
- Shipwright::Util::DumpFile( $self->version_path, $map );
+ dump_yaml_file( $self->version_path, $map );
}
sub _update_branches {
@@ -591,10 +591,10 @@ sub _update_branches {
my $map = {};
if ( -e $self->version_path && !-z $self->branches_path ) {
- $map = Shipwright::Util::LoadFile( $self->branches_path );
+ $map = load_yaml_file( $self->branches_path );
}
$map->{$name} = $branches;
- Shipwright::Util::DumpFile( $self->branches_path, $map );
+ dump_yaml_file( $self->branches_path, $map );
}
sub _is_skipped {
@@ -639,7 +639,7 @@ sub _copy {
)
);
};
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
}
}
diff --git a/lib/Shipwright/Source/CPAN.pm b/lib/Shipwright/Source/CPAN.pm
index ce6f041..a800ce9 100644
--- a/lib/Shipwright/Source/CPAN.pm
+++ b/lib/Shipwright/Source/CPAN.pm
@@ -109,7 +109,7 @@ sub _run {
my ( $source, $distribution );
- Shipwright::Util->select('cpan');
+ select_fh('cpan');
if ( $self->source =~ /\.tar\.gz$/ ) {
@@ -170,7 +170,7 @@ sub _run {
return -1;
}
- Shipwright::Util->select('stdout');
+ select_fh('stdout');
$self->name( 'cpan-' . $name );
$self->_update_map( $self->source, 'cpan-' . $name );
diff --git a/lib/Shipwright/Source/Git.pm b/lib/Shipwright/Source/Git.pm
index 19e097c..f32d650 100644
--- a/lib/Shipwright/Source/Git.pm
+++ b/lib/Shipwright/Source/Git.pm
@@ -65,7 +65,7 @@ sub _run {
@cmds = sub {
my $cwd = getcwd();
chdir $cloned_path;
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_GIT'}, 'pull' ] );
chdir $cwd;
};
@@ -80,11 +80,11 @@ sub _run {
my $cwd = getcwd();
chdir $cloned_path;
if ( $self->version ) {
- Shipwright::Util->run(
+ run_cmd(
[ $ENV{'SHIPWRIGHT_GIT'}, 'checkout', $self->version ] );
}
else {
- my ($out) = Shipwright::Util->run(
+ my ($out) = run_cmd(
[ $ENV{'SHIPWRIGHT_GIT'}, 'log' ] );
if ( $out =~ /^commit\s+(\w+)/m ) {
$self->version($1);
@@ -97,7 +97,7 @@ sub _run {
};
$self->source( $path );
- Shipwright::Util->run($_) for @cmds;
+ run_cmd($_) for @cmds;
}
1;
diff --git a/lib/Shipwright/Source/SVK.pm b/lib/Shipwright/Source/SVK.pm
index feb6a6e..36b5b3e 100644
--- a/lib/Shipwright/Source/SVK.pm
+++ b/lib/Shipwright/Source/SVK.pm
@@ -62,7 +62,7 @@ sub _run {
push @cmds, [ $ENV{'SHIPWRIGHT_SVK'}, 'co', '-d', $path, ];
unless ( $self->version ) {
- my ($out) = Shipwright::Util->run(
+ my ($out) = run_cmd(
[ $ENV{'SHIPWRIGHT_SVK'}, 'info', $self->source, ] );
if ( $out =~ /^Revision: (\d+)/m ) {
@@ -73,7 +73,7 @@ sub _run {
remove_tree($path) if -e $path;
$self->source( $path );
- Shipwright::Util->run($_) for @cmds;
+ run_cmd($_) for @cmds;
}
1;
diff --git a/lib/Shipwright/Source/SVN.pm b/lib/Shipwright/Source/SVN.pm
index 327b431..5960be2 100644
--- a/lib/Shipwright/Source/SVN.pm
+++ b/lib/Shipwright/Source/SVN.pm
@@ -59,7 +59,7 @@ sub _run {
unless ( $self->version ) {
my ($out) =
- Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_SVN'}, 'info', $source, ] );
+ run_cmd( [ $ENV{'SHIPWRIGHT_SVN'}, 'info', $source, ] );
if ( $out =~ /^Revision: (\d+)/m ) {
$self->version($1);
@@ -68,7 +68,7 @@ sub _run {
remove_tree($path) if -e $path;
$self->source( $path );
- Shipwright::Util->run($cmd);
+ run_cmd($cmd);
}
1;
diff --git a/lib/Shipwright/Source/Shipwright.pm b/lib/Shipwright/Source/Shipwright.pm
index 193427d..bfa8b96 100644
--- a/lib/Shipwright/Source/Shipwright.pm
+++ b/lib/Shipwright/Source/Shipwright.pm
@@ -46,13 +46,13 @@ sub run {
# follow
if ( $self->follow ) {
- my $out = Shipwright::Util->run(
+ my $out = run_cmd(
$source_shipwright->backend->_cmd(
'cat', path => "/scripts/$dist/require.yml",
),
1
);
- my $require = Shipwright::Util::Load($out) || {};
+ my $require = load_yaml($out) || {};
for my $type ( keys %$require ) {
for my $req ( keys %{ $require->{$type} } ) {
diff --git a/lib/Shipwright/Test.pm b/lib/Shipwright/Test.pm
index f2065db..18edf12 100644
--- a/lib/Shipwright/Test.pm
+++ b/lib/Shipwright/Test.pm
@@ -35,7 +35,7 @@ sub has_svk {
&& can_run( $ENV{'SHIPWRIGHT_SVN'} . 'admin' ) )
{
my $out =
- Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_SVK'}, '--version' ], 1 );
+ run_cmd( [ $ENV{'SHIPWRIGHT_SVK'}, '--version' ], 1 );
if ( $out && $out =~ /version v(\d)\./i ) {
return 1 if $1 >= 2;
}
@@ -55,7 +55,7 @@ sub has_svn {
&& can_run( $ENV{'SHIPWRIGHT_SVN'} . 'admin' ) )
{
my $out =
- Shipwright::Util->run( [ $ENV{'SHIPWRIGHT_SVN'}, '--version' ], 1 );
+ run_cmd( [ $ENV{'SHIPWRIGHT_SVN'}, '--version' ], 1 );
if ( $out && $out =~ /version 1\.(\d)/i ) {
return 1 if $1 >= 4;
}
@@ -136,7 +136,7 @@ sub create_git_repo {
my $dir = tempdir( 'shipwright_test_git_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
my $cwd = getcwd();
chdir $dir;
- Shipwright::Util->run( [$ENV{'SHIPWRIGHT_GIT'}, 'init', '--bare' ] );
+ run_cmd( [$ENV{'SHIPWRIGHT_GIT'}, 'init', '--bare' ] );
chdir $cwd;
return "file://$dir";
}
@@ -231,7 +231,7 @@ sub test_cmd {
unshift @$cmd, $^X, '-MDevel::Cover' if devel_cover_enabled;
require Test::More;
- my ( $out, $err ) = Shipwright::Util->run( $cmd, 1 ); # ingnore failure
+ my ( $out, $err ) = run_cmd( $cmd, 1 ); # ingnore failure
_test_cmd( $out, $exp, $msg ) if defined $exp;
_test_cmd( $err, $exp_err, $msg_err ) if defined $exp_err;
diff --git a/lib/Shipwright/Util.pm b/lib/Shipwright/Util.pm
index dc8e2c0..e10a6cc 100644
--- a/lib/Shipwright/Util.pm
+++ b/lib/Shipwright/Util.pm
@@ -9,35 +9,59 @@ use Cwd qw/abs_path getcwd/;
use Shipwright; # we need this to find where Shipwright.pm lives
use YAML::Tiny;
+use base 'Exporter';
+our @EXPORT = qw/load_yaml load_yaml_file dump_yaml dump_yaml_file run_cmd
+select_fh shipwright_root share_root user_home
+shipwright_user_root parent_dir find_module/;
our ( $SHIPWRIGHT_ROOT, $SHARE_ROOT );
-BEGIN {
- *Load = *YAML::Tiny::Load;
- *Dump = *YAML::Tiny::Dump;
- *LoadFile = *YAML::Tiny::LoadFile;
- *DumpFile = *YAML::Tiny::DumpFile;
+sub load_yaml {
+ goto &YAML::Tiny::Load;
}
+sub load_yaml_file {
+ goto &YAML::Tiny::LoadFile;
+}
+
+sub dump_yaml {
+ goto &YAML::Tiny::Dump;
+}
+
+sub dump_yaml_file {
+ goto &YAML::Tiny::DumpFile;
+}
+
+
=head1 LIST
-=head2 YAML
+=head2 General Helpers
+
+=head3 load_yaml, load_yaml_file, dump_yaml, dump_yaml_file
+
+they are just dropped in from YAML::Tiny
-=head3 Load, LoadFile, Dump, DumpFile
+=head3 parent_dir
-Load, LoadFile, Dump and DumpFile are just dropped in from L<YAML> or L<YAML::Syck>.
+return the dir's parent dir, the arg must be a dir path
+=cut
-=head2 GENERAL HELPERS
+sub parent_dir {
+ my $dir = shift;
+ my @dirs = splitdir($dir);
+ pop @dirs;
+ return catdir(@dirs);
+}
-=head3 run
+
+=head3 run_cmd
a wrapper of run3 sub in IPC::Run3.
=cut
-sub run {
- my $class = shift;
+sub run_cmd {
my $cmd = shift;
my $ignore_failure = shift;
@@ -56,9 +80,9 @@ sub run {
my ( $out, $err );
$log->info( "run cmd: " . join ' ', @$cmd );
- Shipwright::Util->select('null');
+ select_fh('null');
run3( $cmd, undef, \$out, \$err );
- Shipwright::Util->select('stdout');
+ select_fh('stdout');
$log->debug("run output:\n$out") if $out;
$log->error("run err:\n$err") if $err;
@@ -93,7 +117,7 @@ EOF
}
-=head3 select
+=head3 select_fh
wrapper for the select in core
@@ -109,23 +133,22 @@ open $null_fh, '>', '/dev/null';
$cpan_log_path = catfile( tmpdir(), 'shipwright_cpan.log');
open $cpan_fh, '>>', $cpan_log_path;
-$stdout_fh = CORE::select();
+$stdout_fh = select;
-sub select {
- my $self = shift;
+sub select_fh {
my $type = shift;
if ( $type eq 'null' ) {
- CORE::select $null_fh;
+ select $null_fh;
}
elsif ( $type eq 'stdout' ) {
- CORE::select $stdout_fh;
+ select $stdout_fh;
}
elsif ( $type eq 'cpan' ) {
warn "CPAN related output will be at $cpan_log_path\n"
unless $cpan_fh_flag;
$cpan_fh_flag = 1;
- CORE::select $cpan_fh;
+ select $cpan_fh;
}
else {
confess "unknown type: $type";
@@ -138,10 +161,10 @@ Takes perl modules name space and name of a module in the space.
Finds and returns matching module name using case insensitive search, for
example:
- Shipwright::Util->find_module('Shipwright::Backend', 'svn');
+ find_module('Shipwright::Backend', 'svn');
# returns 'Shipwright::Backend::SVN'
- Shipwright::Util->find_module('Shipwright::Backend', 'git');
+ find_module('Shipwright::Backend', 'git');
# returns 'Shipwright::Backend::Git'
Returns undef if there is no module matching criteria.
@@ -149,7 +172,6 @@ Returns undef if there is no module matching criteria.
=cut
sub find_module {
- my $self = shift;
my $space = shift;
my $name = shift;
@@ -174,13 +196,10 @@ Uses %INC to figure out where Shipwright.pm is.
=cut
sub shipwright_root {
- my $self = shift;
-
unless ($SHIPWRIGHT_ROOT) {
my $dir = ( splitpath( $INC{"Shipwright.pm"} ) )[1];
$SHIPWRIGHT_ROOT = rel2abs($dir);
}
-
return ($SHIPWRIGHT_ROOT);
}
@@ -192,10 +211,8 @@ currently only used to store the initial files in project.
=cut
sub share_root {
- my $self = shift;
-
unless ($SHARE_ROOT) {
- my @root = splitdir( $self->shipwright_root );
+ my @root = splitdir( shipwright_root() );
if ( $root[-2] ne 'blib'
&& $root[-1] eq 'lib'
@@ -246,20 +263,6 @@ sub shipwright_user_root {
return $ENV{SHIPWRIGHT_USER_ROOT} || catdir( user_home, '.shipwright' );
}
-=head3 parent_dir
-
-return the dir's parent dir, the arg must be a dir path
-
-=cut
-
-sub parent_dir {
- my $self = shift;
- my $dir = shift;
- my @dirs = splitdir($dir);
- pop @dirs;
- return catdir(@dirs);
-}
-
1;
__END__
diff --git a/lib/Shipwright/Util/CleanINC.pm b/lib/Shipwright/Util/CleanINC.pm
index e83e3de..37b6e8e 100644
--- a/lib/Shipwright/Util/CleanINC.pm
+++ b/lib/Shipwright/Util/CleanINC.pm
@@ -1,4 +1,4 @@
-package Shipwright::Util::CleanINC;
+package CleanINC;
use strict;
use warnings;
use Config;
@@ -52,11 +52,11 @@ __END__
=head1 NAME
-Shipwright::Util::CleanINC - Use this to clean @INC
+CleanINC - Use this to clean @INC
=head1 SYNOPSIS
- use Shipwright::Util::CleanINC;
+ use CleanINC;
=head1 DESCRIPTION
diff --git a/lib/Shipwright/Util/PatchModuleBuild.pm b/lib/Shipwright/Util/PatchModuleBuild.pm
index 842da22..d634b04 100644
--- a/lib/Shipwright/Util/PatchModuleBuild.pm
+++ b/lib/Shipwright/Util/PatchModuleBuild.pm
@@ -1,4 +1,4 @@
-package Shipwright::Util::PatchModuleBuild;
+package PatchModuleBuild;
use strict;
use warnings;
@@ -18,11 +18,11 @@ __END__
=head1 NAME
-Shipwright::Util::PatchModuleBuild - use this to ignore man pages generation
+PatchModuleBuild - use this to ignore man pages generation
=head1 SYNOPSIS
- use Shipwright::Util::PatchModuleBuild;
+ use PatchModuleBuild;
=head1 DESCRIPTION
diff --git a/t/05.util.t b/t/05.util.t
index 45d5221..66fc3cc 100644
--- a/t/05.util.t
+++ b/t/05.util.t
@@ -30,24 +30,24 @@ else {
for ( 1 .. 2 ) {
is(
$shipwright_root,
- Shipwright::Util->shipwright_root,
+ shipwright_root,
'shipwright_root works',
);
- is( $share_root, Shipwright::Util->share_root, 'share_root works' );
+ is( $share_root, share_root, 'share_root works' );
}
my ( $out, $err );
-$out = Shipwright::Util->run( [ $^X, '-e', 'print "ok"' ] );
+$out = run_cmd( [ $^X, '-e', 'print "ok"' ] );
like( $out, qr/ok/, "normal run" );
-( undef, $err ) = Shipwright::Util->run( [ $^X, '-e', 'die "error"' ], 1 );
+( undef, $err ) = run_cmd( [ $^X, '-e', 'die "error"' ], 1 );
like(
$err,
qr/error/i,
"run with error again, also with ignore_failure"
);
-$out = Shipwright::Util->run( sub { 'ok' } );
+$out = run_cmd( sub { 'ok' } );
like( $out, qr/ok/, "normal code run" );
my $hashref = { foo => 'bar' };
@@ -60,21 +60,21 @@ my ( $fh, $fn ) = tempfile;
print $fh $string;
close $fh;
-is_deeply( $hashref, Shipwright::Util::LoadFile($fn), 'LoadFile works' );
-is_deeply( $hashref, Shipwright::Util::Load($string), 'Load works' );
+is_deeply( $hashref, load_yaml_file($fn), 'LoadFile works' );
+is_deeply( $hashref, load_yaml($string), 'Load works' );
-is_deeply( $string, Shipwright::Util::Dump($hashref), 'Dump works' );
+is_deeply( $string, dump_yaml($hashref), 'Dump works' );
my ( undef, $fn2 ) = tempfile;
-Shipwright::Util::DumpFile( $fn2, $hashref );
+dump_yaml_file( $fn2, $hashref );
my $string2;
{ local $/; open my $fh, '<', $fn2 or die $!; $string2 = <$fh>; }
is( $string, $string2, 'DumpFile works' );
-ok( Shipwright::Util->select('null'), 'selected null' );
-ok( Shipwright::Util->select('cpan'), 'selected cpan' )
+ok( select_fh('null'), 'selected null' );
+ok( select_fh('cpan'), 'selected cpan' )
for 1 .. 2; # for test coverage
-ok( Shipwright::Util->select('stdout'), 'selected stdout' );
-eval { Shipwright::Util->select('noexists') };
+ok( select('stdout'), 'selected stdout' );
+eval { select_fh('noexists') };
like( $@, qr/unknown type/, 'unknown type results in death' );
diff --git a/t/08.build.t b/t/08.build.t
index 9e5fe85..d65cfd1 100644
--- a/t/08.build.t
+++ b/t/08.build.t
@@ -5,7 +5,7 @@ use Test::More tests =>3;
use Shipwright::Util;
use File::Spec::Functions qw/catfile/;
-my $share_root = Shipwright::Util->share_root;
+my $share_root = share_root;
my $builder = catfile( $share_root, 'bin', 'shipwright-builder' );
my $help = `$^X $builder --help`;
diff --git a/t/71.script_cmds.t b/t/71.script_cmds.t
index 1a89655..e0e560d 100644
--- a/t/71.script_cmds.t
+++ b/t/71.script_cmds.t
@@ -43,7 +43,7 @@ SKIP: {
my $source = create_svn_repo() . '/foo'; # svn source we'll import
- Shipwright::Util->run(
+ run_cmd(
[
$ENV{'SHIPWRIGHT_SVN'}, 'import',
'-m', q{''},
@@ -68,7 +68,7 @@ SKIP: {
my $repo = 'svk://__shipwright/hello';
my $source = '//foo';
- Shipwright::Util->run(
+ run_cmd(
[
$ENV{'SHIPWRIGHT_SVK'}, 'import',
'-m', q{''},
@@ -356,7 +356,7 @@ qr/set mandatory flags with success\s+mandatory flags of man1 are build/,
else {
# for the update_cmd
- Shipwright::Util->run( $item, 1 );
+ run_cmd( $item, 1 );
}
}
}
commit 6941056eae88a6cec1017a5dc83073126a454ff7
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Mar 21 12:08:14 2010 +0800
use confess or die in according to SHIPWRIGHT_DEVEL env
diff --git a/lib/Shipwright/Backend.pm b/lib/Shipwright/Backend.pm
index 957b129..2cfb1cb 100644
--- a/lib/Shipwright/Backend.pm
+++ b/lib/Shipwright/Backend.pm
@@ -2,7 +2,6 @@ package Shipwright::Backend;
use warnings;
use strict;
-use Carp;
use UNIVERSAL::require;
use Shipwright::Util;
@@ -10,7 +9,7 @@ sub new {
my $class = shift;
my %args = @_;
- confess 'need repository arg' unless exists $args{repository};
+ confess_or_die 'need repository arg' unless exists $args{repository};
$args{repository} =~ s/^\s+//;
$args{repository} =~ s/\s+$//;
@@ -24,16 +23,16 @@ sub new {
if ( $args{repository} =~ /^([a-z]+)(?:\+([a-z]+))?:/ ) {
($backend, $subtype) = ($1, $2);
} else {
- confess "invalid repository, doesn't start from xxx: or xxx+yyy:";
+ confess_or_die "invalid repository, doesn't start from xxx: or xxx+yyy:";
}
my $module = find_module(__PACKAGE__, $backend);
unless ( $module ) {
- confess "Couldn't find backend implementing '$backend'";
+ confess_or_die "Couldn't find backend implementing '$backend'";
}
$module->require
- or confess "Couldn't load module '$module'"
+ or confess_or_die "Couldn't load module '$module'"
." implementing backend '$backend': $@";
return $module->new(%args);
}
diff --git a/lib/Shipwright/Backend/Base.pm b/lib/Shipwright/Backend/Base.pm
index d1dfb93..9cb406b 100644
--- a/lib/Shipwright/Backend/Base.pm
+++ b/lib/Shipwright/Backend/Base.pm
@@ -2,7 +2,6 @@ package Shipwright::Backend::Base;
use warnings;
use strict;
-use Carp;
use File::Spec::Functions qw/catfile catdir splitpath/;
use Shipwright::Util;
use File::Temp qw/tempdir/;
@@ -52,7 +51,7 @@ sub build {
sub _subclass_method {
my $method = ( caller(0) )[3];
- confess "your should subclass $method\n";
+ confess_or_die "your should subclass $method\n";
}
=item initialize
@@ -68,7 +67,7 @@ sub initialize {
tempdir( 'shipwright_backend_base_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
rcopy( share_root(), $dir )
- or confess "copy share_root failed: $!";
+ or confess_or_die "copy share_root failed: $!";
$self->_install_yaml_tiny($dir);
$self->_install_clean_inc($dir);
@@ -97,7 +96,7 @@ sub _install_module_build {
my $module_build_path = catdir( $dir, 'inc', 'Module', );
make_path( catdir( $module_build_path, 'Build' ) );
rcopy( Module::Info->new_from_module('Module::Build')->file,
- $module_build_path ) or confess "copy Module/Build.pm failed: $!";
+ $module_build_path ) or confess_or_die "copy Module/Build.pm failed: $!";
rcopy(
catdir(
Module::Info->new_from_module('Module::Build')->inc_dir, 'Module',
@@ -105,7 +104,7 @@ sub _install_module_build {
),
catdir( $module_build_path, 'Build' )
)
- or confess "copy Module/Build failed: $!";
+ or confess_or_die "copy Module/Build failed: $!";
}
sub _install_yaml_tiny {
@@ -115,7 +114,7 @@ sub _install_yaml_tiny {
my $yaml_tiny_path = catdir( $dir, 'inc', 'YAML' );
make_path( $yaml_tiny_path );
rcopy( Module::Info->new_from_module('YAML::Tiny')->file, $yaml_tiny_path )
- or confess "copy YAML/Tiny.pm failed: $!";
+ or confess_or_die "copy YAML/Tiny.pm failed: $!";
}
sub _install_clean_inc {
@@ -126,7 +125,7 @@ sub _install_clean_inc {
for my $mod qw(CleanINC PatchModuleBuild) {
rcopy( Module::Info->new_from_module("Shipwright::Util::$mod")->file,
$util_inc_path )
- or confess "copy $mod failed: $!";
+ or confess_or_die "copy $mod failed: $!";
}
}
@@ -137,7 +136,7 @@ sub _install_file_compare {
my $path = catdir( $dir, 'inc', 'File' );
make_path( $path );
rcopy( Module::Info->new_from_module('File::Compare')->file, $path )
- or confess "copy File/Compare.pm failed: $!";
+ or confess_or_die "copy File/Compare.pm failed: $!";
}
sub _install_file_copy_recursive {
@@ -147,7 +146,7 @@ sub _install_file_copy_recursive {
my $path = catdir( $dir, 'inc', 'File', 'Copy' );
make_path( $path );
rcopy( Module::Info->new_from_module('File::Copy::Recursive')->file, $path )
- or confess "copy File/Copy/Recursive.pm failed: $!";
+ or confess_or_die "copy File/Copy/Recursive.pm failed: $!";
}
sub _install_file_path {
@@ -156,7 +155,7 @@ sub _install_file_path {
my $path = catdir( $dir, 'inc', 'File' );
rcopy( Module::Info->new_from_module('File::Path')->file, $path )
- or confess "copy File/Path.pm failed: $!";
+ or confess_or_die "copy File/Path.pm failed: $!";
}
=item import
@@ -380,7 +379,7 @@ sub update_order {
my $source = Algorithm::Dependency::Source::HoA->new($require);
$source->load();
my $dep = Algorithm::Dependency::Ordered->new( source => $source, )
- or confess $@;
+ or confess_or_die $@;
my $order = $dep->schedule_all();
$self->order($order);
@@ -720,7 +719,7 @@ sub update {
my $self = shift;
my %args = @_;
- confess "need path option" unless $args{path};
+ confess_or_die "need path option" unless $args{path};
if ( $args{path} =~ m{/$} ) {
# it's a directory
@@ -741,7 +740,7 @@ sub update {
}
else {
- confess "$args{path} seems not shipwright's own file"
+ confess_or_die "$args{path} seems not shipwright's own file"
unless -e catfile( share_root(), $args{path} );
return $self->_update_file( $args{path},
diff --git a/lib/Shipwright/Backend/FS.pm b/lib/Shipwright/Backend/FS.pm
index b927f19..6a32b72 100644
--- a/lib/Shipwright/Backend/FS.pm
+++ b/lib/Shipwright/Backend/FS.pm
@@ -2,7 +2,6 @@ package Shipwright::Backend::FS;
use warnings;
use strict;
-use Carp;
use File::Spec::Functions qw/catfile splitdir catdir rel2abs/;
use Shipwright::Util;
use File::Copy::Recursive qw/rcopy rmove/;
@@ -62,7 +61,7 @@ sub initialize {
$self->delete; # clean repository in case it exists
rcopy( $dir, $self->repository )
- or confess "can't copy $dir to " . $self->repository . ": $!";
+ or confess_or_die "can't copy $dir to " . $self->repository . ": $!";
}
# a cmd generating factory
@@ -73,7 +72,7 @@ sub _cmd {
$args{path} ||= '';
for ( @{ $REQUIRE_OPTIONS{$type} } ) {
- confess "$type need option $_" unless $args{$_};
+ confess_or_die "$type need option $_" unless $args{$_};
}
my @cmd;
@@ -159,7 +158,7 @@ sub _cmd {
if ( -d $path ) {
my $dh;
- opendir $dh, $path or confess $!;
+ opendir $dh, $path or confess_or_die $!;
my $dirs = join "\t", grep { /^[^.]/ } readdir $dh;
return $dirs;
}
@@ -174,13 +173,13 @@ sub _cmd {
return ( 'No such file or directory' ) unless -e $path;
return ( '', 'Is a directory' ) unless -f $path;
local $/;
- open my $fh, '<', $path or confess $!;
+ open my $fh, '<', $path or confess_or_die $!;
my $c = <$fh>;
return $c;
};
}
else {
- confess "invalid command: $type";
+ confess_or_die "invalid command: $type";
}
return @cmd;
@@ -255,7 +254,7 @@ sub _update_file {
my $file = catfile( $self->repository, $path );
unlink $file;
- rcopy( $latest, $file ) or confess "can't copy $latest to $file: $!";
+ rcopy( $latest, $file ) or confess_or_die "can't copy $latest to $file: $!";
}
sub _update_dir {
@@ -264,7 +263,7 @@ sub _update_dir {
my $latest = shift;
my $dir = catfile( $self->repository, $path );
- rcopy( $latest, $dir ) or confess "can't copy $latest to $dir: $!";
+ rcopy( $latest, $dir ) or confess_or_die "can't copy $latest to $dir: $!";
}
=item import
diff --git a/lib/Shipwright/Backend/Git.pm b/lib/Shipwright/Backend/Git.pm
index 23bb5f6..8a82227 100644
--- a/lib/Shipwright/Backend/Git.pm
+++ b/lib/Shipwright/Backend/Git.pm
@@ -2,7 +2,6 @@ package Shipwright::Backend::Git;
use warnings;
use strict;
-use Carp;
use File::Spec::Functions qw/catfile catdir/;
use Shipwright::Util;
use File::Temp qw/tempdir/;
@@ -77,7 +76,7 @@ sub initialize {
$self->_initialize_local_dir();
rcopy( $dir, $self->local_dir )
- or confess "can't copy $dir to $path: $!";
+ or confess_or_die "can't copy $dir to $path: $!";
$self->commit( comment => 'create project' );
}
@@ -110,7 +109,7 @@ sub _init_new_git_repos {
{
open my $f,
'>', $initial_file
- or confess "$! writing $dir/$initial_file"
+ or confess_or_die "$! writing $dir/$initial_file"
}
run_cmd(
diff --git a/lib/Shipwright/Backend/SVK.pm b/lib/Shipwright/Backend/SVK.pm
index 2c99462..484ed69 100644
--- a/lib/Shipwright/Backend/SVK.pm
+++ b/lib/Shipwright/Backend/SVK.pm
@@ -2,7 +2,6 @@ package Shipwright::Backend::SVK;
use warnings;
use strict;
-use Carp;
use File::Spec::Functions qw/catfile/;
use Shipwright::Util;
use File::Copy::Recursive qw/rcopy/;
@@ -79,7 +78,7 @@ sub _svnroot {
return $self->{svnroot} = "file://$svnroot/$1";
}
}
- confess "Can't find determine underlying SVN repository for ". $self->repository;
+ confess_or_die "Can't find determine underlying SVN repository for ". $self->repository;
}
# a cmd generating factory
@@ -91,7 +90,7 @@ sub _cmd {
$args{comment} ||= '';
for ( @{ $REQUIRE_OPTIONS{$type} } ) {
- confess "$type need option $_" unless $args{$_};
+ confess_or_die "$type need option $_" unless $args{$_};
}
my @cmd;
@@ -209,7 +208,7 @@ sub _cmd {
@cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'cat', $self->_svnroot . $args{path} ];
}
else {
- confess "invalid command: $type";
+ confess_or_die "invalid command: $type";
}
return @cmd;
@@ -298,7 +297,7 @@ sub _update_file {
my $file = $self->local_dir . $path;
$self->_sync_local_dir( $path );
- rcopy( $latest, $file ) or confess "can't copy $latest to $file: $!";
+ rcopy( $latest, $file ) or confess_or_die "can't copy $latest to $file: $!";
$self->commit(
path => $file,
comment => "updated $path",
@@ -313,7 +312,7 @@ sub _update_dir {
$self->_sync_local_dir( $path );
my $dir = $self->local_dir . $path;
remove_tree( $dir );
- rcopy( $latest, $dir ) or confess "can't copy $latest to $dir: $!";
+ rcopy( $latest, $dir ) or confess_or_die "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 006c7c4..65e7f94 100644
--- a/lib/Shipwright/Backend/SVN.pm
+++ b/lib/Shipwright/Backend/SVN.pm
@@ -2,7 +2,6 @@ package Shipwright::Backend::SVN;
use warnings;
use strict;
-use Carp;
use File::Spec::Functions qw/catfile/;
use Shipwright::Util;
use File::Copy::Recursive qw/rcopy/;
@@ -90,7 +89,7 @@ sub _cmd {
$args{comment} ||= '';
for ( @{ $REQUIRE_OPTIONS{$type} } ) {
- confess "$type need option $_" unless $args{$_};
+ confess_or_die "$type need option $_" unless $args{$_};
}
my @cmd;
@@ -182,7 +181,7 @@ sub _cmd {
@cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'cat', $self->repository . $args{path} ];
}
else {
- confess "invalid command: $type";
+ confess_or_die "invalid command: $type";
}
return @cmd;
@@ -274,7 +273,7 @@ sub _update_file {
$self->_sync_local_dir( $path );
my $file = $self->local_dir . $path;
- rcopy( $latest, $file ) or confess "can't copy $latest to $file: $!";
+ rcopy( $latest, $file ) or confess_or_die "can't copy $latest to $file: $!";
$self->commit(
path => $file,
comment => "updated $path",
diff --git a/lib/Shipwright/Logger.pm b/lib/Shipwright/Logger.pm
index 1dd310d..a975ca5 100644
--- a/lib/Shipwright/Logger.pm
+++ b/lib/Shipwright/Logger.pm
@@ -1,7 +1,7 @@
package Shipwright::Logger;
use strict;
use warnings;
-use Carp;
+use Shipwright::Util;
use Log::Log4perl;
use Scalar::Util qw/blessed/;
diff --git a/lib/Shipwright/Manual/ENV.pod b/lib/Shipwright/Manual/ENV.pod
index 728c309..420a6c8 100644
--- a/lib/Shipwright/Manual/ENV.pod
+++ b/lib/Shipwright/Manual/ENV.pod
@@ -65,6 +65,10 @@ F<svnadmin> command is expected to be in the same directory as F<svn>.
test git backend if this's true
+=item SHIPWRIGHT_DEVEL
+
+ use confess instead of die if this's true
+
=item PERL_MM_USE_DEFAULT
CPAN in Shipwright is always run without interaction,
diff --git a/lib/Shipwright/Script.pm b/lib/Shipwright/Script.pm
index 52017e7..af3c0f7 100644
--- a/lib/Shipwright/Script.pm
+++ b/lib/Shipwright/Script.pm
@@ -2,7 +2,7 @@ package Shipwright::Script;
use strict;
use warnings;
use App::CLI;
-use Carp;
+use Shipwright::Util;
use base qw/App::CLI Class::Accessor::Fast/;
__PACKAGE__->mk_accessors(qw/repository log_file log_level/);
@@ -67,7 +67,7 @@ sub prepare {
log_level => $cmd->log_level,
log_file => $cmd->log_file,
);
- confess 'invalid repository: '
+ confess_or_die 'invalid repository: '
. $cmd->repository
unless $backend->check_repository(
action => $action,
@@ -75,7 +75,7 @@ sub prepare {
);
}
else {
- confess "need repository arg\n";
+ confess_or_die "need repository arg\n";
}
}
return $cmd;
diff --git a/lib/Shipwright/Script/Create.pm b/lib/Shipwright/Script/Create.pm
index 9011fea..9e8c580 100644
--- a/lib/Shipwright/Script/Create.pm
+++ b/lib/Shipwright/Script/Create.pm
@@ -2,7 +2,6 @@ package Shipwright::Script::Create;
use strict;
use warnings;
-use Carp;
use base qw/App::CLI::Command Shipwright::Script/;
diff --git a/lib/Shipwright/Script/Defaultbranch.pm b/lib/Shipwright/Script/Defaultbranch.pm
index 45d3222..ce0986d 100644
--- a/lib/Shipwright/Script/Defaultbranch.pm
+++ b/lib/Shipwright/Script/Defaultbranch.pm
@@ -1,7 +1,7 @@
package Shipwright::Script::Defaultbranch;
use strict;
use warnings;
-use Carp;
+use Shipwright::Util;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
@@ -12,8 +12,8 @@ sub run {
my $name = shift;
my $default = shift;
- confess "need name arg\n" unless $name;
- confess "need default arg\n" unless $default;
+ confess_or_die "need name arg\n" unless $name;
+ confess_or_die "need default arg\n" unless $default;
my $shipwright = Shipwright->new( repository => $self->repository, );
@@ -29,7 +29,7 @@ sub run {
"set default branch for $name with success, now it's $default");
}
else {
- confess "$name doesn't have branches $default.
+ confess_or_die "$name doesn't have branches $default.
Available branches are " . join( ', ', @{ $branches->{$name} } ) . "\n";
}
}
diff --git a/lib/Shipwright/Script/Delete.pm b/lib/Shipwright/Script/Delete.pm
index cfedaf9..c81b3ed 100644
--- a/lib/Shipwright/Script/Delete.pm
+++ b/lib/Shipwright/Script/Delete.pm
@@ -2,7 +2,6 @@ package Shipwright::Script::Delete;
use strict;
use warnings;
-use Carp;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(qw/unreferenced check_only/);
@@ -22,11 +21,11 @@ sub run {
my $name = shift;
unless ( $name || $self->unreferenced ) {
- confess "need name arg or --unreferenced\n";
+ confess_or_die "need name arg or --unreferenced\n";
}
if ( $name && $self->unreferenced ) {
- confess "please choose only one thing: a dist name or --unreferenced";
+ confess_or_die "please choose only one thing: a dist name or --unreferenced";
}
my $shipwright = Shipwright->new( repository => $self->repository, );
diff --git a/lib/Shipwright/Script/Flags.pm b/lib/Shipwright/Script/Flags.pm
index cbe94d5..ce7f5e8 100644
--- a/lib/Shipwright/Script/Flags.pm
+++ b/lib/Shipwright/Script/Flags.pm
@@ -2,7 +2,7 @@ package Shipwright::Script::Flags;
use strict;
use warnings;
-use Carp;
+use Shipwright::Util;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(qw/add delete set mandatory/);
@@ -23,7 +23,7 @@ sub run {
my $self = shift;
my $name = shift;
- confess "need name arg\n" unless $name;
+ confess_or_die "need name arg\n" unless $name;
if ( $name =~ /^__/ ) {
$self->log->fatal( "$name can't start as __" );
@@ -43,7 +43,7 @@ sub run {
}
unless ( 1 == grep { defined $_ } $self->add, $self->delete, $self->set ) {
- confess "you should specify one and only one of add, delete and set\n";
+ confess_or_die "you should specify one and only one of add, delete and set\n";
}
my $list;
diff --git a/lib/Shipwright/Script/Import.pm b/lib/Shipwright/Script/Import.pm
index 89db067..434e5c2 100644
--- a/lib/Shipwright/Script/Import.pm
+++ b/lib/Shipwright/Script/Import.pm
@@ -2,7 +2,6 @@ package Shipwright::Script::Import;
use strict;
use warnings;
-use Carp;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(
@@ -46,7 +45,7 @@ sub run {
my @sources = @_;
my $source;
$source = $sources[0];
- confess "--name and --as args are not supported when importing multiple sources"
+ confess_or_die "--name and --as args are not supported when importing multiple sources"
if @sources > 1 && $self->name;
if ( $self->min_perl_version ) {
@@ -79,7 +78,7 @@ sub run {
@sources = $source;
}
- confess "we need source arg\n" unless $source;
+ confess_or_die "we need source arg\n" unless $source;
if ( $self->extra_tests ) {
@@ -108,7 +107,7 @@ sub run {
$self->name($name);
}
if ( $self->name !~ /^[-.\w]+$/ ) {
- confess
+ confess_or_die
qq{name can only have alphanumeric characters, "." and "-"\n};
}
}
@@ -127,7 +126,7 @@ sub run {
skip_all_recommends => $self->skip_all_recommends,
);
- confess "cpan dists can't be branched"
+ confess_or_die "cpan dists can't be branched"
if $shipwright->source->isa('Shipwright::Source::CPAN')
&& $self->as;
@@ -185,7 +184,7 @@ sub run {
if ( $self->no_follow ) {
open my $fh, '>', catfile( $script_dir, 'require.yml' ) or
- confess "can't write to $script_dir/require.yml: $!\n";
+ confess_or_die "can't write to $script_dir/require.yml: $!\n";
print $fh "---\n";
close $fh;
}
@@ -196,7 +195,7 @@ sub run {
move(
catfile( $source, '__require.yml' ),
catfile( $script_dir, 'require.yml' )
- ) or confess "move __require.yml failed: $!\n";
+ ) or confess_or_die "move __require.yml failed: $!\n";
}
}
@@ -308,7 +307,7 @@ sub _import_req {
move(
catfile( $s, '__require.yml' ),
catfile( $script_dir, 'require.yml' )
- ) or confess "move $s/__require.yml failed: $!\n";
+ ) or confess_or_die "move $s/__require.yml failed: $!\n";
}
$self->_generate_build( $s, $script_dir, $shipwright );
@@ -399,7 +398,7 @@ EOF
);
}
- open my $fh, '>', catfile( $script_dir, 'build' ) or confess $@;
+ open my $fh, '>', catfile( $script_dir, 'build' ) or confess_or_die $@;
print $fh $_, "\n" for @commands;
close $fh;
}
diff --git a/lib/Shipwright/Script/Ktf.pm b/lib/Shipwright/Script/Ktf.pm
index 67dfea7..6bf4d25 100644
--- a/lib/Shipwright/Script/Ktf.pm
+++ b/lib/Shipwright/Script/Ktf.pm
@@ -2,7 +2,7 @@ package Shipwright::Script::Ktf;
use strict;
use warnings;
-use Carp;
+use Shipwright::Util;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(qw/set delete/);
@@ -26,7 +26,7 @@ sub run {
my $ktf = $shipwright->backend->ktf;
if ( $self->delete || defined $self->set ) {
- confess "need name arg\n" unless @names;
+ confess_or_die "need name arg\n" unless @names;
if ( $self->delete ) {
delete $ktf->{$_} for @names;
diff --git a/lib/Shipwright/Script/List.pm b/lib/Shipwright/Script/List.pm
index 307797f..3227eb0 100644
--- a/lib/Shipwright/Script/List.pm
+++ b/lib/Shipwright/Script/List.pm
@@ -2,7 +2,7 @@ package Shipwright::Script::List;
use strict;
use warnings;
-use Carp;
+use Shipwright::Util;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(qw/with_latest_version only_update/);
diff --git a/lib/Shipwright/Script/Maintain.pm b/lib/Shipwright/Script/Maintain.pm
index 9232692..3bb5506 100644
--- a/lib/Shipwright/Script/Maintain.pm
+++ b/lib/Shipwright/Script/Maintain.pm
@@ -2,7 +2,7 @@ package Shipwright::Script::Maintain;
use strict;
use warnings;
-use Carp;
+use Shipwright::Util;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(
diff --git a/lib/Shipwright/Script/Relocate.pm b/lib/Shipwright/Script/Relocate.pm
index 20942f5..2c70e95 100644
--- a/lib/Shipwright/Script/Relocate.pm
+++ b/lib/Shipwright/Script/Relocate.pm
@@ -2,7 +2,7 @@ package Shipwright::Script::Relocate;
use strict;
use warnings;
-use Carp;
+use Shipwright::Util;
use base qw/App::CLI::Command Shipwright::Script/;
@@ -18,8 +18,8 @@ sub run {
my $self = shift;
my ( $name, $new_source ) = @_;
- confess "need name arg" unless $name;
- confess "need source arg" unless $new_source;
+ confess_or_die "need name arg" unless $name;
+ confess_or_die "need source arg" unless $new_source;
my $shipwright = Shipwright->new(
repository => $self->repository,
@@ -31,7 +31,7 @@ sub run {
# die if the specified branch doesn't exist
if ( $branches && $self->as ) {
- confess "$name doesn't have branch "
+ confess_or_die "$name doesn't have branch "
. $self->as
. ". please use import cmd instead"
unless grep { $_ eq $self->as } @{ $branches->{$name} || [] };
diff --git a/lib/Shipwright/Script/Rename.pm b/lib/Shipwright/Script/Rename.pm
index 6d27f65..920ef4b 100644
--- a/lib/Shipwright/Script/Rename.pm
+++ b/lib/Shipwright/Script/Rename.pm
@@ -2,7 +2,6 @@ package Shipwright::Script::Rename;
use strict;
use warnings;
-use Carp;
use base qw/App::CLI::Command Shipwright::Script/;
@@ -14,17 +13,17 @@ sub run {
my ( $name, $new_name ) = @_;
- confess "need name arg\n" unless $name;
- confess "need new-name arg\n" unless $new_name;
+ confess_or_die "need name arg\n" unless $name;
+ confess_or_die "need new-name arg\n" unless $new_name;
- confess "invalid new-name: $new_name, should only contain - and alphanumeric\n"
+ confess_or_die "invalid new-name: $new_name, should only contain - and alphanumeric\n"
unless $new_name =~ /^[-\w]+$/;
my $shipwright = Shipwright->new( repository => $self->repository, );
my $order = $shipwright->backend->order;
- confess "no such dist: $name\n" unless grep { $_ eq $name } @$order;
+ confess_or_die "no such dist: $name\n" unless grep { $_ eq $name } @$order;
$shipwright->backend->move(
path => "/sources/$name",
diff --git a/lib/Shipwright/Script/Requires.pm b/lib/Shipwright/Script/Requires.pm
index bec667d..c60b6e9 100644
--- a/lib/Shipwright/Script/Requires.pm
+++ b/lib/Shipwright/Script/Requires.pm
@@ -2,7 +2,6 @@ package Shipwright::Script::Requires;
use strict;
use warnings;
-use Carp;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(
@@ -29,7 +28,7 @@ sub options {
sub run {
my $self = shift;
my $source = shift;
- confess "we need source arg\n" unless $source;
+ confess_or_die "we need source arg\n" unless $source;
$self->skip( { map { $_ => 1 } split /\s*,\s*/, $self->skip || '' } );
$self->skip_recommends(
diff --git a/lib/Shipwright/Script/Update.pm b/lib/Shipwright/Script/Update.pm
index f9dbff4..1404f35 100644
--- a/lib/Shipwright/Script/Update.pm
+++ b/lib/Shipwright/Script/Update.pm
@@ -2,7 +2,6 @@ package Shipwright::Script::Update;
use strict;
use warnings;
-use Carp;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(
@@ -56,7 +55,7 @@ sub run {
}
elsif ( $self->add_deps ) {
my @deps = split /\s*,\s*/, $self->add_deps;
- my $name = shift or confess 'need name arg';
+ my $name = shift or confess_or_die 'need name arg';
my $requires = $shipwright->backend->requires( name => $name ) || {};
for my $dep ( @deps ) {
my $new_dep;
@@ -81,7 +80,7 @@ sub run {
}
elsif ( $self->delete_deps ) {
my @deps = split /\s*,\s*/, $self->delete_deps;
- my $name = shift or confess 'need name arg';
+ my $name = shift or confess_or_die 'need name arg';
my $requires = $shipwright->backend->requires( name => $name ) || {};
for my $dep ( @deps ) {
for my $type ( qw/requires build_requires recommends/ ) {
@@ -100,7 +99,7 @@ sub run {
$branches = $shipwright->backend->branches;
if ( $self->all ) {
- confess '--all can not be specified with --as or NAME'
+ confess_or_die '--all can not be specified with --as or NAME'
if @_ || $self->as;
my $dists = $shipwright->backend->order || [];
@@ -110,11 +109,11 @@ sub run {
}
else {
my $name = shift;
- confess "need name arg\n" unless $name;
+ confess_or_die "need name arg\n" unless $name;
# die if the specified branch doesn't exist
if ( $branches && $self->as ) {
- confess "$name doesn't have branch "
+ confess_or_die "$name doesn't have branch "
. $self->as
. ". please use import cmd instead"
unless grep { $_ eq $self->as } @{ $branches->{$name} || [] };
@@ -236,7 +235,7 @@ sub _update {
$name = $map->{$name};
}
else {
- confess 'invalid name ' . $name . "\n";
+ confess_or_die 'invalid name ' . $name . "\n";
}
unless ( $s ) {
diff --git a/lib/Shipwright/Source.pm b/lib/Shipwright/Source.pm
index ada4ef3..fb0cda8 100644
--- a/lib/Shipwright/Source.pm
+++ b/lib/Shipwright/Source.pm
@@ -2,7 +2,6 @@ package Shipwright::Source;
use warnings;
use strict;
-use Carp;
use UNIVERSAL::require;
use File::Temp qw/tempdir/;
use File::Spec::Functions qw/catfile catdir/;
@@ -51,11 +50,11 @@ sub new {
for (qw/map_path url_path version_path branches_path/) {
next if -e $args{$_};
- open my $fh, '>', $args{$_} or confess "can't write to $args{$_}: $!";
+ open my $fh, '>', $args{$_} or confess_or_die "can't write to $args{$_}: $!";
close $fh;
}
- confess "need source arg" unless exists $args{source};
+ confess_or_die "need source arg" unless exists $args{source};
for my $dir (qw/directory download_directory scripts_directory/) {
make_path( $args{$dir} ) unless -e $args{$dir};
@@ -63,7 +62,7 @@ sub new {
my $type = type( \$args{source} );
- confess "invalid source: $args{source}" unless $type;
+ confess_or_die "invalid source: $args{source}" unless $type;
my $module = 'Shipwright::Source::' . $type;
$module->require;
diff --git a/lib/Shipwright/Source/Base.pm b/lib/Shipwright/Source/Base.pm
index a157a25..d932433 100644
--- a/lib/Shipwright/Source/Base.pm
+++ b/lib/Shipwright/Source/Base.pm
@@ -2,7 +2,6 @@ package Shipwright::Source::Base;
use warnings;
use strict;
-use Carp;
use File::Spec::Functions qw/catfile catdir/;
use File::Slurp;
use Module::CoreList;
@@ -108,7 +107,7 @@ sub _follow {
$file .= '.pm';
# so it's a bundle module
- open my $fh, '<', 'MANIFEST' or confess "no manifest found: $!";
+ open my $fh, '<', 'MANIFEST' or confess_or_die "no manifest found: $!";
while (<$fh>) {
chomp;
if (/$file/) {
@@ -116,7 +115,7 @@ sub _follow {
last;
}
}
- open $fh, '<', $file or confess "can't open $file: $!";
+ open $fh, '<', $file or confess_or_die "can't open $file: $!";
my $flip;
while (<$fh>) {
chomp;
@@ -158,19 +157,19 @@ sub _follow {
);
run_cmd( [ $^X, 'Build.PL' ] ) if $? || !-e 'Build';
my $source = read_file( catfile( '_build', 'prereqs' ) )
- or confess "can't read _build/prereqs: $!";
+ or confess_or_die "can't read _build/prereqs: $!";
my $eval = '$require = ' . $source;
- eval "$eval;1" or confess "eval error: $@"; ## no critic
+ eval "$eval;1" or confess_or_die "eval error: $@"; ## no critic
$source = read_file( catfile('Build.PL') )
- or confess "can't read Build.PL: $!";
+ or confess_or_die "can't read Build.PL: $!";
run_cmd(
[ $^X, 'Build', 'realclean', '--allow_mb_mismatch', 1 ] );
}
elsif ( -e 'Makefile.PL' ) {
my $makefile = read_file('Makefile.PL')
- or confess "can't read Makefile.PL: $!";
+ or confess_or_die "can't read Makefile.PL: $!";
if ( $makefile =~ /inc::Module::Install/ ) {
$self->log->info("is a Module::Install based dist");
@@ -338,14 +337,14 @@ EOF
run_cmd( [ $^X, 'shipwright_makefile.pl' ] )
if $? || !-e 'Makefile';
my $prereqs = read_file( catfile('shipwright_prereqs') )
- or confess "can't read prereqs: $!";
- eval "$prereqs;1;" or confess "eval error: $@"; ## no critic
+ or confess_or_die "can't read prereqs: $!";
+ eval "$prereqs;1;" or confess_or_die "eval error: $@"; ## no critic
if ( -e 'META.yml' ) {
# if there's META.yml, let's find more about it
my $meta = load_yaml_file('META.yml')
- or confess "can't read META.yml: $!";
+ or confess_or_die "can't read META.yml: $!";
$require ||= {};
$require->{requires} = {
%{ $meta->{requires} || {} },
@@ -383,7 +382,7 @@ EOF
if ( $source && $source =~ /({.*})/ ) {
my $eval .= '$require = ' . $1;
$eval =~ s/([\w:]+)=>/'$1'=>/g;
- eval "$eval;1" or confess "eval error: $@"; ## no critic
+ eval "$eval;1" or confess_or_die "eval error: $@"; ## no critic
}
for ( keys %$require ) {
@@ -404,7 +403,7 @@ EOF
}
dump_yaml_file( $require_path, $require )
- or confess "can't dump __require.yml: $!";
+ or confess_or_die "can't dump __require.yml: $!";
}
if ( my $require = load_yaml_file($require_path) ) {
@@ -536,7 +535,7 @@ EOF
dump_yaml_file( $require_path, $require );
}
else {
- confess "invalid __require.yml in $path";
+ confess_or_die "invalid __require.yml in $path";
}
# go back to the cwd before we run _follow
@@ -716,11 +715,11 @@ sub _lwp_get {
if ( $response->is_success ) {
open my $fh, '>', $self->source
- or confess "can't open file " . $self->source . ": $!";
+ or confess_or_die "can't open file " . $self->source . ": $!";
print $fh $response->content;
}
else {
- confess "failed to get $source: " . $response->status_line;
+ confess_or_die "failed to get $source: " . $response->status_line;
}
}
diff --git a/lib/Shipwright/Source/CPAN.pm b/lib/Shipwright/Source/CPAN.pm
index a800ce9..322941f 100644
--- a/lib/Shipwright/Source/CPAN.pm
+++ b/lib/Shipwright/Source/CPAN.pm
@@ -2,7 +2,7 @@ package Shipwright::Source::CPAN;
use warnings;
use strict;
-use Carp;
+use Shipwright::Util;
use File::Spec::Functions qw/catfile catdir rootdir/;
use Shipwright::Source::Compressed;
use CPAN;
@@ -96,7 +96,7 @@ sub run {
chdir rootdir(); #< chdir to root dir in case CPAN has chdir'd
#into one of the temp dirs, preventing its
#deletion
- confess $error;
+ confess_or_die $error;
} else {
$self->log->warn("Removing source ".$self->source);
return;
diff --git a/lib/Shipwright/Source/Compressed.pm b/lib/Shipwright/Source/Compressed.pm
index f0e1451..949e18a 100644
--- a/lib/Shipwright/Source/Compressed.pm
+++ b/lib/Shipwright/Source/Compressed.pm
@@ -2,13 +2,13 @@ package Shipwright::Source::Compressed;
use warnings;
use strict;
-use Carp;
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/;
+use Shipwright::Util;
=head2 run
@@ -61,7 +61,7 @@ sub path {
$base_dir =~ s![/\\].*!!;
if ( @$files != grep { /^\Q$base_dir\E/ } @$files ) {
- confess 'only support compressed file which contains only one directory: '
+ confess_or_die 'only support compressed file which contains only one directory: '
. $base_dir;
}
diff --git a/lib/Shipwright/Source/Directory.pm b/lib/Shipwright/Source/Directory.pm
index 85147b6..7f4cb62 100644
--- a/lib/Shipwright/Source/Directory.pm
+++ b/lib/Shipwright/Source/Directory.pm
@@ -1,7 +1,7 @@
package Shipwright::Source::Directory;
use strict;
use warnings;
-use Carp;
+use Shipwright::Util;
use File::Spec::Functions qw/catdir/;
use File::Basename;
use File::Copy::Recursive qw/rcopy/;
diff --git a/lib/Shipwright/Source/FTP.pm b/lib/Shipwright/Source/FTP.pm
index 4c39c79..727e530 100644
--- a/lib/Shipwright/Source/FTP.pm
+++ b/lib/Shipwright/Source/FTP.pm
@@ -2,12 +2,12 @@ package Shipwright::Source::FTP;
use warnings;
use strict;
-use Carp;
use Shipwright::Source::Compressed;
use File::Spec::Functions qw/catfile/;
use base qw/Shipwright::Source::Base/;
+use Shipwright::Util;
=head2 run
@@ -40,7 +40,7 @@ sub _run {
$self->_lwp_get($source);
}
else {
- confess "invalid source: $source";
+ confess_or_die "invalid source: $source";
}
}
diff --git a/lib/Shipwright/Source/Git.pm b/lib/Shipwright/Source/Git.pm
index f32d650..fe717aa 100644
--- a/lib/Shipwright/Source/Git.pm
+++ b/lib/Shipwright/Source/Git.pm
@@ -2,7 +2,7 @@ package Shipwright::Source::Git;
use warnings;
use strict;
-use Carp;
+use Shipwright::Util;
use File::Spec::Functions qw/catdir/;
use File::Path qw/remove_tree/;
use File::Copy::Recursive qw/rcopy/;
@@ -92,7 +92,7 @@ sub _run {
}
chdir $cwd;
remove_tree( $path ) if -e $path;
- rcopy( $cloned_path, $path ) or confess $!;
+ rcopy( $cloned_path, $path ) or confess_or_die $!;
remove_tree( catdir( $path, '.git' ) );
};
diff --git a/lib/Shipwright/Source/HTTP.pm b/lib/Shipwright/Source/HTTP.pm
index 895ee61..45cbd42 100644
--- a/lib/Shipwright/Source/HTTP.pm
+++ b/lib/Shipwright/Source/HTTP.pm
@@ -2,11 +2,11 @@ package Shipwright::Source::HTTP;
use warnings;
use strict;
-use Carp;
use File::Spec::Functions qw/catfile/;
use Shipwright::Source::Compressed;
use base qw/Shipwright::Source::Base/;
+use Shipwright::Util;
=head2 run
@@ -42,7 +42,7 @@ sub _run {
$self->_lwp_get($source);
}
else {
- confess "invalid source: $source";
+ confess_or_die "invalid source: $source";
}
return 1;
}
diff --git a/lib/Shipwright/Source/SVK.pm b/lib/Shipwright/Source/SVK.pm
index 36b5b3e..96f0cbf 100644
--- a/lib/Shipwright/Source/SVK.pm
+++ b/lib/Shipwright/Source/SVK.pm
@@ -2,7 +2,7 @@ package Shipwright::Source::SVK;
use warnings;
use strict;
-use Carp;
+use Shipwright::Util;
use File::Spec::Functions qw/catdir/;
use File::Path qw/remove_tree/;
diff --git a/lib/Shipwright/Source/SVN.pm b/lib/Shipwright/Source/SVN.pm
index 5960be2..4778644 100644
--- a/lib/Shipwright/Source/SVN.pm
+++ b/lib/Shipwright/Source/SVN.pm
@@ -2,7 +2,7 @@ package Shipwright::Source::SVN;
use warnings;
use strict;
-use Carp;
+use Shipwright::Util;
use File::Spec::Functions qw/catdir/;
use File::Path qw/remove_tree/;
diff --git a/lib/Shipwright/Source/Shipwright.pm b/lib/Shipwright/Source/Shipwright.pm
index bfa8b96..a909747 100644
--- a/lib/Shipwright/Source/Shipwright.pm
+++ b/lib/Shipwright/Source/Shipwright.pm
@@ -2,7 +2,7 @@ package Shipwright::Source::Shipwright;
use strict;
use warnings;
-use Carp;
+use Shipwright::Util;
use File::Spec::Functions qw/catdir/;
use base qw/Shipwright::Source::Base/;
diff --git a/lib/Shipwright/Test.pm b/lib/Shipwright/Test.pm
index 18edf12..dd94fbc 100644
--- a/lib/Shipwright/Test.pm
+++ b/lib/Shipwright/Test.pm
@@ -3,7 +3,6 @@ package Shipwright::Test;
use warnings;
use strict;
use base qw/Exporter/;
-use Carp;
use File::Temp qw/tempdir/;
use IPC::Cmd qw/can_run/;
@@ -168,7 +167,7 @@ sub create_svn_repo {
my $repo =
tempdir( 'shipwright_test_svn_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
system("$ENV{SHIPWRIGHT_SVN}admin create $repo")
- && confess "create repo failed: $!";
+ && confess_or_die "create repo failed: $!";
return "file://$repo";
}
diff --git a/lib/Shipwright/Util.pm b/lib/Shipwright/Util.pm
index e10a6cc..99c8638 100644
--- a/lib/Shipwright/Util.pm
+++ b/lib/Shipwright/Util.pm
@@ -2,16 +2,16 @@ package Shipwright::Util;
use warnings;
use strict;
-use Carp;
+use Shipwright::Util;
use IPC::Run3;
use File::Spec::Functions qw/catfile catdir splitpath splitdir tmpdir rel2abs/;
use Cwd qw/abs_path getcwd/;
-
+use Carp;
use Shipwright; # we need this to find where Shipwright.pm lives
use YAML::Tiny;
use base 'Exporter';
our @EXPORT = qw/load_yaml load_yaml_file dump_yaml dump_yaml_file run_cmd
-select_fh shipwright_root share_root user_home
+select_fh shipwright_root share_root user_home confess_or_die
shipwright_user_root parent_dir find_module/;
our ( $SHIPWRIGHT_ROOT, $SHARE_ROOT );
@@ -41,6 +41,19 @@ sub dump_yaml_file {
they are just dropped in from YAML::Tiny
+=head3 confess_or_die
+
+=cut
+
+sub confess_or_die {
+ if ( $ENV{SHIPWRIGHT_DEVEL} ) {
+ goto &confess;
+ }
+ else {
+ die @_,"\n";
+ }
+}
+
=head3 parent_dir
return the dir's parent dir, the arg must be a dir path
@@ -101,7 +114,7 @@ sub run_cmd {
}
my $cwd = getcwd;
- confess <<"EOF";
+ confess_or_die <<"EOF";
command failed: @$cmd
\$?: $?
cwd: $cwd
@@ -151,7 +164,7 @@ sub select_fh {
select $cpan_fh;
}
else {
- confess "unknown type: $type";
+ confess_or_die "unknown type: $type";
}
}
@@ -244,7 +257,7 @@ sub user_home {
my $home = eval { (getpwuid $<)[7] };
if ( $@ ) {
- confess "can't find user's home, please set it by env HOME";
+ confess_or_die "can't find user's home, please set it by env HOME";
}
else {
return $home;
commit 2da9d420dab6d8b08e60786bff3ad4ab4fb3de81
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Mar 21 12:08:37 2010 +0800
exclude xt for env-coverage
diff --git a/xt/env-coverage.t b/xt/env-coverage.t
index 724432d..c266e82 100644
--- a/xt/env-coverage.t
+++ b/xt/env-coverage.t
@@ -9,7 +9,7 @@ plan skip_all => 'MANIFEST does not exist' unless -e $manifest;
plan tests => 1;
open my $fh, '<', $manifest;
-my @files = map { chomp; $_ } grep m{^(lib/.*\.pm$|(?:t|xt)/.*\.t$|bin/)}, <$fh>;
+my @files = map { chomp; $_ } grep m{^(lib/.*\.pm$|t/.*\.t$|bin/)}, <$fh>;
close $fh;
commit aaec9365f3b34f7e5f968f9c3045fd15fb548d72
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Mar 21 12:26:38 2010 +0800
tiny fix
diff --git a/t/71.script_cmds.t b/t/71.script_cmds.t
index e0e560d..b351a13 100644
--- a/t/71.script_cmds.t
+++ b/t/71.script_cmds.t
@@ -10,6 +10,7 @@ else {
}
use Shipwright;
+use Shipwright::Util;
use Shipwright::Test;
use File::Spec::Functions qw/catdir tmpdir/;
use File::Path qw/remove_tree/;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list