File Coverage

blib/lib/SimpleFlow.pm

Criterion	Covered	Total	%
statement	166	213	77.9
branch	36	64	56.2
condition	15	20	75.0
subroutine	19	19	100.0
pod	0	2	0.0
total	236	318	74.2

use strict;
use warnings FATAL => 'all';
require 5.010;
use feature 'say';
use DDP {output => 'STDOUT', array_max => 10, show_memsize => 1};
use Devel::Confess 'color';
use Cwd 'getcwd';
package SimpleFlow;
our $VERSION = 0.12;
use Time::HiRes;
use Term::ANSIColor;
use Scalar::Util 'openhandle';
use DDP {output => 'STDOUT', array_max => 10, show_memsize => 1};
use Devel::Confess 'color';
use Cwd 'getcwd';
use warnings FATAL => 'all';
use Capture::Tiny 'capture';
use List::Util 'max';
use Exporter 'import';
our @EXPORT = qw(say2 task);
our @EXPORT_OK = @EXPORT;

sub say2 { # say to both command line and log file
	my ($msg, $fh) = @_;
	my $current_sub = (split(/::/,(caller(0))[3]))[-1]; # https://stackoverflow.com/questions/2559792/how-can-i-get-the-name-of-the-current-subroutine-in-perl
	my @c = caller;
	if (not openhandle($fh)) {
		die "the filehandle given to $current_sub with \"$msg\" from $c[1] line $c[2] isn't actually a filehandle";
	}
	$msg = "\@ $c[1] line $c[2] $msg";
	say $msg;
	say $fh $msg;
	return $msg;
}

sub task {
	my ($args) = @_;
	my $current_sub = (split(/::/,(caller(0))[3]))[-1];
	unless (ref $args eq 'HASH') {
		die "args must be given as a hash ref, e.g. \"$current_sub({ data => \@blah })\"";
	}
	my @c = caller;
	my @reqd_args = (
		'cmd', # the shell command
	);
	my @undef_args = grep { !defined $args->{$_}} @reqd_args;
	if (scalar @undef_args > 0) {
		p @undef_args;
		die 'the above args are necessary, but were not defined.';
	}
	my @defined_args = ( @reqd_args,
		'die',			  # die if not successful; 0 or 1
		'dry.run',       # dry run or not
		'input.files',   # check for input files; SCALAR or ARRAY
		'log.fh',
		'note',          # a note for the log
		'overwrite',     #
		'output.files'	  # product files that need to be checked; can be scalar or array
	);
	my @bad_args = grep { my $key = $_; not grep {$_ eq $key} @defined_args} keys %{ $args };
	if (scalar @bad_args > 0) {
		p @bad_args, array_max => scalar @bad_args;
		say "the above arguments are not recognized by $current_sub";
		p @defined_args, array_max => scalar @defined_args;
		die "The above args are accepted by $current_sub";
	}
	if (
			(defined $args->{'log.fh'}) &&
			(not openhandle($args->{'log.fh'}))
		) {
		p $args;
		die "the filehandle given to $current_sub isn't actually a filehandle";
	}
	my (%input_file_size, @existing_files, @output_files, @empty_filenames);
	if (defined $args->{'input.files'}) {
		my $ref = ref $args->{'input.files'};
		my @missing_files;
		if ($ref eq 'ARRAY') {
			@missing_files = grep {not -f -r $_ } @{ $args->{'input.files'} };
			%input_file_size = map { $_ => -s $_ } @{ $args->{'input.files'} };
			@empty_filenames = grep {length $_ == 0} @{ $args->{'input.files'} };
		} elsif ($ref eq '') { # scalar
			@missing_files = grep {not -f -r $_ } ($args->{'input.files'});
			%input_file_size = map { $_ => -s $_ } ($args->{'input.files'} );
			@empty_filenames = grep {(defined $_) && (length $_ == 0)} ($args->{'input.files'});
		} else {
			p $args;
			die 'ref type "' . $ref . '" is not allowed for "input.files"';
		}
		if (scalar @missing_files > 0) {
			say STDERR 'this list of arguments:';
			p $args;
			say STDERR 'Cannot run because these files are either missing or unreadable in: ' . getcwd();
			p @missing_files;
			die 'the above files are missing or are not readable';
		}
	}
	if (scalar @empty_filenames > 0) {
		p $args;
		die '0-length filenames are not allowed (found in "input.files")';
	}
	my $msg = "\@ $c[1] line $c[2] The command is:\n" . colored(['blue on_bright_red'], $args->{cmd});
	say $msg;
	say {$args->{'log.fh'}} "\@ $c[1] line $c[2] The command is:\n $args->{cmd})" if defined $args->{'log.fh'};
	if (defined $args->{'output.files'}) { # avoid "uninitialized value" warning
		my $ref = ref $args->{'output.files'};
		if ($ref eq 'ARRAY') {
			@output_files = @{ $args->{'output.files'} };
		} elsif ($ref eq '') { # a scalar
			@output_files = $args->{'output.files'};
		} else {
			p $args;
			die "$ref isn't allowed for \"output.files\"";
		}
	}
	@empty_filenames = grep {length $_ == 0} @output_files; # 0-length filenames aren't allowed
	if (scalar @empty_filenames > 0) {
		p $args;
		die '0-length filenames are not allowed (found in "output.files"';
	}
	if (scalar @output_files > 0) {
		@existing_files = grep {-f $_} @output_files;
	}
	my %r = (
		cmd            => $args->{cmd},
		dir				=> getcwd(),
		'source.file'  => $c[1],
		'source.line'  => $c[2],
		'output.files' => [@output_files],
	);
	$r{'die'}     = $args->{'die'}     // 1; # by default, true
	$r{'dry.run'} = $args->{'dry.run'} // 0; # by default, false
	$r{note}      = $args->{note}      // '';# by default, false
	$r{overwrite} = $args->{overwrite} // 0; # by default, false
	$r{'will.do'} = 'yes';
	$r{'will.do'} = 'no: dry run'  if $args->{'dry.run'};
	my $string_max = 0;
	if (defined $args->{'input.files'}) {
		$r{'input.files'} = $args->{'input.files'};
		$r{'input.file.size'} = \%input_file_size;
	}
	my %output_file_size = map {$_ => -s $_} @output_files;
	foreach my $val (grep {ref $r{$_} eq ''} keys %r) {
		$string_max = max($string_max, length $r{$val});
	}
	if ((!$args->{overwrite}) && (scalar @output_files > 0) && (scalar @existing_files == scalar @output_files)) { # this has been done before
		$r{done} = 'before';
		$r{'will.do'} = 'no';
		say colored(['black on_green'], "\"$args->{cmd}\"\n") . ' has been done before';
		$r{done} = 'before';
		$r{'output.file.size'} = \%output_file_size;
		p(%r, output => $args->{'log.fh'}, string_max => $string_max) if defined $args->{'log.fh'};
		$r{duration} = 0;
		p %r, string_max => $string_max;
		return \%r;
	} else {
		$r{done} = 'not yet';
	}
	if ($r{'dry.run'}) {
		say "\@ $c[1] line $c[2] in $r{dir} the command was going to be:";
		say colored(['red on_black'], "\"$args->{cmd}\"");
		say 'But this is a dry run';
		say '-------------';
		$r{duration} = 0;
		return \%r;
	}
	my $t0 = Time::HiRes::time();
	($r{stdout}, $r{stderr}, $r{'exit'}) = capture {
		system( $args->{cmd} );
	};
	my $t1 = Time::HiRes::time();
	$r{duration} = $t1-$t0;
	$r{'exit'} = $r{'exit'} >> 8;
	foreach my $std ('stderr', 'stdout') {
		$r{$std} =~ s/\s+$//; # remove trailing whitespace/newline
		$string_max = max($string_max, length $r{$std});
	}
	$r{signal} = $r{'exit'} & 127;# Useful to see if it was killed by signal 9 or 15
	$r{done} = 'now';
	$r{'will.do'} = 'done';
	my @missing_output_files = grep {not -f -r $_} @output_files;
	if (scalar @missing_output_files > 0) {
		$r{'will.do'} = 'FAILED';
		say STDERR "this input to $current_sub:";
		p $args;
		say {$args->{'log.fh'}} "this input to $current_sub:" if defined $args->{'log.fh'};
		p($args, output => $args->{'log.fh'}, string_max => $string_max) if defined $args->{'log.fh'};
		say STDERR 'has these output files missing:';
		say {$args->{'log.fh'}} 'has these output files missing:' if defined $args->{'log.fh'};
		p @missing_output_files;
		p(@missing_output_files, output => $args->{'log.fh'}, string_max => $string_max) if defined $args->{'log.fh'};
		p %r, string_max => $string_max;
		p(%r, output => $args->{'log.fh'}, string_max => $string_max) if defined $args->{'log.fh'};
		if ($args->{'die'}) {
			die 'those above files should have been made but are missing';
		} else {
			say STDERR 'those above files should have been made but are missing';
		}
	}
	%output_file_size = map {$_ => -s $_} @output_files;
	$r{'output.file.size'} = \%output_file_size;
#	p %output_file_size;
	my @files_with_zero_size = grep { $output_file_size{$_} == 0} @output_files;
	if (scalar @files_with_zero_size > 0) {
		p @files_with_zero_size;
		warn 'the above output files have 0 size.';
	}
	p(%r, output => $args->{'log.fh'}) if defined $args->{'log.fh'};
	if (($r{'die'}) && ($r{'exit'} != 0)) {
		$r{'will.do'} = 'FAILED';
		p %r, string_max => $string_max;
		die "\"$args->{cmd}\" failed from $c[1] line $c[2]"
	}
	p %r, string_max => $string_max;
	return \%r;
}
1;
__END__