[lintian] 02/04: Rewrite rundir into a run_cmd and move it to L::Util
This is an automated email from the git hooks/post-receive script.
nthykier pushed a commit to branch master
in repository lintian.
commit 79c937a04638ef8f80927e212b5dcdab0681c8a8
Author: Niels Thykier <niels@thykier.net>
Date: Thu Apr 20 10:05:50 2017 +0000
Rewrite rundir into a run_cmd and move it to L::Util
Signed-off-by: Niels Thykier <niels@thykier.net>
---
commands/reporting-html-reports.pm | 11 ++--
lib/Lintian/Command/Simple.pm | 50 +++-------------
lib/Lintian/Util.pm | 90 +++++++++++++++++++++++++++++
t/scripts/Lintian/Command/Simple/01-basic.t | 9 ---
t/scripts/Lintian/Util/run_cmd.t | 25 ++++++++
5 files changed, 128 insertions(+), 57 deletions(-)
diff --git a/commands/reporting-html-reports.pm b/commands/reporting-html-reports.pm
index 8fca975..4d02415 100644
--- a/commands/reporting-html-reports.pm
+++ b/commands/reporting-html-reports.pm
@@ -34,14 +34,13 @@ use URI::Escape;
use Text::Template ();
use Lintian::Command qw(safe_qx spawn);
-use Lintian::Command::Simple qw(rundir);
use Lintian::Data;
use Lintian::Internal::FrontendUtil qw(split_tag);
use Lintian::Profile;
use Lintian::Relation::Version qw(versions_comparator);
use Lintian::Reporting::ResourceManager;
use Lintian::Util qw(read_dpkg_control slurp_entire_file load_state_cache
- find_backlog copy_dir delete_dir);
+ find_backlog copy_dir delete_dir run_cmd);
# ------------------------------
# Global variables and configuration
@@ -626,9 +625,8 @@ sub update_history_and_make_graphs {
close($common);
print "Plotting global statistics...\n";
- rundir($graph_dir, 'gnuplot',
- "$LINTIAN_ROOT/reporting/graphs/statistics.gpi") == 0
- or die "gnuplot died with $?\n";
+ run_cmd({ 'chdir' => $graph_dir},
+ 'gnuplot',"$LINTIAN_ROOT/reporting/graphs/statistics.gpi");
$RESOURCE_MANAGER->install_resource("${graph_dir}/statistics.svg");
}
@@ -655,8 +653,7 @@ sub update_history_and_make_graphs {
if ($GRAPHS) {
close($gnuplot_fd);
- rundir($graph_dir, 'gnuplot', 'call.gpi') == 0
- or die("gnuplot died with $?\n");
+ run_cmd({'chdir' => $graph_dir}, 'gnuplot', 'call.gpi');
unlink($commonf);
for my $tag (sort(keys(%{$tag_statistics_ref}))) {
my $graph_file = "${graph_dir}/tags/${tag}.svg";
diff --git a/lib/Lintian/Command/Simple.pm b/lib/Lintian/Command/Simple.pm
index 2d7f2cd..b957b06 100644
--- a/lib/Lintian/Command/Simple.pm
+++ b/lib/Lintian/Command/Simple.pm
@@ -17,14 +17,11 @@ package Lintian::Command::Simple;
use strict;
use warnings;
-use autodie qw(open close chdir);
use Exporter qw(import);
use POSIX qw(:sys_wait_h);
-use Lintian::Util qw(do_fork);
-
-our @EXPORT_OK = qw(rundir wait_any kill_all);
+our @EXPORT_OK = qw(wait_any kill_all);
=head1 NAME
@@ -32,9 +29,15 @@ Lintian::Command::Simple - Run commands without pipes
=head1 SYNOPSIS
- use Lintian::Command::Simple qw(rundir);
+ use Lintian::Command::Simple qw(wait_any);
+
+ my %pid_info;
+ my $pid = fork() // die("fork: $!");
+ exec('do', 'something') if $pid == 0;
+ $pid_info{$pid} = "A useful value associated with $pid";
- rundir('./some-dir/', 'echo', 'hello world');
+ my ($termiated_pid, $value) = wait_any(\%pid_info);
+ ...;
=head1 DESCRIPTION
@@ -47,41 +50,6 @@ If you want to pipe to/from Perl, look at Lintian::Command instead.
=over 4
-=item rundir(dir, command, argument [, ...])
-
-Executes the given C<command> with the given arguments and in C<dir>
-returns the status code as one would see it from a shell script.
-
-Being fair, the only advantage of this function over the
-CORE::system() function is the way the return status is reported
-and the chdir support.
-
-=cut
-
-sub rundir {
- my $pid;
- my $res;
-
- $pid = do_fork();
- if (not defined($pid)) {
- # failed
- $res = -1;
- } elsif ($pid > 0) {
- # parent
- waitpid($pid, 0);
- $res = $? >> 8;
- } else {
- # child
- my $dir = shift;
- close(STDIN);
- open(STDIN, '<', '/dev/null');
- chdir($dir);
- CORE::exec @_ or die("Failed to exec '$_[0]': $!\n");
- }
-
- return $res;
-}
-
=item wait_any (hashref[, nohang])
When starting multiple processes asynchronously, it is common to wait
diff --git a/lib/Lintian/Util.pm b/lib/Lintian/Util.pm
index 9bc2842..d8caad4 100644
--- a/lib/Lintian/Util.pm
+++ b/lib/Lintian/Util.pm
@@ -65,6 +65,7 @@ BEGIN {
is_string_utf8_encoded
fail
do_fork
+ run_cmd
strip
lstrip
rstrip
@@ -1007,6 +1008,95 @@ sub perm2oct {
return $o;
}
+=item run_cmd([OPTS, ]COMMAND[, ARGS...])
+
+Executes the given C<COMMAND> with the (optional) arguments C<ARGS> and
+returns the status code as one would see it from a shell script. Shell
+features cannot be used.
+
+OPTS, if given, is a hash reference with zero or more of the following key-value pairs:
+
+=over 4
+
+=item chdir
+
+The child process with chdir to the given directory before executing the command.
+
+=item in
+
+The STDIN of the child process will be reopened and read from the filename denoted by the value of this key.
+By default, STDIN will reopened to read from /dev/null.
+
+=item out
+
+The STDOUT of the child process will be reopened and write to filename denoted by the value of this key.
+By default, STDOUT is discarded.
+
+=item update-env-vars
+
+Each key/value pair defined in the hashref associated with B<update-env-vars> will be updated in the
+child processes's environment. If a value is C<undef>, then the corresponding environment variable
+will be removed (if set). Otherwise, the environment value will be set to that value.
+
+=back
+
+=cut
+
+sub run_cmd {
+ my (@cmd_args) = @_;
+ my ($opts, $pid);
+ if (ref($cmd_args[0]) eq 'HASH') {
+ $opts = shift(@cmd_args);
+ } else {
+ $opts = {};
+ }
+ $pid = do_fork();
+ if (not defined($pid)) {
+ # failed
+ die("fork failed: $!\n");
+ } elsif ($pid > 0) {
+ # parent
+ waitpid($pid, 0);
+ if ($?) {
+ my $exit_code = ($? >> 8) & 0xff;
+ my $signal = $? & 0x7f;
+ my $cmd = join(' ', @cmd_args);
+ if ($exit_code) {
+ die("Command $cmd returned: $exit_code\n");
+ } else {
+ my $signame = signal_number2name($signal);
+ die("Command $cmd received signal: $signame ($signal)\n");
+ }
+ }
+ } else {
+ # child
+ if (defined(my $env = $opts->{'update-env-vars'})) {
+ while (my ($k, $v) = each(%{$env})) {
+ if (defined($v)) {
+ $ENV{$k} = $v;
+ } else {
+ delete($ENV{$k});
+ }
+ }
+ }
+ if ($opts->{'in'}) {
+ open(STDIN, '<', $opts->{'in'});
+ } else {
+ open(STDIN, '<', '/dev/null');
+ }
+ if ($opts->{'out'}) {
+ open(STDOUT, '>', $opts->{'out'});
+ } else {
+ open(STDOUT, '>', '/dev/null');
+ }
+ chdir($opts->{'chdir'}) if $opts->{'chdir'};
+ # Avoid shell evaluation.
+ CORE::exec {$cmd_args[0]} @cmd_args
+ or die("Failed to exec '$_[0]': $!\n");
+ }
+ return 1;
+}
+
=item delete_dir (ARGS)
Convenient way of calling I<rm -fr ARGS>.
diff --git a/t/scripts/Lintian/Command/Simple/01-basic.t b/t/scripts/Lintian/Command/Simple/01-basic.t
deleted file mode 100755
index 9df83ff..0000000
--- a/t/scripts/Lintian/Command/Simple/01-basic.t
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More tests => 2;
-
-BEGIN { use_ok('Lintian::Command::Simple', 'rundir'); }
-
-is(rundir('/bin', './true'), 0, 'Basic run (cd /bin && ./true)');
diff --git a/t/scripts/Lintian/Util/run_cmd.t b/t/scripts/Lintian/Util/run_cmd.t
new file mode 100644
index 0000000..14971c1
--- /dev/null
+++ b/t/scripts/Lintian/Util/run_cmd.t
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+BEGIN { use_ok('Lintian::Util', qw(run_cmd)); }
+
+eval {run_cmd('/bin/true');};
+is($@, '', 'Basic run (/bin/true)');
+
+eval {run_cmd('true');};
+is($@, '', 'Basic run (true using PATH)');
+
+eval {run_cmd({ 'chdir' => '/bin' }, './true');};
+is($@, '', 'Basic run (cd /bin && ./true)');
+
+eval {
+ run_cmd({ 'update-env-vars' => { 'FOO' => 'bar', } },
+ $^X, '-e', '$ENV{"FOO"} eq "bar" or die("ENV passing failed");');
+};
+is($@, '', "Basic run with env ($^X)");
+
+eval {run_cmd({ 'out' => '/dev/null' }, 'true');};
+is($@, '', 'Basic run STDOUT redirect (true)');
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/lintian/lintian.git
Reply to: