Skip Menu |
 
rt.cpan.org will be shut down on March 1st, 2021.

This queue is for tickets about the Devel-System CPAN distribution.

Report information
The Basics
Id: 30055
Status: new
Priority: 0/
Queue: Devel-System

People
Owner: Nobody in particular
Requestors: jozef [...] kutej.net
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: 0.01
Fixed in: (no value)

Attachments


Subject: patch to add more usefull (?) flags
Download (untitled) / with headers
text/plain 431b
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 '$_'"; } }


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.