# # Jerome.Gouzy@toulouse.inra.fr # # $Id: ParamParser.pm 86 2007-10-10 08:05:41Z sletort $ # package ParamParser;
Copyright I.N.R.A. - C.N.R.S.
emmanuel.courcelle@toulouse.inra.fr jerome.gouzy@toulouse.inra.fr
This software is a perl module whose purpose is to help you writing your own scripts
This software is governed by the CeCILL license under French law and abiding by the rules of distribution of free software. You can use, modify and/ or redistribute the software under the terms of the CeCILL license as circulated by CEA, CNRS and INRIA at the following URL http://www.cecill.info"
As a counterpart to the access to the source code and rights to copy, modify and redistribute granted by the license, users are provided only with a limited warranty and the software's author, the holder of the economic rights, and the successive licensors have only limited liability.
In this respect, the user's attention is drawn to the risks associated with loading, using, modifying and/or developing or reproducing the software by the user in light of its specific status of free software, that may mean that it is complicated to manipulate, and that also therefore means that it is reserved for developers and experienced professionals having in-depth computer knowledge. Users are therefore encouraged to load and test the software's suitability as regards their requirements in conditions enabling the security of their systems and/or data to be ensured and, more generally, to use and operate it in the same conditions as regards security.
The fact that you are presently reading this means that you have had knowledge of the CeCILL license and that you accept its terms.
ParamParser - parse parameters from different sources (CGI.pm, GetOpt, cgi-lib, configuration file, ARGV, ENV)
1. parameter source defined from a configuration file use ParamParser; $rh_param = New ParamParser($filename);
------ example.cfg ------- # lines starting with # are ignored OPTION=value of the option --------------------------
2. from ARGV use ParamParser; $rh_param = New ParamParser('ARGV');
% program OPTION1="value of the option" OPTION2=value 3. from environment variables use ParamParser; $rh_param = New ParamParser('ENV'); or $rh_param = New ParamParser('ENV','prefix'); to add a tag to environment variables
4. from CGI object use CGI; use ParamParser; $rh_param = New ParamParser('CGIPM');
5. from CGI-LIB data structure (version 2) require "cgi-lib2.pl"; use ParamParser; $rh_param = New ParamParser('CGILIB');
6. from Getopt::Std object use Getopt::Std; use ParamParser; $rh_param = New ParamParser('GETOPTSTD',"list_of_singlet-character_switches");
run the command man Getopt::Std to see what is "list_of_singlet-character_switches" to use the same options with the current module you must write $rh_param = New ParamParser('GETOPTSTD',"oif:"); $rh_param = New ParamParser('GETOPTSTD',"oDI");
7. from Getopt::Long object use Getopt::Long; use ParamParser; $rh_param = New ParamParser('GETOPTLONG',(list_of_getoptlong_option));
run the command man Getopt::Long to see what is a "list_of_getoptlong_option" to use the same options with the current module you must write $rh_param = New ParamParser('GETOPTLONG',("length=i","file=s","verbose"));
8. from another ParamParser object use ParamParser; $rh_param = New ParamParser('PARAMPARSER',$rh_other_param); =head1 DESCRIPTION
24-Jun-2004 add two new functions: IsDefined and SetUnlessDefined 26-Oct-2004 creation of Dump methods in order to export paramparser to a file or %ENV 29-Oct-2004 add the capability to define/select a NameSpace : SelectNameSpace add a fonction to get all keys matching a given pattern : GetKeys
use strict; use warnings; use Carp; BEGIN { our $VERSION = do {my @r = (q$Rev: 86 $ =~ /\d+/g); $r[0]}; }
see SYNOPSIS
sub New { my ($pkg, $source, @a_opt) = @_; my $self = { __h_opt => {}, __h_behaviour => {}, __nb => 0, __mode => "", __name_space => "", __usage => sub {print "\nWarning: something is wrong but the program usage is not yet described\n"}, __possible_sources => "", __last_source => $source }; bless($self, $pkg); &SetBehaviour($self, 'assert_strict'); &UnsetBehaviour($self, 'assert_empty_file_allowed'); &UnsetBehaviour($self, 'ignore_space'); &UnsetBehaviour($self, 'exit_on_getopt_error'); &UnsetBehaviour($self, 'use_substitution_table'); &__InitPossibleSources($self); &Update($self, $source, 'I', @a_opt); return ($self); }
$rh_param->Update(source,mode,GetOpt_Std_or_Long_list_of_option);
source: CGIPM|CGILIB|GetOptStd|GetOptLong|ARGV|$filename|ENV mode: I: init : clean the data structure first A: append mode : preserve the previous value of duplicate keys O: overwrite mode : replace the value of a duplicate key
Update the data structure with a new parameter source. Call Usage if a help or HELP parameter is found
sub Update { my ($self, $source, $mode, @a_opt) = @_; my $opt = (defined($a_opt[0])) ? $a_opt[0] : ""; $$self{'__mode'} = $mode; if ($mode eq 'I') { $self->Init(); } if (defined($source) && -e $source && !-z $source) { &__FromFile($self, $source); $$self{'__last_source'} = "$source"; # pas de message d'erreur ? return; } if (!defined($source)) { # the module tries to find automaticaly the source of parameter # (the source cannot be neither GetOpt* nor filename) if ($$self{'__possible_sources'} =~ /ARGV/) { $source = "ARGV"; } elsif ($$self{'__possible_sources'} =~ /CGIPM/) { $source = "CGIPM"; } elsif ($$self{'__possible_sources'} =~ /CGILIB/) { $source = "CGILIB"; } else { $source = "ENV"; } } if (!defined($source) || $$self{'__possible_sources'} !~ / $source /) { $$self{'__last_source'} = "undef"; return; } if ($source =~ /CGILIB/i) { my (@a_backup) = @_; # this backup is needed because cgi-lib uses @_ as parameter input source &__FromCGILIB($self, @a_backup); } elsif ($source =~ /CGIPM/i) { &__FromCGIPM($self); } elsif ($source =~ /ENV/i) { &__FromENV($self); } elsif ($source =~ /GETOPTSTD/i) { &__FromGetOptStd($self, $opt); } elsif ($source =~ /GETOPTLONG/i) { &__FromGetOptLong($self, @a_opt); } elsif ($source =~ /ARGV/i) { &__FromARGV($self); } elsif ($source =~ /PARAMPARSER/i) { &__FromPARAMPARSER($self, @a_opt); } $$self{'__last_source'} = "\U$source"; $self->__CallUsageIfNeeded(); }
$rh_param->Dump(target[,prefix]);
source: $filename|ENV|GetOptLong prefix: add the prefix 'prefix' to %ENV keys
sub Dump { my ($self, $target, @a_opt) = @_; my $opt = (defined($a_opt[0])) ? $a_opt[0] : ""; if ($$self{'__possible_sources'} =~ / $target /) { if ($target =~ /ENV/) { &__ToENV($self, $opt); } if ($target =~ /GETOPTLONG/) { &__ToGetOptLong($self, $opt); } } else # the parameter is assumed to be a filename { &__ToFile($self, $target, $opt); } }
$rh_param->SelectNameSpace('NS'); # create the namespace NS (in fact a prefix to all parameters) $rh_param->SelectNameSpace(); # select the namespace which contains all parameters
Select/Init working NameSpace of parameters
sub SelectNameSpace { my ($self, $opt) = @_; $opt = "" if (!defined($opt)); $$self{'__name_space'} = $opt; }
$rh_param->Init();
Initialise the data structure
sub Init { my ($self) = @_; $$self{'__nb'} = 0; $$self{'__last_source'} = ""; $$self{'__mode'} = ""; #$$self{'__usage'} = ""; # removed by manu - __usage is not modified by __Init, just like the behaviours foreach my $key (keys(%{$$self{'__h_opt'}})) { delete($$self{'__h_opt'}{$key}); } }
$rh_param->Set($opt,$value);
Associate a new value to $opt
sub Set { my ($self, $opt, $value) = @_; $$self{'__last_source'} = "INLINE"; $$self{'__nb'}++ if (!defined($$self{'__h_opt'}{$opt})); my $key = $$self{'__name_space'} . $opt; $$self{'__h_opt'}{$key} = $value; $self->__SubstituteKey($key) if ($self->GetBehaviour('use_substitution_table')); }
$rh_param->SetUnlessDefined($opt,$value);
Associate a new value to $opt ONLY if the key is not yet defined
sub SetUnlessDefined { my ($self, $opt, $value) = @_; my $key = $$self{'__name_space'} . $opt; if (!defined($$self{'__h_opt'}{$key})) { $$self{'__last_source'} = "INLINE"; $$self{'__nb'}++; $$self{'__h_opt'}{$key} = $value; $self->__SubstituteKey($key) if ($self->GetBehaviour('use_substitution_table')); } }
$rh_param->Delete($opt);
Delete the $opt key
sub Delete { my ($self, $opt, $value) = @_; $$self{'__nb'}--; my $key = $$self{'__name_space'} . $opt; if (defined($$self{'__h_opt'}{$key})) { delete($$self{'__h_opt'}{$key}); } }
$value = $rh_param->Get($opt);
Return the value of $opt key
sub Get { my ($self, $opt) = @_; my $key = $$self{'__name_space'} . $opt; if (defined($$self{'__h_opt'}{$key})) { return $$self{'__h_opt'}{$key}; } else { return ""; } }
@a_keys = $rh_param->GetKeys(pattern);
Return a list of parameters matching the given pattern
sub GetKeys { my ($self, $pattern) = @_; $pattern = '' if (!defined $pattern); my @a_keys = (); my $cpt = 0; my $ns = $$self{'__name_space'}; foreach my $key (sort keys(%{$$self{'__h_opt'}})) { if ($key =~ /^$ns/) { my $nkey = $key; $nkey =~ s/^$ns//; if ($nkey =~ /$pattern/) { $a_keys[$cpt++] = $nkey; } } } return (@a_keys); }
$value = $rh_param->IsDefined($opt);
boolean, TRUE if the key is defined
sub IsDefined { my ($self, $opt) = @_; my $key = $$self{'__name_space'} . $opt; my ($bool) = (defined($$self{'__h_opt'}{$key})) ? 1 : 0; return $bool; }
$value = $rh_param->HowMany();
Return the number of parameters
sub HowMany { my ($self) = @_; return $$self{'__nb'}; }
$value = $rh_param->GetSource();
Return the last parameter source
sub GetSource { my ($self) = @_; return $$self{'_last_source'}; }
$rh_param->Substitute($to_substitute,$ref_substituted)
Declare some string (format: %[a-zA-Z] to be substituted by the content of a variable or the result of a function
sub SetSubstitution { my ($self, $to_substitute, $ref) = @_; if ($to_substitute !~ /\A%[a-z0-9]\Z/i) { &Carp::croak("\n" . '=>You can declare as substitution strings ONLY %0..%9, %A..%Z, %a,..%z'); } $$self{'__substitution_table'}{$to_substitute} = $ref; }
$rh_param->Print(); $rh_param->Print('html');
Print keys and associated values in text of html format
sub Print { my ($self, $format) = @_; my ($header) = ""; my ($tail) = ""; my ($sep) = ":"; my ($newline) = "\n"; my ($style) = ""; if (defined($format) && $format =~ /html/i) { $header = "<table>"; $tail = "</table>"; $sep = "<td>"; $newline = "<tr><td>"; $style = "<b>"; } print "$header"; foreach my $key (sort keys(%{$$self{'__h_opt'}})) { my $ns = $$self{'__name_space'}; next if ($key !~ /^$ns/); if (defined($key) && defined($$self{'__h_opt'}{$key})) { print "$newline$style$key$sep " . $$self{'__h_opt'}{$key}; } } print "${newline}Total number (all namespaces) of keys$sep " . $$self{'__nb'}; print "${newline}Last source$sep " . $$self{'__last_source'}; print "$tail"; }
$rh_param->SetBehaviour('assert_strict'); # when set, the assertion will fail if the parameter is not defined (default) $rh_param->SetBehaviour('ignore_space'); # when set, the space between the '=' are ignored in the configuration file $rh_param->SetBehaviour('exit_on_getopt_error') # execute the usage function when GetOptions return an error code; $rh_param->SetBehaviour('assert_empty_file_allowed') # when set, no exit on empty files $rh_param->SetBehaviour('use_substitution_table') # when set, the substitution table is used at every Set NOTE - When this behaviour is set, the function __SubstituteNow is called Control the behaviour of the parser
sub SetBehaviour { my ($self, $key) = @_; return unless ($self->__ValidBehaviour($key)); $$self{'__h_behaviour'}{$key} = 1; if ($key eq 'use_substitution_table') { $self->__SubstituteAll(); } }
$rh_param->UnsetBehaviour('assert_strict'); # if unset, the assertion is true when the parameter is not defined $rh_param->UnsetBehaviour('ignore_space'); # if unset, the space between the '=' are not ignored in the configuration file (default) $rh_param->UnSetBehaviour('exit_on_getopt_error') # ignore the value returned by GetOptions (default) $rh_param->UnSetBehaviour('assert_empty_file_allowed') # if unset, then the program exits on empty files (default) $rh_param->UnSetBehaviour('use_substitution_table') # if unset, the substitution table is ignored (default) Control the behaviour of the parser
sub UnsetBehaviour { my ($self, $key) = @_; return unless ($self->__ValidBehaviour($key)); $$self{'__h_behaviour'}{$key} = 0; }
Returns 1 if the behaviour whose name is passed by parameter is set, 0 if not set.
sub GetBehaviour { my ($self, $key) = @_; return 0 unless ($self->__ValidBehaviour($key)); return $$self{'__h_behaviour'}{$key}; }
$rh_param->AssertFileExists(@a_opt);
The programs stops if the key $opt does not refer to a non empty file
sub AssertFileExists { my ($self, @a_file) = @_; foreach my $file (@a_file) { my $key = $$self{'__name_space'} . $file; my ($lfile) = $$self{'__h_opt'}{$key}; next if (!defined($lfile) && !$$self{'__h_behaviour'}{'assert_strict'}); if (!defined($lfile) || !-e $lfile || (-z $lfile && !$$self{'__h_behaviour'}{'assert_empty_file_allowed'})) { &__PrintUsage($self); $lfile = &__DefinedIfNot($lfile); &Carp::croak( "\n=>The value of the parameter $file is >$lfile< which is not a name of an existing and non empty file" ); } } return 1; }
$rh_param->AssertDirExists(@a_opt);
The programs stops if the key $opt does not refer to a directory
sub AssertDirExists { my ($self, @a_file) = @_; foreach my $file (@a_file) { my $key = $$self{'__name_space'} . $file; my ($lfile) = $$self{'__h_opt'}{$key}; next if (!defined($lfile) && !$$self{'__h_behaviour'}{'assert_strict'}); if (!defined($lfile) || !-d $lfile) { &__PrintUsage($self); $lfile = &__DefinedIfNot($lfile); &Carp::croak( "\n=>The value of the parameter $file is >$lfile< which is not a name of an existing directory"); } } return 1; }
$rh_param->AssertInteger(@a_opt);
The programs stops if one of the key in the list does not refer to an integer
sub AssertInteger { my ($self, @a_opt) = @_; foreach my $opt (@a_opt) { my $key = $$self{'__name_space'} . $opt; my ($lopt) = $$self{'__h_opt'}{$key}; next if (!defined($lopt) && !$$self{'__h_behaviour'}{'assert_strict'}); if (!defined($lopt) || $lopt !~ /^[\+\-]*\d+$/) { &__PrintUsage($self); $lopt = &__DefinedIfNot($lopt); &Carp::croak("\n=>The value of the parameter $opt is >$lopt< which is not a valid integer value"); } } return 1; }
$rh_param->AssertDefined(@a_opt);
The programs stop if one of the key in the list is not defined
sub AssertDefined { my ($self, @a_opt) = @_; foreach my $opt (@a_opt) { my $key = $$self{'__name_space'} . $opt; my ($lopt) = $$self{'__h_opt'}{$key}; if (!defined($lopt)) { &__PrintUsage($self); &Carp::croak("=>The parameter $opt must be provided"); } } return 1; }
$rh_param->AssertAllowedValue($value,@a_list_of_allowed_values);
The program stop if the value of the key does not match one value of the list of allowed values
sub AssertAllowedValue { my ($self, $value, @a_list_of_allowed_values) = @_; my $key = $$self{'__name_space'} . $value; my ($lvalue) = $$self{'__h_opt'}{$key}; if (defined($lvalue)) { foreach my $one_value (@a_list_of_allowed_values) { if ($lvalue =~ /^$one_value$/) { return 1; } } } &__PrintUsage($self); my ($allowed) = join(',', @a_list_of_allowed_values); $lvalue = &__DefinedIfNot($lvalue); &Carp::croak( "=>The current value of the parameter $value is >$lvalue< which is not in the set of allowed values [$allowed]" ); }
$rh_param->AssertNonEmptyFile(@a_opt);
The programs stops if the elements of the list does not refer to non empty files
sub AssertNonEmptyFile { my ($self, @a_file) = @_; foreach my $file (@a_file) { my $file = $$self{'__name_space'} . $file; if (!defined($file) || !-e $file || -z $file) { &__PrintUsage($self); $file = &__DefinedIfNot($file); &Carp::croak("AssertNonEmptyFile failed for $file"); } } return 1; }
$rh_param->Usage(); $rh_param->Usage('html');
Print the usage of the program
sub Usage { my ($self, $format) = @_; my ($head) = ""; my ($tail) = ""; if (defined($format) && $format =~ /html/i) { $head = "<html><head><title>$0</title></head><body><br><pre>"; $tail = "<br></pre></body></html>"; } print $head; &__PrintUsage($self); print $tail; exit; }
$rh_param->SetUsage(my $usage= sub { &my_usage_fct();} )
Attach an usage fonction to the ParamParser object
sub SetUsage { my ($self, $r_fct_usage) = @_; $$self{'__usage'} = $r_fct_usage; $self->__CallUsageIfNeeded(); }
$rh_param->__CallUsage() Private method Call Usage if --self specified =cut
sub __CallUsageIfNeeded { my $self = shift; if (defined($$self{'__h_opt'}{'help'}) || defined($$self{'__h_opt'}{'HELP'})) { if ($$self{'__last_source'} =~ /CGI/i) { &Usage($self, 'html'); } else { &Usage($self); } } }
use CGI qw/:standard/; use ParamParser;
my $rh_param = New ParamParser("CGIPM");
$rh_param->SetUsage(my $usage=sub { print "\nPlease read the documentation\n"; } ); # attach an usage fonction to the parser # the best way is to reference a real fonction $rh_param->SetUsage(my $usage=sub { &UsageFct(); } ); $rh_param->Set('TIMEOUT','10000'); # add a single variable to the data structure $rh_param->Update('ENV',"O"); # append all environment variables in overwrite mode (overwrite duplicates) $rh_param->AssertFileExists('CFG'); # check that the value of the parameter CFG is an existing file, print the usage and exit if it is not. $rh_param->Update($rh_param->Get('CFG'),"A"); # add all variables contained in the configuration file in append mode (do not overwrite duplicates) print header; $rh_param->Print('html');
use Getopt::Long; use ParamParser;
my $rh_param = New ParamParser('GETOPTLONG',("help:s","min=i","max=i","inputfile=s","what=s"));
$rh_param->SetUsage(my $usage=sub { print "\nPlease read the documentation\n"; } ); # attach an usage fonction to the parser # the best way is to reference a real fonction $rh_param->SetUsage(my $usage=sub { &UsageFct(); } );
$rh_param->Update('ENV',"A"); # append all environment variables in append mode (do not overwrite duplicates)
$rh_param->AssertFileExists('inputfile'); # check that the value of the parameter inputfile is an existing file, print the usage and exit if it is not. $rh_param->AssertInteger('max','min'); # check that the value of the parameters are integers, print the usage and exit if one of them is not. $rh_param->AssertAllowedValue('what','yes','no','maybe'); # check that the value of the parameters is a correct value $rh_param->Print();
Print the usage of the program
sub __PrintUsage { my ($self) = @_; &{$$self{'__usage'}}(); }
Update the value of the given key, depending on the selected insertion mode
sub __UpdateIfPossible { my ($self, $item, $value) = @_; my $how = ($$self{'__mode'} eq "") ? "A" : $$self{'__mode'}; $item = $$self{'__name_space'} . $item; if ( !defined($$self{'__h_opt'}{$item}) # the key doesn't already exist || (defined($$self{'__h_opt'}{$item}) && $how eq 'O') ) # or the key already exists but the mode is 'O'verwrite { $$self{'__nb'}++; $$self{'__h_opt'}{$item} = $value; } if ($self->GetBehaviour('use_substitution_table')) { $self->__SubstituteAll(); } }
return 1 if the behaviour passed by parameter is legal, 0 if not. If not loegal, croak something. =cut
sub __ValidBehaviour { my ($self, $key) = @_; return 1 if ($key eq 'assert_strict'); return 1 if ($key eq 'ignore_space'); return 1 if ($key eq 'exit_on_getopt_error'); return 1 if ($key eq 'assert_empty_file_allowed'); return 1 if ($key eq 'use_substitution_table'); &Carp::croak("\n=>The behaviour $key is unknown"); return 0; }
Try to make the substitutions for the key passed by parameter =cut
sub __SubstituteKey { my ($self, $key) = @_; return unless (defined($self->{'__h_opt'}{$key})); # If value not defined, nothing to substitute return unless (exists $self->{'__substitution_table'}); # If no table, nothing to substitute my $rh_sub_table = $self->{'__substitution_table'}; my $to_subst = $self->{'__h_opt'}{$key}; return unless ($to_subst =~ /%/); # If no %, nothing to substitute foreach my $s (keys(%$rh_sub_table)) { next unless ($to_subst =~ /$s/); my $r = $rh_sub_table->{$s}; if (ref($r) eq 'SCALAR') # Substitute if ref to a scalar { $to_subst =~ s/$s/$$r/g; } if (ref($r) eq 'CODE') # Substitute, calling the sub, if ref to a sub { my $subst = &$r($self, $key); $to_subst =~ s/$s/$subst/g; # N.B. May be several substitutions, but only 1 call } } $self->{'__h_opt'}{$key} = $to_subst; return; }
For each parameter, call __SubstituteKey =cut
sub __SubstituteAll { my $self = shift; foreach my $key (sort keys(%{$self->{'__h_opt'}})) { $self->__SubstituteKey($key); } }
Initialize the ParamParser object using Getopt::Std style as source of param/values
sub __FromGetOptStd { my ($self, $optlist) = @_; use Getopt::Std; my @a_backup = @ARGV; our %options = (); &getopts($optlist, \%options); #my $getopt_succeed = &getopts($optlist,\%options); #if ( ! $getopt_succeed && $$self{'__h_behaviour'}{'exit_on_getopt_error'} ) #{ # &Usage(); #} foreach my $key (keys(%options)) { &__UpdateIfPossible($self, $key, $options{$key}); } @ARGV = @a_backup; # restore original parameters # -> can be parsed again is necessary # -> avoid site effect }
Initialize the ParamParser object using Getopt::Long style as source of param/values
sub __FromGetOptLong { my ($self, @a_opt) = @_; use Getopt::Long; my @a_backup = @ARGV; my %h_options = (); my %h_value = (); foreach my $key (@a_opt) { $h_options{$key} = \$h_value{$key}; } my $getopt_succeed = &GetOptions(%h_options); if (!$getopt_succeed && $$self{'__h_behaviour'}{'exit_on_getopt_error'}) { &Usage($self); } foreach my $key (keys(%h_value)) { my (@F) = split(/[:=]/, $key); my ($real_key) = $F[0]; &__UpdateIfPossible($self, $real_key, $h_value{$key}); } @ARGV = @a_backup; # restore original parameters # -> can be parsed again is necessary # -> avoid site effect }
Initialize the ParamParser object using CGI-LIB2 as source of param/value
sub __FromCGILIB { my ($self, @a_backup) = @_; @_ = @a_backup; my ($keyin); if (defined(ref(&main::ReadParse))) { &main::ReadParse; foreach $keyin (keys(%main::in)) { &__UpdateIfPossible($self, $keyin, $main::in{$keyin}); } } }
Initialize the ParamParser object using CGI.pm source
sub __FromCGIPM { my ($self) = @_; my ($keyin); my ($cgi) = new CGI; my (@a_all_params) = $cgi->param(); foreach $keyin (@a_all_params) { &__UpdateIfPossible($self, $keyin, $cgi->param($keyin)); } }
Initialize the ParamParser object using a configuration file.
sub __FromFile { my ($self, $source) = @_; my ($lign) = ""; open(PARAMPARSERCFG, "$source") or &Carp::croak("ERROR Cannot open >$source<"); while ($lign = <PARAMPARSERCFG>) { next if ($lign =~ /^#/); chop($lign); my (@F); if ($$self{'__h_behaviour'}{'ignore_space'}) { @F = split(/\s*=\s*/, $lign, 2); } else { @F = split('=', $lign, 2); } next if (!defined($F[0]) || !defined($F[1])); &__UpdateIfPossible($self, $F[0], $F[1]); } close(PARAMPARSERCFG); }
Initialize the ParamParser object using the @ARGV array as source of param/values
sub __FromARGV { my ($self) = @_; foreach my $option (@ARGV) { my (@F) = split('=', $option, 2); next if (!defined($F[0]) || !defined($F[1])); &__UpdateIfPossible($self, $F[0], $F[1]); } }
Initialize the ParamParser object using the %ENV hash as source of param/values
sub __FromENV { my ($self) = @_; foreach my $option (keys(%ENV)) { next if (!defined($option) || !defined($ENV{$option})); &__UpdateIfPossible($self, $option, $ENV{$option}); } }
Initialize the ParamParser object using another ParamParser object
sub __FromPARAMPARSER { my $self = shift; my $o_p = shift; my ($keyin); my $rh_opt = $o_p->{'__h_opt'}; # The parameters from the othe ParamParser object foreach $keyin (keys(%$rh_opt)) { &__UpdateIfPossible($self, $keyin, $rh_opt->{$keyin}); } }
Dump the paramparser into a file
sub __ToFile { my ($self, $target, $prefix) = @_; my $ns = $$self{'__name_space'}; open(PARAMPARSERCFG, ">$target") or &Carp::croak("ERROR Can't open >$target< for writing\n"); foreach my $key (sort keys(%{$$self{'__h_opt'}})) { if (defined($key) && defined($$self{'__h_opt'}{$key}) && $key =~ /^$ns/) { if ($prefix ne "" && $key !~ /^$prefix/) { my $nkey = "$prefix$key"; print PARAMPARSERCFG "$nkey=" . $$self{'__h_opt'}{$key} . "\n"; } else { print PARAMPARSERCFG "$key=" . $$self{'__h_opt'}{$key} . "\n"; } } } close(PARAMPARSERCFG); }
Dump the paramparser into a file
sub __ToENV { my ($self, $prefix) = @_; my $ns = $$self{'__name_space'}; foreach my $key (sort keys(%{$$self{'__h_opt'}})) { next if ($key !~ /^$ns/); if (defined($key) && defined($$self{'__h_opt'}{$key})) { if ($prefix ne "" && $key !~ /^$prefix/) { my $nkey = "$prefix$key"; $ENV{$nkey} = "$$self{'__h_opt'}{$key}"; } else { $ENV{$key} = "$$self{'__h_opt'}{$key}"; } } } }
Dump the paramparser to @ARGV, using OptLong conventions
sub __ToGetOptLong { my ($self, $prefix) = @_; my $ns = $$self{'__name_space'}; @ARGV = (); foreach my $key (sort keys(%{$$self{'__h_opt'}})) { next if ($key !~ /^$ns/); if (defined($key) && defined($$self{'__h_opt'}{$key})) { if ($prefix ne "" && $key !~ /^$prefix/) { my $nkey = "$prefix$key"; push(@ARGV, '--' . $nkey, $$self{'__h_opt'}{$key}); } else { push(@ARGV, '--' . $key, $$self{'__h_opt'}{$key}); } } } }
Init a variable if it is not defined (in order to avoid warnings)
sub __DefinedIfNot { my ($var) = @_; if (!defined($var) || $var eq "") { return "undef"; } return $var; }
Build a list of possible sources depending on loaded modules
sub __InitPossibleSources { my ($self) = @_; my (%h_src) = ( "CGIPM" => defined($CGI::VERSION), "GETOPTSTD" => defined($Getopt::Std::VERSION), "GETOPTLONG" => defined($Getopt::Long::VERSION), "CGILIB" => defined($cgi_lib::version), "ARGV" => defined($ARGV[0]), "PARAMPARSER" => 1 ); $$self{'__possible_sources'} = " ENV "; foreach my $key (keys(%h_src)) { if ($h_src{$key}) { $$self{'__possible_sources'} .= " $key "; } } } 1;