File Coverage

blib/lib/Devel/System.pm

Criterion	Covered	Total	%
statement	18	18	100.0
branch	6	6	100.0
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	29	29	100.0

use strict;
package Devel::System;
use String::ShellQuote qw( shell_quote );
use Carp qw( croak );
our $VERSION = '0.01';

=head1 NAME

Devel::System - intercept calls to C to add extra diagnostics

=head1 SYNOPSIS

  use Devel::System;
  $Devel::System::dry_run = 1; # don't really do it

  system qw( rm -rf / );

or from the command line:

  perl -MDevel::System=dry_run -e'system qw( rm -rf / )'

=head1 DESCRIPTION

Devel::System hooks the system builtin to add diagnostic output about
what system calls are being made.  It's like the -x switch for /bin/sh
all over again.

=head2 Variables

The behaviour of the substitued C builtin can be swayed by the
following package variables in the C namespace

=over

=item $dry_run

Don't actually perform the command. Always returns $return

=cut

our $dry_run;


=item $return

The return value to use when $dry_run is active.  Defaults to 0

=cut

our $return = 0;


=item $fh

The filehandle to print the diagnostics to.  Defaults to \*STDERR

=back

=cut

our $fh = \*STDERR;

*CORE::GLOBAL::system = sub {
    print $fh "+ ", @_ > 1 ? shell_quote(@_) : @_, "\n";
    return $return if $dry_run;

    return CORE::system @_;
};


=head2 Options

In addition there are the following import symbols that you can use to
set options from the commands line.

=over

=item dry_run

Sets $dry_run to a true value.

=back

=cut


sub import {
    my $class = shift;
    for (@_) {
        /^dry_run$/ and do { $dry_run = 1; next };
        croak "unknown option '$_'";
    }
}

1;
__END__