File Coverage

blib/lib/Getopt/Config/FromPod.pm

Criterion	Covered	Total	%
statement	77	81	95.0
branch	20	26	76.9
condition	15	25	60.0
subroutine	18	18	100.0
pod	6	6	100.0
total	136	156	87.1

package Getopt::Config::FromPod;

use strict;
use warnings;

# ABSTRACT: Extract getopt configuration from POD
our $VERSION = 'v0.0.4'; # VERSION

package Getopt::Config::FromPod::Extractor;

use strict;
use warnings;

use parent qw(Pod::Simple);

sub new
{
	my ($ref, %args) = @_;
	my $class = ref $ref || $ref;
	my $self = bless Pod::Simple::new($class, %args), $class;
	my $tag = $args{-tag} || 'getopt';
	$self->{_TAG} = $tag;
	$self->accept_targets($tag);
	return $self;
}

sub _handle_element_start
{
	my ($parser, $element_name, $attr) = @_;
	if($element_name eq 'Document') {
		$parser->{_RESULT} = [];
	}
	if(($element_name eq 'for' || $element_name eq 'begin') && $attr->{target} eq $parser->{_TAG}) {
		$parser->{_IN_TARGET} = 1;
	}
}

sub _handle_element_end
{
	my ($parser, $element_name, $attr) = @_;
	if($element_name eq 'for' || ($element_name eq 'end' && $attr->{target} eq $parser->{_TAG})) {
		$parser->{_IN_TARGET} = 0;
	}
}

sub _handle_text
{
	my ($parser, $text) = @_;
	push @{$parser->{_RESULT}}, eval $text if $parser->{_IN_TARGET}; ## no critic (ProhibitStringyEval)
}

package Getopt::Config::FromPod;

use Carp;

sub new
{
	my $self = shift;
	my $class = ref $self || $self;
	return bless { _ARG => \@_ }, $class;
}

sub _extract
{
	my ($self, %args) = @_;
	%args = (@{$self->{_ARG}}, %args);
	my $parser = Getopt::Config::FromPod::Extractor->new(%args);
	my $file = $args{-file};
	$args{-package} ||= 'main';
	if(! defined $file) {
		my $idx = 0;
		my @caller;
		while(@caller = caller($idx++)) {
			if($caller[0] eq $args{-package}) {
				$file = $caller[1];
				last;
			}
		}
		confess "Target module not found" if ! defined $file;
		# At least, in PAR environment, this adjustment is necessary.
		if(! -f $file) {
			for my $inc (@INC) {
				if(-f "$inc/$file") {
					$file = "$inc/$file";
					last;
				}
			}
		}
	}
	croak "Target file not found: $file" if ref $file eq '' && ! -f $file;
	$parser->parse_file($file);
	return $parser->{_RESULT};
}

my $SELF = __PACKAGE__->new;

sub __ref
{
	my $ref = shift;
	return if ref $ref->[0];
	croak 'Calling as neither instance method nor class method' unless eval { $ref->[0]->isa(__PACKAGE__) };
	splice @$ref, 0, 1, $SELF;
}

sub string
{
	__ref(\@_);
	my ($self, %args) = @_;
	return join(exists $args{-separator} ? $args{-separator} : '', $self->array(%args));
}

sub array
{
	__ref(\@_);
	my ($self, %args) = @_;
	return @{$self->_extract(%args)};
}

sub arrayref
{
	__ref(\@_);
	my ($self, %args) = @_;
	return [$self->array(%args)];
}

sub hashref
{
	__ref(\@_);
	my ($self, %args) = @_;
	return {$self->array(%args)};
}

sub set_class_default
{
	my ($self, %args) = @_;
	$SELF = __PACKAGE__->new(%args);
}

1;

__END__