App::Framework::Lite - A lightweight framework for creating applications

  use App::Framework::Lite ;

  go() ;

  sub app
  {
	my ($app, $opts_href, $args_href) = @_ ;

	# options
	my %opts = $app->options() ;

	# aplication code here....  	
  }

    use App::Framework::Lite ;

    use App::Framework::Lite '+Args(open=none)' ;

    # Create application and run it
    App::Framework::Lite->new()->go() ;

    # Create application and run it
    go() ;

    __DATA__

    [SUMMARY]

    An example of using the application framework

    [ARGS]

    * infile=f        Input file

    Should be set to the input file

    * indir=d        Input dir

    Should be set to the input dir

    [OPTIONS]

    -table=s        Table [default=listings2]

    Sql table name

    -database=s        Database [default=tvguide]

    Sql database name

    


    [DESCRIPTION]

    B<$name> is an example script.

    * <name>=<specification>    <Summary>    <optional default setting>

    <Description> 

   [ <direction> ] [ <binary> ] <type> [ <multiple> ]

    [default=<value>]

    [ARGS]

    * file=f		Input file

    A simple input directory name (directory must exist)

    * out=>f		Output file (file will be created)

    An output filename

    infile.txt outfile.txt

    'file'    => 'infile.txt'
    'out'     => 'outfile.txt'
    'file_fh' => <file handle of 'infile.txt'>
    'out_fh'  => <file handle of 'outfile.txt'>

    # Open no file handles 
    use App::Framework '+Args(open=none)' ;

    # Open only input file handles 
    use App::Framework '+Args(open=in)' ;

    # Open only output file handles 
    use App::Framework '+Args(open=out)' ;

    # Open all file handles (the default)
    use App::Framework '+Args(open=all)' ;

	$<name>
	${<name>}

    sub app
    {
        my ($app, $opts_href, $args_href) = @_ ;

        # use parameter
        my $infile = $args_href->{infile}

        # access alias
        my @args = $app->args() ;
        $infile = $args[0] ;

        # access alias
        @args = $app->Args() ;
        $infile = $args[0] ;

        ($infile) = $app->args('infile') ;

        # feature object
        @args = $app->feature('Args')->args() ;
        $infile = $args[0] ;
    }

    [ARGS]

    * file=f		Input file

    A simple input file name (file must exist)

    * dir=d			Input directory

    A simple input directory name (directory must exist)

    * out=>f		Output file (file will be created)

    An output filename

    * outdir=>d		Output directory

    An output directory name (path will be created) 

    * append=>>f	Output file append

    An output filename (an existing file will be appended; otherwise file will be created)

    * array=<f*		All other args are input files

    Any other command line arguments will be pushced on to this array. 

    infile.txt indir outfile.txt odir append.txt file1.txt file2.txt file3.txt 

    'file'     => 'infile.txt'
    'file_fh'  => <infile.txt file handle>
    'dir'      => 'indir'
    'out'      => 'outfile.txt'
    'out_fh'   => <outfile.txt file handle>
    'outdir'   => 'odir'
    'append'   => 'append.txt'
    'append_fh'=> <append.txt file handle>
    'array'    => [
    	'file1.txt'
    	'file2.txt'
    	'file3.txt'
    ]
    'array_fh' => [
    	<file1.txt file handle>
    	<file2.txt file handle>
    	<file3.txt file handle>
    ]

    sub app
    {
        my ($app, $opts_href, $args_href) = @_ ;

        foreach my $fh (@{$args_href->{array_fh}})
        {
            while (my $data = <$fh>)
            {
                # do something ... 
            }
        }
    }    

    __DATA__
    [ARGS]
    * array=f@    Input file

    -<name><specification>    <Summary>    <optional default setting>

    <Description> 

    -log|logfile|l
    -l|'log'|logfile
    -log

   [ <flag> ] <type> [ <desttype> ]

    [default=<value>]

	$<name>
	${<name>}

    sub app
    {
        my ($app, $opts_href, $args_href) = @_ ;

        # use parameter
        my $log = $opts_href->{log}

        # access alias
        my %options = $app->options() ;
        $log = $options{log} ;

        # access alias
        %options = $app->Options() ;
        $log = $options{log} ;

        # feature object
        %options = $app->feature('Options')->options() ;
        $log = $options{log} ;
    }

    [OPTIONS]

    -n|'name'=s        Test name [default=a name]

    String option, accessed as $opts_href->{name}. 

    -nomacro    Do not create test macro calls

    Boolean option, accessed as $opts_href->{nomacro}

    -log=s        Override default [default=another default]

    Over rides the default log option (specified by the framework)

    -int=i        An integer

    Example of integer option

    -float=f    An float

    Example of float option

    -array=s@    An array

    Example of an array option

    -hash=s%    A hash

    Example of a hash option

    -int 1234 -float 1.23 -array a -array b -array c -hash key1=val1 -hash key2=val2 -nomacro

    'name' => 'a name'
    'nomacro' => 1
    'log' => 'another default'
    'int' => 1234
    'float' => 1.23
    'array' => [ 'a', 'b', 'c' ]
    'hash' => {
    	'key1' => 'val1',
    	'key2' => 'val2',
    }

  [ <section name> ]

  <settings>

	my $data = $app->data('data1') ;

	__DATA__

	[DESCRIPTION]
	An example

	__DATA__ test.txt

	some text

	__DATA__ a_bit_of_sql.sql

	DROP TABLE IF EXISTS `listings2`;

	my $file = $app->data('text.txt') ;
	# or
	$file = $app->data('data1') ;

	my $sql = $app->data('a_bit_of_sql.sql') ;
	# or
	$file = $app->Data('data2') ;

	$<name>
	${<name>}

    __#

	* $progpath
	* $progpath/lib

	perl test.pl -alf-embed alf-test.pl

	perl test.pl -alf-embed alf-test.pl -alf-embed-lib 0

	perl test.pl -alf-embed alf-test.pl -alf-compress 0

 * name = Program name (default is name of program)
 * summary = Program summary text
 * synopsis = Synopsis text (default is program name and usage)
 * description = Program description text
 * history = Release history information
 * version = Program version (default is value of 'our $VERSION')

 * app_start_fn = Function called before app() function (default is application-defined 'app_start' subroutine if available)
 * app_fn = Function called to execute program (default is application-defined 'app' subroutine if available)
 * app_end_fn = Function called after app() function (default is application-defined 'app_end' subroutine if available)
 * usage_fn = Function called to display usage information (default is application-defined 'usage' subroutine if available)

 * package = Name of the application package (usually main::)
 * filename = Full filename path to the application (after following any links)
 * progname = Name of the program (without path or extension)
 * progpath = Pathname to program
 * progext = Extension of program

    perldoc App::Framework::Lite

package App::Framework::Lite ;

use 5.008004;

use strict ;


our $VERSION = "1.07" ;


#============================================================================================
# USES
#============================================================================================
use Carp ;
use Cwd ;
use Getopt::Long qw(:config no_ignore_case) ;
use Pod::Usage ;
use File::Basename ;
use File::Path ;
use File::Temp ;
use File::Spec ;
use File::DosGlob 'glob' ;
#use File::Which ;


#============================================================================================
# OBJECT HIERARCHY
#============================================================================================
our @ISA ; 

#============================================================================================
# GLOBALS
#============================================================================================

my $class_debug ;

# default to state that the module is embedded (overwritten inside BEGIN block)
my $EMBEDDED = 0 ;

# Maximum line length when embedding (e.g. ensures Clearcase doesn't think file is binary!)
my $MAX_LINE_LEN = 5000 ;

# Keep track of import info
my $import_args ;

# Run error action
our $ON_ERROR_DEFAULT = 'fatal' ;

## Set up variables
my	%FIELDS = (
		'name'				=> undef,
		'progname'			=> undef,
		'progpath'			=> undef,
		'progext'			=> undef,
		'package'			=> undef,
		'filename'			=> undef,
		'version'			=> undef,
		'app'				=> undef,

		'synopsis'			=> "",
		'description'		=> "",
		'summary'			=> "",
		
		'debug'				=> 0,
		
		'app_start_fn'	=> undef,	
		'app_fn'		=> undef,	
		'app_end_fn'	=> undef,
	
		## Data fields
		'_data'				=> [],
		'_data_hash'		=> {},
		
		## Options fields
		'_user_options'		=> [],
		'_options_list'		=> [],
		'_options'			=> {},
		'_get_options'		=> [],
		'_option_fields_hash'		=> {},
		'option_names'		=> [],
		'opts_feature_args'	=> '',
		
		## Args fields
		'user_args'			=> [],		# User-specified args
		'argv'				=> [],		# ref to @ARGV
		'arg_names'			=> [],		# List of arg names
		'_arg_list'			=> [],	# Final ARRAY ref of args - EXCLUDING any opened files
		'_args'				=> {},	# Final args HASH - key = arg name; value = arg value
		'_arg_names_hash'	=> {},	# List of HASHes, each hash contains details of an arg
		'_fh_list'			=> [],	# List of any opened file handles
		'args_feature_args'	=> '',
		
		## Exit
		'exit_type'			=> 'exit',

		## Run fields
		'cmd'		=> undef,
		'args'		=> undef,
		'timeout'	=> undef,
		'nice'		=> undef,
		'dryrun'	=> 0,
		
		'on_error'	=> $ON_ERROR_DEFAULT,
		'error_str'	=> "",
		'required'	=> {},
		
		'check_results'	=> undef,
		'progress'		=> undef,
		
		'status'	=> 0,
		'results'	=> [],
		
		'norun'		=> 0,


		'log'		=> {
			'all'		=> 0,
			'cmd'		=> 0,
			'results'	=> 0,
			'status'	=> 0,
		},

		## Logging
		'logfile'		=> undef,
		'mode'			=> 'truncate',
		'to_stdout'		=> 0,
		
		'_started'		=> 0,
		
	) ;

my $POD_HEAD =	"=head" ;
my $POD_OVER =	"=over" ;

my @DEFAULT_OPTS = (
	['debug=i',			'Set debug level', 	'Set the debug level value', ],
	['v|"verbose"',		'Verbose output',	'Make script output more verbose', ],
	['dryrun|"norun"',	'Dry run', 			'Do not execute anything that would alter the file system, just show the commands that would have executed'],
	['h|"help"',		'Print help', 		'Show brief help message then exit'],
	['man',				'Full documentation', 'Show full man page then exit' ],
	['man-dev',			'Full developer\'s documentation', 'Show full man page for the application developer then exit' ],
	['log=s',			'Log file', 		'Specify a log file', ],
	['dev:pod',			'Output full pod', 	'Show full man page as pod then exit' ],
	['dev:dbg-data',		'Debug option: Show __DATA__', 				'Show __DATA__ definition in script then exit' ],
	['dev:dbg-data-array',	'Debug option: Show all __DATA__ items', 	'Show all processed __DATA__ items then exit' ],
	['dev:alf-info',	'Module information', 	'Display information about the App::Framework::Lite module then exit' ],
	['dev:alf-debug=i',	 'Debug App::Framework::Lite', 	'Set the debug level value of the App::Framework::Lite module', ],
#@NO-EMBED BEGIN
	['dev:alf-embed=s',		'Embed module', 	'Embed the App::Framework::Lite module into script then exit. Specify the filename of the new script.' ],
	['dev:alf-embed-lib=i',	'Embed libraries', 	'(Only used when embedding). Embed user modules as well as the App::Framework::Lite module.', 1 ],
	['dev:alf-compress=i',	'Compress embedded', 	'(Only used when embedding). Compress the embedded modules.', 1 ],
#@NO-EMBED END
	) ;

our @USED = (
	'Carp',
	'Cwd',
	'Getopt::Long qw(:config no_ignore_case)',
	'Pod::Usage',
	'File::Basename',
	'File::Path',
	'File::Temp',
	'File::Spec',
	'File::DosGlob qw(glob)',
) ;

our @OPT_MOD = (
	'File::Which',
) ;
our %AVAILABLE_MOD ;


#============================================================================================
BEGIN {

#@NO-EMBED BEGIN
	# Clear flag for non-embedded
	$EMBEDDED = 1 ;
#@NO-EMBED END

	## Get caller information
	my ($package, $filename, $line, $subr, $has_args, $wantarray) = caller(0) ;

	## Add a couple of useful function calls into the caller namespace
	{
		no warnings 'redefine';
		no strict 'refs';

		foreach my $fn (qw/go/)	
		{
			*{"${package}::$fn"} = sub {  
			    my @callinfo = caller(0);
				my $app = App::Framework::Lite->new(@_,
					'_caller_info' => \@callinfo) ;
				$app->$fn() ;
			};
		}	
	}
	
	## Optional modules
	foreach my $mod (@OPT_MOD)
	{
		# see if we can load up the package
		if (eval "require $mod") 
		{
			$mod->import() ;
			++$AVAILABLE_MOD{$mod} ;

		}
	}
}

#============================================================================================
# Set up module import
sub import 
{
    my $pkg     = shift;

	# save for later    
    $import_args = join ' ', @_ ;

	## Get caller information
	my ($package, $filename, $line, $subr, $has_args, $wantarray) = caller(0) ;

	## Set program info
	App::Framework::Lite->_set_paths($filename) ;
	

	## Import modules into caller space
	my $include = "package $package;\n" ;
	foreach my $use (@USED)
	{
		$include .= "use $use ;\n" ;
	}
	foreach my $use (keys %AVAILABLE_MOD)
	{
		if ($AVAILABLE_MOD{$use})
		{
			$include .= "use $use ;\n" ;
		}
	}
	eval $include ;
	die "Error: Unable to load modules into $package : $@" if $@ ;
}


#============================================================================================

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

sub new
{
	my ($obj, %args) = @_ ;

	my $class = ref($obj) || $obj ;

	# Create object
	my $this = {} ;
	bless ($this, $class) ;
	$this->{'app'} = $this ;

	## get import args
	if (exists($args{'specification'}))
	{
		$import_args = delete $args{'specification'} ;
	}
	

	## init
	foreach my $field (keys %FIELDS)
	{
		$this->{$field} = $FIELDS{$field} ;
	}
	$this->_setup_modules() ;
	
	## Get caller information
	my $callinfo_aref = delete $args{'_caller_info'} ;
	if (!$callinfo_aref)
	{
		$callinfo_aref = [ caller(0) ] ;	
	}
	my ($package, $filename, $line, $subr, $has_args, $wantarray) = @$callinfo_aref ;
	$this->set(
		'package'	=> $package,
		'filename'	=> $filename,
	) ;
	
	## Set program info
	$this->_set_paths($filename) ;
	
	## set up functions
	foreach my $fn_aref (
		# prefered
		['app_start',	'app_start'],
		['app',			'app'],
		['app_end',		'app_end'],
		['usage',		'usage'],

		# alternates
		['app_begin',	'app_start'],
		['app_enter',	'app_start'],
		['app_init',	'app_start'],
		['app_finish',	'app_end'],
		['app_exit',	'app_end'],
		['app_term',	'app_end'],
	)
	{
		my ($fn, $alias) = @$fn_aref ;
		
		# Only add function if it's not already been specified
		$this->_register_fn($fn, $alias) ;
	}


	## Get version
	$this->_register_scalar('VERSION', 'version') ;

	## Ensure name set
	if (!$this->{name})
	{
		$this->{name} = $this->{progname} ;		
	}
	
	# Process import args
	#
	my %feature_args ;

	my $personality ;
	my @features ;
	my @extensions ;
	my %extension_args ;
	
	# Expect something of the form:
	# :Personality ::Extension ::Ext(option1 option2) +Feature +Feat(opt1, opt2)
	#
	#                           type        name       args 
	while ($import_args =~ /\s*([\:\+]{1,2})([\w_]+)\s*(?:\(([^\)]+)\)){0,1}/g)
	{
		my ($type, $name, $args) = ($1, $2, $3) ;
		if ($type eq ':')
		{
			if ($personality)
			{
				croak "Sorry, App::Framework::Lite does not support multiple personalities (please see a psychiatrist!)" ;
			}
			if ($args)
			{
				warn "Sorry, personalities do not support arguments" ;
			}
			$personality = $name ;
		}
		elsif ($type eq '::')
		{
			push @extensions, $name ;
			$extension_args{$name} = $args || "" ;
		}
		elsif ($type eq '+')
		{
			push @features, $name ;
			$feature_args{$name} = $args || "" ;
		}
		else
		{
			croak "App::Framework does not understand the import string \"$import_args\" at \"$type\" " ;
		}
	}

	# set feature args
	foreach my $feature (keys %feature_args)
	{
		my $field = lc $feature ;
		$field .= "_feature_args" ;
		$this->{$field} = $feature_args{$feature} ;
	}
	
	## Set any fields
	$this->set(%args) ;
	
	return($this) ;
}

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

sub set
{
	my $this = shift ;
	my (%args) = @_ ;

	foreach my $field (keys %FIELDS)
	{
		if (exists($args{$field})) 
		{
			$this->{$field} = $args{$field}  ;
		}
	}
}

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

sub vars
{
	my $this = shift ;
	my %vars = () ;

	foreach my $field (keys %FIELDS)
	{
		if (!ref($this->{$field}) || (ref($this->{$field}) eq 'SCALAR'))
		{
			$vars{$field} = $this->{$field} ;
		}
	}
	
	return %vars ;
}

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

sub feature
{
	my $this = shift ;
	my ($name, %args) = @_ ;

	return $this ;	
}




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

sub go
{
	my $this = shift ;

	$this->app_start() ;
	$this->app_handle_opts() ;
	$this->application() ;
	$this->app_end() ;

	$this->exit(0) ;
}


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

sub getopts
{
	my $this = shift ;

	# get options	
	my $ok = $this->get_options() ;

	# If ok, get any specified filenames
	if ($ok)
	{
		# Get args
		my $arglist = $this->get_args() ;

		$this->_dbg_prt(["getopts() : arglist=", $arglist], 2) ;
	}
	
	## Expand vars
	my %values ;
	my ($opt_values_href, $opt_defaults_href) = $this->option_values_hash() ;
	my ($args_values_href) = $this->args_values_hash() ;
	
	%values = (%$opt_values_href) ;
	my %args_clash ;
	foreach my $key (keys %$args_values_href)
	{
		if (exists($values{$key}))
		{
			$args_clash{$key} = $args_values_href->{$key} ;
		}
		else
		{
			$values{$key} = $args_values_href->{$key} ;
		}
	}

	my @vars ;
	my %app_vars = $this->vars ;
	push @vars, \%app_vars ;
	push @vars, \%ENV ;

	## expand all vars
	$this->expand_keys(\%values, \@vars) ;
	
	# set new values
	foreach my $key (keys %$opt_values_href)
	{
		$opt_values_href->{$key} = $values{$key} ;
	}
	foreach my $key (keys %$args_values_href)
	{
		$args_values_href->{$key} = $values{$key} ;
	}

	## handle any name clash
	if (keys %args_clash)
	{
		unshift @vars, \%values ;
		$this->expand_keys(\%args_clash, \@vars) ;

		# set new values
		foreach my $key (keys %args_clash)
		{
			$args_values_href->{$key} = $args_clash{$key} ;
		}
	}

	## update settings
	$this->option_values_set($opt_values_href, $opt_defaults_href) ;
	$this->args_values_set($args_values_href) ;

	return $ok ;
}

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

sub app_start
{
	my $this = shift ;

	## Process data
	$this->process_data() ;

	## Get options
	
	# get the list suitable for GetOpts
	my $get_options_aref = $this->{_get_options} ;

	## Get options
	# NOTE: Need to do this here so that derived objects work properly
	my $ok = $this->getopts() ;
	
	## Expand any variables in the application object field values
	$this->_expand_vars() ;

	# Handle options errors here after expanding variables
	unless ($ok)
	{
		$this->usage('opt') ;
		$this->exit(1) ;
	} 

	## Run application function
	my %options = $this->options() ;
	$this->_exec_fn('app_start', $this, \%options) ;


	## expand data variables
	my %app_vars = $this->vars() ;
	my %opts = $this->options() ;
	my $args_values_href = $this->args_values_hash() ;
	my $data_href = $this->{_data_hash} ;
	$this->expand_keys($data_href, [\%opts, $args_values_href, \%app_vars, \%ENV]) ;
}

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

sub app_handle_opts
{
	my $this = shift ;

	## Get options
	my %options = $this->options() ;

	## Handle special options
	my %opts = $this->options() ;
	if ($opts{'man'} || $opts{'help'})
	{
		my $type = $opts{'man'} ? 'man' : 'help' ;
		$this->usage($type) ;
		$this->exit(0) ;
	}
	if ($opts{'man-dev'})
	{
		$this->usage('man-dev') ;
		$this->exit(0) ;
	}
	if ($opts{'pod'})
	{
		print $this->pod() ;
		$this->exit(0) ;
	}
	if ($opts{'alf-debug'})
	{
		$this->{debug} = $opts{'alf-debug'} ;
	}
	if ($opts{'dbg-data'})
	{
		$this->_show_data() ;
		$this->exit(0) ;
	}
	if ($opts{'dbg-data-array'})
	{
		$this->_show_data_array() ;
		$this->exit(0) ;
	}

	if ($opts{'alf-info'})
	{
		print "App::Framework::Lite info\n" ;
		print "  Version:  $VERSION\n" ;
		print "  Embedded: " . ($EMBEDDED ? "yes" : "no") . "\n" ;
		$this->exit(0) ;
	}

#@NO-EMBED BEGIN
	if ($opts{'alf-embed'})
	{
		my $src = $this->{'filename'} ;
#		my $dest = $this->{'progpath'} . '/' . "alf-" . $this->{'progname'} . $this->{'progext'} ;
		my $dest = $opts{'alf-embed'} ;
		my %libs = $this->embed($src, $dest, $opts{'alf-compress'}, $opts{'alf-embed-lib'}) ;
		print "Embedded App::Framework::Lite into $src. Stand-alone script saved as $dest.\n" ;
		print "Embedded the following library modules:\n" ;
		foreach my $mod (sort {$libs{$a}{'order'} <=> $libs{$b}{'order'} } keys %libs)
		{
			print "    $mod\n" ;
		}
		
		print "Have a nice life.\n" ;
		$this->exit(0) ;
	}
#@NO-EMBED END

	if ($opts{'log'})
	{
		$this->{logfile} = $opts{'log'} ;
	}

}


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

sub application
{
	my $this = shift ;

	## Get options
	my %options = $this->options() ;

	## Check args here (do this AFTER allowing derived objects/features a chance to check the options etc)
	$this->check_args() ;
	
	# get args
	my %args = $this->arg_hash() ;

	## Run application function
	$this->_exec_fn('app', $this, \%options, \%args) ;

	## Close any open arguments
	$this->close_args() ;
}

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

sub app_end
{
	my $this = shift ;

	# get options
	my %options = $this->options() ;

	## Execute function
	$this->_exec_fn('app_end', $this, \%options) ;
}



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

sub exit
{
	my $this = shift ;
	my ($exit_code) = @_ ;

	if ($this->{'exit_type'} =~ /exit/i)
	{
		exit $exit_code ;
	}
	else
	{
		# check for eval (for testing)
		if ($^S) 
		{
			die "End of application. Exit code = $exit_code" ;
   		} 
   		else 
   		{
      		carp(@_);
			exit $exit_code ;
   		}
	}	
}


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

sub usage
{
	my $this = shift ;
	my ($level) = @_ ;

	$level ||= "" ;

	# TODO: Work out a better way to convert pod without the use of external file!
	
	# get temp file
	my $fh = new File::Temp();
	my $fname = $fh->filename;
	
	# write pod
	my $developer = $level eq 'man-dev' ? 1 : 0 ;
	print $fh $this->pod($developer) ;
	close $fh ;

	# pod2usage 
	my ($exitval, $verbose) = (0, 0) ;
	($exitval, $verbose) = (2, 0) if ($level eq 'opt') ;
	($exitval, $verbose) = (1, 0) if ($level eq 'help') ;
	($exitval, $verbose) = (0, 2) if ($level =~ /^man/) ;

	# make file readable by all - in case we're running as root
	chmod 0644, $fname ;

#	system("perldoc",  $fname) ;
	pod2usage(
		-verbose	=> $verbose,
#		-exitval	=> $exitval,
		-exitval	=> 'noexit',
		-input		=> $fname,
		-noperldoc =>1,
		
		-title => $this->{name},
		-section => 1,
	) ;

	# remove temp file
	unlink $fname ;

}


#============================================================================================
# OPTIONS
#============================================================================================


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

sub options
{
	my $this = shift ;

$this->_dbg_prt( ["Options()\n"] ) ;

	my $options_href = $this->{_options} ;
	return %$options_href ;
}

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

*Options = \&options ;


#----------------------------------------------------------------------------
#
#=item B<_expand_options()>
#
#Expand any variables in the options
#
#=cut
#
sub _expand_options 
{
	my $this = shift ;

$this->_dbg_prt(["_expand_options()\n"]) ;

	my $options_href = $this->{_options} ;
	my $options_fields_href = $this->{_option_fields_hash} ;

	# get defaults & options
	my (%defaults, %values) ;
	foreach my $opt (keys %$options_fields_href)
	{
		$defaults{$opt} = $options_fields_href->{$opt}{'default'} ;
		$values{$opt} = $options_href->{$opt} if defined($options_href->{$opt}) ;
	}
$this->_dbg_prt(["_expand_options: defaults=",\%defaults," values=",\%values,"\n"]) ;

#	# get replacement vars
#	my @vars ;
#	my $app = $this->app ;
#	if ($app)
#	{
#		my %app_vars = $app->vars ;
#		push @vars, \%app_vars ;
#	}
	
#	## expand
#	my @vars ;
#	push @vars, \%ENV ;
#	$this->expand_keys(\%values, \@vars) ;
#	push @vars, \%values ;	# allow defaults to use user-specified values
#	$this->expand_keys(\%defaults, \@vars) ;
#
#$this->_dbg_prt(["_expand_options - end: defaults=",\%defaults," values=",\%values,"\n"]) ;
	
	## Update
	foreach my $opt (keys %$options_fields_href)
	{
		# update defaults to reflect any user specified options
		$defaults{$opt} = $values{$opt} ;
		$options_fields_href->{$opt}{'default'} = $defaults{$opt} ;
		
		# update values
		$options_href->{$opt} = $values{$opt} if defined($options_href->{$opt}) ;
	}
}

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

sub get_options
{
	my $this = shift ;

	# Do final processing of the options
	$this->update() ;
	
	# get the list suitable for GetOpts
	my $get_options_aref = $this->{_get_options} ;

$this->_dbg_prt( ["get_options() : ARGV=", \@ARGV, " Options=", $get_options_aref], 2 ) ;

	# Parse options using GetOpts
	my $ok = GetOptions(@$get_options_aref) ;

	# Expand the options variables
	$this->_expand_options() ;

$this->_dbg_prt( ["get_options() : ok=$ok  Options now=", $get_options_aref], 2 ) ;

	return $ok ;
}


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

sub option_entry
{
	my $this = shift ;
	my ($option_name) = @_ ;

	my $option_fields_href = $this->{_option_fields_hash} ;
	my $opt_href ;
	if (exists($option_fields_href->{$option_name}))
	{
		$opt_href = $option_fields_href->{$option_name} ;
	}
	return $opt_href ;
}


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

sub option_values_hash
{
	my $this = shift ;

	my $options_href = $this->{_options} ;
	my $options_fields_href = $this->{_option_fields_hash} ;

	# get defaults & options
	my (%values, %defaults) ;
	foreach my $opt (keys %$options_fields_href)
	{
		$defaults{$opt} = $options_fields_href->{$opt}{'default'} ;
		$values{$opt} = $options_href->{$opt} if defined($options_href->{$opt}) ;
	}

	return (\%values, \%defaults) ;
}

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

sub option_values_set
{
	my $this = shift ;
	my ($values_href, $defaults_href) = @_ ;

	my $options_href = $this->{_options} ;
	my $options_fields_href = $this->{_option_fields_hash} ;

	## Update
	foreach my $opt (keys %$options_fields_href)
	{
		# update defaults to reflect any user specified options
		$defaults_href->{$opt} = $values_href->{$opt} ;
		$options_fields_href->{$opt}{'default'} = $defaults_href->{$opt} ;
		
		# update values
		$options_href->{$opt} = $values_href->{$opt} if defined($options_href->{$opt}) ;
	}
}



#============================================================================================
# ARGS
#============================================================================================

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

sub args
{
	my $this = shift ;
	my (@names) = @_ ;
	
	my $args_href = $this->{_args} ;
	my @args = $this->arg_list() ;

	if (keys %$args_href)
	{
		# do named args
		if (@names)
		{
			@args = () ;
			foreach my $name (@names)
			{
				push @args, $args_href->{$name} if exists($args_href->{$name}) ;
			}			
		}
	}	
	
	return @args ;
}

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

*Args = \&args ;


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

sub arg_list
{
	my $this = shift ;

	my $args_aref = $this->{_arg_list} ;

	return @$args_aref ;
}

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

sub arg_hash
{
	my $this = shift ;

	my $args_href = $this->{_args} ;
	return %$args_href ;
}


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

sub append_args
{
	my $this = shift ;
	my ($args_aref) = @_ ;

$this->_dbg_prt(["Args: append_args()\n"]) ;

	my @combined_args = (@{$this->{user_args}}, @$args_aref) ;
	$this->{user_args} = \@combined_args ;

$this->_dbg_prt(["Options: append_args() new=", $args_aref], 2)   ;
$this->_dbg_prt(["combined=", \@combined_args], 2)   ;

	## Build new set of args
	$this->update() ;
	
	return @combined_args ;
}

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

sub update
{
	my $this = shift ;

$this->_dbg_prt(["Args: update()\n"]) ;

	## get user settings
	my $args_aref = $this->{user_args} ;

	## set up internals
	
	# rebuild these
	my $args_href = {} ;

	# keep full details
	my $args_names_href = {} ;

	## fill args_href, get_args_aref
	my $args_list = [] ;
	
	# Cycle through
	my $optional = 0 ;
	my $last_dest_type ;
	foreach my $arg_entry_aref (@$args_aref)
	{
$this->_dbg_prt(["Arg entry=", $arg_entry_aref], 2)   ;

		my ($arg_spec, $summary, $description, $default_val) = @$arg_entry_aref ;
		
		## Process the arg spec
		my ($name, $pod_spec, $dest_type, $arg_type, $arg_direction, $arg_optional, $arg_append, $arg_mode) ;
		($name, $arg_spec, $pod_spec, $dest_type, $arg_type, $arg_direction, $arg_optional, $arg_append, $arg_mode) =
			$this->_process_arg_spec($arg_spec) ;

		if ($last_dest_type)
		{
			$this->throw_fatal("Application definition error: arg $name defined after $last_dest_type defined as array") ;
		}
		$last_dest_type = $name if $dest_type ;
		
		# Set default if required
		$args_href->{$name} = $default_val if (defined($default_val)) ;

		# See if optional
		$arg_optional++ if defined($default_val) ;
		if ($optional && !$arg_optional)
		{
			$this->throw_fatal("Application definition error: arg $name should be optional since previous arg is") ;
		}		
		$optional ||= $arg_optional ;

$this->_dbg_prt(["Args: update() - arg_optional=$arg_optional optional=$optional\n"]) ;
		
		# Create full entry
		my $href = $this->_new_arg_entry($name, $arg_spec, $summary, $description, $default_val, $pod_spec, $arg_type, $arg_direction, $dest_type, $optional, $arg_append, $arg_mode) ;
		$args_names_href->{$name} = $href ;

$this->_dbg_prt(["Arg $name HASH=", $href], 2)   ;

		# save arg in specified order
		push @$args_list, $name ; 
	}

$this->_dbg_prt(["update() - END\n"], 2) ;

	## Save
	$this->{arg_names} = $args_list ;
	$this->{_args} = $args_href ;
	$this->{_arg_names_hash} = $args_names_href ;

	return %$args_href ;
}



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

sub check_args 
{
	my $this = shift ;

	# specified args
	my $argv_aref = $this->{argv} ;
	# values
	my $args_href = $this->{_args} ;
	# details
	my $arg_names_href = $this->{_arg_names_hash} ;

	# File handles
	my $fh_aref = $this->{_fh_list} ;

$this->_dbg_prt(["check_args() Names=", $arg_names_href, "Values=", $args_href, "Name list=", $this->{arg_names}], 2)   ;
	
		
	## Check feature settings
	my ($open_out, $open_in) = (1, 1) ;
	my $feature_args = $this->{args_feature_args} ;
	if ($feature_args =~ m/open\s*=\s*(out|in|no)/i)
	{
		if ($1 =~ /out/i)
		{
			++$open_out ;
		}
		elsif ($1 =~ /in/i)
		{
			++$open_in ;
		}
		else
		{
			# none
			$open_in = 0;
			$open_out = 0;
		}
	}	
#	elsif ($feature_args =~ m/open/i)
#	{
#		## open both
#		++$open_out ;
#		++$open_in ;
#	}	
	
	## Process each arg checking that it's been specified (where required)
	my $idx = -1 ;
	my $arg_list = $this->{arg_names} ;
	foreach my $name (@$arg_list)
	{
#		# skip if optional
#		next if $arg_names_href->{$name}{'optional'} ;

		# create file handle name
		my $fh_name = "${name}_fh";		

		my $type = "" ;
		if ($arg_names_href->{$name}{'type'} eq 'f')
		{
			$type = "file " ;
		}
		if ($arg_names_href->{$name}{'type'} eq 'd')
		{
			$type = "directory " ;
		}

		my $value = $args_href->{$name} ;
		my @values = ($value) ;

		## Special handling for @* spec
		if ($arg_names_href->{$name}{'dest_type'})
		{
	$this->_dbg_prt([" + + special dest type\n"], 2) ;
			if (defined($value))
			{
				@values = @$value ;
			}
			
			push @values, '' unless @values ;

			if ($open_in && ($arg_names_href->{$name}{'type'} eq 'f'))
			{
				$args_href->{$fh_name} = [] ;
			}
		}

$this->_dbg_prt([" + values (@values) [".scalar(@values)."]\n"], 2) ;

		## Very special case of * spec with no args - set fh to STDIN if required
		if ($arg_names_href->{$name}{'dest_type'} eq '*')
		{
			if (!defined($value) || scalar(@$value)==0)
			{
				if ($open_in && ($arg_names_href->{$name}{'type'} eq 'f'))
				{
					# Create new entry
					my $href = $this->_new_arg_entry($fh_name) ;
					$arg_names_href->{$fh_name} = $href ;
					
					# set value
					$args_href->{$fh_name} = [\*STDIN] ;

					$args_href->{$name} ||= [] ;
					push @{$args_href->{$name}}, 'STDIN' ;
					
					next ;
				}
			}
		}
		
		
		## Check all of the values
		foreach my $val (@values)
		{
			
			++$idx ;
			my $arg_optional = $arg_names_href->{$name}{'optional'} ;
			
$this->_dbg_prt([" + checking $name value=$val, type=$type, optional=$arg_optional ..\n"], 2) ;
		
			# First check that an arg has been specified
			if ($idx >= scalar(@$argv_aref))
			{
				# Ignore if * type -OR- optional
				if ( ($arg_names_href->{$name}{'dest_type'} ne '*') && (! $arg_optional) )
				{
					$this->_complain_usage_exit("Must specify input $type\"$name\"") ;
				}
			}
			
			next unless $val ;
			
			## Input
			if ($arg_names_href->{$name}{'direction'} eq 'i')
			{
	$this->_dbg_prt([" + Check $val for existence\n"], 2) ;
				
				## skip checks if optional and no value specified (i.e. do the check if a default is specified)
				if (!$arg_optional && $val)
				{
					# File check
					if ( ($arg_names_href->{$name}{'type'} eq 'f') && (! -f $val) )
					{
						$this->_complain_usage_exit("Must specify a valid input filename for \"$name\"") ;
					}
					# Directory check
					if ( ($arg_names_href->{$name}{'type'} eq 'd') && (! -d $val) )
					{
						$this->_complain_usage_exit("Must specify a valid input directory for \"$name\"") ;
					}
				}
				else
				{
	$this->_dbg_prt([" + Skipped checks opt=$arg_optional val=$val bool=".."...\n"], 2) ;
					
				}	
				
				
				## File open
				if ($open_in && ($arg_names_href->{$name}{'type'} eq 'f'))
				{
					open my $fh, "<$val" ;
					if ($fh)
					{
						push @$fh_aref, $fh ;
						
						if ($arg_names_href->{$name}{'mode'} eq 'b')
						{
							binmode $fh ;
						}
	
						# Create new entry
						my $href = $this->_new_arg_entry($fh_name) ;
						$arg_names_href->{$fh_name} = $href ;
						
						# set value
						if ($arg_names_href->{$name}{'dest_type'})
						{
							$args_href->{$fh_name} ||= [] ;
							push @{$args_href->{$fh_name}}, $fh ;
						}
						else
						{
							$args_href->{$fh_name} = $fh ;
						}
					}
					else
					{
						$this->_complain_usage_exit("Unable to read file \"$val\" : $!") ;
					}
				}
			}
			
			## Output
			if ($open_out)
			{
				if (($arg_names_href->{$name}{'direction'} eq 'o') && ($arg_names_href->{$name}{'type'} eq 'f'))
				{
					my $mode = '>' ;	
					if ($arg_names_href->{$name}{'append'})
					{
						$mode .= '>' ;
					}
					
					open my $fh, "$mode$val" ;
					if ($fh)
					{
						push @$fh_aref, $fh ;
						
						if ($arg_names_href->{$name}{'mode'} eq 'b')
						{
							binmode $fh ;
						}
	
						# Create new entry
						my $href = $this->_new_arg_entry($fh_name) ;
						$arg_names_href->{$fh_name} = $href ;
						
						# set value
						$args_href->{$fh_name} = $fh ;
					}
					else
					{
						my $md = $arg_names_href->{$name}{'append'} ? 'append' : 'write' ;
		
						$this->_complain_usage_exit("Unable to $md file \"$val\" : $!") ;
					}
				}
			}
		}
	}
		
}

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

sub close_args 
{
	my $this = shift ;

	# File handles
	my $fh_aref = $this->{_fh_list} ;
	
	foreach my $fh (@$fh_aref)
	{
		close $fh ;
	}

}



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

sub get_args
{
	my $this = shift ;

	# save @ARGV
	$this->{argv} = \@ARGV ;
	my @args = @ARGV ;

	# Copy values over
	$this->_process_argv() ;

	my %args ;
	
	%args = $this->arg_hash() ;
$this->_dbg_prt(["Args before expand : hash=", \%args]) ;

	# Expand the args variables
	$this->_expand_args() ;

	# Set arg list
	my @arg_array ;
	%args = $this->arg_hash() ;
	my $arg_list = $this->{arg_names} ;
	foreach my $name (@$arg_list)
	{
		push @arg_array, $args{$name} ;
	}
	$this->{_arg_list} = \@arg_array ;


	# return arglist
	return $this->arg_list ;
}

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

sub arg_entry
{
	my $this = shift ;
	my ($arg_name) = @_ ;

	my $arg_names_href = $this->{_arg_names_hash} ;
	my $arg_href ;
	if (exists($arg_names_href->{$arg_name}))
	{
		$arg_href = $arg_names_href->{$arg_name} ;
	}
	return $arg_href ;
}


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

sub args_values_hash 
{
	my $this = shift ;

	my $args_href = $this->{_args} ;
	my $args_names_href = $this->{_arg_names_hash} ;

	# get args
	my %values ;
	foreach my $arg (keys %$args_names_href)
	{
		$values{$arg} = $args_href->{$arg} if defined($args_href->{$arg}) ;
	}

	return \%values ;
}

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

sub args_values_set 
{
	my $this = shift ;
	my ($values_href) = @_ ;

	my $args_href = $this->{_args} ;
	my $args_names_href = $this->{_arg_names_hash} ;

	## Update
#	foreach my $arg (keys %$args_names_href)
#	{
#		$args_href->{$arg} = $values_href->{$arg} if defined($args_href->{$arg}) ;
#	}

	# Cycle through
	my $names_aref = $this->{arg_names} ;
	foreach my $arg (@$names_aref)
	{
		if ( defined($args_href->{$arg}) )
		{
			my $arg_entry_href = $this->arg_entry($arg) ;
			
			$args_href->{$arg} = $values_href->{$arg} ;
			$arg_entry_href->{'default'} = $values_href->{$arg} ;
		}
	}
}

#----------------------------------------------------------------------------
#
#=item B<_expand_vars()>
#
#Run through some of the application variables/fields and expand any instances of variables embedded
#within the values.
#
#Example:
#
#	__DATA_  
#
#	[SYNOPSIS]
#	
#	$name [options] <rrd file(s)>
#
#Here the 'synopsis' field contains the $name field variable. This needs to be expanded to the value of $name.
#
#NOTE: Currently this will NOT cope with cross references (so, if in the above example $name also contains a variable
#then that variable may or may not be expanded before the synopsis field is processed)
#
#
#=cut
#
sub _expand_vars 
{
	my $this = shift ;

	# Get hash of fields
	my %fields = $this->vars() ;

print "_expand_vars()\n" if $this->{'debug'}>=2 ;

	# work through each field, create a list of those that have changed
	my %changed ;
	foreach my $field (sort keys %fields)
	{
		# Skip non-scalars
		next if ref($fields{$field}) ;

print " + check $field...\n" if $this->{'debug'}>=2 ;
		
		# First see if this contains a '$'
		$fields{$field} ||= "" ;
		my $ix = index $fields{$field}, '$' ; 
		if ($ix >= 0)
		{
print " + + got some vars in $field = $fields{$field}\n" if $this->{'debug'}>=2 ;
			# Do replacement
			$fields{$field} =~ s{
								     								     \$                         # find a literal dollar sign
								     								     \{{0,1}					# optional brace
								    								    (\w+)                       # find a "word" and store it in $1
								     								     \}{0,1}					# optional brace
																}{
								    								    no strict 'refs';           # for $$1 below
								    								    if (defined $fields{$1}) {
								        								        $fields{$1};            # expand global variables only
								    								    } else {
								        								        "\${$1}";  				# leave it
								    								    }
																}egx;


			# Add to list
			$changed{$field} = $fields{$field} ;

print " + + $field now = $fields{$field}\n" if $this->{'debug'}>=2 ;
		}
	}

	# If some have changed then set them
	if (keys %changed)
	{
		$this->set(%changed) ;
	}

print "_expand_vars() - done\n" if $this->{'debug'}>=2 ;

}

#----------------------------------------------------------------------------
#
#=item B<_expand_args()>
#
#Expand any variables in the args
#
#=cut
#
sub _expand_args 
{
	my $this = shift ;

	my $args_href = $this->{_args} ;
	my $args_names_href = $this->{_arg_names_hash} ;

	# get args
	my %values ;
	foreach my $arg (keys %$args_names_href)
	{
		$values{$arg} = $args_href->{$arg} if defined($args_href->{$arg}) ;
	}

	# get replacement vars
#	my @vars ;
#	my $app = $this->app ;
#	if ($app)
#	{
#		my %app_vars = $app->vars ;
#		push @vars, \%app_vars ;
#		my %opt_vars = $app->options() ;
#		push @vars, \%opt_vars ;
#	}
#	push @vars, \%ENV ;
	
#	## expand
#	$this->expand_keys(\%values, \@vars) ;
		
	## Update
	foreach my $arg (keys %$args_names_href)
	{
		$args_href->{$arg} = $values{$arg} if defined($args_href->{$arg}) ;
	}
	
}

#----------------------------------------------------------------------------
#
#=item B<_process_argv()>
#
#Processes the @ARGV array
#
#=cut
#
sub _process_argv
{
	my $this = shift ;

	my $argv_aref = $this->{argv} ;
	my @args = @$argv_aref ;
	$argv_aref = [] ;		# clear our args, rebuild the list as we process them
	my $idx = 0 ;

$this->_dbg_prt(["_process_argv() : args=", \@args]) ;
	
	# values
	my $args_href = $this->{_args} ;
	# details
	my $args_names_href = $this->{_arg_names_hash} ;
	
	my $dest_type ;
	my $arg_list = $this->{arg_names} ;
	foreach my $name (@$arg_list)
	{
		if ($args_names_href->{$name}{'dest_type'}) 
		{
			# set value
			$args_href->{$name} = [] ;	
		}	
	}
				
	foreach my $name (@$arg_list)
	{
		last unless @args ;
		my $arg = shift @args ;
		
		# set value
		$args_href->{$name} = $arg ;	
		push @$argv_aref, $arg ;
		
		# get this dest type
		$dest_type = $name if $args_names_href->{$name}{'dest_type'} ;

		++$idx ;
	}

	# If last arg specified as ARRAY, then convert  value to ARRAY ref
	if ($dest_type)
	{
		my $arg = $args_href->{$dest_type} ;
		$args_href->{$dest_type} = [] ;
		pop @$argv_aref ;

		## Handle wildcards (mainly to cope with Windoze)
		if ($arg =~ m/[\*\?]/)
		{
			my @files = glob("$arg") ;
			if (@files)
			{
				push @{$args_href->{$dest_type}}, @files ;
				push @$argv_aref, @files ;
				$arg = undef ;		
			}
		}

		if ($arg)
		{
			push @{$args_href->{$dest_type}}, $arg ;			
			push @$argv_aref, $arg ;
		}
		
	}

$this->_dbg_prt(["_process_argv() : args hash (so far)=", $args_href, "args now=", \@args]) ;
	
	# If there are any args left over, handle them
	foreach my $arg (@args)
	{
		# If last arg specified as ARRAY, then just add all ARGS
		if ($dest_type)
		{
			## Handle wildcards (mainly to cope with Windoze)
			if ($arg =~ m/[\*\?]/)
			{
				my @files = glob("$arg") ;
				if (@files)
				{
					push @{$args_href->{$dest_type}}, @files ;
					push @$argv_aref, @files ;
					$arg = undef ;		
				}
			}
			
			if ($arg)
			{
				push @{$args_href->{$dest_type}}, $arg ;			
				push @$argv_aref, $arg ;
			}
		}
		else
		{
			push @$argv_aref, $arg ;

			# create name
			my $name = sprintf "arg%d", $idx++ ;		
			
			# Create new entry
			my $href = $this->_new_arg_entry($name) ;
			$args_names_href->{$name} = $href ;
			
			# save arg in specified order
			push @$arg_list, $name ; 
	
			# set value
			$args_href->{$name} = $arg ;
			
		}

	}

	$this->{argv} = $argv_aref ;
}

#----------------------------------------------------------------------------
#
#=item B<_process_arg_spec($arg_spec)>
#
#Processes the arg specification string, returning:
#
#	($name, $arg_spec, $spec, $dest_type, $arg_type, $arg_direction, $arg_optional, $arg_append, $arg_mode)
#
#=cut
#
sub _process_arg_spec 
{
	my $this = shift ;
	my ($arg_spec) = @_ ;

$this->_dbg_prt(["arg: _process_arg_spec($arg_spec)"], 2)   ;

	my $developer_only = 0 ;

	# If arg starts with start char then remove it
	$arg_spec =~ s/^[\-\+\*]// ;
	
	# Get arg name
	my $name = $arg_spec ;
	if ($arg_spec =~ /[\'\"](\w+)[\'\"]/)
	{
		$name = $1 ;
		$arg_spec =~ s/[\'\"]//g ;
	}
	$name =~ s/\=.*$// ;

	my $spec = $arg_spec ;
	my $arg = "";
	if ($spec =~ s/\=(.*)$//)
	{
		$arg = $1 ;
	}
$this->_dbg_prt(["_process_arg_spec() set: pod spec=$spec arg=$arg\n"], 2) ;
	
	my $dest_type = "" ;
	if ($arg =~ /([\@\*])/i)
	{
		$dest_type = $1 ;
	}			
	
	my $arg_type = "" ;
	if ($arg =~ /([sfd])/i)
	{
		$arg_type = $1 ;
		if ($arg_type eq 's')
		{
			$spec .= " <string>" ;
		}
		elsif ($arg_type eq 'f')
		{
			$spec .= " <file>" ;
		}
		elsif ($arg_type eq 'd')
		{
			$spec .= " <dir>" ;
		}
	}

	my $arg_direction = "i" ;
	my $arg_append = "" ;
	if ($arg =~ /(i|<)/i)
	{
		$arg_direction = 'i' ;
		$spec .= " <input>" ;
	}
	elsif ($arg =~ /a|>>/i)
	{
		$arg_direction = 'o' ;
		$arg_append = "a" ;
		$spec .= " <output>" ;
	}
	elsif ($arg =~ /(o|>)/i)
	{
		$arg_direction = 'o' ;
		$spec .= " <output>" ;
	}
	
	my $arg_optional = 0 ;
	if ($arg =~ /\?/i)
	{
$this->_dbg_prt(["_process_arg_spec() set: optional\n"], 2) ;
		$arg_optional = 1 ;
	}	

	my $arg_mode = "" ;
	if ($arg =~ /b/i)
	{
		$arg_mode = 'b' ;
	}
	
$this->_dbg_prt(["_process_arg_spec() set: final pod spec=$spec arg=$arg\n"], 2) ;
				
	return ($name, $arg_spec, $spec, $dest_type, $arg_type, $arg_direction, $arg_optional, $arg_append, $arg_mode) ;
}


#----------------------------------------------------------------------------
#
#=item B<_new_arg_entry($name, $arg_spec, $summary, $description, $default_val, $pod_spec, $arg_type, $arg_direction, $dest_type, $optional, $arg_append, $arg_mode)>
#
#Create a new HASH with the specified values. Sets the values to defaults if not specified
#
#=cut
#
sub _new_arg_entry
{
	my $this = shift ;
	my ($name, $arg_spec, $summary, $description, $default_val, $pod_spec, $arg_type, $arg_direction, $dest_type, $optional, $arg_append, $arg_mode) = @_ ;
	
	$summary ||= "Arg" ;
	$description ||= "" ;
	$arg_type ||= "s" ;
	$arg_direction ||= "i" ;
	$dest_type ||= "" ;
	$optional ||= 0 ;
	$arg_spec ||= "$arg_type" ;
	$arg_append ||= "" ;
	$arg_mode ||= "" ;
	my $entry_href = 
	{
		'name'=>$name, 
		'spec'=>$arg_spec, 
		'summary'=>$summary, 
		'description'=>$description,
		'default'=>$default_val,
		'pod_spec'=>$pod_spec,
		'type' => $arg_type,
		'direction' => $arg_direction,
		'dest_type' => $dest_type,
		'optional' => $optional,
		'append' => $arg_append,
		'mode' => $arg_mode,
	} ;

	return $entry_href ;
}



#============================================================================================
# DATA
#============================================================================================

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

sub data
{
	my $this = shift ;
	my ($name, %vars) = @_ ;
	
	my $data_ref ;
	$name ||= "" ;
	
$this->_dbg_prt(["Data: data($name)\n"]) ;
	
	if ($name)
	{
		my $data_href = $this->{_data_hash} ;
$this->_dbg_prt(["Data HASH=", $data_href], 2) ;
		if (exists($data_href->{$name}))
		{
			$data_ref = $data_href->{$name} ;
$this->_dbg_prt([" + Found data for $name=", $data_ref]) ;
		}		
	}
	else
	{
		my $data_aref = $this->{_data} ;
		if (@$data_aref)
		{
			$data_ref = $data_aref->[0] ;
		}
		
	}

	return undef unless $data_ref ;
	
	return wantarray ? @$data_ref : join "\n", @$data_ref ;	
}

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

*Data = \&data ;



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

sub process_data
{
	my $this = shift ;
	
	my $package = $this->{'package'} ;

$this->_dbg_prt(["Data: Process data from package $package\n"]) ;

    local (*alias, *stash);             # a local typeglob

    # We want to get access to the stash corresponding to the package
    # name
	no strict "vars" ;
	no strict "refs" ;
    *stash = *{"${package}::"};  # Now %stash is the symbol table

$this->_dbg_prt(["Data: $package symbols=\n", \%stash], 5) ;

	if (exists($stash{'DATA'}))
	{
		my @data ;
		my %data ;
		my $data_aref = [] ;
		
		push @data, $data_aref ;
		
		*alias = $stash{'DATA'} ;

$this->_dbg_prt(["Reading __DATA__\n"]) ;

		## Read data in - first split into sections
		my $line ;
		my $data_num = 1 ;
		while (defined($line=<alias>))
		{
			chomp $line ;
$this->_dbg_prt(["DATA: $line\n"], 2) ;
			
			if ($line =~ m/^\s*__DATA__/)
			{
$this->_dbg_prt(["+ New __DATA__\n"], 2) ;
				# Start a new list
				$data_aref = [] ;
				push @data, $data_aref ;

$this->_dbg_prt(["+ Data list size=",scalar(@data),"\n"], 2) ;
				
				# default name
				my $name = sprintf "data%d", $data_num++ ;
				$data{$name} = $data_aref ;
				
				# Check for specified name
				if ($line =~ m/__DATA__\s*(\S+)/)
				{
					$name = $1 ;
					$data{$name} = $data_aref ;
$this->_dbg_prt(["+ + named __DATA__ : $name\n"], 2) ;
				}
			}
			elsif ($line =~ m/^\s*__END__/ )
			{
$this->_dbg_prt(["+ __END__\n"], 2) ;
				last ;
			}
			elsif ($line =~ m/^\s*__#/ )
			{
$this->_dbg_prt(["+ __# comment\n"], 2) ;
				# skip
			}
			else
			{
				push @$data_aref, $line ;
			}
		}
$this->_dbg_prt(["Gathered data=", \@data], 2) ;

		# Store
		$this->{_data} = \@data ;
		$this->{_data_hash} = \%data ;

$this->_dbg_prt(["Processing __DATA__\n"]) ;
		
		## Look at first section
		my $obj_settings=0;
		$data_aref = $data[0] ;
		my $field ;
		my @field_data ;
		foreach $line (@$data_aref)
		{

			if ($line =~ m/^\s*\[(\w+)\]/)
			{
				my ($new_field) = lc $1 ;
				
				# This is object settings, so need to remove from list
				$obj_settings=1;

				# Use the data found so far for this field
				$this->_handle_field($field, \@field_data) if $field ;
				
				# next field
				$field = $new_field ;
				@field_data = () ;

			}
			elsif ($field)
			{
				push @field_data, $line ;
			}
		}

		if ($field)
		{
			# Use the data found so far for this field
			$this->_handle_field($field, \@field_data) ;
		}

	}

	use strict "vars" ;
	use strict "refs" ;

	## get user settings
	my $options_aref = [@DEFAULT_OPTS] ;
	push @$options_aref, @{$this->{_user_options}} ;

	## set up internals
	
	# rebuild these
	my $options_href = {} ;
	my $get_options_aref = [] ;
	my $option_names_aref = [] ;

	# keep full details
	my $options_fields_href = {} ;


	## Cycle through options
	foreach my $option_entry_aref (@$options_aref)
	{
		my ($option_spec, $summary, $description, $default_val, $owner_pkg) = @$option_entry_aref ;
		
		## Process the option spec
		my ($field, $spec, $dest_type, $developer_only, $fields_aref, $arg_type) ;
		($field, $option_spec, $spec, $dest_type, $developer_only, $fields_aref, $arg_type) = 
			$this->_process_option_spec($option_spec) ;
		
		# Set default if required
		$options_href->{$field} = $default_val if (defined($default_val)) ;
		
		# Add to Getopt list
		push @$get_options_aref, $option_spec => \$options_href->{$field} ;
		
		# Create full entry
		$options_fields_href->{$field} = {
				'field'=>$field, 
				'spec'=>$option_spec, 
				'summary'=>$summary, 
				'description'=>$description,
				'default'=>$default_val,
				'pod_spec'=>$spec,
				'type' => $arg_type,
				'dest_type' => $dest_type,
				'developer' => $developer_only,
				'entry' => $option_entry_aref,
				'owner' => $owner_pkg,
		} ;
		
		# add to list of names
		push @$option_names_aref, $field ;
	}

	## Save
	$this->{_options_list} = $options_aref ;
	$this->{_options} = $options_href ;
	$this->{_get_options} = $get_options_aref ;
	$this->{_option_fields_hash} = $options_fields_href ;

$this->_dbg_prt(["Get options=", $get_options_aref]) ;

	$this->{option_names} = $option_names_aref ;

}



#----------------------------------------------------------------------------
#
#=item B<_handle_field($field_data_aref)>
#
#Set the field based on the accumlated data
#
#=cut
#
sub _handle_field 
{
	my $this = shift ;
	my ($field, $field_data_aref) = @_ ;

$this->_dbg_prt(["Data: _handle_field($field, $field_data_aref)\n"], 2) ;

	# Handle any existing field values
	if ($field eq 'options')
	{
		# Parse the data into options
		my @options = $this->_parse_options($field_data_aref) ;

$this->_dbg_prt(["Data: set app options\n"], 2) ;
		## set the options
		$this->_append_options(\@options) ;
	}
	elsif ($field eq 'args')
	{
		# Parse the data into args
		my @args = $this->_parse_options($field_data_aref) ;

$this->_dbg_prt(["Data: set app options\n"], 2) ;
		## Access the application's 'Options' feature to set the options
		$this->append_args(\@args) ;
	}
	else
	{
		# Glue the lines together and set the field
		my $data = join "\n", @$field_data_aref ;

		# Remove leading/trailing space
		$data =~ s/^\s+// ;
		$data =~ s/\s+$// ;

$this->_dbg_prt(["Data: set app field $field => $data\n"], 2) ;
			
		## Set field directly into application	
		$this->set($field => $data) ;
	}
}


#----------------------------------------------------------------------------
#
#=item B<_parse_options($data_aref)>
#
#Parses option definition lines(s) of the form:
# 
# -<opt>[=s]		Summary of option [default=<value>]
# Description of option
#
#Optional [default] specification that sets the option to the default if not otherwised specified.
#
#And returns an ARRAY in the format useable by the 'options' method. 
#
#=cut
#
sub _parse_options 
{
	my $this = shift ;
	my ($data_aref) = @_ ;

$this->_dbg_prt(["Data: _parse_options($data_aref)\n"], 2) ;

	my @options ;
	
	# Scan through the options specification to create a number of options entries
	my ($spec, $summary, $description, $default_val) ;
	foreach my $line (@$data_aref)
	{
		## Options specified as:
		#
		# -<name list>[=<opt spec>]  [\[default=<default value>\]]
		#
		# <name list>:
		#    <name>|'<name>'
		#
		# <opt spec> (subset of that supported by Getopt::Long):
		#    <type> [ <desttype> ]	
		# <type>:
		#	s = String. An arbitrary sequence of characters. It is valid for the argument to start with - or -- .
		#	i = Integer. An optional leading plus or minus sign, followed by a sequence of digits.
		#	o = Extended integer, Perl style. This can be either an optional leading plus or minus sign, followed by a sequence of digits, or an octal string (a zero, optionally followed by '0', '1', .. '7'), or a hexadecimal string (0x followed by '0' .. '9', 'a' .. 'f', case insensitive), or a binary string (0b followed by a series of '0' and '1').
		#	f = Real number. For example 3.14 , -6.23E24 and so on.
		#	
		# <desttype>:
		#   @ = store options in ARRAY ref
		#   % = store options in HASH ref
		# 
		if ($line =~ m/^\s*[\-\*\+]\s*([\'\"\w\|\=\%\@\+\{\:\,\}\-\_\>\<\*]+)\s+(.*?)\s*(\[default=([^\]]+)\]){0,1}\s*$/)
		{
			# New option
			my ($new_spec, $new_summary, $new_default, $new_default_val) = ($1, $2, $3, $4) ;

			my ($dbg_default, $dbg_defval) = ($new_default||"", $new_default_val||"") ;
			$this->_dbg_prt([" + spec: $new_spec,  summary: $new_summary,  default: $dbg_default, defval=$dbg_defval\n"], 2) ;

			# Allow default value to be specified with "" or ''
			if (defined($new_default_val))
			{
				$new_default_val =~ s/^['"](.*)['"]$/$1/ ;
			}

			# Save previous option			
			if ($spec)
			{
				# Remove leading/trailing space
				$description ||= '' ;
				$description =~ s/^\s+// ;
				$description =~ s/\s+$// ;

				push @options, [$spec, $summary, $description, $default_val] ;
			}
			
			# update current
			($spec, $summary, $default_val, $description) = ($new_spec, $new_summary, $new_default_val, '') ;
		}
		elsif ($spec)
		{
			# Add to description
			$description .= "$line\n" ;
		}
	}

	# Save option
	if ($spec)
	{
		# Remove leading/trailing space
		$description ||= '' ;
		$description =~ s/^\s+// ;
		$description =~ s/\s+$// ;

		push @options, [$spec, $summary, $description, $default_val] ;
	}
	
	return @options ;
}


#----------------------------------------------------------------------------
#
#=item B<_append_options($aref)>
#
#Add these user defined options to the list
#
#=cut
#
sub _append_options 
{
	my $this = shift ;
	my ($aref) = @_ ;

	my $options = $this->{_user_options} ;
	push @$options, @$aref ;
}

#----------------------------------------------------------------------------
#
#=item B<_process_option_spec($option_spec)>
#
#Processes the option specification string, returning:
#
#	($field, $option_spec, $spec, $dest_type, $developer_only, $fields_aref, $arg_type)
#
#=cut
#
sub _process_option_spec 
{
	my $this = shift ;
	my ($option_spec) = @_ ;

$this->_dbg_prt( ["option: _process_option_spec($option_spec)"] , 2) ;

	my $developer_only = 0 ;

	# <opt spec> (subset of that supported by Getopt::Long):
	#    <type> [ <desttype> ]	
	# <type>:
	#	s = String. An arbitrary sequence of characters. It is valid for the argument to start with - or -- .
	#	i = Integer. An optional leading plus or minus sign, followed by a sequence of digits.
	#	o = Extended integer, Perl style. This can be either an optional leading plus or minus sign, followed by a sequence of digits, or an octal string (a zero, optionally followed by '0', '1', .. '7'), or a hexadecimal string (0x followed by '0' .. '9', 'a' .. 'f', case insensitive), or a binary string (0b followed by a series of '0' and '1').
	#	f = Real number. For example 3.14 , -6.23E24 and so on.
	#	
	# <desttype>:
	#   @ = store options in ARRAY ref
	#   % = store options in HASH ref
		
	# If option starts with start char then remove it
	$option_spec =~ s/^[\-\+\*]// ;
	
	# if starts with dev: then remove and flag
	if ($option_spec =~ s/^dev://i)
	{
		$developer_only = 1 ;
	}
	
	# Get field name
	my $field = $option_spec ;
	if ($option_spec =~ /[\'\"](\w+)[\'\"]/)
	{
		$field = $1 ;
		$option_spec =~ s/[\'\"]//g ;
	}
	$field =~ s/\|.*$// ;
	$field =~ s/\=.*$// ;
	
	# re-create spec with field name highlighted
	my $spec = $option_spec ;
	my $arg = "";
	if ($spec =~ s/\=(.*)$//)
	{
		$arg = $1 ;
	}
$this->_dbg_prt( ["_process_option_spec() set: pod spec=$spec arg=$arg\n"], 2 ) ;

	my @fields = split /\|/, $spec ;
	if (@fields > 1)
	{
		# put field name first
		$spec = "$field" ;
		foreach my $fld (@fields)
		{
			next if $fld eq $field ;
			
	$this->_dbg_prt( [" + $fld\n"], 2 ) ;
			$spec .= '|' if $spec;
			$spec .= $fld ;
		}	
	}
	
	my $dest_type = "" ;
	if ($arg =~ /([\@\%])/i)
	{
		$dest_type = $1 ;
	}			

	my $arg_type = "" ;
	if ($arg =~ /([siof])/i)
	{
		$arg_type = $1 ;
		if ($arg_type eq 's')
		{
			if ($dest_type eq '%')
			{
				$spec .= " <key=value>" ;
			}
			else
			{
				$spec .= " <string>" ;
			}
		}
		elsif ($arg_type eq 'i')
		{
			$spec .= " <integer>" ;
		}
		elsif ($arg_type eq 'f')
		{
			$spec .= " <float>" ;
		}
		elsif ($arg_type eq 'o')
		{
			$spec .= " <extended int>" ;
		}
		else
		{
			$spec .= " <arg>"
		}
	}

$this->_dbg_prt( ["_process_option_spec() set: final pod spec=$spec arg=$arg\n"], 2 ) ;
				
	return ($field, $option_spec, $spec, $dest_type, $developer_only, \@fields, $arg_type) ;
			
}


#============================================================================================
# POD
#============================================================================================



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

sub pod
{
	my $this = shift ;
	my ($developer) = @_ ;

	my $pod = 
		$this->pod_head($developer) .
		$this->pod_options($developer) .
		$this->pod_description($developer) .
		"\n=cut\n" ;
	return $pod ;
}	
	
#----------------------------------------------------------------------------

sub pod_head
{
	my $this = shift ;
	my ($developer) = @_ ;

	my $name = $this->{name} ;
	my $summary = $this->{summary} ;
	my $synopsis = $this->get_synopsis() ;
	my $version = $this->{version} ;

	my $pod =<<"POD_HEAD" ;

${POD_HEAD}1 NAME

$name (v$version) - $summary

${POD_HEAD}1 SYNOPSIS

$synopsis

Options:

POD_HEAD

	# Cycle through
	my $names_aref = $this->{option_names} ;
	foreach my $option_name (@$names_aref)
	{
		my $option_entry_href = $this->option_entry($option_name) ;
		my $default = "" ;
		if ($option_entry_href->{'default'})
		{
			$default = "[Default: $option_entry_href->{'default'}]" ;
		}

		my $multi = "" ;
		if ($option_entry_href->{dest_type})
		{
			$multi = "(option may be specified multiple times)" ;
		}
				
		if ($developer)
		{
			$pod .= sprintf "       -%-20s $option_entry_href->{summary}\t$default\n", $option_entry_href->{'spec'} ;
		}
		else
		{
			# show option if it's not a devevloper option
			$pod .= sprintf "       -%-20s $option_entry_href->{summary}\t$default\t$multi\n", $option_entry_href->{'pod_spec'} 
				unless $option_entry_href->{'developer'} ;
		}
	}
	
	unless (@$names_aref)
	{
		$pod .= "       NONE\n" ;
	}

	return $pod ;
}

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

sub pod_options
{
	my $this = shift ;
	my ($developer) = @_ ;

	my $pod ="\n${POD_HEAD}1 OPTIONS\n\n" ;

	if ($developer)
	{
		$pod .= "Get options from application object as:\n   my \%opts = \$app->options();\n\n" ;
	}

	$pod .= "${POD_OVER} 8\n\n" ;


	# Cycle through
	my $names_aref = $this->{option_names} ;
	foreach my $option_name (@$names_aref)
	{
		my $option_entry_href = $this->option_entry($option_name) ;
$this->_dbg_prt(["entry for $option_name=",$option_entry_href]) ;
		my $default = "" ;
		if ($option_entry_href->{'default'})
		{
			$default = "[Default: $option_entry_href->{'default'}]" ;
		}

		my $show = 1 ;
		$show = 0  if ($option_entry_href->{'developer'} && !$developer) ;
		if ($show)
		{
			if ($developer)
			{
				$pod .= "=item -$option_entry_href->{spec} $default # Access as \$opts{$option_entry_href->{field}} \n" ;
			}
			else
			{
				$pod .= "=item B<-$option_entry_href->{pod_spec}> $default\n" ;
			}
			$pod .= "\n$option_entry_href->{description}\n" ;
			
			if ($option_entry_href->{dest_type})
			{
				$pod .= "This option may be specified multiple times.\n" ;
				
				if ($developer)
				{
					my $dtype = "" ;
					if ($option_entry_href->{dest_type} eq '@')
					{
						$dtype = 'ARRAY' ;
					}
					elsif ($option_entry_href->{dest_type} eq '%')
					{
						$dtype = 'HASH' ;
					}
					$pod .= "(The option values will be available internally via the $dtype ref \$opts{$option_entry_href->{field}})\n" ;
				}			
			}
			$pod .= "\n" ;
		}
	}

	unless (@$names_aref)
	{
		$pod .= "       NONE\n" ;
	}

	$pod .= "\n=back\n\n" ;

	return $pod ;
}


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