File Coverage

blib/lib/App/Run/Command/ToFail.pm

Criterion	Covered	Total	%
statement	48	49	97.9
branch	11	12	91.6
condition	3	3	100.0
subroutine	6	6	100.0
pod	2	2	100.0
total	70	72	97.2

package App::Run::Command::ToFail;

use strict;
use warnings;

use Getopt::Std;
use Readonly;

Readonly::Hash our %PRESETS => (
	'blank' => [
		0,
		'',
	],
	'perl' => [
		1,
		'perl %s',
	],
	'strace_perl' => [
		1,
		'strace -ostrace.log -esignal,write perl -Ilib %s',
	],
);

our $VERSION = 0.05;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Object.
	return $self;
}

# Run.
sub run {
	my $self = shift;

	# Process arguments.
	$self->{'_opts'} = {
		'h' => 0,
		'l' => 0,
		'n' => 100,
		'p' => 'perl',
	};
	if (! getopts('hln:p:', $self->{'_opts'}) || $self->{'_opts'}->{'h'}) {
		print STDERR "Usage: $0 [-h] [-l] [-n cycles] [-p preset] [--version]\n";
		print STDERR "\t-h\t\tPrint help.\n";
		print STDERR "\t-l\t\tList presets.\n";
		print STDERR "\t-n cycles\tNumber of cycles (default is 100).\n";
		print STDERR "\t-p preset\tPreset for run (default is perl).\n";
		print STDERR "\t--version\tPrint version.\n";
		return 1;
	}

	if ($self->{'_opts'}->{'l'}) {
		foreach my $key (sort keys %PRESETS) {
			print $key.': '.$PRESETS{$key}[1]."\n";
		}
		return 0;
	}

	# Check presets.
	if (! exists $PRESETS{$self->{'_opts'}->{'p'}}) {
		print STDERR 'Bad preset. Possible values are \''.(join "', '", (sort keys %PRESETS))."'.\n";
		return 1;
	}

	if ($PRESETS{$self->{'_opts'}->{'p'}}[0] > @ARGV) {
		print STDERR 'Wrong number of arguments (need '.$PRESETS{$self->{'_opts'}->{'p'}}[0].
			" for command '".$PRESETS{$self->{'_opts'}->{'p'}}[1]."').\n";
		return 1;
	}

	my @preset_args;
	my @other_args;
	for (my $i = 0; $i < @ARGV; $i++) {
		if ($i + 1 <= $PRESETS{$self->{'_opts'}->{'p'}}[0]) {
			push @preset_args, $ARGV[$i];
		} else {
			push @other_args, $ARGV[$i];
		}
	}
	my $command = sprintf $PRESETS{$self->{'_opts'}->{'p'}}[1], @preset_args;
	$command .= ' '.(join ' ', @other_args);
	foreach my $i (1 .. $self->{'_opts'}->{'n'}) {
		my $ret = system $command;
        	if ($ret > 1) {
                	print STDERR "Exited in $i round with exit code $ret.\n";
                	return 1;
        	}
	}
	print "Everything is ok.\n";

	return 0;
}

1;

__END__