[libmoosex-has-sugar-perl] 22/120: Reimplement all calls to system in a safe wrapper
Intrigeri
intrigeri at moszumanska.debian.org
Wed Aug 27 21:35:07 UTC 2014
This is an automated email from the git hooks/post-receive script.
intrigeri pushed a commit to annotated tag 0.05070422-source
in repository libmoosex-has-sugar-perl.
commit f3c91b56ad2e43c6399650f85d89aa02a5a1987e
Author: Kent Fredric <kentfredric at gmail.com>
Date: Mon Oct 21 02:26:16 2013 +1300
Reimplement all calls to system in a safe wrapper
---
before_script.pl | 11 +++++++++--
install_deps.pl | 11 +++++++++--
script.pl | 11 +++++++++--
sterilize_env.pl | 34 ++++++++++++++++++++++++++--------
sync_tree.pl | 25 ++++++++++++++++++++++++-
5 files changed, 77 insertions(+), 15 deletions(-)
diff --git a/before_script.pl b/before_script.pl
index 4809820..f7d63f7 100644
--- a/before_script.pl
+++ b/before_script.pl
@@ -12,8 +12,15 @@ sub safe_exec {
diag("running $command @params");
my $exit = system( $command, @params );
if ( $exit != 0 ) {
- warn "$command failed: $? $!";
- exit $exit;
+ my $low = $exit & 0b11111111;
+ my $high = $exit >> 8;
+ warn "$command failed: $? $! and exit = $high , flags = $low";
+ if ( $high != 0 ) {
+ exit $high;
+ }
+ else {
+ exit 1;
+ }
}
return 1;
}
diff --git a/install_deps.pl b/install_deps.pl
index d11d333..d569918 100644
--- a/install_deps.pl
+++ b/install_deps.pl
@@ -12,8 +12,15 @@ sub safe_exec {
diag("running $command @params");
my $exit = system( $command, @params );
if ( $exit != 0 ) {
- warn "$command failed: $? $!";
- exit $exit;
+ my $low = $exit & 0b11111111;
+ my $high = $exit >> 8;
+ warn "$command failed: $? $! and exit = $high , flags = $low";
+ if ( $high != 0 ) {
+ exit $high;
+ }
+ else {
+ exit 1;
+ }
}
return 1;
}
diff --git a/script.pl b/script.pl
index 7e62d78..202c039 100644
--- a/script.pl
+++ b/script.pl
@@ -13,8 +13,15 @@ sub safe_exec {
diag("running $command @params");
my $exit = system( $command, @params );
if ( $exit != 0 ) {
- warn "$command failed: $? $!";
- exit $exit;
+ my $low = $exit & 0b11111111;
+ my $high = $exit >> 8;
+ warn "$command failed: $? $! and exit = $high , flags = $low";
+ if ( $high != 0 ) {
+ exit $high;
+ }
+ else {
+ exit 1;
+ }
}
return 1;
}
diff --git a/sterilize_env.pl b/sterilize_env.pl
index df4c9de..76887b1 100644
--- a/sterilize_env.pl
+++ b/sterilize_env.pl
@@ -4,8 +4,26 @@ use warnings;
use utf8;
sub diag {
- print STDERR @_;
- print STDERR "\n";
+ print STDERR @_;
+ print STDERR "\n";
+}
+
+sub safe_exec {
+ my ( $command, @params ) = @_;
+ diag("running $command @params");
+ my $exit = system( $command, @params );
+ if ( $exit != 0 ) {
+ my $low = $exit & 0b11111111;
+ my $high = $exit >> 8;
+ warn "$command failed: $? $! and exit = $high , flags = $low";
+ if ( $high != 0 ) {
+ exit $high;
+ }
+ else {
+ exit 1;
+ }
+ }
+ return 1;
}
if ( not exists $ENV{STERILIZE_ENV} ) {
@@ -21,11 +39,11 @@ if ( not exists $ENV{TRAVIS} ) {
exit 1;
}
for my $i (@INC) {
- next if $i !~ /site/;
- next if $i eq '.';
- diag( 'Sterilizing files in ' . $i );
- system( 'find', $i, '-type', 'f', '-delete' );
- diag( 'Sterilizing dirs in ' . $i );
- system( 'find', $i, '-depth', '-type', 'd', '-delete' );
+ next if $i !~ /site/;
+ next if $i eq '.';
+ diag( 'Sterilizing files in ' . $i );
+ safe_exec( 'find', $i, '-type', 'f', '-delete' );
+ diag( 'Sterilizing dirs in ' . $i );
+ safe_exec( 'find', $i, '-depth', '-type', 'd', '-delete' );
}
diff --git a/sync_tree.pl b/sync_tree.pl
index 542d325..98167a3 100755
--- a/sync_tree.pl
+++ b/sync_tree.pl
@@ -8,8 +8,31 @@ my $root = find_dev('./');
chdir "$root";
+sub diag {
+ print STDERR @_;
+ print STDERR "\n";
+}
+
+sub safe_exec {
+ my ( $command, @params ) = @_;
+ diag("running $command @params");
+ my $exit = system( $command, @params );
+ if ( $exit != 0 ) {
+ my $low = $exit & 0b11111111;
+ my $high = $exit >> 8;
+ warn "$command failed: $? $! and exit = $high , flags = $low";
+ if ( $high != 0 ) {
+ exit $high;
+ }
+ else {
+ exit 1;
+ }
+ }
+ return 1;
+}
+
sub git_subtree {
- system( 'git', 'subtree', @_ ) == 0 or die "Git subtree had nonzero exit";
+ safe_exec( 'git', 'subtree', @_ );
}
my $travis = 'https://github.com/kentfredric/travis-scripts.git';
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmoosex-has-sugar-perl.git
More information about the Pkg-perl-cvs-commits
mailing list