parse all arguments and store to hash - perl

How can i parse all the arbitrary arguments to a hash without specifying the argument names inside my perl script.
Running command with below argument should give hash like below.
-arg1=first --arg2=second -arg3 -arg4=2.0013 -arg5=100
{
'arg2' => 'second',
'arg1' => 'first',
'arg4' => '2.0013',
'arg3' => 1,
'arg5' => 100
};
This can be achieved using Getopt::Long as below
GetOptions(\%hash,
"arg1=s",
"arg2=s",
"arg3",
"arg4=f",
"arg5=i");
However, my argument list is too long and i don't want to specify argument names in GetOptions.
So a call to GetOptions with only hash as a parameter should figure out what arguments are (and their type integer/string/floats/lone arguments) and just create a hash.

There are a lot of Getopt modules. The following are some that will just slurp everything into a hash like you desire:
Getopt::Mini
Getopt::Whatever
Getopt::Casual
I personally would never do something like this though, and have no real world experience with any of these modules. I'd always aim to validate every script for both error checking and as a means to self-document what the script is doing and uses.

Try this:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
sub getOptions {
my (%opts, #args);
while (#_) {
my $opt = shift;
if ($opt =~ /^-/) {
if ($opt =~ /-+([^=]+)(?:=(.+))?/) {
$opts{$1} = $2 ? $2 : 1;
}
}
else {
push #args, $opt;
}
}
return (\%opts, \#args);
}
my ($opts, $args) = getOptions(#ARGV);
print Dumper($opts, $args);
Testing:
$ perl t.pl -arg1=first --arg2=second -arg3 -arg4=2.0013 -arg5=100 datafile
$VAR1 = {
'arg2' => 'second',
'arg1' => 'first',
'arg4' => '2.0013',
'arg3' => 1,
'arg5' => '100'
};
$VAR2 = [
'datafile'
];

This will work as expected for your example,
my %hash = map { s/^-+//; /=/ ? split(/=/, $_, 2) : ($_ =>1) } #ARGV;

Related

In Perl, how to dereference temp hash passed as argument?

In Perl, how to dereference temporary hash passed as argument to function?
MyFunct({
Param1 => "knob1",
Param2 => "knob2"
});
# this part never seems to work...
sub MyFunct {
my %param = %{shift()};
my $p1 = $param{Param1};
print "p1: $p1\n";
}
Your code works as is.
$ perl -e'
MyFunct({
Param1 => "knob1",
Param2 => "knob2"
});
# this part never seems to work...
sub MyFunct {
my %param = %{shift()};
my $p1 = $param{Param1};
print "p1: $p1\n";
}
'
p1: knob1
That said, you are needlessly making a copy of the referenced hash. The following is a better approach:
$ perl -e'
MyFunct({
Param1 => "knob1",
Param2 => "knob2"
});
sub MyFunct {
my $param = shift;
my $p1 = $param->{Param1};
print "p1: $p1\n";
}
'
p1: knob1
In addition to #ikegami's answer, I'll add that perhaps you do not need a reference. Passing in the values as key/value pairs will make it easy to convert the list into a hash, using the implicit argument array #_.
The key/value pairs can be performed by using the arrow => delimiter, or in its place a standard comma , delimiter. Below is an example using the arrow.
IDEOne Example
#!/usr/bin/perl
MyFunct(
Param1 => "knob1",
Param2 => "knob2"
);
# this part never seems to work...
sub MyFunct {
my %param = #_;
my $p1 = $param{Param1};
local $\ = "\n";
print "p1: $p1";
print "p2: $param{Param2}";
}

Perl: overwrite structure member value

I am creating $input with this code:
push(#{$input->{$step}},$time);, then I save it in an xml file, and at the next compiling, I read it from that file. When i print it, i get the structure bellow.
if(-e $file)
my $input =XMLin($file...);
print Dumper $input;
and I get this structure
$VAR1 = {
'opt' => {
'step820' => '0',
'step190' => '0',
'step124' => '0',
}
};
for each step with it's time..
push(#{$input->{$step}},$time3);
XmlOut($file, $input);
If I run the program again, I get this structure:
$VAR1 = {
'opt' => {
'step820' => '0',
'step190' => '0',
'step124' => '0',
'opt' => {
'step820' => '0',
'step190' => '0',
'step124' => '0'
}
}
I just need to overwrite the values of steps(ex:$var1->opt->step820 = 2). How can i do that?
I just need to overwrite the values of steps(ex:$var1->opt->step820 = 2). How can i do that?
$input->{opt}->{step820} = 2;
I'm going to say what I always do, whenever someone posts something asking about XML::Simple - and that is that XML::Simple is deceitful - it isn't simple at all.
Why is XML::Simple "Discouraged"?
So - in your example:
#!/usr/bin/env perl
use strict;
use warnings;
use XML::Twig;
my $xml= XML::Twig->new->parsefile($file);
$xml -> get_xpath('./opt/step820',0)->set_text("2");
$xml -> print;
The problem is that XML::Simple is only any good for parsing the type of XML that you didn't really need XML for in the first place.
For more simple examples - have you considered using JSON for serialisation? As it more directly reflects the hash/array structure of native perl data types.
That way you can instead:
print {$output_fh} to_json ( $myconfig, {pretty=>1} );
And read it back in:
my $myconfig = from_json ( do { local $/; <$input_fh> });
Something like:
#!/usr/bin/env perl
use strict;
use warnings;
use JSON;
my $input;
my $time = 0;
foreach my $step ( qw ( step820 step190 step124 ) ) {
push(#{$input->{$step}},$time);
}
print to_json ( $input, {pretty=>1} );
Giving resultant JSON of:
{
"step190" : [
0
],
"step820" : [
0
],
"step124" : [
0
]
}
Although actually, I'd probably:
foreach my $step ( qw ( step820 step190 step124 ) ) {
$input->{$step} = $time;
}
print to_json ( $input, {pretty=>1} );
Which gives;
{
"step190" : 0,
"step124" : 0,
"step820" : 0
}
JSON uses very similar conventions to perl - in that {} denote key value pairs (hashes) and [] denote arrays.
Look at the RootName option of XMLout. By default, when "XMLout()" generates XML, the root element will be named 'opt'. This option allows you to specify an alternative name.
Specifying either undef or the empty string for the RootName option will produce XML with no root elements.

String Parsing for nested parenthesis in perl

The issue is when I try to compare the input to the output file, i am unable to handle the nesting of the parenthesis, and the complexity needs to be very low. is there a parsing module for this? compatible to 5.8.4. I found modules but they needed at least 5.10.:(
Input
(K1=V1,K2=V2,K3=V3(K2=V2.K5=V5)K6=V6(K7=V7,K8=V8(K9=V9,K10=V10)K11=V11)K12=V12,K13=V13)
OUTPUT FILE
(K0=V0,K1=V1,K2=V2,K3=V3(K1=V1,K2=V2,K4=V4,K5=V5,K14=V14),K15=V15,K6=V6(K18=V18,K7=V7,K19=V19,K8=V8(K20=V20,K9=V9,K16=V16,K10=V10,K21=V21)K11=V11)K12=V12,K13=V13,K22=V22)
I need to pick up each key value pair from input and one by one verify from the output file that the value is the same. if not
I need to store the key with the existing value.( The issue is with the nesting )
INPUT
K3=V3(K2=V2,K5=V5)
OUTPUT
K3=V3(K1=V1,K2=V2,K4=V4,K5=V5,K14=V14)
The issue is that "K2=V2" inside the V3 value is to be checked inside the V3 value in the output file. So I cannot just use a regular expression to do that as K2=V2 may appear outside the V3 parenthesis too.
I was trying to create a hash of a hash of a hash but failed. could someone suggest a way I could achieve this?
The following code builds the hash of hashes. Note that values (V3) are lost if they contain an inner hash.
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
sub to_hash {
my $string = shift;
$string =~ s/^\( | \)$//gx; # Remove the outer parentheses.
my #stack = {};
my #keys;
while (length $string) {
$string =~ s/^([^,=()]+) = ([^(),]*)//x or die $string;
my ($key, $value) = ($1, $2);
$stack[-1]{$key} = $value;
next if $string =~ s/^,//;
if ($string =~ s/^\(//) {
push #stack, {};
push #keys, $key;
} elsif ($string =~ s/^\),?//) {
my $last = pop #stack;
$stack[-1]{ pop #keys } = $last;
}
}
return $stack[0]
}
my $input = '(K1=V1,K2=V2,K3=V3(K2=V2,K5=V5)K6=V6(K7=V7,K8=V8(K9=V9,K10=V10)K11=V11)K12=V12,K13=V13)';
print Dumper to_hash($input);
Output
$VAR1 = {
'K2' => 'V2',
'K13' => 'V13',
'K6' => {
'K7' => 'V7',
'K8' => {
'K9' => 'V9',
'K10' => 'V10'
},
'K11' => 'V11'
},
'K3' => {
'K2' => 'V2',
'K5' => 'V5'
},
'K12' => 'V12',
'K1' => 'V1'
};
Nested parens either suggests an application of Text::Balanced and its extract_bracketed function, or building yourself a little parser subclass on Parser::MGC. Using the latter to build a little "convert string into data structure" parser is usually pretty straightforward for simple examples like this.

perl eval() gives 'Insecure dependency in eval while running with -T switch' on string variable

The variables $var and $var2 in the following code hold same value but behave differently with respect to eval().
Source:
use Data::Dumper;
sub trim($)
{
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
$string =~ s/\R//g;
return $string;
}
my $var2="";
$var2.="{id=>1962}";
$var2.=",{id=>1645}";
$var2.=",{id=>905}";
$var2.=",{id=>273}";
$var2.=",{id=>1800}";
$var2.=",{id=>21}";
$var2.=",{id=>1639}";
$var2.=",{id=>55}";
$var2.=",{id=>57}";
$var2.=",{id=>59}";
$var2.=",{id=>420}";
$var2.=",{id=>418}";
$var2="[".$var2."]";
print Dumper $var2;
print Dumper eval($var2); #evaluates to an ARRAY
my $filename = "sample.txt";
open(FILE, $filename) or die "Can't read file 'filename' [$!]\n";
$document = <FILE>;
close (FILE);
$document=trim($document);
#data = split(',', $document);
my $var = "";
foreach my $val (#data) {
$var.="{id=>".$val."},";
}
chop($var);
$var = "[".$var."]";
print "\n";
if ($var eq $var2){
print "var and var2 stringwise equal\n" ;
}else{
print "var and var2 stringwise not equal\n" ;
}
print Dumper $var;
print Dumper eval($var); #error
exit(0);
Content of sample.txt:
1962,1645,905,273,1800,21,1639,55,57,59,420,418
Output:
$VAR1 = '[{id=>1962},{id=>1645},{id=>905},{id=>273},{id=>1800},{id=>21},{id=>1639},{id=>55},{id=>57},{id=>59},{id=>420},{id=>418}]';
$VAR1 = [
{
'id' => 1962
},
{
'id' => 1645
},
{
'id' => 905
},
{
'id' => 273
},
{
'id' => 1800
},
{
'id' => 21
},
{
'id' => 1639
},
{
'id' => 55
},
{
'id' => 57
},
{
'id' => 59
},
{
'id' => 420
},
{
'id' => 418
}
];
var and var2 stringwise equal
$VAR1 = '[{id=>1962},{id=>1645},{id=>905},{id=>273},{id=>1800},{id=>21},{id=>1639},{id=>55},{id=>57},{id=>59},{id=>420},{id=>418}]';
Insecure dependency in eval while running with -T switch at assignment.pl line 51.
Can anyone tell why "eval($var)" doesn't get evaluated despite having same value as that of $var2 ?
While $var might be the same as $var2 in your specific case of data, it isn't necessarily always that case. You script also doesn't forbid the eval even if it is not the same.
Thus, the tainted check is right to complain about the insecure eval, as it is intended to detect potentially unsafe operations which your eval($var) definitely is.
Generally, you should try to avoid eval wherever you can, as it is a prime source of remote-code-execution vulnerabilities. Instead, you should try to parse your data structures using other, safer means, e.g. by using split on your input data and then looping over the resulting array to produce your desired data structure.
This is perl Taint Mode doing exactly what it's supposed to be doing. You're reading in data from an external resource, and perl -T is not allowing you to run tainted data through eval since that literally could end up doing anything (very insecure).
In order to launder your data you simply need to run in through a regular expression to verify what it is. Replace the following line:
#my #data = split(',', $document);
my #data = $document =~ m/(\d+)/g;
Because we're running the external document data through a regex, the values in #data will no longer be tainted and can be eval'd.
Either way, I'd advise against using eval at all unless there is a specific reason why you need it. The following accomplishes the same thing without the need for an eval
my $var = [map {id => $_}, #data];

How can I loop through a list of functions in Perl?

I have a list of functions in Perl. Example:
my #funcs = qw (a b c)
Now they all belong to this module Foo::Bar::Stix. I would like to call them iteratively in a loop:
foreach $func (#funcs) {
Foo::Bar::Stix::$func->(%args)
}
where args is a hash of arguments. However I keep getting this error: "Bad name after :: ..." at the line which contains Foo::Bar::Stix::$func->(%args) How do I fix this error?
a b and c are not function objects but strings
Rather than storing the names of the functions in your array, store references to them in a hash so that you can refer to them by name. Here's a simple code example:
#!/usr/bin/perl
use strict;
use warnings;
my %func_refs = (
'a' => \&Foo::Bar::Stix::a,
'b' => \&Foo::Bar::Stix::b,
'c' => \&Foo::Bar::Stix::c
);
foreach my $func_ref ( values %func_refs ) {
print $func_ref->( "woohoo: " ), "\n";
}
{
package Foo::Bar::Stix;
sub a {
my $arg = shift;
return $arg . "a";
}
sub b {
my $arg = shift;
return $arg . "b";
}
sub c {
my $arg = shift;
return $arg . "c";
}
}
If you're stuck with storing the names for some reason, try this:
my $package = "Foo::Bar::Stix";
my #func_names = qw/ a b c /;
foreach my $func_name (#func_names) {
my $str = &{ "$package\::$func_name" }( "woohoo: " );
print $str, "\n";
}
However, this doesn't work under use strict, and because of this I prefer the first solution. Whatever you do, try to avoid using eval. It's unnecessary, and will likely only cause you problems.
Also, most people who work with Perl capitalize it as Perl rather than PERL. Here's a Stackoverflow question on the subject:
How should I capitalize Perl?
Bad answer: use a symbolic reference:
for $func (#funcs) {
&{"Foo::Bar::Stix::$func"}(\%args);
}
Good answer: use a dispatch table:
my %call_func = (
'a' => \&Foo::Bar::Stix::a,
'b' => \&Foo::Bar::Stix::b,
'c' => \&Foo::Bar::Stix::c,
);
...
for $func (#funcs) {
$call_func{$func}->(\%args);
}
Slight change of syntax will give you what you want
Foo::Bar::Stix->$func(%args)
Though this will pass the package name as the first parameter.
You can use can
my #funcs = qw (a b c)
foreach $func (#funcs) {
Foo::Bar::Stix->can($func)->(%args)
}
You could access it through the special %Foo::Bar::Stix:: variable. This gives full access directly to the symbol table. You'll also notice that it works under strict mode.
#! /usr/bin/env perl
use strict;
use warnings;
{
package Foo::Bar::Stix;
sub a{ print "sub a\n" }
sub b{ print "sub b\n" }
sub c{ print "sub c\n" }
}
my #funcs = qw' a b c ';
my %args;
for my $func (#funcs) {
$Foo::Bar::Stix::{$func}->(%args); # <====
}
Another option:
my $symbol_table = $::{'Foo::'}{'Bar::'}{'Stix::'};
my %funcs = (
# we only want the CODE references
'a' => *{ $symbol_table->{'a'} }{'CODE'},
'b' => *{ $symbol_table->{'b'} }{'CODE'},
'c' => *{ $symbol_table->{'c'} }{'CODE'},
);
for my $func (#funcs) {
$funcs{$func}->(%args); # <====
}
If you are going to be doing that for a large number of subroutines, this is how I would load up the %funcs variable.
my %funcs;
BEGIN{
my $symbol_table = $::{'Foo::'}{'Bar::'}{'Stix::'};
for my $name (qw' a b c '){
$funcs{$name} = *{ $symbol_table->{$name} }{'CODE'};
}
}
I wouldn't do this unless you need the subroutines to have both a fully qualified name, and access to it through a hash variable.
If you only need access to the subroutines through a hash variable this is a better way to set it up.
my %funcs = (
'a' => sub{ print "sub a\n" },
'b' => sub{ print "sub b\n" },
'c' => sub{ print "sub c\n" },
);
Note: you could replace "my %funcs" with "our %funcs"