block reading in perl - perl

I need to read one block from file and then need to match the particular patterns and get the values for the matched pattern.
> Call report:$VAR1 = {
> 'service_status' => 'DIAL-IN-SEQUENTIAL',
> 'called_id' => '761',
> 'id' => '41298',
> 'redirect_number' => undef,
> 'profile_id' => '137',
> 'not_answered_action' => '0',
> 'call_landed_day' => '1',
> 'call_end_status' => 'CALLER_HANGSUP',
> 'announce_caller_type' => '0',
> 'user_id' => '143',
> 'follow_me_group' => '135',
> 'call_end_time' => '29/11/2010 09:39:57',
> 'findme_id' => '135',
> 'fmsonenumber' => '43902761',
> 'profile_cause' => 'IMMEDIATE_OVERRIDE',
> 'fms_id' => '85dd3b2a-fb6e-11df-a0b0-a1f3d600a5a6',
> 'caller_type' => 'UNKNOWN',
> 'fms_type' => 'FOLLOWME',
> 'profile_desc' => 'office',
> 'caller_id' => '43902761',
> 'call_landed_time' => '29/11/2010 09:39:55'
> };
From the above block I need to read the block between two { } braces.After that I want to match the particular pattern like service_status and then after matching the service_status pattern should retrieve the value of the service_status as DIAL-IN-SEQUENTIAL.Likewise I need to match the patterns in some of the lines and get the values for that patterns. How can we achieve this?. If anyone know the way to solve this pls give me the solution.
Thanks in advance.

You can process the file so that it became a valid perl module that contains a definition of an array of hashes. Write a filter (or do it with emacs/vim or your favorite editor) to substitute the "Call report:$VAR1 = {" to a statement that pushes the hash into an array, something like "push #all_hashes, {".
Then you can use the module and iterate through the variables as normal perl hashes.

Well, given the constraints my solution is rather ugly, but you can get it as a regexp exercise ( but you can avoid it ):
#!/usr/bin/env perl
use v5.12;
use strict;
open my $fh, '<', 'block.txt';
while ( <$fh> ) {
if ( /^[^}^{]++$/ .. /^[^}]++$/ ) {
if ( /(?<='service_status' => )'([^']+)'/ ) { say $1 };
}
}
Just note how I used the flip-flop operator in the first conditional, and the positive lookbehind in the second conditional.
The first conditional returns true when it finds a line without open or closed curly brace; it keeps returning true until it finds a line with a closed curly brace, when it returns false.
With this kind of a filter you get only lines between those with braces.

Related

Setting a OpenOffice::OODoc to Landscape (Perl)

I am trying to create an Open Office document using PERL and OpenOffice::OODoc, and I wish for the resulting document to be in the landscape orientation.
I tried going through the OpenOffice::OODoc::Styles, and the best I got is: switchPageOrientation(page); but I don't know what page is.
So I put together the following code:
#!/usr/bin/perl -w
use strict;
use Data::Dumper;
use OpenOffice::OODoc;
my $docFile = "../resources/landscape.odt";
my $doc = odfDocument( file => $docFile,
create => 'text' );
my $pageLayout = $doc->updatePageLayout(
"LandscapeStyle",
properties => {
'fo:margin-bottom' => '0.7874in',
'fo:page-width' => '11in',
'style:footnote-max-height' => '0in',
'style:shadow' => 'none',
'fo:margin-left' => '0.7874in',
'fo:margin-right' => '0.7874in',
'fo:page-height' => '8.5in',
'style:num-format' => '1',
'style:print-orientation' => 'landscape',
'style:writing-mode' => 'lr-tb',
'fo:margin-top' => '0.7874in'
}
);
$doc->switchPageOrientation($pageLayout);
$doc->appendParagraph( text => "Testing",
style => $pageLayout );
$doc->save;
print "\"$docFile\" is saved.\n";
print "Done.";
exit 0;
The Output is:
Odd number of elements in hash assignment at C:/Strawberry/perl/site/lib/OpenOffice/OODoc/Styles.pm line 1301.
Use of uninitialized value in list assignment at C:/Strawberry/perl/site/lib/OpenOffice/OODoc/Styles.pm line 1301.
"../resources/landscape.odt" is saved.
Done.`
The document is created but not in landscape, rather within the regular portrait orientation.
Does anyone know what page is, and how I can get it to change my document?
Any ideas?

MongoDB/Perl: find_one doesn't return data after unrelated code

mongodb is v4.0.5
Perl is 5.26.3
MongoDB Perl driver is 2.0.3
This Data::Dumper output shows what's driving me crazy
INFO - $VAR1 = [
'275369249826930689 1',
{
'conf' => {
'param' => 'argument'
},
'id' => '275369249826930689',
'lastmsg' => '604195211232139552',
'_id' => bless( {
'oid' => ']:\',&�h�GeR'
}, 'BSON::OID' )
}
];
352832438449209345 275369249826930689
INFO - $VAR1 = [
'275369249826930689 2'
];
The second INFO - $VAR1 should show the same content as the first one. This is the original code, which I have (see below) broken down to find the culprit.
ddump(["$userid 1",
$c_identities->find_one({
channel => 'chan1',
id => $userid,
})
]);
my #filtered = reverse
grep { $_->{author}->{id} == $userid } #{$answers};
ddump(["$userid 2",
$c_identities->find_one({
channel => 'chan1',
id => $userid,
})
]);
ddump is just a wrapper for Data::Dumper. If I remove the "my #filtered" line, the second find one again returns the expected result (a MongoDB document). $answers is just a listref of hashes - no objects - from some API, completely unrelated to MongoDB.
So I broke the "reverse grep" code down to see where the culprit is. The say are the two numbers you see between the dumpers above. This is what I can do, to get answer from the second find_one:
for my $answer (#{$answers}) {
say $answer->{author}->{id}, ' ', $userid;
push #filtered, $answer;
}
As long as I do just this, the second find_one delivers a result. If, however, I do this:
for my $answer (#{$answers}) {
say $answer->{author}->{id}, ' ', $userid;
if ($answer->{author}->{id} == $userid) {
}
push #filtered, $answer;
}
I get the output from above (where the second dumper yields no return from the find_one. It's insane - the if-clause containing the numeric eq causes the second find_one to fail! This is also the grep body in the intended code.
What's going on here? How can this have possibly any effect on the MongoDB methods?
Using the numeric comparison operator == numifies the value, but it's probably too large to fit into an integer and becomes a float. It can also just become an integer and lose double quotes when serialized to JSON or similar format. Using eq instead of == keeps the value unchanged.

Perl Net::Telnet::Cisco Bad named parameter

I'm trying to get some scripting finished to deploy changes en masse to about 400 Cisco devices. I've got a perl script modified from MrAudit that's using Net::Telnet::Cisco and for the life of me, I can't figure out the named parameter component.
In the documentation, they have:
$ok = $obj->cmd($string);
$ok = $obj->cmd(String => $string,
[Output => $ref,]
[Prompt => $match,]
[Timeout => $secs,]
[Cmd_remove_mode => $mode,]);
#output = $obj->cmd($string);
#output = $obj->cmd(String => $string,
[Output => $ref,]
[Prompt => $match,]
[Timeout => $secs,]
[Cmd_remove_mode => $mode,]
[Normalize_cmd => $boolean,]);
And my code is:
$testString is the test command I'm running against the device, $userTest1 is an array being cast where I want the output to be stored.
$::OPENRTR->cmd(String=>$testString,[Timeout=>5,Output=>$userTest1,]);
And every single time, no matter which component I modify or try and write it a different way, I get a variation of the error:
Odd number of elements in hash assignment at(filename)
bad named parameter "ARRAY(0x2e46460)" given to Net::Telnet::Cisco::cmd() at mrAudit-TACACSMod.pl line 279
I know it has to be something simple, but it's just flying right by. Any help would be appreciated.
I think the square brackets in the documentation just show the arguments are optional, you shouldn't use them in real code:
$OPENRTR->cmd( String => $testString,
Timeout => 5,
Output => $userTest1);

What is wrong with my declaration of a hash inside a hash in Perl?

I am struggling with the following declaration of a hash in Perl:
my %xmlStructure = {
hostname => $dbHost,
username => $dbUsername,
password => $dbPassword,
dev_table => $dbTable,
octopus => {
alert_dir => $alert_dir,
broadcast_id => $broadcast_id,
system_id => $system_id,
subkey => $subkey
}
};
I've been googling, but I haven't been able to come up with a solution, and every modification I make ends up in another warning or in results that I do not want.
Perl complaints with the following text:
Reference found where even-sized list expected at ./configurator.pl line X.
I am doing it that way, since I want to use the module:
XML::Simple
In order to generate a XML file with the following structure:
<settings>
<username></username>
<password></password>
<database></database>
<hostname></hostname>
<dev_table></dev_table>
<octopus>
<alert_dir></alert_dir>
<broadcast_id></broadcast_id>
<subkey></subkey>
</octopus>
</settings>
so sometthing like:
my $data = $xmlFile->XMLout(%xmlStructure);
warn Dumper($data);
would display the latter xml sample structure.
Update:
I forgot to mention that I also tried using parenthesis instead of curly braces for the hash reference, and eventhough it seems to work, the XML file is not written properly:
I end up with the following structure:
<settings>
<dev_table>5L3IQWmNOw==</dev_table>
<hostname>gQMgO3/hvMjc</hostname>
<octopus>
<alert_dir>l</alert_dir>
<broadcast_id>l</broadcast_id>
<subkey>l</subkey>
<system_id>l</system_id>
</octopus>
<password>dZJomteHXg==</password>
<username>sjfPIQ==</username>
</settings>
Which is not exactly wrong, but I'm not sure if I'm going to have problems latter on as the XML file grows bigger. The credentials are encrypted using RC4 algorith, but I am encoding in base 64 to avoid any misbehavior with special characters.
Thanks
{} are used for hash references. To declare a hash use normal parentheses ():
my %xmlStructure = (
hostname => $dbHost,
username => $dbUsername,
password => $dbPassword,
dev_table => $dbTable,
octopus => {
alert_dir => $alert_dir,
broadcast_id => $broadcast_id,
system_id => $system_id,
subkey => $subkey
}
);
See also perldoc perldsc - Perl Data Structures Cookbook.
For your second issue, you should keep in mind that XML::Simple is indeed too simple for most applications. If you need a specific layout, you're better off with a different way of producing the XML, say, using HTML::Template. For example (I quoted variable names for illustrative purposes):
#!/usr/bin/env perl
use strict; use warnings;
use HTML::Template;
my $tmpl = HTML::Template->new(filehandle => \*DATA);
$tmpl->param(
hostname => '$dbHost',
username => '$dbUsername',
password => '$dbPassword',
dev_table => '$dbTable',
octopus => [
{
alert_dir => '$alert_dir',
broadcast_id => '$broadcast_id',
system_id => '$system_id',
subkey => '$subkey',
}
]
);
print $tmpl->output;
__DATA__
<settings>
<username><TMPL_VAR username></username>
<password><TMPL_VAR password></password>
<database><TMPL_VAR database></database>
<hostname><TMPL_VAR hostname></hostname>
<dev_table><TMPL_VAR dev_table></dev_table>
<octopus><TMPL_LOOP octopus>
<alert_dir><TMPL_VAR alert_dir></alert_dir>
<broadcast_id><TMPL_VAR broadcast_id></broadcast_id>
<subkey><TMPL_VAR subkey></subkey>
<system_id><TMPL_VAR system_id></system_id>
</TMPL_LOOP></octopus>
</settings>
Output:
<settings>
<username>$dbUsername</username>
<password>$dbPassword</password>
<database></database>
<hostname>$dbHost</hostname>
<dev_table>$dbTable</dev_table>
<octopus>
<alert_dir>$alert_dir</alert_dir>
<broadcast_id>$broadcast_id</broadcast_id>
<subkey>$subkey</subkey>
<system_id>$system_id</system_id>
</octopus>
</settings>
You're using the curly braces { ... } to construct a reference to an anonymous hash. You should either assign that to a scalar, or change the { ... } to standard parentheses ( ... ).

How can I prettify Perl code generated by Perl?

I have a test generator written in Perl. It generates tests that connect to a simulator. These tests are themselves written in Perl and connect to the simulator via its API. I would like the generated code to be human-readable, which means I'd like it to be properly indented and formatted. Is there a good way to do it?
Details follow, or you can skip to the actual question below.
This is an example:
my $basic = ABC
TRIGGER => DELAY(
NUM => 500,
),
)
BASIC
my $additional = STATE_IS(
STATE => DEF,
INDEX => 0,
),
ADDITIONAL
I'd like the command ABC to be executed with a delay of 500 (units aren't relevant just now) after I call &event, and the state of index 0 is DEF. Sometimes I'll also want to wait for indeces 1, 2, 3 etc...
For only one index I'd like to see this in my test:
&event(
CMD => ABC
TRIGGER => DELAY(
NUM => 500,
TRIGGER => STATE_IS(
STATE => DEF,
INDEX => 0,
),
),
)
For two indeces I'd like to see:
&event(
CMD => ABC
TRIGGER => DELAY(
NUM => 500,
TRIGGER => STATE_IS(
STATE => DEF,
INDEX => 0,
TRIGGER => STATE_IS(
STATE => DEF,
INDEX => 1,
),
),
),
)
So basically I'm adding a block of:
TRIGGER => STATE_IS(
STATE => DEF,
INDEX => 0,
),
for each index, and the index number changes.
Here's how I'm doing it:
for $i (0..$num_indeces) {
# update the index number
$additional =~ s/(INDEX\s*=>\s*)\d+,/$1 $i,/;
$basic =~ s/(
(\),\s*) # capture sequences of ),
+ # as many as possible
\)\s* # end with ) without a ,
} )/$additional $1/sx; # replace with the additional data
Here's the actual question
The problem here is that the code comes out poorly indented. I'd like to run the resulting $basic through a prettifier like this:
&prettify($basic, "perl");
Which would format it nicely according to Perl's best practices. Is there any good way to do this?
PerlTidy makes your code not only tidy, but really beautiful. You can easily tweak it according to your local coding standards.
I have used this:
use Perl::Tidy;
sub Format {
my $source = shift;
my $result;
Perl::Tidy::perltidy(
source => \$source,
destination => \$result,
argv => [qw(-pbp -nst)]
);
return $result;
}