App-Framework-Lite
view release on metacpan or search on metacpan
lib/App/Framework/Lite.pm view on Meta::CPAN
For more details see L</Options> and L</Args>.
=head4 Summary
This should be a single line, concise summary of what the script does. It's used in the terse man page created by pod2man.
=head4 Description
As you'd expect, this should be a full description, user-guide etc. on what the script does and how to do it. Notice that this example
has used one (of many) of the variables available: $name (which expands to the script name, without any path or extension).
=head4 Example
An example script setup is:
__DATA__
[SUMMARY]
lib/App/Framework/Lite.pm view on Meta::CPAN
# Open all file handles (the default)
use App::Framework '+Args(open=all)' ;
=head3 Variable Expansion
Argument values can contain variables, defined using the standard Perl format:
$<name>
${<name>}
When the argument is used, the variable is expanded and replaced with a suitable value. The value will be looked up from a variety of possible sources:
object fields (where the variable name matches the field name) or environment variables.
The variable name is looked up in the following order, the first value found with a matching name is used:
=over 4
=item *
Argument names - the values of any other arguments may be used as variables in arguments
lib/App/Framework/Lite.pm view on Meta::CPAN
The summary is multiple lines of text used to fully describe the option. It is used in the man pages in 'man' mode.
=head3 Variable Expansion
Option values and default values can contain variables, defined using the standard Perl format:
$<name>
${<name>}
When the option is used, the variable is expanded and replaced with a suitable value. The value will be looked up from a variety of possible sources:
object fields (where the variable name matches the field name) or environment variables.
The variable name is looked up in the following order, the first value found with a matching name is used:
=over 4
=item *
Option names - the values of any other options may be used as variables in options
lib/App/Framework/Lite.pm view on Meta::CPAN
$file = $app->Data('data2') ;
=head3 Variable Expansion
The data text can contain variables, defined using the standard Perl format:
$<name>
${<name>}
When the data is used, the variable is expanded and replaced with a suitable value. The value will be looked up from a variety of possible sources:
object fields (where the variable name matches the field name) or environment variables.
The variable name is looked up in the following order, the first value found with a matching name is used:
=over 4
=item *
Option names - the values of any command line options may be used as variables
lib/App/Framework/Lite.pm view on Meta::CPAN
{
$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) ;
lib/App/Framework/Lite.pm view on Meta::CPAN
#----------------------------------------------------------------------------
=item B<app_start()>
Set up before running the application.
Calls the following methods in turn:
* getopts
* [internal _expand_vars method]
* options
=cut
sub app_start
{
my $this = shift ;
## Process data
lib/App/Framework/Lite.pm view on Meta::CPAN
## 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]) ;
}
#----------------------------------------------------------------------------
=item B<app_handle_opts()>
Handles the default options (for example -man, -help etc)
=cut
lib/App/Framework/Lite.pm view on Meta::CPAN
Alias to L</options>
=cut
*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}) ;
lib/App/Framework/Lite.pm view on Meta::CPAN
# 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 ;
}
#----------------------------------------------------------------------------
=item B<option_entry($option_name)>
lib/App/Framework/Lite.pm view on Meta::CPAN
# 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 ;
lib/App/Framework/Lite.pm view on Meta::CPAN
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 ;
lib/App/Framework/Lite.pm view on Meta::CPAN
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)
{
lib/App/Framework/Lite.pm view on Meta::CPAN
# 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}) ;
}
}
#----------------------------------------------------------------------------
lib/App/Framework/Lite.pm view on Meta::CPAN
}
}
#============================================================================================
# UTILITY
#============================================================================================
#----------------------------------------------------------------------------
=item B<expand_keys($hash_ref, $vars_aref)>
Processes all of the HASH values, replacing any variables with their contents. The variable
values are taken from the ARRAY ref I<$vars_aref>, which is an array of hashes. Each hash
containing variable name / variable value pairs.
The HASH values being expanded can be either scalar, or an ARRAY ref. In the case of the ARRAY ref each
ARRAY entry must be a scalar (e.g. an array of file lines).
=cut
sub expand_keys
{
my $this = shift ;
my ($hash_ref, $vars_aref, $_state_href, $_to_expand) = @_ ;
print "expand_keys($hash_ref, $vars_aref)\n" if $this->{debug};
$this->prt_data("vars=", $vars_aref, "hash=", $hash_ref) if $this->{debug} ;
my %to_expand = $_to_expand ? (%$_to_expand) : (%$hash_ref) ;
if (!$_state_href)
{
## Top-level
my %data_ref ;
# create state HASH
$_state_href = {} ;
# scan through hash looking for variables
%to_expand = () ;
foreach my $key (keys %$hash_ref)
{
my @vals ;
if (ref($hash_ref->{$key}) eq 'ARRAY')
{
@vals = @{$hash_ref->{$key}} ;
}
elsif (!ref($hash_ref->{$key}))
{
push @vals, $hash_ref->{$key} ;
lib/App/Framework/Lite.pm view on Meta::CPAN
my $ref = $hash_ref->{$key} || '' ;
if ($ref && exists($data_ref{"$ref"}))
{
print " + already seen data for key=$key\n" if $this->{debug}>=2;
# already got created a state for this data, point to it
$_state_href->{$key} = $data_ref{"$ref"} ;
}
else
{
print " + new state key=$key\n" if $this->{debug}>=2;
my $state = 'expanded' ;
$_state_href->{$key} = \$state ;
}
# save data reference
$data_ref{"$ref"} = $_state_href->{$key} if $ref ;
print " + check for expansion...\n" if $this->{debug}>=2;
foreach my $val (@vals)
{
next unless $val ;
print " + + val=$val\n" if $this->{debug}>=2;
if (index($val, '$') >= 0)
{
print " + + + needs expanding\n" if $this->{debug}>=2;
$to_expand{$key}++ ;
${$_state_href->{$key}} = 'to_expand' ;
last ;
}
}
}
}
$this->prt_data("to expand=", \%to_expand) if $this->{debug};
$this->prt_data("Hash=", $hash_ref) if $this->{debug};
## Expand them
foreach my $key (keys %to_expand)
{
print " # Key=$key State=${$_state_href->{$key}}\n" if $this->{debug};
# skip if not valid (if called recursively with a variable that is not in the hash)
next unless exists($hash_ref->{$key}) ;
# Do replacement iff required
next if ${$_state_href->{$key}} eq 'expanded' ;
my @vals ;
if (ref($hash_ref->{$key}) eq 'ARRAY')
{
foreach my $val (@{$hash_ref->{$key}})
{
push @vals, \$val ;
}
}
elsif (!ref($hash_ref->{$key}))
{
push @vals, \$hash_ref->{$key} ;
}
# mark as expanding
${$_state_href->{$key}} = 'expanding' ;
$this->prt_data("Vals to expand=", \@vals) if $this->{debug};
#use re 'debugcolor' ;
foreach my $val_ref (@vals)
{
print " # Expand \"$$val_ref\" ...\n" if $this->{debug};
$$val_ref =~ s{
(?:
lib/App/Framework/Lite.pm view on Meta::CPAN
$replace = $escaped ;
print " ## escaped prefix=$prefix replace=$replace\n" if $this->{debug};
print " ## DONE\n" if $this->{debug};
}
else
{
## use current HASH values before vars
if (defined $hash_ref->{$var})
{
print " ## var=$var current state=${$_state_href->{$var}}\n" if $this->{debug};
if (${$_state_href->{$var}} eq 'to_expand')
{
print " ## var=$var call expand..\n" if $this->{debug};
# go expand it first
$this->expand_keys($hash_ref, $vars_aref, $_state_href, {$var => 1}) ;
}
if (${$_state_href->{$var}} eq 'expanded')
{
print " ## var=$var already expanded\n" if $this->{debug};
$replace = $hash_ref->{$var}; # expand variable
$replace = join("\n", @{$hash_ref->{$var}}) if (ref($hash_ref->{$var}) eq 'ARRAY') ;
}
}
print " ## var=$var can replace from hash=$replace\n" if $this->{debug};
## If not found, use vars
if (!$replace)
{
## use vars
foreach my $href (@$vars_aref)
{
if (defined $href->{$var})
{
$replace = $href->{$var}; # expand variable
$replace = join("\n", @{$hash_ref->{$var}}) if (ref($href->{$var}) eq 'ARRAY') ;
print " ## found var=$var replace=$replace\n" if $this->{debug};
last ;
}
}
}
print " ## var=$var can replace now=$replace\n" if $this->{debug};
if (!$replace)
{
lib/App/Framework/Lite.pm view on Meta::CPAN
}
}
print " ## ALL DONE $key: $escaped$var = \"$prefix$replace\"\n\n" if $this->{debug};
"$prefix$replace" ;
}egxm; ## NOTE: /m is for multiline anchors; /s is for multiline dots
}
$this->prt_data("Hash now=", $hash_ref) if $this->{debug}>=2;
# mark as expanded
${$_state_href->{$key}} = 'expanded' ;
$this->prt_data("State now=", $_state_href) if $this->{debug}>=2;
}
}
#----------------------------------------------------------------------------
=item B<throw_fatal($message)>
Output error message then exit
lib/App/Framework/Lite/Object.pm view on Meta::CPAN
$str = "'".$str."'" ;
}
return $str ;
}
#----------------------------------------------------------------------------
=item B<expand_vars($string, \%vars)>
Work through string expanding any variables, replacing them with the value stored in the %vars hash.
If variable is not stored in %vars, then that variable is left.
Returns expanded string.
=cut
sub expand_vars
{
my $this = shift ;
my ($string, $vars_href) = @_ ;
# Do replacement
$string =~ 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 $vars_href->{$1}) {
$vars_href->{$1}; # expand variable
} else {
"\${$1}"; # leave it
}
}egx;
return $string ;
}
t/00-Misc.t view on Meta::CPAN
#!perl
use Test::More;
use App::Framework::Lite ;
## expand keys
my %vars = (
'var1' => 'this is a var',
'var2' => 'another var',
) ;
my %hash = (
'v1v2' => '$$var1${var1}$var2$var1$var2',
'simple' => 'a simple var',
'single' => 'contains $simple',
'esc' => 'contains \$simple',
t/00-Misc.t view on Meta::CPAN
# SUBROUTINES EXECUTED BY APP
#=================================================================================
#----------------------------------------------------------------------
# Main execution
#
sub app
{
my ($app) = @_ ;
$app->expand_keys(\%hash, [\%vars]) ;
$app->prt_data("HASH=", \%hash) ;
is_deeply(\%hash, \%expect, "Key expansion") ;
}
t/02-Options-3.t view on Meta::CPAN
# VERSION
our $VERSION = '1.234' ;
my $DEBUG=0;
my $VERBOSE=0;
my $stdout="" ;
my $stderr="" ;
diag( "Testing options expanded variables" );
## run time options
my %expected_options = (
'test_name=s' => 'this is different',
'default=s' => 'this is different',
'default2=s' => 'my def',
'default3=s' => 'my def another default',
'log=s' => 'another default',
'dbg-namestuff=s' => 'this is different this is different',
) ;
t/02-Options-4.t view on Meta::CPAN
# VERSION
our $VERSION = '1.234' ;
my $DEBUG=0;
my $VERBOSE=0;
my $stdout="" ;
my $stderr="" ;
diag( "Testing options and args expanded variables" );
## run time options
my %expected_options = (
'test_name=s' => 'im the series name',
'default=s' => 'im the series name',
'default2=s' => 'im the series name im the series name',
'default3=s' => 'im the series name im the series name another default',
'log=s' => 'another default',
'dbg-namestuff=s' => 'a name',
) ;
( run in 0.673 second using v1.01-cache-2.11-cpan-5623c5533a1 )