[Bps-public-commit] r15632 - in Shipwright/trunk: . lib/Shipwright/Backend lib/Shipwright/Script lib/Shipwright/Source share/bin share/etc
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Thu Aug 28 22:58:37 EDT 2008
Author: sunnavy
Date: Thu Aug 28 22:58:36 2008
New Revision: 15632
Modified:
Shipwright/trunk/ (props changed)
Shipwright/trunk/lib/Shipwright/Backend/Base.pm
Shipwright/trunk/lib/Shipwright/Build.pm
Shipwright/trunk/lib/Shipwright/Script.pm
Shipwright/trunk/lib/Shipwright/Script/Defaultbranch.pm
Shipwright/trunk/lib/Shipwright/Script/Delete.pm
Shipwright/trunk/lib/Shipwright/Script/Flags.pm
Shipwright/trunk/lib/Shipwright/Script/Import.pm
Shipwright/trunk/lib/Shipwright/Script/Ktf.pm
Shipwright/trunk/lib/Shipwright/Script/Relocate.pm
Shipwright/trunk/lib/Shipwright/Script/Rename.pm
Shipwright/trunk/lib/Shipwright/Script/Update.pm
Shipwright/trunk/lib/Shipwright/Source.pm
Shipwright/trunk/lib/Shipwright/Source/Base.pm
Shipwright/trunk/lib/Shipwright/Source/CPAN.pm
Shipwright/trunk/lib/Shipwright/Source/FTP.pm
Shipwright/trunk/lib/Shipwright/Source/HTTP.pm
Shipwright/trunk/lib/Shipwright/Test.pm
Shipwright/trunk/lib/Shipwright/Util.pm
Shipwright/trunk/share/bin/shipwright-builder
Shipwright/trunk/share/bin/shipwright-utility
Shipwright/trunk/share/etc/shipwright-utility
Log:
r16274 at sunnavys-mb: sunnavy | 2008-08-29 10:41:58 +0800
replace die with confess
Modified: Shipwright/trunk/lib/Shipwright/Backend/Base.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Backend/Base.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Backend/Base.pm Thu Aug 28 22:58:36 2008
@@ -45,7 +45,7 @@
sub _subclass_method {
my $method = ( caller(0) )[3];
- die "your should subclass $method\n";
+ confess "your should subclass $method\n";
}
=item initialize
@@ -66,7 +66,7 @@
mkpath $yaml_tiny_path;
require Module::Info;
copy( Module::Info->new_from_module('YAML::Tiny')->file, $yaml_tiny_path )
- or die "copy YAML/Tiny.pm failed: $!";
+ or confess "copy YAML/Tiny.pm failed: $!";
# share_root can't keep empty dirs, we have to create them manually
for (qw/scripts t sources/) {
@@ -277,7 +277,7 @@
my $source = Algorithm::Dependency::Source::HoA->new($require);
$source->load();
my $dep = Algorithm::Dependency::Ordered->new( source => $source, )
- or die $@;
+ or confess $@;
my $order = $dep->schedule_all();
$order = $self->fiddle_order( $order );
Modified: Shipwright/trunk/lib/Shipwright/Build.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Build.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Build.pm Thu Aug 28 22:58:36 2008
@@ -217,7 +217,7 @@
. catdir( 'sources', $dir, split /\//, $branches->{$dir}[0] )
. ' '
. catdir( 'dists', $dir ) )
- && die "cp sources/$dir/$branches->{$dir}[0] to dists/$dir failed";
+ && confess "cp sources/$dir/$branches->{$dir}[0] to dists/$dir failed";
}
chdir catfile( 'dists', $dir );
@@ -282,7 +282,7 @@
elsif ( $type ne 'clean' ) {
# clean is trivial, we'll just ignore if 'clean' fails
- die "build $dir $type part with failure.";
+ confess "build $dir $type part with failure.";
}
}
}
@@ -319,7 +319,7 @@
my $type;
if ( -T $file ) {
- open my $fh, '<', $file or die "can't open $file: $!";
+ open my $fh, '<', $file or confess "can't open $file: $!";
my $shebang = <$fh>;
my $base = quotemeta $self->install_base;
my $perl = quotemeta $self->perl;
@@ -338,7 +338,7 @@
}
move( $file => catfile( $self->install_base, "$dir-wrapped" ) )
- or die $!;
+ or confess $!;
# if we have this $type(e.g. perl) installed and have that specific wrapper,
# then link to it, else link to the normal one
@@ -347,12 +347,12 @@
&& -e catfile( '..', 'etc', "shipwright-$type-wrapper" ) )
{
symlink catfile( '..', 'etc', "shipwright-$type-wrapper" ) => $file
- or die $!;
+ or confess $!;
}
else {
symlink catfile( '..', 'etc', 'shipwright-script-wrapper' ) => $file
- or die $!;
+ or confess $!;
}
};
@@ -408,7 +408,7 @@
$self->log->info("run tests $type:");
if ( system($cmd) ) {
$self->log->error("tests failed");
- die;
+ confess;
}
}
}
Modified: Shipwright/trunk/lib/Shipwright/Script.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script.pm Thu Aug 28 22:58:36 2008
@@ -2,6 +2,7 @@
use strict;
use warnings;
use App::CLI;
+use Carp;
use base qw/App::CLI Class::Accessor::Fast/;
__PACKAGE__->mk_accessors(qw/repository log_file log_level/);
@@ -51,11 +52,11 @@
log_level => $cmd->log_level,
log_file => $cmd->log_file,
);
- die 'invalid repository: ' . $cmd->repository
+ confess 'invalid repository: ' . $cmd->repository
unless $backend->check_repository( action => $action );
}
else {
- die "need repository arg\n";
+ confess "need repository arg\n";
}
}
return $cmd;
Modified: Shipwright/trunk/lib/Shipwright/Script/Defaultbranch.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Defaultbranch.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Defaultbranch.pm Thu Aug 28 22:58:36 2008
@@ -12,8 +12,8 @@
my $name = shift;
my $default = shift;
- die "need name arg\n" unless $name;
- die "need default arg\n" unless $default;
+ confess "need name arg\n" unless $name;
+ confess "need default arg\n" unless $default;
my $shipwright = Shipwright->new( repository => $self->repository, );
@@ -28,7 +28,7 @@
print "set default branch for $name with success, now it's $default\n";
}
else {
- die "$name doesn't have branches $default.
+ confess "$name doesn't have branches $default.
Available branches are " . join( ', ', @{ $branches->{$name} } ) . "\n";
}
}
Modified: Shipwright/trunk/lib/Shipwright/Script/Delete.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Delete.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Delete.pm Thu Aug 28 22:58:36 2008
@@ -14,7 +14,7 @@
my $self = shift;
my $name = shift;
- die "need name arg\n" unless $name;
+ confess "need name arg\n" unless $name;
my $shipwright = Shipwright->new( repository => $self->repository, );
my $map = $shipwright->backend->map || {};
Modified: Shipwright/trunk/lib/Shipwright/Script/Flags.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Flags.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Flags.pm Thu Aug 28 22:58:36 2008
@@ -23,7 +23,7 @@
my $self = shift;
my $name = shift;
- die "need name arg\n" unless $name;
+ confess "need name arg\n" unless $name;
if ( $name =~ /^__/ ) {
print "$name can't start as __\n";
@@ -43,7 +43,7 @@
}
unless ( 1 == grep { defined $_ } $self->add, $self->delete, $self->set ) {
- die "you should specify one and only one of add, delete and set\n";
+ confess "you should specify one and only one of add, delete and set\n";
}
my $list;
Modified: Shipwright/trunk/lib/Shipwright/Script/Import.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Import.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Import.pm Thu Aug 28 22:58:36 2008
@@ -62,7 +62,7 @@
}
- die "we need source arg\n" unless $source;
+ confess "we need source arg\n" unless $source;
if ( $self->extra_tests ) {
$shipwright->backend->import(
@@ -86,7 +86,7 @@
$self->name($name);
}
if ( $self->name !~ /^[-.\w]+$/ ) {
- die
+ confess
qq{name can only have alphanumeric characters, "." and "-"\n};
}
}
@@ -158,7 +158,7 @@
move(
catfile( $source, '__require.yml' ),
catfile( $script_dir, 'require.yml' )
- ) or die "move __require.yml failed: $!\n";
+ ) or confess "move __require.yml failed: $!\n";
}
}
@@ -263,7 +263,7 @@
move(
catfile( $s, '__require.yml' ),
catfile( $script_dir, 'require.yml' )
- ) or die "move $s/__require.yml failed: $!\n";
+ ) or confess "move $s/__require.yml failed: $!\n";
}
$self->_generate_build( $s, $script_dir, $shipwright );
@@ -355,7 +355,7 @@
push @commands, 'clean: ';
}
- open my $fh, '>', catfile( $script_dir, 'build' ) or die $@;
+ open my $fh, '>', catfile( $script_dir, 'build' ) or confess $@;
print $fh $_, "\n" for @commands;
close $fh;
}
Modified: Shipwright/trunk/lib/Shipwright/Script/Ktf.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Ktf.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Ktf.pm Thu Aug 28 22:58:36 2008
@@ -21,7 +21,7 @@
my $self = shift;
my $name = shift;
- die "need name arg\n" unless $name;
+ confess "need name arg\n" unless $name;
my $shipwright = Shipwright->new( repository => $self->repository, );
Modified: Shipwright/trunk/lib/Shipwright/Script/Relocate.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Relocate.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Relocate.pm Thu Aug 28 22:58:36 2008
@@ -12,8 +12,8 @@
my $self = shift;
my ( $name, $new_source ) = @_;
- die "need name arg\n" unless $name;
- die "need source arg\n" unless $new_source;
+ confess "need name arg\n" unless $name;
+ confess "need source arg\n" unless $new_source;
my $shipwright = Shipwright->new(
repository => $self->repository,
Modified: Shipwright/trunk/lib/Shipwright/Script/Rename.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Rename.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Rename.pm Thu Aug 28 22:58:36 2008
@@ -15,17 +15,17 @@
my ( $name, $new_name ) = @_;
- die "need name arg\n" unless $name;
- die "need new-name arg\n" unless $new_name;
+ confess "need name arg\n" unless $name;
+ confess "need new-name arg\n" unless $new_name;
- die "invalid new-name: $new_name, should only contain - and alphanumeric\n"
+ confess "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;
- die "no such dist: $name\n" unless grep { $_ eq $name } @$order;
+ confess "no such dist: $name\n" unless grep { $_ eq $name } @$order;
$shipwright->backend->move(
path => "/sources/$name",
Modified: Shipwright/trunk/lib/Shipwright/Script/Update.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Update.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Update.pm Thu Aug 28 22:58:36 2008
@@ -44,7 +44,7 @@
}
else {
- die "need name arg\n" unless $name || $self->all;
+ confess "need name arg\n" unless $name || $self->all;
$map = $shipwright->backend->map || {};
$source = $shipwright->backend->source || {};
@@ -121,7 +121,7 @@
$name = $map->{$name};
}
else {
- die 'invalid name ' . $name . "\n";
+ confess 'invalid name ' . $name . "\n";
}
$shipwright->source(
Modified: Shipwright/trunk/lib/Shipwright/Source.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Source.pm Thu Aug 28 22:58:36 2008
@@ -22,7 +22,7 @@
$DEFAULT{branches_path} = catfile( $DEFAULT{directory}, 'branches.yml' );
for (qw/map_path url_path version_path branches_path/) {
- open my $fh, '>', $DEFAULT{$_} or die "can't write to $DEFAULT{$_}: $!";
+ open my $fh, '>', $DEFAULT{$_} or confess "can't write to $DEFAULT{$_}: $!";
close $fh;
}
Modified: Shipwright/trunk/lib/Shipwright/Source/Base.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/Base.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Source/Base.pm Thu Aug 28 22:58:36 2008
@@ -91,12 +91,12 @@
if ( -e 'Build.PL' ) {
Shipwright::Util->run( [ $^X, 'Build.PL' ] );
my $source = read_file( catfile( '_build', 'prereqs' ) )
- or die "can't read _build/prereqs: $!";
+ or confess "can't read _build/prereqs: $!";
my $eval = '$require = ' . $source;
- eval $eval or die "eval error: $@"; ## no critic
+ eval $eval or confess "eval error: $@"; ## no critic
$source = read_file( catfile('Build.PL') )
- or die "can't read Build.PL: $!";
+ or confess "can't read Build.PL: $!";
if ( $source =~ /Module::Build/
&& $self->name ne 'cpan-Module-Build' )
{
@@ -109,7 +109,7 @@
}
elsif ( -e 'Makefile.PL' ) {
my $makefile = read_file('Makefile.PL')
- or die "can't read Makefile.PL: $!";
+ or confess "can't read Makefile.PL: $!";
if ( $makefile =~ /inc::Module::Install/ ) {
@@ -199,8 +199,8 @@
Shipwright::Util->run( [ $^X, 'shipwright_makefile.pl' ] );
my $prereqs = read_file( catfile('shipwright_prereqs') )
- or die "can't read prereqs: $!";
- eval $prereqs or die "eval error: $@"; ## no critic
+ or confess "can't read prereqs: $!";
+ eval $prereqs or confess "eval error: $@"; ## no critic
Shipwright::Util->run( [ 'rm', 'shipwright_makefile.pl' ] );
Shipwright::Util->run( [ 'rm', 'shipwright_prereqs' ] );
@@ -213,7 +213,7 @@
if ( $source && $source =~ /({.*})/ ) {
my $eval .= '$require = ' . $1;
$eval =~ s/([\w:]+)=>/'$1'=>/g;
- eval $eval or die "eval error: $@"; ## no critic
+ eval $eval or confess "eval error: $@"; ## no critic
}
for ( keys %$require ) {
@@ -243,7 +243,7 @@
}
Shipwright::Util::DumpFile( $require_path, $require )
- or die "can't dump __require.yml: $!";
+ or confess "can't dump __require.yml: $!";
}
if ( my $require = Shipwright::Util::LoadFile($require_path) ) {
Modified: Shipwright/trunk/lib/Shipwright/Source/CPAN.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/CPAN.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Source/CPAN.pm Thu Aug 28 22:58:36 2008
@@ -72,7 +72,7 @@
$compressed->run(@_);
}
elsif ($self->source =~ /\S/) {
- die 'invalid source: ' . $self->source;
+ confess 'invalid source: ' . $self->source;
}
}
@@ -134,7 +134,7 @@
my $name = CPAN::DistnameInfo->new( $distribution->{ID} )->dist;
if ( $name eq 'perl' ) {
- die 'perl itself contains ' . $self->source . ', will not process';
+ confess 'perl itself contains ' . $self->source . ', will not process';
}
$distribution->get;
Modified: Shipwright/trunk/lib/Shipwright/Source/FTP.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/FTP.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Source/FTP.pm Thu Aug 28 22:58:36 2008
@@ -48,7 +48,7 @@
if ( $response->is_success ) {
open my $fh, '>', $self->source
- or die "can't open file " . $self->source . ": $!";
+ or confess "can't open file " . $self->source . ": $!";
print $fh $response->content;
}
else {
Modified: Shipwright/trunk/lib/Shipwright/Source/HTTP.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Source/HTTP.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Source/HTTP.pm Thu Aug 28 22:58:36 2008
@@ -48,7 +48,7 @@
if ( $response->is_success ) {
open my $fh, '>', $self->source
- or die "can't open file " . $self->source . ": $!";
+ or confess "can't open file " . $self->source . ": $!";
print $fh $response->content;
}
else {
Modified: Shipwright/trunk/lib/Shipwright/Test.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Test.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Test.pm Thu Aug 28 22:58:36 2008
@@ -3,6 +3,7 @@
use warnings;
use strict;
use base qw/Exporter/;
+use Carp;
use File::Temp qw/tempdir/;
use IPC::Cmd qw/can_run/;
@@ -88,7 +89,7 @@
sub create_svn_repo {
my $repo = tempdir( 'shipwright_XXXXXX', CLEANUP => 1, TMPDIR => 1 );
- system("svnadmin create $repo") && die "create repo failed: $!";
+ system("svnadmin create $repo") && confess "create repo failed: $!";
return "file://$repo";
}
Modified: Shipwright/trunk/lib/Shipwright/Util.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Util.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Util.pm Thu Aug 28 22:58:36 2008
@@ -70,7 +70,7 @@
$log->error(
'failed to run ' . join( ' ', @$cmd ) . " with exit number $?" );
unless ($ignore_failure) {
- die <<"EOF";
+ confess <<"EOF";
something wrong when execute @$cmd: $?
the output is: $out
the error is: $err
@@ -165,7 +165,7 @@
select $cpan_fh;
}
else {
- die "unknown type: $type";
+ confess "unknown type: $type";
}
}
Modified: Shipwright/trunk/share/bin/shipwright-builder
==============================================================================
--- Shipwright/trunk/share/bin/shipwright-builder (original)
+++ Shipwright/trunk/share/bin/shipwright-builder Thu Aug 28 22:58:36 2008
@@ -17,7 +17,7 @@
my %args;
-die "unknown option"
+confess "unknown option"
unless GetOptions(
\%args, 'install-base=s',
'perl=s', 'skip=s',
Modified: Shipwright/trunk/share/bin/shipwright-utility
==============================================================================
--- Shipwright/trunk/share/bin/shipwright-utility (original)
+++ Shipwright/trunk/share/bin/shipwright-utility Thu Aug 28 22:58:36 2008
@@ -5,10 +5,11 @@
use Getopt::Long;
use YAML::Syck;
use List::MoreUtils qw/uniq firstidx/;
+use Carp;
my %args;
-die "unknown option"
+confess "unknown option"
unless GetOptions( \%args, 'update-order', 'keep-requires=s',
'keep-recommends=s', 'keep-build-requires=s', 'for-dists=s', 'help', );
@@ -70,7 +71,7 @@
my $source = Algorithm::Dependency::Source::HoA->new($require);
$source->load();
my $dep = Algorithm::Dependency::Ordered->new( source => $source, )
- or die $@;
+ or confess $@;
my $order = $dep->schedule_all();
# fiddle the order a bit
Modified: Shipwright/trunk/share/etc/shipwright-utility
==============================================================================
--- Shipwright/trunk/share/etc/shipwright-utility (original)
+++ Shipwright/trunk/share/etc/shipwright-utility Thu Aug 28 22:58:36 2008
@@ -5,6 +5,7 @@
use Getopt::Long;
use File::Spec::Functions qw/catfile catdir/;
use Cwd;
+use Carp;
my %args;
GetOptions( \%args, 'install-links=s', 'help' );
@@ -31,7 +32,7 @@
for my $dir (qw/bin sbin libexec/) {
next unless -e $dir;
my $dh;
- opendir $dh, $dir or die $!;
+ opendir $dh, $dir or confess $!;
mkdir catfile( $args{'install-links'}, $dir )
unless -e catfile( $args{'install-links'}, $dir );
@@ -39,7 +40,7 @@
for (@files) {
next if $_ eq '.' || $_ eq '..';
symlink catfile( $cwd, $dir, $_ ),
- catfile( $args{'install-links'}, $dir, $_ ) or die
+ catfile( $args{'install-links'}, $dir, $_ ) or confess
$!;
}
}
More information about the Bps-public-commit
mailing list