App-Framework
view release on metacpan or search on metacpan
lib/App/Framework.pm view on Meta::CPAN
The application settings are entered into the __DATA__ section at the end of the file. All program settings are grouped under sections which are introduced by '[section]' style headings. There are many
different settings that can be set using this mechanism, but the framework sets most of them to useful defaults. The most common sections are described below.
=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 Options
Command line options are defined in this section in the format:
-<name>=<specification> <Summary> <optional default setting>
<Description>
For example:
lib/App/Framework/Base.pm view on Meta::CPAN
# Add extra fields
$class->add_fields(\%FIELDS, \%args) ;
# init class
$class->SUPER::init_class(%args) ;
}
#----------------------------------------------------------------------------
=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 $class = shift ;
my ($hash_ref, $vars_aref, $_state_href, $_to_expand) = @_ ;
print "expand_keys($hash_ref, $vars_aref)\n" if $class_debug;
$class->prt_data("vars=", $vars_aref, "hash=", $hash_ref) if $class_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/Base.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 $class_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 $class_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 $class_debug>=2;
foreach my $val (@vals)
{
next unless $val ;
print " + + val=$val\n" if $class_debug>=2;
if (index($val, '$') >= 0)
{
print " + + + needs expanding\n" if $class_debug>=2;
$to_expand{$key}++ ;
${$_state_href->{$key}} = 'to_expand' ;
last ;
}
}
}
}
$class->prt_data("to expand=", \%to_expand) if $class_debug;
$class->prt_data("Hash=", $hash_ref) if $class_debug;
## Expand them
foreach my $key (keys %to_expand)
{
print " # Key=$key State=${$_state_href->{$key}}\n" if $class_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' ;
$class->prt_data("Vals to expand=", \@vals) if $class_debug;
#use re 'debugcolor' ;
foreach my $val_ref (@vals)
{
print " # Expand \"$$val_ref\" ...\n" if $class_debug;
$$val_ref =~ s{
(?:
lib/App/Framework/Base.pm view on Meta::CPAN
$replace = $escaped ;
print " ## escaped prefix=$prefix replace=$replace\n" if $class_debug;
print " ## DONE\n" if $class_debug;
}
else
{
## use current HASH values before vars
if (defined $hash_ref->{$var})
{
print " ## var=$var current state=${$_state_href->{$var}}\n" if $class_debug;
if (${$_state_href->{$var}} eq 'to_expand')
{
print " ## var=$var call expand..\n" if $class_debug;
# go expand it first
$class->expand_keys($hash_ref, $vars_aref, $_state_href, {$var => 1}) ;
}
if (${$_state_href->{$var}} eq 'expanded')
{
print " ## var=$var already expanded\n" if $class_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 $class_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 $class_debug;
last ;
}
}
}
print " ## var=$var can replace now=$replace\n" if $class_debug;
if (!$replace)
{
lib/App/Framework/Base.pm view on Meta::CPAN
}
}
print " ## ALL DONE $key: $escaped$var = \"$prefix$replace\"\n\n" if $class_debug;
"$prefix$replace" ;
}egxm; ## NOTE: /m is for multiline anchors; /s is for multiline dots
}
$class->prt_data("Hash now=", $hash_ref) if $class_debug>=2;
# mark as expanded
${$_state_href->{$key}} = 'expanded' ;
$class->prt_data("State now=", $_state_href) if $class_debug>=2;
}
}
##============================================================================================
#
#=back
lib/App/Framework/Base/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 ;
}
lib/App/Framework/Base/SearchPath.pm view on Meta::CPAN
=over 4
=item B<dir_mask> - directory creation mask
When the write_path is searched, any directories created are created using this mask [default = 0755]
=item B<env> - environment HASH ref
Any paths that contain variables have the variables expanded using the standard environment variables. Specifying
this HASH ref causes the variables to be replaced from this HASH before looking in the envrionment.
=item B<path> - search path
A comma seperated list (in scalar context), or an ARRAY ref list of paths to be searched (for a file)
=item B<write_path> - search path for writing
A comma seperated list (in scalar context), or an ARRAY ref list of paths to be searched (for a file) when writing. If not set, then
B<path> is used.
lib/App/Framework/Base/SearchPath.pm view on Meta::CPAN
# comma/semicolon seperated list
@dirs = split /[,;]/, $path_ref ;
}
$this->_dbg_prt([" + dirs=", \@dirs]) ;
$this->_dbg_prt(["this=", $this], 10) ;
my $vars_href = $this->env ;
$this->_dbg_prt([" + env=", $vars_href]) ;
## expand directories
foreach my $d (@dirs)
{
# Replace any '~' with $HOME
$d =~ s/~/\$HOME/g ;
# Now replace any vars with values from the environment
$d =~ s/\$(\w+)/$vars_href->{$1} || $ENV{$1} || $1/ge ;
# Ensure path is clean
$d = File::Spec->rel2abs($d) ;
lib/App/Framework/Core.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
$opt->option_values_set($opt_values_href, $opt_defaults_href) ;
lib/App/Framework/Core.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
* (Application registered 'app_start' function)
=cut
sub app_start
{
my $this = shift ;
lib/App/Framework/Core.pm view on Meta::CPAN
## Add user-defined options last
$this->feature('Data')->append_user_options() ;
## Get options
# NOTE: Need to do this here so that derived objects work properly
my $ret = $this->getopts() ;
## Expand any variables in the data
$this->_expand_vars() ;
# Handle options errors here after expanding variables
unless ($ret)
{
$this->usage('opt') ;
$this->exit(1) ;
}
# get options
my %options = $this->options() ;
## function
lib/App/Framework/Core.pm view on Meta::CPAN
$this->set($field_name => \&alias) ;
}
}
}
}
#----------------------------------------------------------------------------
#
#=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 ;
$this->_dbg_prt(["_expand_vars() - START\n"], 2) ;
# Get hash of fields
my %fields = $this->vars() ;
#$this->_dbg_prt([" + fields=", \%fields], 2) ;
# work through each field, create a list of those that have changed
my %changed ;
foreach my $field (sort keys %fields)
{
lib/App/Framework/Core.pm view on Meta::CPAN
# 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;
$this->_dbg_prt([" + + + new = $fields{$field}\n"], 3) ;
# Add to list
$changed{$field} = $fields{$field} ;
lib/App/Framework/Core.pm view on Meta::CPAN
$this->_dbg_prt([" + changed=", \%changed], 2) ;
# If some have changed then set them
if (keys %changed)
{
$this->_dbg_prt([" + + set changed\n"], 2) ;
$this->set(%changed) ;
}
$this->_dbg_prt(["_expand_vars() - END\n"], 2) ;
}
#----------------------------------------------------------------------------
=item B<debug_prt($items_aref [, $min_debug])>
Print out the items in the $items_aref ARRAY ref iff the application's debug level is >0.
If $min_debug is specified, will only print out items if the application's debug level is >= $min_debug.
lib/App/Framework/Extension/Filter.pm view on Meta::CPAN
my %filter ;
$filter{'filter_fmt'} = $this->outfile ;
$filter{'filter_file'} = $state_href->{file} ;
$filter{'filter_filenum'} = $state_href->{file_number} ;
my ($base, $path, $ext) = fileparse($state_href->{file}, '\..*') ;
$filter{'filter_name'} = $base ;
$filter{'filter_base'} = $base ;
$filter{'filter_path'} = $path ;
$filter{'filter_ext'} = $ext ;
$this->expand_keys(\%filter, [\%opts, \%app_vars, \%ENV]) ;
$outfile = $filter{'filter_fmt'} ;
$this->_dbg_prt([" + eval=$@\n"]) ;
$this->_dbg_prt([" + outfile=$outfile: dir=$dir fmt=$filter{'filter_fmt'} file=$filter{'filter_file'} num=$filter{'filter_filenum'} base=$base path=$path\n"]) ;
$outfile = File::Spec->catfile($dir, $outfile) ;
}
## Output file specified?
lib/App/Framework/Feature/Args.pm view on Meta::CPAN
# Open all file handles (the default)
use App::Framework '+Args(open=all)' ;
=head2 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/Feature/Args.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/Feature/Args.pm view on Meta::CPAN
}
}
}
# ============================================================================================
# PRIVATE METHODS
# ============================================================================================
#----------------------------------------------------------------------------
#
#=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/Feature/Args.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/Feature/Data.pm view on Meta::CPAN
$file = $app->Data('data2') ;
=head2 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/Feature/Data.pm view on Meta::CPAN
=over 4
=cut
#============================================================================================
#----------------------------------------------------------------------------
=item B<app_start_exit()>
Called at the end of app_start. Used to expand the variables in the data
=cut
sub app_start_exit
{
my $this = shift ;
## Handle special options
my $app = $this->app ;
my %app_vars = $app->vars ;
my %opts = $app->options() ;
my $args_values_href = $app->feature('Args')->args_values_hash() ;
my $data_href = $this->_data_hash() ;
$this->expand_keys($data_href, [\%opts, $args_values_href, \%app_vars, \%ENV]) ;
}
#----------------------------------------------------------------------------
=item B<application_entry()>
Called at start of application
=cut
lib/App/Framework/Feature/Options.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.
=head2 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/Feature/Options.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/Feature/Options.pm view on Meta::CPAN
$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) ;
}
#----------------------------------------------------------------------------
#
#=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 ;
}
push @vars, \%ENV ;
# ## expand
# $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/Feature/Sql.pm view on Meta::CPAN
#
# * $sqlvar_<context>
#
#where <context> is the hash key. This created variable contains the sql for this command or option.
#
#If the control hash entry contains a 'vals' entry, then the following variable is created:
#
# * @sqlvar_<context>
#
#This will be a text string containing something like "@sqlvar_select_vals,@sqlvar_where_vals" i.e. a comma
#seperated list of references to other arrays. These values will be expanded into a real array before use in the
#sql prepare.
#
#Also, as each entry is processed, extra variables are created:
#
# * $sqlvar_<context>_prefix - Prefix string for this entry
# * $sqlvar_<context>_format - Just the same as sqlvar_<context>
#
#
#=head2 Specification variables
#
lib/App/Framework/Feature/Sql.pm view on Meta::CPAN
$this->_sql_setvars($cmd, \%spec, \%vars) ;
}
elsif (!ref($spec))
{
# Process spec - set vars
$this->_sql_setvars($cmd || 'query', $spec, \%vars) ;
}
$this->_dbg_prt(["Vars=", \%vars], 2) ;
$this->_dbg_prt(["+ expand vars\n"], 2) ;
## Run through all vars and expand them
$this->_sql_expand_vars(\%vars) ;
## Run through all vars and expand arrays them
$this->_sql_expand_arrays(\%vars) ;
# query should now be in variable 'sqlvar_query'
my $sql = $vars{'sqlvar_query'} ;
# values should now be in variable '@sqlvar_query'
my $values_aref = $vars{'@sqlvar_query'} ;
if ($this->debug())
{
lib/App/Framework/Feature/Sql.pm view on Meta::CPAN
sub sth_query
{
my $this = shift ;
my ($name, @vals) = @_ ;
my $sth_href = $this->_sth_record($name) ;
if ($sth_href)
{
my ($sth, $vals_aref, $query) = @$sth_href{qw/sth vals query/} ;
# TODO: expand vars?
my @args ;
foreach my $arg (@$vals_aref)
{
## process each value
if (ref($arg) eq 'SCALAR')
{
## Ref to scalar
push @args, $$arg ;
}
elsif (ref($arg) eq 'HASH')
lib/App/Framework/Feature/Sql.pm view on Meta::CPAN
# Set var
$vars_href->{$var} = $format ;
$this->_dbg_prt([" > _sql_setvars($context) - END [format=$format]\n"], 2) ;
}
#----------------------------------------------------------------------------
=item B<_sql_expand_vars($vars_href)>
Expand all the variables in the HASH ref
=cut
sub _sql_expand_vars
{
my $this = shift ;
my ($vars_href) = @_ ;
$this->_dbg_prt(["_sql_expand_vars()\n"], 2) ;
$this->_dbg_prt(["vars", \$vars_href], 2) ;
# do all vars in HASH
foreach my $var (keys %$vars_href)
{
# skip non SCALAR
next if ref($vars_href->{$var}) ;
# skip if empty
next unless $vars_href->{$var} ;
$this->_dbg_prt([" + $var\n"], 2) ;
# Keep replacing until all variables have been expanded
my $ix = index $vars_href->{$var}, '$' ;
while ($ix >= 0)
{
$this->_dbg_prt([" + + ix=$ix : $var = $vars_href->{$var}\n"], 2) ;
# At least 1 more variable to replace, so replace it
$vars_href->{$var} =~ s{
\$ # find a literal dollar sign
\{{0,1} # optional brace
(\w+) # find a "word" and store it in $1
\}{0,1} # optional brace
}{
if (defined $vars_href->{$1}) {
$vars_href->{$1}; # expand
} else {
""; # remove
}
}egx;
$ix = index $vars_href->{$var}, '$' ;
$this->_dbg_prt([" + + + $var = $vars_href->{$var}\n"], 2) ;
}
}
$this->_dbg_prt(["_sql_expand_vars - END\n"], 2) ;
}
#----------------------------------------------------------------------------
=item B<_sql_expand_arrays($vars_href)>
Expand all the array variables in the HASH ref
=cut
sub _sql_expand_arrays
{
my $this = shift ;
my ($vars_href) = @_ ;
$this->_dbg_prt(["_sql_expand_arrays()\n"], 2) ;
$this->_dbg_prt(["vars", \$vars_href], 2) ;
# do all vars in HASH
foreach my $var (keys %$vars_href)
{
$this->_dbg_prt([" + $var=", $vars_href->{$var}, "\n"], 2) ;
# skip variables that aren't named @....
next unless $var =~ /^\@/ ;
# skip if already an array
next if ref($vars_href->{$var}) eq 'ARRAY' ;
# Expand it
$this->_sql_expand_array($var, $vars_href) ;
}
$this->_dbg_prt(["_sql_expand_arrays() - END\n"], 2) ;
}
#----------------------------------------------------------------------------
=item B<_sql_expand_array($arr, $vars_href)>
Expand the named array
=cut
sub _sql_expand_array
{
my $this = shift ;
my ($array, $vars_href) = @_ ;
$this->_dbg_prt(["_sql_expand_array($array)\n"], 2) ;
# skip if already an array
unless (ref($vars_href->{$array}) eq 'ARRAY')
{
if ($vars_href->{$array})
{
# split on commas
my @arr_list = split(/[,\s+]/, $vars_href->{$array}) ;
# start array off
lib/App/Framework/Feature/Sql.pm view on Meta::CPAN
$this->_dbg_prt([" -- setting array\n"], 2) ;
# process them
foreach my $arr (@arr_list)
{
$this->_dbg_prt([" -- -- get $arr\n"], 2) ;
# if reference to another array, evaluate it
if ($arr =~ /^\@/)
{
$this->_dbg_prt([" -- -- -- expand $arr\n"], 2) ;
my $arr_aref = $this->_sql_expand_array($arr, $vars_href) ;
$this->_dbg_prt([" -- -- -- push array $arr=", $arr_aref, "\n"], 2) ;
# Add to list
push @{$vars_href->{$array}}, @$arr_aref if $arr_aref ;
}
else
{
$this->_dbg_prt([" -- -- -- push value ", $arr, "\n"], 2) ;
# Add to list
push @{$vars_href->{$array}}, $arr ;
}
}
}
}
$this->_dbg_prt(["ARRAY $array=", $vars_href->{$array}], 2) ;
$this->_dbg_prt(["_sql_expand_array($array) - END\n"], 2) ;
return ($vars_href->{$array}) ;
}
#----------------------------------------------------------------------------
=item B<_sth_record($name)>
Returns the saved sth information looked up from $name; returns undef otherwise
lib/App/Framework/GetStarted.pod view on Meta::CPAN
=head3 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.
=head3 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).
=head3 Options
Command line options are defined in general as:
-<name>=<specification> <Summary> <optional default setting>
<Description>
The specification is in the format:
lib/App/Framework/GetStarted.pod view on Meta::CPAN
or
-tbl|'table'|sql_table=s Table [default=listings2]
so that the command line could use -tbl, -table, or -sql_table and the option value be retrieved using 'table' as the option name.
The option spec (which in the example is set to 's') is a subset of the set supported by L<Getpt::Long>. For full details of the supported
set please see L<App::Framework::Feature::Options>
If a default is specified, that the option will be given the default value if it is not specified at the command line. Also, the default
can contains variables which will be expanded once the script starts. These variables can include the values of other options. For example,
we could have specified the 'database' option as:
-database=s Database [default=${table}_db]
Then the database option would be set to 'listings2_db' if no options were specified by the user at the command line.
By default, the application is called with the options HASH as the 2nd parameter. Using the option values is discussed
in L<Application body>
lib/App/Framework/GetStarted.pod view on Meta::CPAN
=head2 Advanced
In addition to the straightforward cases described above, additional features may be optionally included into the script as described below.
=head3 Data sections
The framework installs the 'Data' feature automatically in order to process the script settings. The user may then add additional data sections
below the setup. These data sections can be named, and the data contents accessed via this name. Also, the contents (text) of the data sections
may contain variables the are expanded from the current settings of options, application setup, or the environment variables.
For example, the following data definition:
__DATA__
[SUMMARY]
Tests the application object with SQL
[DESCRIPTION]
lib/App/Framework/GetStarted.pod view on Meta::CPAN
`date` date NOT NULL,
`start` time NOT NULL,
KEY `pid` (`pid`),
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
and script command arguments:
-table listings2
result in the data section 'sql' being expanded to:
-- --------------------------------------------------------
--
-- Table structure for table `listings2`
--
DROP TABLE IF EXISTS `listings2`;
CREATE TABLE IF NOT EXISTS `listings2` (
`pid` varchar(128) NOT NULL,
`title` varchar(128) NOT NULL,
`date` date NOT NULL,
t/00-Misc.t view on Meta::CPAN
#!perl
use Test::More;
use App::Framework ;
## 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
#----------------------------------------------------------------------
# Main execution
#
sub app
{
my ($app) = @_ ;
$App::Framework::Base::class_debug = 5 ;
$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 1.010 second using v1.01-cache-2.11-cpan-5623c5533a1 )