[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