File Coverage

blib/lib/Config/Param.pm

Criterion	Covered	Total	%
statement	906	1126	80.4
branch	490	782	62.6
condition	127	216	58.8
subroutine	53	56	94.6
pod	22	43	51.1
total	1598	2223	71.8

# This has been a simple routine for command line and config file parsing.
# Now it deals with differing styles (grades of laziness) of command line parameters,
# has funky operators on them, and is a tool box to work with other program's config files.

# It also carries a badge with the inscript "NIH syndrome".
# On the backside, you can read "But still better than anything that came before!".

# current modus operandi:
# 1. parse command line args into temporary storage
# 2. parse config files (that may have been set on command line)
# 3. merge settings (overwrite config file settings)
# 4. finalize with help/error message

# TODO: I got sections now. A next step could be sub-commands, presented as sections
# in help output and also defined like/with those. Needs some namespacing, though.
# Maybe just sub-instances of Config::Param.

# TODO: I should restructure the the internal data. It's too many hashes now
# with the same key. Nested hash or better array with named indices (to avoid typos and
# less wasteful storage)?

# TODO: --config with append mode, by config option

package Config::Param;

use strict;
use warnings;

use Carp;
use 5.008;
# major.minor.bugfix, the latter two with 3 digits each
# or major.minor_alpha
our $VERSION = '4.000006';
$VERSION = eval $VERSION;
our %features = qw(array 1 hash 1);

our $verbose = 0; # overriding config

# parameter flags
our $count  = 1;
our $arg    = 2;
our $switch = 4;
our $append = 8;
our $nonempty = 16;

# using exit values from sysexists.h which make sense
# for configuration parsing
my $ex_usage  = 64;
my $ex_config = 78;
my $ex_software = 70;

use Sys::Hostname;
use FindBin qw($Bin);
use File::Spec;
use File::Basename;

# The official API for simple use:

# This is the procedural interface: Just call get() with your setup and get the pars.
sub get #(config, params)
{
	# Handling of the differing API variants
	# 1. just plain list of parameter definitions
	# 2. config hash first, then parameter definitions
	# 3. config hash, then array ref for definitions
	#   ... in that case, optional ref to argument array to parse
	my $config = ref $_[0] eq 'HASH' ? shift : {};
	my $pardef;
	my $args = \@ARGV;
	my $give_error;
	if(ref $_[0] eq 'ARRAY')
	{
		$pardef = shift;
		if(ref $_[0] eq 'ARRAY')
		{
			$args = shift;
			$give_error = 1;
		}
	}
	else{ $pardef = \@_; }

	my $pars = Config::Param->new($config, $pardef);
	# Aborting on bad specification. Not sensible to continue.
	# Match this with documentation in POD.
	my $bad = not (
		    $pars->good()
		and $pars->parse_args($args)
		and $pars->use_config_files()
		and $pars->apply_args()
		and $pars->INT_value_check()
	);
	$pars->final_action($bad);

	$_[0] = $pars->{errors} if $give_error;
	return $pars->{param};
}

# Now the meat.

# Codes for types of parameters. It's deliberate that simple scalars are false and others are true.
my $scalar = 0; # Undefined also counts as scalar.
my $array = 1;
my $hash = 2;
my @initval  = (undef, [], {});
#This needs to be changed. Also for a hash, --hash is equivalent to --hash=1, which
#results in 1=>undef, not truth=>1
my @trueval  = (1, [1], {truth=>1});
my @falseval = (0, [0], {truth=>0});
my @typename = ('scalar', 'array', 'hash');
my %typemap  = (''=>$scalar, scalar=>$scalar, array=>$array, hash=>$hash);

# A name is allowed to contain just about everything but "=", but shall not end with something that will be mistaken for an operator.
# The checks for valid names besides the generic regexes are stricter and should be employed in addition.

# Parser regex elements.
# Generally, it's optinal operators before "=" or just operators for short parameters.
# The addition with /./ is for choosing an arbitrary array separator for the value.
# Since long names are not allowed to end with an operator, using "/" that way is
# no additional restriction.
# Context is needed to decide for /,/ and // with special function for arrays and hashes.
# The grammar is not context-free anymore. Meh.
# Well, treating it this way: // is a special operator for long names,
# // is parsed as /=/, then interpreted accordingly for arrays as //.
my $ops = '.+\-*\/'; # There's also <
my $sopex = '['.$ops.']?=|['.$ops.']=?';
my $lopex = '\/.\/['.$ops.']?=|['.$ops.']?=|\/\/|\/.\/';
my $noop = '[^+\-=.*\/\s<>]'; # a non-whitespace character that is unspecial
my $parname = $noop.'[^\s=\/<>]*'.$noop;

# Regular expressions for parameter parsing.
# The two variants are crafted to yield matching back-references.
# -x -x=bla -xyz -xyz=bla
our $shortex_strict = qr/^(([-+])($noop+|($noop+)($sopex)(.*)))$/;
# -x -x=bla -xyz x x=bla xyz
our $shortex_lazy   = qr/^(([-+]?)($noop+|($noop)($sopex)(.*)))$/;
# -xbla with x possibly arg-requiring option and bla an argument
our $shortarg = qr/^[-+]($noop)($sopex|)(.+)$/;
# --long --long=bla
our $longex_strict  = qr/^(([-+]{2})($parname)(($lopex)(.*)|))$/;
# --long --long=bla -long=bla long=bla
our $longex_lazy    = qr/^(([-+]{0,2})($parname)()($lopex)(.*)|(--|\+\+)($parname))$/;

my %example =
(
	 'lazy'   => '[-]s [-]xyz [-]s=value --long [-[-]]long=value - [files/stuff]'
	,'normal' => '-s -xyz -s=value --long --long=value [--] [files/stuff]'
);
my $lazyinfo = "The [ ] notation means that the enclosed - is optional, saving typing time for really lazy people. Note that \"xyz\" as well as \"-xyz\" mention three short options, opposed to the long option \"--long\". In trade for the shortage of \"-\", the separator for additional unnamed parameters is mandatory (supply as many \"-\" grouped together as you like;-).";

my @morehelp =
(
	 'You mention the options to change parameters in any order or even multiple times.'
,	' They are processed in the oder given, later operations overriding/extending earlier settings.'
,	' Using the separator "--" stops option parsing'."\n"
	,'An only mentioned short/long name (no "=value") means setting to 1, which is true in the logical sense. Also, prepending + instead of the usual - negates this, setting the value to 0 (false).'."\n"
	,'Specifying "-s" and "--long" is the same as "-s=1" and "--long=1", while "+s" and "++long" is the sames as "-s=0" and "--long=0".'."\n"
	,"\n"
	,'There are also different operators than just "=" available, notably ".=", "+=", "-=", "*=" and "/=" for concatenation / appending array/hash elements and scalar arithmetic operations on the value. Arrays are appended to via "array.=element", hash elements are set via "hash.=name=value". You can also set more array/hash elements by specifying a separator after the long parameter line like this for comma separation:'."\n\n"
	,"\t--array/,/=1,2,3  --hash/,/=name=val,name2=val2"
);

# check if long/short name is valid before use
sub valid_name
{
	my ($long, $short) = @_;
	return
	(
		(not defined $short or $short eq '' or $short =~ /^$noop$/o)
		and defined $long
		and $long =~ /^$parname/o
	);
}

sub valid_type
{
	my $type = lc(ref $_[0]);
	return $typemap{$type}; # undefined if invalid
}

# A valid definition also means that the default value type
# must match a possibly specified type.
sub valid_def
{
	my $def = shift;
	$_[0] = (defined $def->{type} and not defined $def->{value})
	?	$def->{type}
	:	valid_type($def->{value});
	return
	(
		valid_name($def->{long}, $def->{short}) and defined $_[0]
		and ( not defined $def->{type} or ($def->{type} ne $_[0]) )
		and ( not defined $def->{regex} or ref $def->{regex} eq 'Regexp')
		and ( not defined $def->{call} or ref $def->{call} eq 'CODE' )
	);
}

sub hashdef
{
	my %h = (     long=>shift, value=>shift,  short=>shift
	,             help=>shift,   arg=>shift,  flags=>shift
	,         addflags=>shift, level=>shift
	,            regex=>shift,  call=>shift );
	$h{short} = '' unless defined $h{short};
	$h{flags} = 0  unless defined $h{flags};
	return \%h;
}

sub builtins
{
	my $config = shift;
	my %bldi = (help=>1, h=>1, I=>1, config=>1);
	$bldi{version} = 1 if(defined $config and defined $config->{version});
	return \%bldi;
}

# helper for below
sub INT_defchecker
{
	my $def = shift;
	my $name_there = shift;
	my $short = defined $def->{short} ? $def->{short} : '';

	return ''
		if defined $def->{section};
	return "'".(defined $def->{long} ? $def->{long} : '')."' definition is not good"
		unless valid_def($def);
	return "'$def->{long}' ".(defined $def->{short} ? "/ $def->{short}" : '')." name already taken"
		if($name_there->{$def->{long}} or $name_there->{$short});
	$name_there->{$def->{long}} = 1
		if defined $def->{long};
	$name_there->{$short} = 1 if $short ne '';

	return ''; # no problem
}

# check if whole definition array is proper,
# modifying the argument to sanitize to canonical form
# That form is an array of definition hashes.
sub sane_pardef
{
	my $config = shift;
	my $name_there = builtins($config);
	my $indef = $_[0];
	$_[0] = []; # If an error comes, nothing is sane.
	if(@{$indef})
	{
		if(ref $indef->[0] ne '')
		{
			# each element is a ref, check them all
			for my $d (@{$indef})
			{
				my $t = ref $d;
				return 'mix of array/hash and other stuff'
					if($t eq '');
				return 'strange refs, neither hash nor array'
					if($t ne 'ARRAY' and $t ne 'HASH');

				my $def = $t eq 'ARRAY' ? hashdef(@{$d}) : $d;
				my $problem = INT_defchecker($def, $name_there);
				$d = $def;
				return $problem if $problem;
			}
		}
		else
		{
			return 'plain member count not multiple of 4' if(@{$indef} % 4);

			my @spars = ();
			while(@{$indef})
			{
				my $sdef;
				my $def = hashdef(splice(@{$indef}, 0, 4));
				my $problem = INT_defchecker($def, $name_there);
				return $problem if $problem;
				push(@spars, $def);
			}
			$indef = \@spars;
		}
	}
	$_[0] = $indef; # only after full success
	return '';
}

sub escape_pod
{
	return undef unless defined $_[0];
	my @text = split("\n", shift, -1);
	for(@text)
	{
		next if m/^\s/; # indented stuff is verbatim
		s/^=(\w)/=Z<>$1/;
		s/([A-Z])
	}
	return join("\n", @text);
}

# Following: The OO API for detailed work.

sub new # strictly (\%config, \@pardef)
{
	my $class = shift;
	my $self = {};
	bless $self, $class;

	$self->{config} = shift;
	$self->{config} = {} unless defined $self->{config};
	my $pars = shift;
	$pars = [] unless defined $pars;
	$self->{files} = [];
	$self->{errors} = [];

	$self->{config}{program} = basename($0) unless defined $self->{config}{program};
	$self->{config}{shortdefaults} = 1 unless exists $self->{config}{shortdefaults};
	$self->{printconfig} = 0;
	my $hh = 'Show the help message. Value 1..9: help level, par:'
	.	' help for paramter par (long name) only.';
	$self->{extrahelp} = 'Additional fun with negative values, optionally'
	.	' followed by comma-separated list of parameter names:'."\n"
	.	'-1: list par names, -2: list one line per name,'
	.	' -3: -2 without builtins, -10: dump values (Perl style),'
	.	' -11: dump values (lines), -100: print POD.';
	my $ih = 'Which configfile(s) to use (overriding automatic search'
	.	' in likely paths);'."\n"
	.	'special: just -I or --config causes printing a current config'
	.	' file to STDOUT';

	if($self->{config}{lazy} and $self->{config}{posixhelp})
	{
		$self->INT_error("POSIX-style help texts and lazy parameter syntax are incompatible.");
		$self->{config}{posixhelp} = 0;
	}
	# Put -- in front of long names in communication, in POSIX mode.
	$self->{longprefix} = $self->{config}{posixhelp} ? '--' : '';
	# Same for - and short names.
	$self->{shortprefix} = $self->{config}{posixhelp} ? '-' : '';
	# An array of sections, with {name=>foo, member=>[$long1, $long2, ...]}.
	# If I opted for
	$self->{section} = [];
	# Start the default, nameless section. Maybe a name should be generated if there
	# are other sections.
	$self->define({ section=>'', level=>1, flags=>$self->{config}{flags}
	,	regex=>$self->{config}{regex}, call=>$self->{config}{call} });

	# Choosing kindof distributed storage of parmeter properties, for direct
	# access. With more and more properties, the count of global hashes
	# increases uncomfortably.
	$self->{param} = {}; # parameter values
	$self->{help}  = {}; # help texts
	$self->{long}  = {}; # map short to long names
	$self->{short} = {}; # map long to short names
	$self->{arg}   = {}; # argument name
	$self->{type}  = {}; # type code
	# store default values, for even more detailed documentation
	$self->{default} = {};  # default value
	$self->{level} = {};    # parameter level for help output
	$self->{length} = 0;    # max length of long names
	$self->{arglength} = 0; # max length of name=arg or name[=arg]
	# Chain of config files being parsed, to be able to check for inclusion loops.
	$self->{parse_chain} = [];
	# TODO set from config hash
	$self->define({ long=>'help',   short=>$self->{config}{shortdefaults} ? 'h' : '', value=>0
	,	help=>\$hh, flags=>0, regex=>qr/./ });
	$self->define(
	{
		long=>'config', short=>$self->{config}{shortdefaults} ? 'I' : '', value=>[]
	,	help=>\$ih, flags=>0, regex=>qr/./
	,	call=> sub
		{ # --config increments printconfig and does not add a config file.
			unless(defined $_[2])
			{
				$self->{printconfig} += 1;
				undef $_[0]; # Skip this operation.
			}
			return 0;
		}
	});
	$self->define({ long=>'version', value=>0, short=>''
	,	help=>\'print out the program version', arg=>''
	,	flags=>0, regex=>qr/./ })
		if(defined $self->{config}{version});

	# deprecated v2 API
	$self->INT_error("Update your program: ignorehelp is gone in favour of nofinals!")
		if exists $self->{config}{ignorehelp};
	$self->INT_error("Update your program: eval option not supported anymore.")
		if exists $self->{config}{eval};

	my $problem = sane_pardef($self->{config}, $pars);
	if($problem)
	{
		$self->INT_error("bad parameter specification: $problem");
	} else
	{
		my $di = 0;
		for my $def (@{$pars})
		{
			++$di;
			# definition failure here is an error in the module
			$self->INT_error("Very unexpected failure to evaluate parameter definition $di.")
				unless($self->define($def));
		}
		$self->find_config_files();
	}
	return $self;
}

sub good
{
	my $self = shift;
	return @{$self->{errors}} == 0;
}

# name[=arg] and variants
sub INT_namearg
{
	my $self = shift;
	my $name = shift;
	my $flags = $self->{flags}{$name};
	my $val= $self->{arg}{$name};
	$val = 'val' unless defined $val;
	return $flags & $arg
	?	$name.'='.$val # mandatory argument
	:	( $val eq ''
		?	$name      # silent optional argument
		:	$name.'[='.$val.']' ) # named optional argument
}

sub define
{
	my $self = shift;
	my $pd = shift;

	my $helpref = defined $pd->{help}
	?	( ref $pd->{help} ? $pd->{help} : \$pd->{help} )
	:	\"";
	# The section keyword defines a section instead of a parameter.
	if(exists $pd->{section})
	{
		# Silence runs with perl -W. Actually, I'm annoyed that 0+undef isn't
		# doing this already. Still doing 0+ to catch idle strings, which are
		# evildoing by the user program.
		my $flags = defined $pd->{flags} ? 0+$pd->{flags} : 0;
		my $level = defined $pd->{level} ? 0+$pd->{level} : 0;
		# The first section is the default one, any further sections mean
		# that you care about parameter order.
		$self->{config}{ordered} = 1
			if @{$self->{section}};
		push(@{$self->{section}}, { section=>$pd->{section}
		,	help=>$helpref, level=>$level
		,	minlevel=>10 # will be lowered when parameters are added to it
		,	flags=>$flags, regex=>$pd->{regex}, call=>$pd->{call} });
		return 1;
	}

	unless(@{$self->{section}})
	{
		$self->INT_error("Define the default section first!");
		return 1;
	}

	my $section = $self->{section}[$#{$self->{section}}];
	my $name = $pd->{long};

	$pd->{help} = \'' unless defined $pd->{help};
	$pd->{short} = '' unless defined $pd->{short};
	my $type; # valid_def sets that
	unless(valid_def($pd, $type))
	{
		$self->INT_error("Invalid definition for $name / $pd->{short}");
		return 0;
	}
	my $flags = defined $pd->{flags}
		?	$pd->{flags}
		:	$section->{flags};
	$flags |= $pd->{addflags}
		if defined $pd->{addflags};
	my $regex = defined $pd->{regex}
	?	$pd->{regex}
	:	$section->{regex};
	my $call  = defined $pd->{call}
	?	$pd->{call}
	:	$section->{call};
	if($flags & $switch and $flags & $arg)
	{
		$self->INT_error("Invalid flags (switch requiring argument) for $name / $pd->{short}");
		return 0;
	}
	unless(defined $self->{param}{$name} or defined $self->{long}{$pd->{short}})
	{
		$self->{type}{$name}  = $type;
		# If the definition value is a reference, make a deep copy of it
		# instead of copying the reference. This keeps the definition
		# and default value unchanged, for reproducible multiple runs of
		# the parser.
		if(ref $pd->{value})
		{
			require Storable; # Only require it if there is really the need.
			$self->{param}{$name}   = Storable::dclone($pd->{value});
			$self->{default}{$name} = Storable::dclone($pd->{value});
		}
		else
		{
			$self->{param}{$name} = $pd->{value};
			$self->{default}{$name} = $pd->{value};
		}
		$self->{long}{$pd->{short}} = $name
			if $pd->{short} ne '';
		$self->{short}{$name} = $pd->{short};
		$self->{help}{$name}  = $helpref;
		$self->{arg}{$name}   = $pd->{arg};
		my $lev = $self->{level}{$name} = 0+( defined $pd->{level}
		?	$pd->{level}
		:	$section->{level} );
		# Store the minimum level needed to display at least one section member.
		$section->{minlevel} = $lev
			if $lev < $section->{minlevel};
		$self->{flags}{$name} = $flags;
		$self->{arg}{$name} = ''
			if $self->{flags}{$name} & $switch;
		push(@{$section->{member}}, $name);
		$self->INT_verb_msg("define $name / $pd->{short} of type $typename[$type] flags $self->{flags}{$name}\n");
		# Call INT_namearg after settling flags!
		$self->{length}       = length($name)
			if length($name) > $self->{length};
		my $arglen = length($self->INT_namearg($name));
		$self->{arglength}    = $arglen
			if $arglen > $self->{arglength};
		$self->{regex}{$name} = $regex
			if defined $regex;
		$self->{call}{$name}  = $call
			if defined $call;
	}
	else
	{
		$self->INT_error("Tried to redefine an option ($pd->{long} / $pd->{short}! Programmer: please check this!");
		return 0;
	}
	return 1;
}

sub find_config_files
{
	my $self = shift;

	if(defined $self->{config}{file})
	{
		@{$self->{param}{config}} = ref $self->{config}{file} eq 'ARRAY'
			? @{$self->{config}{file}}
			: ($self->{config}{file});
	}
	#means: nofile[false,true], file[string], info, verbose[bool],
	#config confusion
	# as long as I was told not to use a config file or it has been already given
	unless($self->{config}{nofile} or @{$self->{param}{config}})
	{
		# Default to reading program.conf and/or program.host.conf if found.
		my $pconf = $self->INT_find_config($self->{config}{program}.'.conf');
		my $hconf = $self->INT_find_config($self->{config}{program}.'.'.hostname().'.conf');
		my @l;
		push(@l, $pconf) if defined $pconf;
		push(@l, $hconf) if defined $hconf;
		# That list can be empty if none existing.
		$self->INT_verb_msg("possible config files: @l\n");
		# The last entry in the list has precedence.
		unless($self->{config}{multi})
		{
			@l = ($l[$#l]) if @l; # Only the last element, if any, prevails.
		}
		@{$self->{param}{config}} = @l;
	}
}

# Parse abcd to the list of corresponding long names.
sub INT_long_names
{
	my $self  = shift;
	my $sname = shift;
	my @names;
	for my $s (split(//,$sname))
	{
		if(defined (my $name = $self->{long}{$s}))
		{
			push(@names, $name);
		}
		else
		{
			if($self->{config}{fuzzy})
			{
				$self->INT_verb_msg("Unknown short option $s, assuming that this is data instead.\n");
				@names = ();
				last;
			}
			else
			{
				unless($self->{config}{ignore_unknown} and $self->{config}{ignore_unknown} > 1)
				{
					#$self->{param}{help} = 1;
					$self->INT_error("unknown short parameter \"$s\" not in (".join('', sort keys %{$self->{long}}).")");
				}
			}
		}
	}
	return \@names;
}

# Works directly on last arguments to avoid passing things back and forth.
sub INT_settle_op # (lastoption, sign, name, op, val, args)
{
	my $self = shift;
	my $lastoption = shift;
	my $sign = shift;
	my $name = shift;
	# op:$_[0] val:$_[1] args:$_[2]
	my $flags = $self->{flags}{$name};
	my $arrhash = defined $self->{type}{$name}
		and grep {$_==$self->{type}{$name}} ($array, $hash);

	# First settle a possibly enforced argument that has to follow.
	# Then call the custom callback that could change things

	if(defined $_[0] and $arrhash)
	{
		# -a/,/=bla and -a/,/bla are equivalent, as is -a/,/ bla
		if($_[0] eq '/' and $_[1] =~ m:(./)(=?)(.*):)
		{
			$_[0] .= $1.$2;
			$_[1] = ($3 eq '' and $2 eq '') ? undef : $3;
			$_[0] .= '='
				if($2 eq '' and defined $_[1]);
		}
		if($_[0] =~ m:^/./$: and $flags & $arg)
		{
			unless(@{$_[2]})
			{
				$self->INT_error( "Array/hash missing explicit argument: $self->{longprefix}$name"
				.	($self->{short}{$name} ne '' ? " ($self->{shortprefix}$self->{short}{$name})" : '') );
				return;
			}
			$_[0] .= '=';
			$_[1] = shift @{$_[2]};
		}
	} elsif(not defined $_[0] and $flags & $arg)
	{
		unless($lastoption and @{$_[2]})
		{
			$self->INT_error( "Parameter missing explicit argument: $self->{longprefix}$name"
			.	($self->{short}{$name} ne '' ? " ($self->{shortprefix}$self->{short}{$name})" : '') );
			return;
		}
		$_[0] = '=';
		$_[1] = shift @{$_[2]};
	}

	# Defined empty value with undefined operator is just confusing to the callback.
	undef $_[1]
		unless defined $_[0];

	# The callback that could modify things.

	if(defined $self->{call}{$name})
	{
		my $nname = $name;
		my $ret = $self->{call}{$name}->($nname, $sign, $_[0], $_[1]);
		if($ret or (not defined $nname or $nname ne $name))
		{
			$self->INT_error("Callback for $name returned an error: $ret")
				if $ret; # otherwise intentional drop
			undef $_[0];
			return;
		}
	}

	# Final translation of operator.

	unless(defined $_[0])
	{
		if($flags & $count)
		{
			($_[0], $_[1]) = $sign =~ /^-/ ? ('+=', 1) : ('=', 0);
		}
		else
		{
			$_[0] = '=';
			$_[1] = $sign =~ /^-/ ? 1 : 0;
		}
	}
	if($arrhash)
	{
		$_[0] =~ s:(^|[^\.])=$:$1.=:
			if $self->{flags}{$name} & $append;
	}
}

# Record a operator and operand for given parameter.
# It is not checked if the operation makes sense.
sub INT_add_op
{
	my $self = shift;
	my ($name, $op, $val) = (shift, shift, shift);
	$self->{ops}{$name} = []
		unless defined $self->{ops}{$name};
	return # undefined ops are intentionally dropped
		unless defined $op;
	$self->INT_verb_msg("name: $name op: $op (val: $val)\n");
	push(@{$self->{ops}{$name}}, ($op =~ /=$/ ? $op : $op.'='), $val);
}

# Step 1: parse command line
sub parse_args
{
	my $self = shift;
	my $args = shift;

	my $olderrs = @{$self->{errors}};
	$self->{ops} = {};
	$self->{printconfig} = 0;

	$self->{param}{help} = 1 if($self->{config}{gimme} and not @{$args}); #giving help when no arguments

	#regexes for option parsing
	my $shorts = $shortex_strict;
	my $longex = $longex_strict;
	my $separator = '^--$'; #exactly this string means "Stop the parsing!"

	if($self->{config}{lazy})
	{
		$shorts = $shortex_lazy;
		$longex = $longex_lazy;
		$separator = '^-+$'; # Lazy about separators, too ... Any number of consecutive "-".
	}

	# The argument parser, long/short parameter evaluation is similar, but separate.
	while(@{$args})
	{
		$self->INT_verb_msg("parsing $args->[0]\n");
		my $e = index($args->[0], "\n");
		my $begin;
		my $end = "";
		my $name;
		if($e >=0)
		{
			$begin = substr($args->[0],0,$e);
			$end   = substr($args->[0],$e);
		}
		else
		{
			$begin = $args->[0];
		}
		if($begin =~ /$separator/o)
		{
			$self->INT_verb_msg("separator\n");
			shift(@{$args});
			last;
		}
		elsif( $begin =~ $shortarg
			and defined ($name = $self->{long}{$1})
			and $self->{flags}{$name} & $arg )
		{
			$self->INT_verb_msg("short with value\n");
			my $op = $2 ne '' ? $2 : '=';
			my $val = $3.$end;
			shift @{$args};
			$self->INT_settle_op(1, '-', $name, $op, $val, $args);
			$self->INT_add_op($name, $op, $val);
		}
		elsif($begin =~ /$shorts/o)
		{
			my $sign = $2;
			$sign = '-' if $sign eq '';
			my $op = $5;
			my $sname = defined $op ? $4 : $3;
			my $val = (defined $6 ? $6 : '').$end;
			$self->INT_verb_msg("a (set of) short one(s)\n");
			# First settle which parameters are mentioned.
			# This returns an empty list if one invalid option is present.
			# Also, the case of a single argument-requiring short option leading
			# a value is handled by redefining the value and operator
			my $names = $self->INT_long_names($sname, $op, $val);
			last unless @{$names};
			shift @{$args}; # It is settled now that this is options.

			while(@{$names})
			{
				my $olderr = @{$self->{errors}};
				my $name = shift @{$names};
				my $lastoption = not @{$names};
				# Only the last one gets the specified operation.
				my $kop  = $lastoption ? $op  : undef;
				my $kval = $lastoption ? $val : undef;
				$self->INT_settle_op($lastoption, $sign, $name, $kop, $kval, $args);
				$self->INT_add_op($name, $kop, $kval)
					if(@{$self->{errors}} == $olderr);
			}
		}
		elsif($begin =~ $longex)
		{
			#yeah, long option
			my $olderr = @{$self->{errors}};
			my $sign = defined $7 ? $7 : $2;
			$sign = '--' if $sign eq '';
			my $name = defined $8 ? $8 : $3;
			$self->INT_verb_msg("param $name\n");
			my $op = $5;
			my $val = (defined $6 ? $6 : '').$end;
			unless(exists $self->{param}{$name} or $self->{config}{accept_unknown})
			{
				if($self->{config}{fuzzy})
				{
					$self->INT_verb_msg("Stopping option parsing at unkown one: $name");
					last;
				}
				else
				{
					unless($self->{config}{ignore_unknown} and $self->{config}{ignore_unknown} > 1)
					{
						$self->INT_error("Unknown parameter (long option): $name");
					}
				}
			}
			shift @{$args};
			# hack for operators, regex may swallow the . in .=
			unless($name =~ /$noop$/o)
			{
				$op = substr($name,-1,1).$op;
				$name = substr($name,0,length($name)-1);
			}
			# On any error, keep parsing for giving the user a full list of errors,
			# but do not process anything erroneous.
			$self->INT_settle_op(1, $sign, $name, $op, $val, $args)
				if(@{$self->{errors}} == $olderr);
			$self->INT_add_op($name, $op, $val)
				if(@{$self->{errors}} == $olderr);
		}
		else
		{
			$self->INT_verb_msg("No parameter, end.\n");
			last;
		} #was no option... consider the switch part over
	}
	$self->{bad_command_line} = not (@{$self->{errors}} == $olderrs)
		unless $self->{bad_command_line};
	return not $self->{bad_command_line};
}

# Step 2: Read in configuration files.
sub use_config_files
{
	my $self = shift;
	my $olderr = @{$self->{errors}};
	# Do operations on config file parameter first.
	$self->INT_apply_ops('config');
	my $newerr = @{$self->{errors}};
	if($olderr != $newerr)
	{
		$self->{bad_command_line} = 1;
		return 0;
	}
	# Now parse config file(s).
	return $self->INT_parse_files();
}

# Step 3: Apply command line parameters.
# This is complicated by accept_unknown > 2.
# I need to wait until config files had the chance to define something properly.
sub apply_args
{
	my $self = shift;
	my $olderrs = @{$self->{errors}};
	for my $key (keys %{$self->{ops}})
	{
		if( not exists $self->{param}{$key}
			and defined $self->{config}{accept_unknown}
			and $self->{config}{accept_unknown} > 1 )
		{
			$self->define({long=>$key});
		}
		if(exists $self->{param}{$key})
		{
			$self->INT_apply_ops($key);
		}
		elsif(not $self->{config}{ignore_unknown})
		{
			$self->INT_error("Unknown long parameter \"$self->{longprefix}$key\"");
		}
	}
	$self->{bad_command_line} = not (@{$self->{errors}} == $olderrs)
		unless $self->{bad_command_line};
	return not $self->{bad_command_line};
}

# Step 4: Take final action.
sub final_action
{
	my $self = shift;
	my $end = shift;
	return if($self->{config}{nofinals});

	my $handle = $self->{config}{output};
	$handle = \*STDOUT
		unless defined $handle;
	my $exitcode = @{$self->{errors}}
	?	( $self->{bad_command_line}
		?	$ex_usage
		:	($self->{bad_config_file} ? $ex_config : $ex_software)
		)
	:	0;

	if($end)
	{
		if(@{$self->{errors}})
		{
			$self->INT_error("There have been errors in parameter parsing. You should seek --help.");
		}
		exit($exitcode)
			unless $self->{config}{noexit};
		return;
	}

	#give the help (info text + option help) and exit when -h or --help was given
	if($self->{param}{help})
	{
		$self->help();
		exit($exitcode)
			unless $self->{config}{noexit};
	}
	elsif(defined $self->{config}{version} and $self->{param}{version})
	{
		print $handle "$self->{config}{program} $self->{config}{version}\n";
		exit($exitcode)
			unless $self->{config}{noexit};
	}
	elsif($self->{printconfig})
	{
		$self->print_file($handle, ($self->{printconfig} > 1));
		exit($exitcode)
			unless $self->{config}{noexit};
	}
}

# Helper functions...

# Produce a string showing the value of a parameter, for the help.
sub par_content
{
	my $self = shift;
	my $k = shift; # The parameter name.
	my $format = shift; # formatting choice
	my $indent = shift; # indent value for dumper
	my $mk = shift; # value selector: 'param' or 'default', usually
	$mk = 'param'
		unless defined $mk;
	if(not defined $format or $format eq 'dump')
	{
		if(eval { require Data::Dumper })
		{
			no warnings 'once'; # triggers when embedding the module
			local $Data::Dumper::Terse = 1;
			local $Data::Dumper::Deepcopy = 1;
			local $Data::Dumper::Indent = $indent;
			$Data::Dumper::Indent = 0 unless defined $Data::Dumper::Indent;
			local $Data::Dumper::Sortkeys = 1;
			local $Data::Dumper::Quotekeys = 0;
			return Data::Dumper->Dump([$self->{$mk}{$k}]);
		}
		else{ return "$self->{$mk}{$k}"; }
	}
	elsif($format eq 'lines')
	{
		return "\n" unless(defined $self->{$mk}{$k});
		if($self->{type}{$k} == $array)
		{
			return "" unless @{$self->{$mk}{$k}};
			return join("\n", @{$self->{$mk}{$k}})."\n";
		}
		elsif($self->{type}{$k} == $hash)
		{
			my $ret = '';
			for my $sk (sort keys %{$self->{$mk}{$k}})
			{
				$ret .= "$sk=$self->{$mk}{$k}{$sk}\n";
			}
			return $ret;
		}
		else{ return "$self->{$mk}{$k}\n"; }
	} else{ $self->INT_error("unknown par_content format: $format"); }
}

# Fill up with given symbol for pretty indent.
sub INT_indent_string
{
	my ($indent, $prefill, $filler) = @_;
	$filler = '.'
		unless defined $filler;
	return ($indent > $prefill)
		? ( ($prefill and ($indent-$prefill>2)) ? $filler : ' ')
			x	($indent - $prefill - 1) . ' '
		: '';
}

# simple formatting of some lines (breaking up with initial and subsequent indendation)
sub INT_wrap_print
{
	my ($handle, $itab, $stab, $length) = (shift, shift, shift, shift);
	return unless @_;
	# Wrap if given line length can possibly hold the input.

	# Probably I will make this more efficient in future, probably also
	# dropping Text::Wrap instead of fighting it. Or use some POD formatting?
	my @paragraphs = split("\n", join("", @_), -1);
	# Drop trailing empty lines. We do not wrap what.
	while(@paragraphs and $paragraphs[$#paragraphs] eq '')
	{
		pop @paragraphs;
	}
	my $first = 1;
	print $handle $itab;
	print $handle "\n"
		unless @paragraphs;
	my $line = undef;
	my $llen = length($itab);
	my $slen = length($stab);
	my $can_wrap = $length > $llen && $length > $slen;
	while(@paragraphs)
	{
		my $p = shift(@paragraphs);
		# Try to handle command line/code blocks by not messing with them.
		if($p =~ /^\t/)
		{
			print $handle (defined $line ? $line : '')."\n"
				if $llen;
			print $handle $stab.$p."\n";
			$line = '';
			$llen = 0;
		}
		elsif($p eq '')
		{
			print $handle (defined $line ? $line : '')."\n";
			$line = '';
			$llen = 0;
		}
		elsif($can_wrap)
		{
			my @words = split(/\s+/, $p);
			while($llen>$slen or @words)
			{
				my $w = shift(@words);
				my $l = length($w);
				if(not $l or $l+$llen >= $length)
				{
					print $handle (defined $line ? $line : '')."\n";
					$llen = 0;
					$line = '';
					$first = 0;
				}
				if($l)
				{
					unless(defined $line)
					{
						$line = '';
					}
					elsif($llen)
					{
						$line .= ' ';
						$llen += 1;
					}
					else
					{
						$line = $stab;
						$llen = $slen;
					}
					$line .= $w;
					$llen += $l;
				}
			}
			$line = '';
			$llen = 0;
		}
		else # wrapping makes no sense
		{
			print $handle (defined $line ? $line : '').$p."\n";
			$line = '';
			$llen = 0;
		}
	}
}

# Produce wrapped text from POD.
sub INT_pod_print
{
	my ($handle, $length) = (shift, shift);
	require Pod::Text;
	my $pod = Pod::Text->new(width=>$length);
	$pod->output_fh($handle);
	$pod->parse_string_document($_[0]);
}

# Produce POD output from text.
sub print_pod
{
	my $self = shift;
	my $handle = $self->{config}{output};
	$handle = \*STDOUT unless defined $handle;

	my $prog = escape_pod($self->{config}{program});
	my $tagline = escape_pod($self->{config}{tagline});
	# usage line is unescaped
	my $usage = $self->{config}{usage};
	my @desc = (); # usage might come from here
	@desc = split("\n", $self->{config}{info}, -1)
		if(defined $self->{config}{info});

	$tagline = escape_pod(shift @desc)
		unless(defined $tagline or not defined $prog);

	while(@desc and $desc[0] =~ /^\s*$/){ shift @desc; }

	unless(defined $usage or not @desc)
	{
		if(lc($desc[0]) =~ /^\s*usage:\s*(.*\S?)\s*$/)
		{
			$usage = $1 if $1 ne '';
			shift(@desc);
			while(@desc and $desc[0] =~ /^\s*$/){ shift @desc; }

			# if the real deal follows on a later line
			if(not defined $usage and @desc)
			{
				$usage = shift @desc;
				$usage =~ s/^\s*//;
				$usage =~ s/\s*$//;
				while(@desc and $desc[0] =~ /^\s*$/){ shift @desc; }
			}
		}
	}
	if(defined $prog)
	{
		print $handle "\n=head1 NAME\n\n$prog";
		print $handle " - $tagline" if defined $tagline;
		print $handle "\n";
	}
	if(defined $usage)
	{
		print $handle "\n=head1 SYNOPSIS\n\n";
		print $handle "\t$_\n" for(split("\n", $usage));
	}
	if(@desc or defined $self->{config}{infopod})
	{
		print $handle "\n=head1 DESCRIPTION\n\n";
		if(defined $self->{config}{infopod})
		{
			print $handle $self->{config}{infopod};
		} else
		{
			for(@desc){ print $handle escape_pod($_), "\n"; }
		}
	}
	my $nprog = defined $prog ? $prog : 'some_program';

	print $handle "\n=head1 PARAMETERS\n\n";
	print $handle "These are the general rules for specifying parameters to this program:\n";
	print $handle "\n\t$nprog ";
	if($self->{config}{lazy})
	{
		print $handle escape_pod($example{lazy}),"\n\n";
		print $handle escape_pod($lazyinfo),"\n";
	}
	else
	{
		print $handle escape_pod($example{normal}),"\n";
	}
	print $handle "\n";
	for(@morehelp)
	{
		print $handle escape_pod($_);
	}
	print $handle "\n\nThe available parameters are these, default values (in Perl-compatible syntax) at the time of generating this document following the long/short names:\n";
	print $handle "\n=over 2\n";
	for my $k (sort keys %{$self->{param}})
	{
		print $handle "\n=item B<".escape_pod($k).">".
			($self->{short}{$k} ne '' ? ', B<'.escape_pod($self->{short}{$k}).'>' : '').
			" ($typename[$self->{type}{$k}])".
			"\n\n";
		my @content = $k eq 'help'
			? 0
			: split("\n", $self->par_content($k, 'dump', 1));
		print $handle "\t$_\n" for(@content);
		print $handle "\n".escape_pod(${$self->{help}{$k}})."\n";
		print $handle "\n".$self->{extrahelp}."\n" if($k eq 'help');
	}
	print $handle "\n=back\n";

	# closing with some simple sections
	my @podsections;
	# user-provided
	push(@podsections, @{$self->{config}{extrapod}})
		if(defined $self->{config}{extrapod});

	# standard
	for( ['BUGS','bugs'], ['AUTHOR', 'author'], ['LICENSE AND COPYRIGHT', 'copyright'] )
	{
		push(@podsections, {head=>$_->[0], body=>$self->{config}{$_->[1]}})
			if(defined $self->{config}{$_->[1]});
	}

	for my $ps (@podsections)
	{
		print $handle "\n=head1 $ps->{head}\n";
		print $handle "\n",$ps->{verbatim} ? $ps->{body} : escape_pod($ps->{body}),"\n";
	}

	print $handle "\n=cut\n";
}

sub _pm
{
	my $self  = shift;
	my $k     = shift;
	return ( ($self->{type}{$k} == $scalar
		and ( $self->{flags}{$k} & $switch
			or (defined $self->{arg}{$k} and $self->{arg}{$k} eq '') ))
		and ($self->{default}{$k}) ) ? '+' : '-';
}

# Well, _the_ help.
sub help
{
	my $self = shift;
	my $handle = $self->{config}{output};
	$handle = \*STDOUT unless defined $handle;
	my $indent = $self->{config}{posixhelp}
	?	$self->{arglength} + 7 # -s, --name[=arg]
	:	$self->{length} + 4; # longest long name + ", s " (s being the short name)

	# Trying to format it fitting the screen to ease eye navigation in large parameter lists.
	my $linewidth = 0;
	if(defined $self->{config}{linewidth})
	{
		$linewidth = $self->{config}{linewidth};
	}
	elsif(eval { require Term::ReadKey })
	{
		# This can die on me! So run it in eval.
		my @s = eval { Term::ReadKey::GetTerminalSize(); };
		$linewidth = $s[0] if @s;
	}
	elsif(eval { require IPC::Run })
	{
		my ($in, $err);
		if(eval { IPC::Run::run([qw(tput cols)], \$in, \$linewidth, \$err) })
		{
			chomp($linewidth);
			$linewidth += 0; # ensure a number;
		}
	}
	my $prosewidth = $linewidth > 80 ? 80 : $linewidth;

	if($self->{param}{help} =~ /^(-\d+),?(.*)$/)
	{
		my $code = $1;
		my @keys = split(',', $2);
		my $badkeys;
		for(@keys)
		{
			unless(exists $self->{param}{$_})
			{
				++$badkeys;
				$self->INT_error("Parameter $_ is not defined!");
			}
		}
		return
			if $badkeys;

		if($code == -1)
		{ # param list, wrapped to screen
			INT_wrap_print( $handle, '', "\t", $linewidth, "List of parameters: "
			,	join(' ', sort keys %{$self->{param}}) );
		}
		elsif($code == -2)
		{ # param list, one one each line
			print $handle join("\n", sort keys %{$self->{param}})."\n";
		}
		elsif($code == -3)
		{ # param list, one one each line, without builtins
			my $builtin = builtins($self->{config});
			my @pars = sort grep {not $builtin->{$_}} keys %{$self->{param}};
			print $handle join("\n", @pars)."\n" if @pars;
		}
		elsif($code == -10)
		{ # dump values, suitable to eval to a big array
			my $first = 1;
			for(@keys)
			{
				if($first){ $first=0; }
				else{ print $handle ", "; }
				print $handle $self->par_content($_, 'dump', 1);
			}
		}
		elsif($code == -11)
		{ # line values
			for(@keys){ print $handle $self->par_content($_, 'lines'); }
		}
		elsif($code == -100)
		{
			$self->print_pod();
		}
		else
		{
			$self->INT_error("bogus help code $code");
			INT_wrap_print(\*STDERR, '', '', $linewidth, "\nHelp for help:\n", ${$self->{help}{help}});
			INT_wrap_print(\*STDERR, '','', $linewidth, $self->{extrahelp});
		}
		return;
	}

	# Anything with at least two characters could be a parameter name.
	if($self->{param}{help} =~ /../)
	{
		my $k = $self->{param}{help};
		if(exists $self->{param}{$k})
		{
			my $val   = $self->{arg}{$k};
			my $s     = $self->{short}{$k};
			my $type  = $self->{type}{$k};
			my $flags = $self->{flags}{$k};
			my $pm    = $self->_pm($k);
			$val = 'val' unless defined $val;
			print $handle $self->{config}{posixhelp}
			?	"Option:\n\t"
				.	($s ne '' ? "$pm$s, " : '')
				.	$pm.$pm.$k."\n"
			:	"Parameter:\n\t$k".($s ne '' ? ", $s" : '')."\n";
			my $c = $self->par_content($k, 'dump', 1);
			$c =~ s/\n$//;
			$c =~s/\n/\n\t/g;
			print $handle "\nValue:\n\t$c\n";
			my $dc = $self->par_content($k, 'dump', 1, 'default');
			$dc =~ s/\n$//;
			$dc =~s/\n/\n\t/g;
			print $handle "\nDefault value: "
			.	($c eq $dc ? "same" : "\n\t$dc")
			.	"\n";
			print $handle "\nSyntax notes:\n";
			my $notes = '';
			if($type eq $scalar)
			{
				my @switchcount;
				push(@switchcount, "switch")
					if($flags & $switch or not $flags & $count);
				push(@switchcount, "counter")
					if($flags & $count or not $flags & $switch);
				$notes .= $flags & $arg
					?	"This is a scalar parameter that requires an explicit"
						.	" argument value."
						.	" You can choose the canonical form --$k=$val or let"
						.	" the value follow like --$k $val"
						.	( $s ne ''
							?	" (short option only: both -$s $val and -$s$val are valid)"
							:	'' )
						.	'.'
					: $val ne ''
						?	"This is a scalar parameter with an optional argument"
							.	" value than can only be provided by attaching it"
							.	" with an equal sign or another operator,"
							.	" e.g. --$k=$val."
						:	"This is a parameter intended as a ".join(" or ", @switchcount)
							.	", providing an argument value is not required.";
				$notes .= " The value can be built"
						.	" in multiple steps via operators for appending (--$k.=) or"
						.	" arithmetic (--$k+= for addition, --$k-=, --$k*=, and --$k/= for"
						.	" subtraction, multiplication, and division)."
					unless $flags & $switch;
				$notes .= "\n\nThe above applies to the short -$s, too, with the"
						.	" addition that the equal sign can be dropped for"
						.	" two-character operators, like -$s+3."
					if(not $flags & $switch and $s ne '');
				$notes .= $flags & $count
					?	"\n\nEach appearance of --$k "
						.	($s ne '' ? "and -$s " : '')
						.	"increments the value by 1, while ++$k "
						.	($s ne '' ? "and +$s " : '')
						.	"set it to zero (false)."
					:	"\n\nJust --$k"
						.	($s ne '' ? " or -$s " : '')
						.	"sets the value to 1 (engages the switch), while ++$k"
						.	($s ne '' ? " or +$s " : '')
						.	"sets the value to 0 (disengages the switch)."
					unless($flags & $arg);
			} elsif(grep {$_ == $type} ($array, $hash))
			{
				$notes .= $type == $hash
				?	'This is a hash (name-value store) parameter. An option argument'
					.	' consists of = to'
					.	' store the actual value with for given key.'
				:	'This is an array parameter.';
				$notes .= ' Assigned values are appended even if the append operator .='
					.	' is not used explicitly.'
					if $flags & $append;
				$notes .= $flags & $arg
				?	' An explicit argument to the option is required.'
					.	" It is equivalent to specify --$k=$val or --$k $val."
					.	" A value is explcitly appended to the "
					.	"$typename[$type] via --$k.=$val."
				:	" An option argument can be given via --$k=$val or --$k.=$val to "
					.	" explicitly append to the $typename[$self->{type}{$k}].";
				$notes .= ' For this parameter, the appending operator .= is implicit.'
					if $flags & $append;
				$notes .= "\n\nThe above applies also to the short option -$s"
				.	($flags & $arg
					?	", with added possibility of directly attaching the argument via -$s$val."
					:	".")
					if $s ne '';
				$notes .= "\n\n";
				$notes .= "Multiple values can be provided with a single separator character"
				.	" that is specified between slashes, like --$k/,/=a,b,c.";
			} else
			{
				$notes .= 'I do not know what kind of parameter that is.'
			}
			$notes .= "\n\n"
				.	'Lazy option syntax is active: you can drop one or both of the'
				.	' leading \'--\', also the \'-\' of the short form. Beware: just'
				.	' -'.$k.' is a group of short options, while -'.$k.'=foo would be'
				.	' an assignment to '.$k.'.'
					if $self->{config}{lazy};
			INT_wrap_print( $handle, "\t", "\t", $prosewidth, $notes);
			print $handle "\nHelp:";
			if(${$self->{help}{$k}} ne '')
			{
				print $handle "\n";
				INT_wrap_print($handle, "\t","\t", $prosewidth, ${$self->{help}{$k}});
			} else
			{
				print $handle " none";
			}
			INT_wrap_print($handle, "\t","\t", $prosewidth, $self->{extrahelp})
				if $k eq 'help';
			print "\n";
		} else
		{
			$self->INT_error("Parameter $k is not defined!");
		}
		return;
	}

	if($self->{param}{help} =~ /\D/)
	{
		$self->INT_error("You specified an invalid help level (parameter name needs two characters minimum).");
		return;
	}

	my $vst = (defined $self->{config}{version} ? "v$self->{config}{version} " : '');
	if(defined $self->{config}{tagline})
	{
		INT_wrap_print($handle, '', '', $prosewidth, "\n$self->{config}{program} ${vst}- ",$self->{config}{tagline});
		if(defined $self->{config}{usage})
		{
			print $handle "\nUsage:\n";
			INT_wrap_print($handle, "\t","\t", $prosewidth, $self->{config}{usage});
		}
		if(defined $self->{config}{info})
		{
			INT_wrap_print($handle, '', '', $prosewidth, "\n".$self->{config}{info});
		} elsif(defined $self->{config}{infopod})
		{
			print {$handle} "\n";
			INT_pod_print($handle, $prosewidth, $self->{config}{infopod});
		}
		INT_wrap_print($handle, '', '', $prosewidth, "\n$self->{config}{copyright}")
			if defined $self->{config}{copyright};
	}
	else
	{
		if(defined $self->{config}{info})
		{
			INT_wrap_print($handle, '', '', $prosewidth, "\n$self->{config}{program} ${vst}- ".$self->{config}{info})
		} elsif(defined $self->{config}{infopod})
		{
			print {$handle} "\n$self->{config}{program} ${vst}\n";
			INT_pod_print($handle, $prosewidth, $self->{config}{infopod});
		}

		INT_wrap_print($handle, '', '', $prosewidth, "\n$self->{config}{copyright}")
			if defined $self->{config}{copyright};
	}

	my $level = 0+$self->{param}{help};
	my $tablehead = '';

	if($self->{config}{posixhelp})
	{
		INT_wrap_print( $handle, '', '', $prosewidth
			,	"\nShort options can be grouped and non-optional arguments"
			.	" can follow without equal sign. Force options end with '--'."
			.	" Switches on with -, off with +."
			.	" See --help=par for details on possible advanced syntax with option"
			.	" --par." );
	} else
	{
		my $preprint = "NAME, SHORT ";
		$indent = length($preprint)
			if length($preprint) > $indent;
		$tablehead = $preprint
		.	INT_indent_string($indent, length($preprint))."VALUE [# DESCRIPTION]\n";
		INT_wrap_print( $handle, '', '', $prosewidth
		,	"\nGeneric parameter example (list of real parameters follows):\n" );
		print $handle "\n";
		if($self->{config}{lazy})
		{
			print $handle "\t$self->{config}{program} $example{lazy}\n";
			if($level > 1)
			{
				INT_wrap_print($handle, '', '', $prosewidth, "\n", $lazyinfo);
			}
		}
		else
		{
			print $handle "\t$self->{config}{program} $example{normal}\n";
		}
		print $handle "\n";
		if($level > 1)
		{
			INT_wrap_print($handle, '', '', $prosewidth, @morehelp)
		} else
		{ # Don't waste so many lines by default.
			INT_wrap_print($handle, '', '', $prosewidth
				, "Just mentioning -s equals -s=1 (true), while +s equals -s=0 (false)."
				, " The separator \"--\" stops option parsing."
			)
		}
		INT_wrap_print($handle, '', '', $prosewidth, "\nRecognized parameters:");
	}
	my @hidden_nonshort;
	my @hidden_level;
	if($self->{config}{ordered})
	{
		foreach my $s (@{$self->{section}})
		{
			if($level >= $s->{minlevel})
			{
				INT_wrap_print( $handle, '', '', $prosewidth, "\n".$s->{section} )
					if($s->{section} ne '');
				INT_wrap_print( $handle, '', '', $prosewidth, ${$s->{help}} )
					if(${$s->{help}} ne '');
				print $handle "\n".$tablehead;
			}
			# Go through the parameters at least to count the hidden ones.
			for my $k (@{$s->{member}})
			{
				$self->INT_param_help( $handle, $k, $level, $prosewidth, $indent
				,	\@hidden_nonshort, \@hidden_level );
			}
		}
	} else
	{
		print $handle "\n".$tablehead;
		for my $k ( sort keys %{$self->{param}} )
		{
			$self->INT_param_help( $handle, $k, $level, $prosewidth, $indent
			,	\@hidden_nonshort, \@hidden_level );
		}
	}
	if(@hidden_nonshort)
	{
		print $handle "\n";
		if($level> 1)
		{
			INT_wrap_print( $handle, '', '', $prosewidth,
				"Hidden parameters intended primarily for config files:" );
			INT_wrap_print( $handle, "\t", "\t", $prosewidth, "@hidden_nonshort" );
		} else
		{
			INT_wrap_print( $handle, '', '', $prosewidth, 'There'
			.	( @hidden_nonshort == 1
				?	'is one hidden config file parameter'
				:	'are '.(0+@hidden_nonshort).' hidden config file parameters' ) );
		}
	}
	if(@hidden_level)
	{
		print $handle "\n";
		if($level > 1)
		{
			INT_wrap_print( $handle, '', "\t", $prosewidth
			,	"Parameters explained at higher help levels: @hidden_level" );
		} else
		{
			INT_wrap_print( $handle, '', '', $prosewidth, "There "
			.	( @hidden_level == 1
				?	'is one parameter'
				:	'are '.(0+@hidden_level).' parameters' )
			.	' explained at higher help levels.' );
		}
	}
	print $handle "\n";
}

sub INT_param_help
{
	my $self = shift;
	my ($handle, $k, $level, $linewidth, $indent, $hidden_nonshort, $hidden_level) = @_;

	# Reasons to hide from current printout.
	my $hide = 0;
	if( $self->{config}{hidenonshort} and $self->{short}{$k} eq ''
		and not ($k eq 'version' and defined $self->{config}{version}) )
	{
		++$hide;
		push(@{$hidden_nonshort}, $k);
	}
	if($level < $self->{level}{$k})
	{
		++$hide;
		push(@{$hidden_level}, $k);
	}
	return
		if $hide;

	if($self->{config}{posixhelp})
	{
		$self->INT_param_help_posix($handle, $k, $linewidth, $indent);
	} else
	{
		$self->INT_param_help_table($handle, $k, $linewidth, $indent);
	}
}

sub INT_param_help_table
{
	my $self = shift;
	my ($handle, $k, $linewidth, $indent) = @_;

	# This format will change, I presume.
	# This is the parameter syntax-agnostic print, where that
	# information is shown elsewhere. People are used to
	# -s, --long=     Blablabla [default]
	# Let's go there.
	# long, s
	my $prefix = $k;
	$prefix .= ", $self->{short}{$k}" if($self->{short}{$k} ne '');
	$prefix .= ' ';
	my $content = $self->par_content($k, 'dump', 0);
	my $stab = ' ' x $indent;
	my @help = split("\n", ${$self->{help}{$k}});
	push(@help, split("\n", $self->{extrahelp}))
		if( $k eq 'help' and $self->{param}{help} > 1
			and defined $self->{extrahelp} );
	$help[0] = $content.(@help and $help[0] ne '' ? " # $help[0]" : '');
	for(my $i=0; $i<@help; ++$i)
	{
		INT_wrap_print( $handle, ( $i==0
			?	$prefix.INT_indent_string($indent, length($prefix))
			:	$stab ) , $stab, $linewidth, $help[$i] );
	}
}

sub INT_param_help_posix
{
	my $self = shift;
	my ($handle, $k, $linewidth, $indent) = @_;
	my $stab = ' ' x $indent;
	my $prefix = '';
	my $pm = $self->_pm($k);
	$prefix = $self->{short}{$k} ne '' ? "$pm$self->{short}{$k}, " : '    ';
	$prefix .= $pm.$pm.$self->INT_namearg($k).' ';
	my @help = split("\n", ${$self->{help}{$k}});
	push(@help, split("\n", $self->{extrahelp}))
		if($k eq 'help' and $self->{param}{help} > 1);
	# Splitting the empty string does not give an array with one empty string,
	# but an empty array instead.
	push(@help, '')
		unless @help;
	$help[0] = 'disable: '.$help[0]
		if $pm eq '+';
	for(my $i=0; $i<@help; ++$i)
	{
		INT_wrap_print( $handle, ( $i==0
			?	$prefix.INT_indent_string($indent, length($prefix), ' ')
			:	$stab ) , $stab, $linewidth, $help[$i] );
	}
}

# Have to cover two use cases:
# 1. Have defined param space, just want values.
# 2. Want to construct param space from file.
# Parse configured config files.
sub INT_parse_files
{
	my $self = shift;
	my $construct = shift;

	for my $file (@{$self->{param}{config}})
	{
		return 0 unless $self->parse_file($file, $construct);
	}
	return 1;
}

# check if it's existing and not a directory
# _not_ explicitly checking for files as that would exclude things that otherwise would work as files just fine
sub INT_filelike
{
	return (-e $_[0] and not -d $_[0])
}

# Look for given config file name in configured directory or search for it in
# the list of likely places. Appending the ending .conf is also tried.
sub INT_find_config
{
	my $self = shift;
	my $name = shift;

	return $name if File::Spec->file_name_is_absolute($name);

	# Let's special-case the current working directory. Do not want to spell it
	# out for the directory search loop.
	# But yes, it is a bit of duplication with the .conf addition. Sorry.
	return $name if(INT_filelike($name));
	return "$name.conf" if(INT_filelike("$name.conf"));

	my $path;
	my @dirs;
	#determine directory to search config files in
	if(defined $self->{config}{confdir})
	{
		@dirs = ($self->{config}{confdir});
	}
	else
	{
		@dirs = (
		 File::Spec->catfile($ENV{HOME},'.'.$self->{config}{program})
		,File::Spec->catfile($Bin,'..','etc',$self->{config}{program})
		,File::Spec->catfile($Bin,'..','etc')
		,File::Spec->catfile($Bin,'etc')
		,$Bin
		,File::Spec->catfile($ENV{HOME},'.config',$self->{config}{program})
		,File::Spec->catfile($ENV{HOME},'.config')
		);
	}

	for my $d (@dirs)
	{
		my $f = File::Spec->catfile($d, $name);
		$f .= '.conf' unless INT_filelike($f);
		if(INT_filelike($f))
		{
			$path = $f;
			last;
		}
	}

	$self->INT_verb_msg("Found config: $path\n") if defined $path;
	return $path
}

# Parse one given file.
sub parse_file
{
	my $self = shift;

	my $confname = shift;
	my $construct = shift;

	my $lend = '(\012\015|\012|\015)';
	my $nlend = '[^\012\015]';
	my $olderrs = @{$self->{errors}};
	require IO::File;

	# TODO: Support loading multiple occurences in order.
	my $file = $self->INT_find_config($confname);
	my $cdat = new IO::File;
	if(not defined $file)
	{
		$self->INT_error("Couldn't find config file $confname!") unless $self->{config}{nocomplain};
	}
	elsif(grep {$_ eq $file} @{$self->{parse_chain}})
	{
		$self->INT_error("Trying to parse config file $file twice in one chain!");
	}
	elsif($cdat->open($file, '<'))
	{
		push(@{$self->{parse_chain}}, $file);
		push(@{$self->{files}}, $file);
		if(defined $self->{config}{binmode})
		{
			binmode($cdat, $self->{config}{binmode});
		}
		#do we need or want binmode for newlines?
		my $multiline = '';
		my $mcollect = 0;
		my $ender = '';
		my $mkey ='';
		my $mop = '';
		my %curpar;
		my $ln = 0;
		while(<$cdat>)
		{
			++$ln;
			unless($mcollect)
			{
				next if ($_ =~ /^\s*#/ or $_ =~ /^\s*#?\s*$lend$/o);

				if($_ =~ /^=($nlend+)$lend*$/o)
				{
					my $meta = $1;
					if($construct)
					{
						if($meta =~ /^param file\s*(\(([^)]*)\)|)\s*for\s*(.+)$/)
						{
							$self->{config}{program} = $3;
							$self->INT_verb_msg("This file is for $self->{config}{program}.\n");
							if(defined $2 and $2 =~ /^(.+)$/)
							{
								for my $s (split(',', $1))
								{
									$self->INT_verb_msg("Activating option $s.\n");
									$self->INT_error("$file:$ln: eval option not supported anymore.") if($s eq 'eval');
									$self->{config}{$s} = 1;
								}
							}
						}
						elsif($meta =~ /^version\s*(.+)$/)
						{
							$self->{config}{version} = $1;
						}
						elsif($meta =~ /^info\s(.*)$/)
						{
							$self->{config}{info} .= $1."\n"; #dos, unix... whatever...
						}
						elsif($meta =~ /^infopod\s(.*)$/)
						{
							$self->{config}{infopod} .= $1."\n"; #dos, unix... whatever...
						}
					}
					# Groping for parameter description in any case.
					if($meta =~ /^(long|key)\s*(\S*)(\s*short\s*(\S)|)(\s*type\s*(\S+)|)/)
					{
						%curpar = (long=>$2, short=>defined $4 ? $4 : '', help=>'');
						my $type = defined $6 ? $6 : '';
						if(exists $typemap{$type})
						{
							$curpar{value} = $initval[$typemap{$type}];
							$self->INT_verb_msg("switching to key $curpar{long} / $curpar{short}\n");
						}
						else{ $self->INT_error("$file:$ln: unknown type $type"); %curpar = (); }
					}
					elsif($meta =~ /^(help|desc)\s(.*)$/)
					{
						$curpar{help} .= $curpar{help} ne '' ? "\n" : "" . $2;
					}
					elsif($meta =~ /^include\s*(.+)$/)
					{
						my $incfile = $1;
						# Avoid endless looping by making this path explicit.
						# Search for config file vicious if you tell it to load ../config and that also contains ../config ...
						$self->INT_verb_msg("including $incfile\n");
						unless(File::Spec->file_name_is_absolute($incfile))
						{
							my $dir = dirname($file);
							$dir = File::Spec->rel2abs($dir);
							$incfile = File::Spec->catfile($dir, $incfile);
							$incfile .= '.conf'
								unless -e $incfile;
						}
						$self->parse_file($incfile, $construct);
					}
				}
				else
				{
					if($_ =~ /^\s*($parname)\s*($lopex)\s*($nlend*)$lend$/)
					{
						my ($par,$op,$val) = ($1,$2,$3);
						#remove trailing spaces
						$val =~ s/\s*$//;
						#remove quotes
						$val =~ s/^"(.*)"$/$1/;
						$self->INT_definery(\%curpar, $par, $construct);
						if(exists $self->{param}{$par})
						{
							$self->INT_verb_msg("Setting $par $op $val\n");
							$self->INT_apply_op($par, $op, $val, $file);
						}
						else
						{
							unless($self->{config}{ignore_unknown})
							{
								$self->{param}{help} = 1 if($self->{config}{nanny});
								$self->INT_error("$file:$ln: unknown parameter $par");
							}
						}
					}
					elsif($_ =~ /^\s*($parname)\s*$lend$/)
					{
						my $par = $1;
						$self->INT_definery(\%curpar, $par, $construct);
						if(exists $self->{param}{$par})
						{
							$self->INT_verb_msg("Setting $par so that it is true.\n");
							$self->{param}{$par} = $trueval[$self->{type}{$par}];
						}
						else
						{
							unless($self->{config}{ignore_unknown})
							{
								$self->{param}{help} = 1 if($self->{config}{nanny});
								$self->INT_error("$file:$ln: unknown parameter $par");
							}
						}
					}
					elsif($_ =~ /^\s*($parname)\s*([$ops]?)<<(.*)$/)
					{
						$ender = $3;
						$mop = $2 ne '' ? $2 : '=';
						$mkey = $1;
						$mcollect = 1;
						$mop .= '=' unless $mop =~ /=$/;
						$self->INT_verb_msg("Reading for $mkey...(till $ender)\n");
					}
				}
			}
			else
			{
				$self->INT_verb_msg("collect: $_");
				unless($_ =~ /^$ender$/)
				{
					s/(^|$nlend)$lend$/$1\n/o;
					$multiline .= $_;
				}
				else
				{
					$mcollect = 0;
					# remove last line end
					$multiline =~ s/(^|$nlend)$lend$/$1/o;
					$self->INT_definery(\%curpar, $mkey, $construct);
					if(exists $self->{param}{$mkey})
					{
						# apply the config file options first, with eval() when desired
						$self->INT_apply_op($mkey, $mop, $multiline, $file);
						$self->INT_verb_msg("set $mkey from $multiline\n");
					}
					else
					{
						unless($self->{config}{ignore_unknown})
						{
							if($self->{config}{nanny}){ $self->{param}{help} = 1; }
							$self->INT_error("$file:$ln: unknown parameter $mkey!");
						}
					}

					$multiline = '';
				}
			}
		}
		$cdat->close();
		$self->INT_verb_msg("... done parsing.\n");
		pop(@{$self->{parse_chain}});
	}
	else{ $self->INT_error("Couldn't open config file $file! ($!)") unless $self->{config}{nocomplain}; }

	if(@{$self->{errors}} == $olderrs)
	{
		return 1
	} else
	{
		$self->{bad_config_file} = 1;
		return 0;
	}
}

# Just helper for the above, not gerneral-purpose.

# Define a parameter in construction mode or when needed to accept something unknown.
sub INT_definery
{
	my ($self, $curpar, $par, $construct) = @_;
	if(
		defined $curpar->{long}
		and (
		$construct
		or
		(
			$self->{config}{accept_unknown}
			and not exists $self->{param}{$par}
			and $curpar->{long} eq $par
		))
	){ $self->define($curpar); }

	$self->define({long=>$par}) if(not exists $self->{param}{$par} and ($construct or $self->{config}{accept_unknown}));
	%{$curpar} = ();
}

# Print out a config file.
sub print_file
{
	my ($self, $handle, $bare) = @_;

	my @omit = ('config','help');
	push(@omit,'version') if defined $self->{config}{version};
	push(@omit, @{$self->{config}{notinfile}}) if defined $self->{config}{notinfile};
	unless($bare)
	{
		print $handle <
# Configuration file for $self->{config}{program}
#
# Syntax:
#
EOT
	print $handle <
# 	name = value
# or
# 	name = "value"
#
# You can provide any number (including 0) of whitespaces before and after name and value. If you really want the whitespace in the value then use the second form and be happy;-)
EOT
	print $handle <
# It is also possible to set multiline strings with
# name <
# ...
# ENDSTRING
#
# (just like in Perl but omitting the ;)
# You can use .=, +=, /= and *= instead of = as operators for concatenation of strings or pushing to arrays/hashes, addition, substraction, division and multiplication, respectively.
# The same holds likewise for .<<, +<<, /<< and *<< .
#
# The short names are just provided as a reference; they're only working as real command line parameters, not in this file!
#
# The lines starting with "=" are needed for parsers of the file (other than $self->{config}{program} itself) and are informative to you, too.
# =param file (options) for program
# says for whom the file is and possibly some hints (options)
# =info INFO
# is the general program info (multiple lines, normally)
# =long NAME short S type TYPE
# says that now comes stuff for the parameter NAME and its short form is S. Data TYPE can be scalar, array or hash.
# =help SOME_TEXT
# gives a description for the parameter.
#
# If you don't like/need all this bloated text, the you can strip all "#", "=" - started and empty lines and the result will still be a valid configuration file for $self->{config}{program}.

EOT
	}
	print $handle '=param file ';
	my @opt = (); # There are no relevant options currently.
	print $handle '('.join(',',@opt).') ' if @opt;
	print $handle 'for '.$self->{config}{program}."\n";
	print $handle '=version '.$self->{config}{version}."\n" if defined $self->{config}{version};
	print $handle "\n";
	if(defined $self->{config}{info} and !$bare)
	{
		my @info = split("\n",$self->{config}{info});
		for(@info){ print $handle '=info '.$_."\n"; }
	}
	if(defined $self->{config}{infopod} and !$bare)
	{
		my @info = split("\n",$self->{config}{infopod});
		for(@info){ print $handle '=infopod '.$_."\n"; }
	}
	for my $k (sort keys %{$self->{param}})
	{
		unless(grep(/^$k$/, @omit))
		{
			#make line ending changeable...
			#or use proper system-independent line end
			#for now we just use \n - what may even work with active perl
			#
			unless($bare)
			{
				print $handle "\n=long $k"
					,$self->{short}{$k} ne '' ? " short $self->{short}{$k}" : ''
					," type $typename[$self->{type}{$k}]"
					,"\n";
				my @help = split("\n",${$self->{help}{$k}});
				for(@help)
				{
					print $handle "=help $_\n";
				}
			}
			my $values = $self->{type}{$k} ? $self->{param}{$k} : [ $self->{param}{$k} ];
			if($self->{type}{$k} == $hash)
			{
				my @vals;
				for my $k (sort keys %{$values})
				{
					push(@vals, $k.(defined $values->{$k} ? '='.$values->{$k} : ''));
				}
				$values = \@vals;
			}
			$values = [ undef ] unless defined $values;
			my $first = 1;
			print $handle "\n" unless $bare;
			for my $v (@{$values})
			{
				my $preop = $self->{type}{$k}
					? ( (not $first)
						? '.'
						: ( (@{$values} > 1) ? ' ' : '' ) )
					: '';
				if(defined $v)
				{
					if($v =~ /[\012\015]/)
					{
						my $end = 'EOT';
						my $num = '';
						$v =~ s/[\012\015]*\z/\n/g; # that line end business needs testing
						while($v =~ /(^|\n)$end$num(\n|$)/){ ++$num; }
						print $handle "$k $preop<<$end$num\n$v$end$num\n";
					}
					else{ print $handle "$k $preop= \"$v\"\n"; }
				}
				else{ print $handle "# $k is undefined\n"; }

				$first = 0;
			}
		}
	}
}

sub INT_push_hash
{
	my $self = shift;
	my $par = shift; for (@_)
	{
		my ($k, $v) = split('=',$_,2);
		if(defined $k)
		{
			$par->{$k} = $v;
		} else
		{
			$self->INT_error("Undefined key for hash $_[0]. Did you mean --$_[0]// to empty it?");
		}
	}
}

# The low-level worker for applying one parameter operation.
sub INT_apply_op
{
	my $self = shift; # (par, op, value, file||undef)

	return unless exists $self->{param}{$_[0]};

	if($self->{type}{$_[0]} == $scalar)
	{
		no warnings 'numeric';
		my $par = \$self->{param}{$_[0]}; # scalar ref
		if   ($_[1] eq  '='){ $$par  = $_[2]; }
		elsif($_[1] eq '.='){ $$par .= $_[2]; }
		elsif($_[1] eq '+='){ $$par += $_[2]; }
		elsif($_[1] eq '-='){ $$par -= $_[2]; }
		elsif($_[1] eq '*='){ $$par *= $_[2]; }
		elsif($_[1] eq '/='){ $$par /= $_[2]; }
		else{ $self->INT_error("Operator '$_[1]' on '$_[0]' is invalid."); $self->{param}{help} = 1; }
	}
	elsif($self->{type}{$_[0]} == $array)
	{
		my $par = $self->{param}{$_[0]}; # array ref
		my $bad;
		if   ($_[1] eq  '='){ @{$par} = ( $_[2] ); }
		elsif($_[1] eq '.='){ push(@{$par}, $_[2]); }
		elsif($_[1] eq  '//=' or ($_[1] eq '/=' and $_[2] eq '/')){ @{$par} = (); }
		elsif($_[1] =~ m:^/(.)/(.*)$:) # operator with specified array separator
		{
			my $sep = $1; # array separator
			my $op  = $2; # actual operator
			my @values = split(/\Q$sep\E/, $_[2]);
			if   ($op eq  '='){ @{$par} = @values; }
			elsif($op eq '.='){ push(@{$par}, @values); }
			else{ $bad = 1; }
		}
		else{ $bad = 1 }
		if($bad)
		{
			$self->INT_error("Operator '$_[1]' is invalid for array '$_[0]'!");
			#$self->{param}{help} = 1;
		}
	}
	elsif($self->{type}{$_[0]} == $hash)
	{
		my $par = $self->{param}{$_[0]}; # hash ref
		my $bad;

		if($_[1] =~ m:^/(.)/(.*)$:) # operator with specified array separator
		{
			my $sep = $1; # array separator
			my $op  = $2; # actual operator
			my @values = split(/\Q$sep\E/, $_[2]);
			# a sub just to avoid duplicating the name=value splitting and setting
			if   ($op eq  '='){ %{$par} = (); $self->INT_push_hash($par,@values); }
			elsif($op eq '.='){ $self->INT_push_hash($par,@values); }
			else{ $bad = 1; }
		}
		elsif($_[1] eq  '//=' or ($_[1] eq '/=' and $_[2] eq '/'))
		{
			%{$par} = ();
		} else
		{
			if   ($_[1] eq  '='){ %{$par} = (); $self->INT_push_hash($par,  $_[2]); }
			elsif($_[1] eq '.='){ $self->INT_push_hash($par, $_[2]); }
			else{ $bad = 1 }
		}
		if($bad)
		{
			$self->INT_error("Operator '$_[1]' is invalid for hash '$_[0]'!");
			$self->{param}{help} = 1;
		}
	}
}

sub INT_value_check
{
	my $self = shift;
	my $p = $self->{param};
	my $olderr = @{$self->{errors}};
	for my $k (keys %{$self->{regex}})
	{
		if($self->{type}{$k} == $scalar)
		{
			$self->INT_error("Value of $k does not match regex: $p->{$k}")
				unless $p->{$k} =~ $self->{regex}{$k};
		} elsif($self->{type}{$k} == $array)
		{
			for(my $i=0; $i<@{$p->{$k}}; ++$i)
			{
				$self->INT_error("Element $i of $k does not match regex: $p->{$k}[$i]")
					unless $p->{$k}[$i] =~ $self->{regex}{$k};
			}
		} elsif($self->{type}{$k} == $hash)
		{
			for my $n (sort keys %{$p->{$k}})
			{
				$self->INT_error("Element $n of $k does not match regex: $p->{$k}{$n}")
					unless $p->{$k}{$n} =~ $self->{regex}{$k};
			}
		}
	}
	for my $k (keys %{$p})
	{
		no warnings 'uninitialized';
		next
			unless ($self->{flags}{$k} & $nonempty);
		unless(
			( $self->{type}{$k} == $scalar and $p->{$k} ne '' ) or
			( $self->{type}{$k} == $array  and @{$p->{$k}}    ) or
			( $self->{type}{$k} == $hash   and %{$p->{$k}}    )
		){
			$self->INT_error("Parameter $k is empty but should not be.");
		}
	}
	return $olderr == @{$self->{errors}};
}

sub current_setup
{
	require Storable;
	my $self = shift;
	my $config = Storable::dclone($self->{config});
	my @pardef;
	my $bin = builtins($self->{config});
	for my $p (sort keys %{$self->{param}})
	{
		next if $bin->{$p};
		my $val = ref($self->{param}{$p}) ? Storable::dclone($self->{param}{$p}) : $self->{param}{$p};
		push(@pardef, $p, $val, $self->{short}{$p}, ${$self->{help}{$p}});
	}
	return ($config, \@pardef);
}


# Little hepler for modifying the parameters.
# Apply all collected operations to a specific parameter.
sub INT_apply_ops
{
	my $self = shift;
	my $key = shift;
	return unless defined $self->{ops}{$key};
	$self->INT_verb_msg("Param: applying (@{$self->{ops}{$key}}) to $key of type $self->{type}{$key}\n");
	while(@{$self->{ops}{$key}})
	{
		my $op  = shift(@{$self->{ops}{$key}});
		my $val = shift(@{$self->{ops}{$key}});
		$self->INT_apply_op($key, $op, $val);
	}
}

sub INT_verb_msg
{
	my $self = shift;
	return unless ($verbose or $self->{config}{verbose});
	print STDERR "[Config::Param] ", @_;
}

sub INT_error
{
	my $self = shift;
	print STDERR "$self->{config}{program}: [Config::Param] Error: "
	,	$_[0], "\n" unless $self->{config}{silenterr};
	push(@{$self->{errors}}, $_[0]);
	return 1;
}

1;

__END__