File Coverage

blib/lib/Getopt/Tiny.pm

Criterion	Covered	Total	%
statement	74	85	87.0
branch	34	44	77.2
condition	10	16	62.5
subroutine	7	7	100.0
pod	0	3	0.0
total	125	155	80.6

package Getopt::Tiny;

use vars qw($VERSION);
$VERSION = 1.02;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(getopt);

use strict;

use vars qw($usageHandle);
$usageHandle = 'STDERR';

sub getopt
{
	my ($avref, $flagref, $switchref, $remainder) = @_;
	unless (defined($avref)) {
		$avref = \@::ARGV;
		$flagref = \%::flags;
		$switchref = \%::switches;
	}

	while (@$avref) {
		$_ = shift @$avref;
		unless (/^-(no)?(.+)$/) {
			if ($remainder) {
				unshift(@$avref, $_);
				return;
			}
			callusage($_, $flagref, $switchref, $remainder);
			return;
		}
		if (@$avref) {
			if (exists $flagref->{$2}) {
				if (ref $flagref->{$2} eq 'ARRAY') {
					my $f = $2;
					for (;;) {
						push(@{$flagref->{$f}}, shift @$avref);
						last unless @$avref && $avref->[0] =~ /^[^-]/;
					}
				} elsif (ref $flagref->{$2} eq 'HASH') {
					my $f = $2;
					for (;;) {
						my $v = shift @$avref;
						if ($v =~ /^(.*)=(.*)/) {
							$flagref->{$f}->{$1} = $2;
						} else {
							callusage("$_ $v", $flagref, $switchref, $remainder);
						}
						last unless @$avref && $avref->[0] =~ /^[^-].*=/;
					}
				} else {
					${$flagref->{$2}} = shift @$avref;
				}
				next;
			}
		}
		if (exists $switchref->{$2}) {
#			if (ref $switchref->{$2} eq 'HASH') {
#				if (@$avref) {
#					$switchref->{$2}->{shift @$avref} = ! $1;
#				} else {
#					callusage($_, $flagref, $switchref, $remainder);
#				}
#			} else {
				${$switchref->{$2}} = ! $1;
#			}
			next;
		}
		callusage($_, $flagref, $switchref, $remainder);
		return;
	}
}

sub callusage
{
	my ($arg, $flagref, $switchref, $remainder) = @_;
	my ($package, $filename) = (caller(1))[0,1];

	{
		no strict;
		if (defined &{"${package}::usage"}) {
			&{"${package}::usage"}($arg);
			return;
		}
	}

	my $o = select($usageHandle || 'STDERR');

	print "$0: unknown option '$arg'\n";

	$remainder = 'args' if $remainder > 0;
	print "Usage: $0 [flags] [switches] $remainder\n";

	usage($filename, $flagref, $switchref);

	select($o);
}

sub usage
{
	my ($filename, $flagref, $switchref) = @_;
	unless (defined $filename) {
		$filename = (caller[0])[1];
		$flagref = \%::flags;
		$switchref = \%::switches;
	}

	my %comment;
	open(USAGESOURCEFILE, "<$filename") or die "open $filename: $!";
	while () {
		last if /^# begin usage info/;
	}
	while () {
		if (/^\s*["'](\S+?)["']\s*=\>.*?\#\s*(\S.*)/) {
			$comment{$1} = $2;
		}
		last if /^# end usage info/;
	}
	if (%$flagref) {
		for my $f (sort keys %$flagref) {
			if (ref $flagref->{$f} eq 'ARRAY') {
				printf "\t-%-25s %s\n", "$f value ...", $comment{$f}||'';
			} elsif (ref $flagref->{$f} eq 'HASH') {
				printf "\t-%-25s %s\n", "$f key=value ...", $comment{$f}||'';
			} else {
				printf "\t-%-25s %s\n", "$f value", $comment{$f}||'';
			}
		}
	}
	if (%$switchref) {
		for my $f (sort keys %$switchref) {
#			if (ref $switchref->{$f} eq 'HASH') {
#				printf "\t-%-25s %s\n", "[no]$f key", $comment{$f}||'';
#			} else {
				printf "\t-[no]%-21s %s\n", $f, $comment{$f}||'';
#			}
		}
	}
}

1;