| Subject: | patch to add more usefull (?) flags |
Hello!
I would be happy if you will add this patch that i have attached to the
Devel::System 0.02.
Changes:
two more flags: fatal, -debug
-debug turns off the system command output to $fh
fatal will make the system croak if the exit status is non zero
Also introduced the IN_DEBUG_MODE environmental variable to turn on the
debug if set. Usefull with -debug flag.
Previous functionality is not affected.
Thank you.
Jozef.
| Subject: | jozef_Devel-System_changes.patch |
==== Patch <jozef_Devel-System_changes> level 2
Source: dfa55e2f-883f-4ff8-bd5d-e8d0412f706a:/local/cpan/Devel-System:184 [local]
Target: b0c1b02c-7ba7-4df7-b273-855bf36df2ab:/cpan/not-mine/Devel-System/trunk:180 [mirrored]
(https://cle.sk/repos/pub)
Log:
r182@ant: jk | 2007-10-17 11:16:54 +0200
copy Devel-System to local
r183@ant: jk | 2007-10-17 12:54:54 +0200
-debug & fatal flags, IN_DEBUG_MODE env option added, tests
r184@ant: jk | 2007-10-17 13:10:56 +0200
fixed the test for the change of die -> croak
=== t/system.t
==================================================================
--- t/system.t (revision 180)
+++ t/system.t (patch jozef_Devel-System_changes level 2)
@@ -1,7 +1,8 @@
#!perl -w
use strict;
-use Test::More tests => 8;
+use Test::More tests => 12;
use IO::Scalar;
+use English '-no_match_vars';
BEGIN { use_ok('Devel::System') }
my $out;
@@ -32,3 +33,30 @@
eval { Devel::System->import('bogus') };
like( $@, qr/^unknown option 'bogus'/, "bogus import croaked" );
+
+###
+# v 0.02 changes tests
+
+# no output without debug
+Devel::System->import('-debug', 'dry_run');
+$out = '';
+system 'foo', 'bar baz';
+is( $out, '', "with -debug no output" );
+
+# with env set we should have the output
+$ENV{'IN_DEBUG_MODE'} = 1;
+system 'foo', 'bar baz';
+is( $out, "+ foo 'bar baz'\n", "with IN_DEBUG_MODE output again" );
+
+# make the system call fatal if failed
+Devel::System->import('fatal');
+eval { system("$^X -e'exit 1'") };
+like($EVAL_ERROR, qr'^exit status code: 1', 'the program should die after system with exit status 1');
+
+# with exist status 0 we should be fine
+eval { system("$^X -e'exit 0'") };
+is($EVAL_ERROR, '', 'no error with existatus 0');
+
+
+
+
=== lib/Devel/System.pm
==================================================================
--- lib/Devel/System.pm (revision 180)
+++ lib/Devel/System.pm (patch jozef_Devel-System_changes level 2)
@@ -1,9 +1,14 @@
+package Devel::System;
+
use strict;
-package Devel::System;
+use warnings;
+
use String::ShellQuote qw( shell_quote );
use Carp qw( croak );
-our $VERSION = '0.01';
+our $VERSION = '0.02';
+
+
=head1 NAME
Devel::System - intercept calls to C<system> to add extra diagnostics
@@ -15,6 +20,14 @@
system qw( rm -rf / );
+or
+
+ use Devel::System qw(
+ dry_run
+ fatal
+ -debug
+ );
+
or from the command line:
perl -MDevel::System=dry_run -e'system qw( rm -rf / )'
@@ -32,39 +45,55 @@
=over
-=item $dry_run
-
-Don't actually perform the command. Always returns $return
-
=cut
our $dry_run;
+our $return;
+our $debug;
+our $fatal;
+=item $dry_run
+Don't actually perform the command. Always returns $return
+
=item $return
The return value to use when $dry_run is active. Defaults to 0
-=cut
+=item $fh
-our $return = 0;
+The filehandle to print the diagnostics to. Defaults to \*STDERR
+=item $debug
-=item $fh
+Print additional debug information. On by default. '-debug' flag turns it off.
-The filehandle to print the diagnostics to. Defaults to \*STDERR
+Debugging information will be printed -
-=back
+ if ($debug or $ENV{'IN_DEBUG_MODE'})
+So you can start with '-debug' flag and control if to print debug or not by IN_DEBUG_MODE
+environmental flag.
+
+=item $fatal
+
+If turned on any system return code other than 0 will execute "die" afterwards.
+This will help to build perl scripts that execute chained system calls.
+
=cut
+
our $fh = \*STDERR;
*CORE::GLOBAL::system = sub {
- print $fh "+ ", @_ > 1 ? shell_quote(@_) : @_, "\n";
+ print $fh "+ ", @_ > 1 ? shell_quote(@_) : @_, "\n"
+ if ($debug or $ENV{'IN_DEBUG_MODE'});
return $return if $dry_run;
- return CORE::system @_;
+ my $status_code = CORE::system @_;
+ croak 'exit status code: '.($status_code >> 8) if ($fatal && ($status_code != 0));
+
+ return $status_code;
};
@@ -79,15 +108,31 @@
Sets $dry_run to a true value.
+=item -debug
+
+Turn off debugging output. That is shell like -x command printing.
+
+=item fatal
+
+Make the program die after some system call exits with status different
+than 0.
+
=back
=cut
sub import {
+ $dry_run = 0;
+ $return = 0;
+ $debug = 1;
+ $fatal = 0;
+
my $class = shift;
for (@_) {
/^dry_run$/ and do { $dry_run = 1; next };
+ /^-debug$/ and do { $debug = 0; next };
+ /^fatal$/ and do { $fatal = 1; next };
croak "unknown option '$_'";
}
}