File Coverage

blib/lib/Getopt/Simple.pm

Criterion	Covered	Total	%
statement	12	67	17.9
branch	0	24	0.0
condition	0	6	0.0
subroutine	4	10	40.0
pod	0	6	0.0
total	16	113	14.1

package Getopt::Simple;

# Name:
#	Getopt::Simple.
#
# Documentation:
#	POD-style documentation is at the end. Extract it with pod2html.*.
#
# Tabs:
#	4 spaces || die.
#
# Author:
#	Ron Savage
#	Home page: http://savage.net.au/index.html
#
# Licence:
#	Australian copyright (c) 1999-2002 Ron Savage.
#
#	All Programs of mine are 'OSI Certified Open Source Software';
#	you can redistribute them and/or modify them under the terms of
#	The Artistic License, a copy of which is available at:
#	http://www.opensource.org/licenses/index.html

use strict;
no strict 'refs';
use vars qw($fieldWidth $switch @ISA @EXPORT @EXPORT_OK);

use Getopt::Long;

require Exporter;

@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

@EXPORT      = qw();

@EXPORT_OK   = qw($switch);	# An alias for $$self{'switch'}.

$fieldWidth  = 25;

our $VERSION = '1.52';

# Preloaded methods go here.
# --------------------------------------------------------------------------

sub byOrder
{
	my($self) = @_;

	$$self{'default'}{$a}{'order'} <=> $$self{'default'}{$b}{'order'};
}

# --------------------------------------------------------------------------

sub dumpOptions
{
	my($self) = @_;

	print $self -> pad('Option'), "Value\n";

	for (sort byOrder keys(%{$$self{'switch'} }) )
	{
		if (ref($$self{'switch'}{$_}) eq 'ARRAY')
		{
			print $self -> pad("-$_"), '(', join(', ', @{$$self{'switch'}{$_} }), ")\n";
		}
		else
		{
			print $self -> pad("-$_"), "$$self{'switch'}{$_}\n";
		}
	}

	print "\n";

}	# End of dumpOptions.

# --------------------------------------------------------------------------
# Return:
#	0 -> Error.
#	1 -> Ok.

sub getOptions
{
	push(@_, 0) if ($#_ == 2);	# Default for $ignoreCase is 0.
	push(@_, 1) if ($#_ == 3);	# Default for $helpThenExit is 1.

	my($self, $default, $helpText, $ignoreCase, $helpThenExit) = @_;

	$$self{'default'}	= $default;
	$$self{'helpText'}	= $helpText;

	Getopt::Long::Configure($ignoreCase ? 'ignore_case' : 'no_ignore_case');

	for (keys(%{$$self{'default'} }) )
	{
		push(@{$$self{'type'} }, "$_$$self{'default'}{$_}{'type'}");
	}

	my($result) = GetOptions($$self{'switch'}, @{$$self{'type'} });

	if ($$self{'switch'}{'help'})
	{
		$self -> helpOptions();
		exit(0) if ($helpThenExit);
	}

	for (keys(%{$$self{'default'} }) )
	{
		if (ref($$self{'switch'}{$_}) eq 'ARRAY')
		{
			$$self{'switch'}{$_} = [split(/\s+/, $$self{'default'}{$_}{'default'})] if (! defined $$self{'switch'}{$_});
		}
		else
		{
			$$self{'switch'}{$_} = $$self{'default'}{$_}{'default'} if (! defined $$self{'switch'}{$_});
		}
	}

	$result;

}	# End of getOptions.

# --------------------------------------------------------------------------

sub helpOptions
{
	my($self) = @_;

	print "$$self{'helpText'}\n" if ($$self{'helpText'});

	print $self -> pad('Option'), $self -> pad('Environment var'), "Default\n";

	for (sort byOrder keys(%{$$self{'default'} }) )
	{
		print $self -> pad("-$_"), $self -> pad("$$self{'default'}{$_}{'env'}");

		if (ref($$self{'default'}{$_}{'default'}) eq 'ARRAY')
		{
			print '(', join(', ', @{$$self{'default'}{$_}{'default'} }), ")\n";
		}
		else
		{
			print "$$self{'default'}{$_}{'default'}\n";
		}

		print "\t$$self{'default'}{$_}{'verbose'}\n"
			if (defined($$self{'default'}{$_}{'verbose'}) &&
				$$self {'default'}{$_}{'verbose'} ne '');
	}

	print "\n";

}	# End of helpOptions.

#-------------------------------------------------------------------

sub new
{
	my($class)			= @_;
	$class				= ref($class) || $class;
	my($self)			= {};
	$$self{'default'}	= {};
	$$self{'helpText'}	= '';
	$$self{'switch'}	= {};
	$switch				= $$self{'switch'};	 # An alias for $$self{'switch'}.
	$$self{'type'}		= [];

	return bless $self, $class;

}	# End of new.

# --------------------------------------------------------------------------

sub pad
{
	my($self, $field) = @_;

	sprintf "%-${fieldWidth}s", $field;

}	# End of pad.
# --------------------------------------------------------------------------

# Autoload methods go after =cut, and are processed by the autosplit program.

1;

__END__