File Coverage

blib/lib/App/Pod/Example.pm

Criterion	Covered	Total	%
statement	89	89	100.0
branch	18	18	100.0
condition	7	9	77.7
subroutine	13	13	100.0
pod	2	2	100.0
total	129	131	98.4

package App::Pod::Example;

use strict;
use warnings;

use Class::Utils qw(set_params);
use English qw(-no_match_vars);
use Error::Pure qw(err);
use File::Temp qw(tempfile);
use Getopt::Std;
use IO::Barf qw(barf);
use Pod::Example qw(get);
use Readonly;

# Constants.
Readonly::Scalar my $DASH => q{-};
Readonly::Scalar my $EMPTY_STR => q{};
Readonly::Scalar my $HASH => q{#};
Readonly::Scalar my $SPACE => q{ };

our $VERSION = 0.20;

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

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

	# Process params.
	set_params($self, @params);

	# Object.
	return $self;
}

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

	# Process arguments.
	$self->{'_opts'} = {
		'd' => 0,
		'h' => 0,
		'e' => 0,
		'n' => undef,
		'p' => 0,
		'r' => 0,
		's' => 'EXAMPLE',
	};
	if (! getopts('d:ehn:prs:', $self->{'_opts'}) || @ARGV < 1
		|| $self->{'_opts'}->{'h'}) {

		print STDERR "Usage: $0 [-d flag] [-e] [-h] [-n number] ".
			"[-p] [-r]\n\t[-s section] [--version] ".
			"pod_file_or_module [argument ..]\n\n";
		print STDERR "\t-d flag\t\tTurn debug (0/1) (default is 1).\n";
		print STDERR "\t-e\t\tEnumerate lines. Only for print mode.\n";
		print STDERR "\t-h\t\tHelp.\n";
		print STDERR "\t-n number\tNumber of example (default is ".
			"nothing).\n";
		print STDERR "\t-p\t\tPrint example.\n";
		print STDERR "\t-r\t\tRun example.\n";
		print STDERR "\t-s section\tUse section (default EXAMPLE).\n";
		print STDERR "\t--version\tPrint version.\n";
		return 1;
	}
	$self->{'_pod_file_or_module'} = shift @ARGV;
	$self->{'_args'} = \@ARGV;
	$self->{'_debug'} = $self->{'_opts'}->{'d'};
	$self->{'_enumerate'} = $self->{'_opts'}->{'e'};
	$self->{'_number'} = $self->{'_opts'}->{'n'};
	$self->{'_print'} = $self->{'_opts'}->{'p'};
	$self->{'_run'} = $self->{'_opts'}->{'r'};
	$self->{'_section'} = $self->{'_opts'}->{'s'};

	# No action.
	if (! $self->{'_print'} && ! $self->{'_run'}) {
		err 'Cannot process any action (-p or -r options).';
	}

	# Get example code.
	my $code = get($self->{'_pod_file_or_module'}, $self->{'_section'}, $self->{'_number'});

	# No code.
	if (! defined $code) {
		print "No code.\n";
		return 0;
	}

	# Print.
	if ($self->{'_print'}) {
		if ($self->{'_debug'}) {
			_debug('Example source');
		}
		if ($self->{'_enumerate'}) {
			my @lines = split "\n", $code;
			my $count = 1;
			foreach my $line (@lines) {
				print $count.': '.$line."\n";
				$count++;
			}
		} else {
			print $code."\n";
		}
	}

	# Run.
	if ($self->{'_run'}) {
		if ($self->{'_debug'}) {
			_debug('Example output');
		}
		my (undef, $tempfile) = tempfile();
		barf($tempfile, $code);
		my $args = $EMPTY_STR;
		if (@{$self->{'_args'}}) {
			$args = '"'.(join '" "', @{$self->{'_args'}}).'"';
		}
		system "$EXECUTABLE_NAME $tempfile $args";
		unlink $tempfile;
	}

	return 0;
}

sub _debug {
	my $text = shift;
	print $HASH, $DASH x 79, "\n";
	print $HASH, $SPACE, $text."\n";
	print $HASH, $DASH x 79, "\n";
	return;
}

1;

__END__