perl configuration and blocks - perl

I am trying to do the configuration file in perl using
Config::Simple
#!/usr/bin/perl
use Config::Simple;
use Data::Dumper;
use Data::Dump qw(dump);
#$cfg = new Config::Simple('new.conf');
$cfg = new Config::Simple(syntax => 'ini');
$cfg->param("Dialer Onboard.user", "user1");
$cfg->param("Dialer Onboard.pass", "pass1");
$cfg->param("Dialer External.user", "user2");
$cfg->param("Dialer External.pass", "pass2");
$cfg->write("new.conf");
$cfg->read('new.conf');
$user = $cfg->param("Dialer Onboard.user");
print "----" . "$user";
And the new.conf file would be
[Dialer External]
pass=pass2
user=user2
[Dialer Onboard]
pass=pass1
user=user1
For the section or block information, I am using the function get_block() like this
my $config = Config::Simple->new("new.conf")->get_block("Dialer Onboard");
print Dumper $config;
This will give me the output like this
$VAR1 = {
'pass' => 'pass1',
'user' => 'user1'
};
Is there any way to get the only the names of all blocks?
Now I am getting only the number of blocks which is
my $config = Config::Simple->new("new.conf")->get_block();
print Dumper $config;
The output would be
$VAR1 = 2;

You are using get_block() in scalar context; that's why you are getting the number of blocks. Use it in list context to get the names of the blocks.
Try this:
my #config = Config::Simple->new("new.conf")->get_block();
print Dumper \#config;
Output:
$VAR1 = [
'Dialer Onboard',
'Dialer External'
];

Related

Passing multiple file lists to perl script

I want to pass two file lists to my perl script and have them handled with Getopt::Long for storing an array (via a reference) in a dictionary.
#!/usr/bin/env perl
# author:sb2
use strict;
use warnings;
use Getopt::Long;
use File::Basename;
use Data::Dumper;
print Dumper(#ARGV);
my($config);
$config = &configure(scalar #ARGV);
sub configure{
my $args = shift;
my $config = {};
my #current_samples = ();
#my #old_samples = ();
$config = {'current_samples' => \#current_samples};
#$config = {'old_samples' => \#old_samples};
GetOptions($config,
#"old_samples=s{,}",
"current_samples=s{,}",
"help|h!", )
|| warn "error : $!\n";
print Dumper($config);
return($config);
}
I can happily pass one file list and have it stored as expected:
[sb2 ~]$ perl test.pl -current_samples WS*
$VAR1 = '-current_samples';
$VAR2 = 'WS68726_1401';
$VAR3 = 'WS68726_1402';
$VAR4 = 'WS68726_1500';
$VAR5 = 'WS68726_1501';
$VAR1 = {
'current_samples' => [
'WS68726_1401',
'WS68726_1402',
'WS68726_1500',
'WS68726_1501'
]
};
However, when I uncomment my second list parameter and use that my 'current_samples' variable is now a string with a single filename. Although the 'old_samples' variable has parsed correctly (as above):
[sb2 ~]$ perl test.pl -current_samples WS* -old_samples HG*
$VAR1 = '-current_samples';
$VAR2 = 'WS68726_1401';
$VAR3 = 'WS68726_1402';
$VAR4 = 'WS68726_1500';
$VAR5 = 'WS68726_1501';
$VAR6 = '-old_samples';
$VAR7 = 'HG001';
$VAR8 = 'HG002';
$VAR9 = 'HG003';
$VAR1 = {
'current_samples' => 'WS68726_1501'
'old_samples' => [
'HG001',
'HG002',
'HG003'
]
};
I tried swapping the order of variables around and the only one that made a difference was switching the config assignment ones:
sub configure{
my $args = shift;
my $config = {};
my #current_samples = ();
#my #old_samples = ();
$config = {'current_samples' => \#current_samples};
#$config = {'old_samples' => \#old_samples};
GetOptions($config,
"current_samples=s{,}",
"old_samples=s{,}",
"help|h!", )
|| warn "error : $!\n";
print Dumper($config);
return($config);
}
Produces:
[sb2 ~]$ perl test.pl -current_samples WS* -old_samples HG*
$VAR1 = '-current_samples';
$VAR2 = 'WS68726_1401';
$VAR3 = 'WS68726_1402';
$VAR4 = 'WS68726_1500';
$VAR5 = 'WS68726_1501';
$VAR6 = '-old_samples';
$VAR7 = 'HG001';
$VAR8 = 'HG002';
$VAR9 = 'HG003';
$VAR1 = {
'current_samples' => [
'WS68726_1401',
'WS68726_1402',
'WS68726_1500',
'WS68726_1501'
],
'old_samples' => 'HG003'
};
I can't see anything in the GetOptions CPAN page which alludes to this ordering affect so any help would be greatly appreciated!
From your commented code it looks like you are overwriting $config with these lines:
$config = {'current_samples' => \#current_samples};
#$config = {'old_samples' => \#old_samples};
Instead, do all config assignments in one line:
my $config = {
'current_samples' => \#current_samples,
'old_samples' => \#old_samples,
};
Or you can do them in single lines and assign to the keys of the hashref:
my $config = {};
$config->{'current_samples'} = \#current_samples;
$config->{'old_samples'} = \#old_samples;
As a an alternative solution, Getopt::Declare has syntax to support loading arguments into array references as well:
use strict;
use warnings;
use Getopt::Declare;
my $args = Getopt::Declare->new(
join( "\n",
'[strict]',
"-current-samples <files>... \t List of file names",
"-old-samples <files>... \t List of file names",
)
) || exit(1);
the ... after each tag tells Getopt::Declare to gather arguments into an array reference.
Then you just specify multiple space-separated values on the command line:
perl test-getopt-declare.pl -current-samples a b c d e f -old-samples 1 2 3 4 5 6

perl retrieving page details after mechanize::POST

I am trying to gather data from a website. Some anti-patterns make looking finding the right form objects difficult but I have this solved. I am using a post method to get around some javascript acting as a wrapper to submit the form. My problem seems to be in getting the results from the mechanize->post method.
Here's a shortened version of my code.
use strict;
use warnings;
use HTML::Tree;
use LWP::Simple;
use WWW::Mechanize;
use HTTP::Request::Common;
use Data::Dumper;
$| = 1;
my $site_url = "http://someURL";
my $mech = WWW::Mechanize->new( autocheck => 1 );
foreach my $number (#numbers)
{
my $content = get($site_url);
$mech->get ($site_url);
my $tree = HTML::Tree->new();
$tree->parse($content);
my ($title) = $tree->look_down( '_tag' , 'a' );
my $atag = "";
my $atag1 = "";
foreach $atag ( $tree->look_down( _tag => q{a}, 'class' => 'button', 'title' => 'SEARCH' ) )
{
print "Tag is ", $atag->attr('id'), "\n";
$atag1 = Dumper $atag->attr('id');
}
# Enter permit number in "Number" search field
my #forms = $mech->forms;
my #fields = ();
foreach my $form (#forms)
{
#fields = $form->param;
}
my ($name, $fnumber) = $fields[2];
print "field name and number is $name\n";
$mech->field( $name, $number, $fnumber );
print "field $name populated with search data $number\n" if $mech->success();
$mech->post($site_url ,
[
'$atag1' => $number,
'internal.wdk.wdkCommand' => $atag1,
]) ;
print $mech->content; # I think this is where the problem is.
}
The data I get from my final print statement is the data from teh original URL not the page the POST command should take me to. What have I done wrong?
Many Thanks
Update
I don't have Firefox installed so I'm avoiding WWW::Mechanize::Firefox intentionally.
Turns out I was excluding some required hidden fields from my POST command.

Passing Variable from Asterisk Dialplan to AGI perl script

I am trying to pass a variable from the Asterisk Dialplan to a perl script using the AGI. I am now to this and am very confused at to how exactly this works. Right now in my dialplan I have this:
exten=>1122,1,Answer
exten=>1122,n,Read(digit)
exten=>1122,n,agi(/home/steve/Desktop/testperlping.pl,${digit})
exten=>1122,n,Hangup()
I want a user to dial the extension 1122, then enter a number from 1-10, and have the number they entered passed into perl using the AGI.
My perl script is as follows:
#!/usr/bin/perl -w
$|=1;
use Net::Ping;
use Asterisk::AGI;
$AGI = new Asterisk::AGI;
my %input = $AGI->ReadParse();
***I think I need something here***
$AGI->verbose("$numbertheytypedintophone"); #This will display the entered number back to the CLI.
Any help would be greatly appreciated.
I am using Asterisk::FastAGI(which is recomended for perl integration) and code looks like this:
my $dst = $self->param('dst');
For Asterisk::AGI it have be(i just read AGI.pm source):
my $digits=$input{'arg_1'};
I higly recomend you read source code of module if you have any issues, will be MUCH faster.
Consider a part of a dialplan
exten => _X.,1,NoOp(${PJSIP_HEADER(read,To)})
exten => _X.,n,Set(FirstTo=${CUT(PJSIP_HEADER(read,To),:,2)})
exten => _X.,n,Set(TO_DID=${CUT(FirstTo,#,1)})
exten => _X.,n,Set(client_number=${CALLERID(num)})
exten => _X.,n,AGI(check_nr.agi,,${client_number})
exten => _X.,n,Set(First_check=${first_ani})
Note the double comma on the agi script
The script part which will use the client_number value
(my $empty_field, my $data ) = #ARGV;
my #data_array = split /--/, $data;
my $callerid = $data_array[0];
The split part is if you have multiple parameters like
AGI(check_nr.agi,,${client_number}--${second}--${third})
In this case would be
(my $empty_field, my $data ) = #ARGV;
my #data_array = split /--/, $data;
my $callerid = $data_array[0];
my $second = $data_array[1];
my $third = $data_array[2];
To pass the variable back to the asterisk dialplan you should use:
print "SET VARIABLE first_ani $first_ani\n";
Full perl script
#!/usr/bin/perl
# Modules to use
use strict ;
use warnings;
use Config::IniFiles;
use DBI;
use sigtrap;
use sigtrap qw(handler my_handler normal-signals stack-trace error-signals);
my $cfg = Config::IniFiles -> new( -file => '/etc/my_file.ini' );
my $dbinst = $cfg -> val('AST', 'DBINST');
my $dbhost = $cfg -> val('AST', 'DBHOST');
my $dbuser = $cfg -> val('AST', 'DBUSER');
my $dbpass = $cfg -> val('AST', 'DBPASS');
my $dbhA = DBI->connect( "dbi:mysql:$dbinst:$dbhost",$dbuser,$dbpass, {RaiseError => 0,PrintError => 1,AutoCommit => 0,}) or die $DBI::errstr;
########################################### Pass data from asterisk channel to perl script ##########################################
(my $empty_field, my $data ) = #ARGV;
my #data_array = split /--/, $data;
my $callerid = $data_array[0];
########################################### Pass data from asterisk channel to perl script ##########################################
my $sthA = $dbhA->prepare( "select ani,
numero,
data_ultima_modifica
from my_table
where numero = ?
ORDER BY data_ultima_modifica DESC ");
$sthA->bind_param( 1, $callerid );
$sthA->execute();
my $sthArows=$sthA->rows;
if ($sthArows > 0)
{
my #aryA = $sthA->fetchrow_array;
my $ani = $aryA[0];
my $numero = $aryA[1];
my $data_ultima_modifica = $aryA[2];
print "SET VARIABLE first_ani $first_ani \n";
}
$sthA->finish();
################## Close DB Connection##################
warn $DBI::errstr if $DBI::err;
$dbhA->commit();
$dbhA->disconnect();
################## Close DB Connection##################

Perl and MongoDB: Returning find results in a String

Relatively simple question, but not one which I've found an exact answer for - let's say we have CPAN'd the MongoDB driver, set up a DB with some data, and want to capture the results of a find into a text string to manipulate in a perl script.
use MongoDB;
use MongoDB::Database;
use MongoDB::OID;
my $conn = MongoDB::Connection->new;
my $db = $conn->test;
my $users = $db->x;
my $parseable;
#Ran this in mongoshell earlier: db.x.insert({"x":82})
$string = $users->find({"x" => 82});
#objects = $string->all;
print "LEN: ".(#objects.length())."\n"; #returns 1....hmmmm...would imply it has my
entry!
print #objects[0]."\n";
print $objects[0]."\n";
print keys(#objects)."\n";
print keys(#objects[0])."\n";
print "#objects[0]"."\n";
These output the following on the command line, none of them what I wanted )-=:
LEN: 1
HASH(0x2d48584)
HASH(0x2d48584)
1
2
HASH(0x2d48584)
What I do want is the BSON as a string - I want what the mongoshell returns just IN a string in Perl! My dream output would be the following:
{ "_id" : ObjectId("4fcd1f450a121808f4d78bd6"), "x" : 82 }
With the further added fact that I can CAPTURE this string IN A VARIABLE to manipulate.
The code below will display things just fine, but won't grab it into a variable for manipulation, most unfortunately:
#!/usr/bin/perl
use MongoDB;
use MongoDB::Database;
use MongoDB::OID;
my $conn = MongoDB::Connection->new;
my $db = $conn->test;
my $users = $db->x;
my $parseable;
#Ran this in mongoshell earlier: db.x.insert({"x":82})
$string = $users->find({"x" => 82});
use Data::Dumper; # new import
print Dumper $string->all,0; # call Dumper method
With output:
$VAR1 = {
'_id' => bless( {
'value' => '4fcd1f450a121808f4d78bd6'
}, 'MongoDB::OID' ),
'x' => '82'
};
Does anybody know how to do this?
Thanks!
Try the following code :
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use MongoDB;
use MongoDB::Collection;
my $conn = new MongoDB::Connection;
my $db = $conn->test;
my $coll = $db->x;
my $all = $coll->find();
my $dts = $all->next;
use Data::Dumper;
print Dumper $dts;
Data::Dumper is a must-have module to print complicated Perl data structures. You will understand how the data is structured this way.
Then you can access directly the keys/values :
#!/usr/bin/perl
use strict;
use warnings;
use MongoDB;
use MongoDB::Collection;
my $conn = new MongoDB::Connection;
my $db = $conn->test;
my $coll = $db->x;
my $all = $coll->find();
my $dts = $all->next;
my #a = keys %$dts;
my $str = '{ "' .
$a[0] .
'" : ObjectId("' .
$dts->{_id}. '"), "'.
$a[1].'" : ' .
$dts->{x} .
" }\n";
print $str;
Output is
{ "_id" : ObjectId("4fcd248f8fa57d73410ec967"), "x" : 82 }

How do I convert Data::Dumper output back into a Perl data structure?

I was wondering if you could shed some lights regarding the code I've been doing for a couple of days.
I've been trying to convert a Perl-parsed hash back to XML using the XMLout() and XMLin() method and it has been quite successful with this format.
#!/usr/bin/perl -w
use strict;
# use module
use IO::File;
use XML::Simple;
use XML::Dumper;
use Data::Dumper;
my $dump = new XML::Dumper;
my ( $data, $VAR1 );
Topology:$VAR1 = {
'device' => {
'FOC1047Z2SZ' => {
'ChassisID' => '2009-09',
'Error' => undef,
'Group' => {
'ID' => 'A1',
'Type' => 'Base'
},
'Model' => 'CATALYST',
'Name' => 'CISCO-SW1',
'Neighbor' => {},
'ProbedIP' => 'TEST',
'isDerived' => 0
}
},
'issues' => [
'TEST'
]
};
# create object
my $xml = new XML::Simple (NoAttr=>1,
RootName=>'data',
SuppressEmpty => 'true');
# convert Perl array ref into XML document
$data = $xml->XMLout($VAR1);
#reads an XML file
my $X_out = $xml->XMLin($data);
# access XML data
print Dumper($data);
print "STATUS: $X_out->{issues}\n";
print "CHASSIS ID: $X_out->{device}{ChassisID}\n";
print "GROUP ID: $X_out->{device}{Group}{ID}\n";
print "DEVICE NAME: $X_out->{device}{Name}\n";
print "DEVICE NAME: $X_out->{device}{name}\n";
print "ERROR: $X_out->{device}{error}\n";
I can access all the element in the XML with no problem.
But when I try to create a file that will house the parsed hash, problem arises because I can't seem to access all the XML elements. I guess, I wasn't able to unparse the file with the following code.
#!/usr/bin/perl -w
use strict;
#!/usr/bin/perl
# use module
use IO::File;
use XML::Simple;
use XML::Dumper;
use Data::Dumper;
my $dump = new XML::Dumper;
my ( $data, $VAR1, $line_Holder );
#this is the file that contains the parsed hash
my $saveOut = "C:/parsed_hash.txt";
my $result_Holder = IO::File->new($saveOut, 'r');
while ($line_Holder = $result_Holder->getline){
print $line_Holder;
}
# create object
my $xml = new XML::Simple (NoAttr=>1, RootName=>'data', SuppressEmpty => 'true');
# convert Perl array ref into XML document
$data = $xml->XMLout($line_Holder);
#reads an XML file
my $X_out = $xml->XMLin($data);
# access XML data
print Dumper($data);
print "STATUS: $X_out->{issues}\n";
print "CHASSIS ID: $X_out->{device}{ChassisID}\n";
print "GROUP ID: $X_out->{device}{Group}{ID}\n";
print "DEVICE NAME: $X_out->{device}{Name}\n";
print "DEVICE NAME: $X_out->{device}{name}\n";
print "ERROR: $X_out->{device}{error}\n";
Do you have any idea how I could access the $VAR1 inside the text file?
Regards,
newbee_me
$data = $xml->XMLout($line_Holder);
$line_Holder has only the last line of your file, not the whole file, and not the perl hashref that would result from evaling the file. Try something like this:
my $ref = do $saveOut;
The do function loads and evals a file for you. You may want to do it in separate steps, like:
use File::Slurp "read_file";
my $fileContents = read_file( $saveOut );
my $ref = eval( $fileContents );
You might want to look at the Data::Dump module as a replacement for Data::Dumper; its output is already ready to re-eval back.
Basically to load Dumper data you eval() it:
use strict;
use Data::Dumper;
my $x = {"a" => "b", "c"=>[1,2,3],};
my $q = Dumper($x);
$q =~ s{\A\$VAR\d+\s*=\s*}{};
my $w = eval $q;
print $w->{"a"}, "\n";
The regexp (s{\A\$VAR\d+\s*=\s*}{}) is used to remove $VAR1= from the beginning of string.
On the other hand - if you need a way to store complex data structure, and load it again, it's much better to use Storable module, and it's store() and retrieve() functions.
This has worked for me, for hashes of hashes. Perhaps won't work so well with structures which contain references other structures. But works well enough for simple structures, like arrays, hashes, or hashes of hashes.
open(DATA,">",$file);
print DATA Dumper(\%g_write_hash);
close(DATA);
my %g_read_hash = %{ do $file };
Please use dump module as a replacement for Data::Dumper
You can configure the variable name used in Data::Dumper's output with $Data::Dumper::Varname.
Example
use Data::Dumper
$Data::Dumper::Varname = "foo";
my $string = Dumper($object);
eval($string);
...will create the variable $foo, and should contain the same data as $object.
If your data structure is complicated and you have strange results, you may want to consider Storable's freeze() and thaw() methods.