How to use a string as an operator? - perl

It is possible to use a string as an operator?
my $ip = "10 > 0.2 && 5 < 1";
if($ip)
{
print "Hello\n\n";
}
else
{
print "wrong\n";
}
How to consider the string > && < as an operator?

A non-empty string will always evaluate to true if you use it like this. What you want to do is to evaluate the content of the string as code, and perl provides the eval-statement for exactly this purpose:
my $ip = "10 > 0.2 && 5 < 1";
if( eval($ip) )
{
print "Hello \n\n";
}
else
{
print "wrong\n";
}
This will give the expected output "wrong".

Related

Syntax error when map() returns LIST

This works,
print map { $_." x" => $_ } 1..5;
print map { ("$_ x" => $_) } 1..5;
print map { ("$_ x") => $_ } 1..5;
but this throws syntax error,
print map { "$_ x" => $_ } 1..5;
Is this documented bug, undocumented bug, or I can't see why this should not compile?
Why perl thinks this should be map EXPR, LIST instead of map BLOCK LIST
From perlref
Because curly brackets (braces) are used for several other things including BLOCKs, you may occasionally have to disambiguate braces at the beginning of a statement by putting a + or a return in front so that Perl realizes the opening brace isn't starting a BLOCK. The economy and mnemonic value of using curlies is deemed worth this occasional extra hassle.
To make your intentions clearer and to help the parser,
Say +{...} to unambiguously specify a hash reference
#list_of_hashrefs = map +{ "$_ x" => $_ }, 1..5;
Say {; ...} to unambiguously specify a code block
%mappings = map {; "$_ x" => $_ } 1..5;
Why perl thinks this should be map EXPR, LIST instead of map BLOCK LIST?
The relevant section of code is in toke.c, Perl's lexer (the below is from Perl 5.22.0):
/* This hack serves to disambiguate a pair of curlies
* as being a block or an anon hash. Normally, expectation
* determines that, but in cases where we're not in a
* position to expect anything in particular (like inside
* eval"") we have to resolve the ambiguity. This code
* covers the case where the first term in the curlies is a
* quoted string. Most other cases need to be explicitly
* disambiguated by prepending a "+" before the opening
* curly in order to force resolution as an anon hash.
*
* XXX should probably propagate the outer expectation
* into eval"" to rely less on this hack, but that could
* potentially break current behavior of eval"".
* GSAR 97-07-21
*/
t = s;
if (*s == '\'' || *s == '"' || *s == '`') {
/* common case: get past first string, handling escapes */
for (t++; t < PL_bufend && *t != *s;)
if (*t++ == '\\')
t++;
t++;
}
else if (*s == 'q') {
if (++t < PL_bufend
&& (!isWORDCHAR(*t)
|| ((*t == 'q' || *t == 'x') && ++t < PL_bufend
&& !isWORDCHAR(*t))))
{
/* skip q//-like construct */
const char *tmps;
char open, close, term;
I32 brackets = 1;
while (t < PL_bufend && isSPACE(*t))
t++;
/* check for q => */
if (t+1 < PL_bufend && t[0] == '=' && t[1] == '>') {
OPERATOR(HASHBRACK);
}
term = *t;
open = term;
if (term && (tmps = strchr("([{< )]}> )]}>",term)))
term = tmps[5];
close = term;
if (open == close)
for (t++; t < PL_bufend; t++) {
if (*t == '\\' && t+1 < PL_bufend && open != '\\')
t++;
else if (*t == open)
break;
}
else {
for (t++; t < PL_bufend; t++) {
if (*t == '\\' && t+1 < PL_bufend)
t++;
else if (*t == close && --brackets <= 0)
break;
else if (*t == open)
brackets++;
}
}
t++;
}
else
/* skip plain q word */
while (t < PL_bufend && isWORDCHAR_lazy_if(t,UTF))
t += UTF8SKIP(t);
}
else if (isWORDCHAR_lazy_if(t,UTF)) {
t += UTF8SKIP(t);
while (t < PL_bufend && isWORDCHAR_lazy_if(t,UTF))
t += UTF8SKIP(t);
}
while (t < PL_bufend && isSPACE(*t))
t++;
/* if comma follows first term, call it an anon hash */
/* XXX it could be a comma expression with loop modifiers */
if (t < PL_bufend && ((*t == ',' && (*s == 'q' || !isLOWER(*s)))
|| (*t == '=' && t[1] == '>')))
OPERATOR(HASHBRACK);
if (PL_expect == XREF)
{
block_expectation:
/* If there is an opening brace or 'sub:', treat it
as a term to make ${{...}}{k} and &{sub:attr...}
dwim. Otherwise, treat it as a statement, so
map {no strict; ...} works.
*/
s = skipspace(s);
if (*s == '{') {
PL_expect = XTERM;
break;
}
if (strnEQ(s, "sub", 3)) {
d = s + 3;
d = skipspace(d);
if (*d == ':') {
PL_expect = XTERM;
break;
}
}
PL_expect = XSTATE;
}
else {
PL_lex_brackstack[PL_lex_brackets-1] = XSTATE;
PL_expect = XSTATE;
}
Explanation
If the first term after the opening curly is a string (delimited by ', ", or `) or a bareword beginning with a capital letter, and the following term is , or =>, the curly is treated as the beginning of an anonymous hash (that's what OPERATOR(HASHBRACK); means).
The other cases are a little harder for me to understand. I ran the following program through gdb:
{ (x => 1) }
and ended up in the final else block:
else {
PL_lex_brackstack[PL_lex_brackets-1] = XSTATE;
PL_expect = XSTATE;
}
Suffice it to say, the execution path is clearly different; it ends up being parsed as a block.

perl date time quandry

I am trying to use perl date/time and also get file date info.
I started with this routine:
sub getTime {
#arrayDate = localtime(time);
($strSec,$strMin,$strHr,$strDate,$strMo,$strYr,$strDOW,$strDOY,$strDST) = localtime(time);
$strYr += 1900;
$strMo += 1;
if (length($strMo) < 2) { $strMo = "0" . $strMo }
if (length($strDate) < 2) { $strDate = "0" . $strDate }
if (length($strHr) < 2) { $strHr = "0" . $strHr }
if (length($strMin) < 2) { $strMin = "0" . $strMin }
if (length($strSec) < 2) { $strSec = "0" . $strSec }
$strDateTime = "$strYr$strMo$strDate $strHr:$strMin:$strSec";
}
Which worked fine.
Then I needed to get file date info using $file1date = ctime(stat($flatFile1)->mtime);.
Here is where the confusion begins. If I add use File::stat and use Time::localtime to get the file date to work, the first routine stops working and gives me this as output: 1900010 0:0:Time::tm=ARRAY(0x9a7b98)
So in order to get both to work I had to change the date routine to this:
sub getTime {
$strMon = localtime->mon();
$strMday = localtime->mday();
$strYear = localtime->year();
$strHour = localtime->hour();
$strMin = localtime->min();
$strSec = localtime->sec();
$strYear += 1900;
$strMon += 1;
if (length($strMon) < 2) { $strMon = "0" . $strMon }
if (length($strMday) < 2) { $strMday = "0" . $strMday }
if (length($strHour) < 2) { $strHour = "0" . $strHour }
if (length($strMin) < 2) { $strMin = "0" . $strMin }
if (length($strSec) < 2) { $strSec = "0" . $strSec }
$strDateTime = "$strYear$strMon$strMday $strHour:$strMin:$strSec";
}
... which I'm sure is not efficient. What's the right way to do this?
I'd like to advise you to use Time::Piece.
The above core module alters the behavior of localtime to return an object of type Time::Piece that has a strftime function. The following are your two goals performed with this module:
use strict;
use warnings;
use Time::Piece;
use File::stat;
print "Current time: " . localtime->strftime("%Y%m%d %H:%M:%S") . "\n";
print "Script created: " . localtime(stat($0)->ctime)->strftime("%Y%m%d %H:%M:%S") . "\n";
Outputs:
Current time: 20140624 19:18:17
Script created: 20140624 15:54:36
I wouldn't say that there's anything wrong with the second method. My only suggestion would be to use sprintf to format $strDateTime instead of a block of if statements:
sub getTime {
$strDateTime = sprintf("%04d%02d%02d %02d:%02d:%02d",
localtime->year() + 1900,
localtime->mon() + 1,
localtime->mday(),
localtime->hour(),
localtime->min(),
localtime->sec());
}
For reference: the field %04d means a decimal (d) field of length 4, padded with 0. Using fixed-length, padded decimal fields is a quick and easy way to format numbers.
You can see the whole guide on sprintf in the documentation.

Perl script appending date

Am running this perl script ever day on my server and am getting the below output for the script. I am trying to modify the script to also include the current hour as part of the output. How can I go about doing this?
This is my current script:
#!/usr/bin/perl
#Prism Performance log Parser
use strict;
my $cbal_total;
my $cbal_count =0;
my $stck_total = 0;
my $stck_count =0;
my $chg_total = 0;
my $chg_count =0;
my $rmac_total = 0;
my $rmac_count =0;
my $rmd_total = 0;
my $rmd_count =0;
my $cbalT;
my $stckT;
my $rmacT;
my $rmdT;
my $chgT;
my $total;
my $count;
my $cbal;
my $stck;
my $hour;
my $chg;
my $rmac;
my $rmd;
my $lesThresh=0;
my $gtThresh=0;
my $stck_lesThresh=0;
my $stck_gtThresh=0;
my $rmd_lesThresh=0;
my $rmd_gtThresh=0;
my $chg_lesThresh=0;
my $chg_gtThresh=0;
my $rmac_lesThresh=0;
my $rmac_gtThresh=0;
my %CheckBal;
my %SubTypeCheck;
my %charging;
my %remoteAct;
my %remoteDct;
my $chgkey;
my $cbalkey;
my $stckkey;
my $rmackey;
my $rmdkey;
my #value;
my $ct;
my $component;
my $component2;
while (my $line =<>) {
chomp;
s/\r//g;
my #f = split(/\|/, $line);
my $i;
$hour = substr($f[0],11,2);
for ($i==0;$i<=100; $i++) {
if (($f[$i]=~m/CBAL/) && ($f[$i]!~m/CBAL,100/)) {
$component="CBAL";
$cbal=$f[$i];
$cbalkey="$hour,$component";
if (!exists($CheckBal{$cbalkey})) {
$cbal_count=0;
$cbal_total=0;
$lesThresh=0;
$gtThresh=0;
}
$cbalT = substr($cbal,index($cbal,",T=")+3,index($cbal,"\n"));
if ($cbalT <= 300) {
$lesThresh++;
}else{
$gtThresh++
}
$cbal_total +=$cbalT;
$cbal_count ++;
#$CheckBal{$cbalkey} =($cbal_total).",".($cbal_count).",".($lesThresh).",".$gtThresh.",".($cbal_total/$cbal_count);
$CheckBal{$cbalkey} =($cbal_count).",".($cbal_total).",".($cbal_total/$cbal_count).",".($lesThresh).",".$gtThresh;
}elsif($f[$i]=~m/STCK/){
$component="STCK";
$stck=$f[$i];
$stckkey="$hour,$component";
if (!exists($SubTypeCheck{$stckkey})) {
$stck_count=0;
$stck_total=0;
$stck_lesThresh=0;
$stck_gtThresh=0
}
$stckT = substr($stck,index($stck,",T=")+3,index($stck,"\n"));
if ($stckT <= 300) {
$stck_lesThresh++;
}else{
$stck_gtThresh++
}
$stck_total +=$stckT;
$stck_count ++;
# $SubTypeCheck{$stckkey} =($stck_total).",".($stck_count).",".($stck_lesThresh).",".$stck_gtThresh.",".($stck_total/$stck_count);
$SubTypeCheck{$stckkey} =($stck_count).",".($stck_total).",".($stck_total/$stck_count).",".($stck_lesThresh).",".$stck_gtThresh;
}elsif($f[$i]=~m/CHG/){
$component="CHG";
$chg=$f[$i];
$chgkey="$hour,$component";
if (!exists($charging{$chgkey})) {
$chg_count=0;
$chg_total=0;
$chg_lesThresh=0;
$chg_gtThresh=0
}
$chgT = substr($chg,index($chg,",T=")+3,index($chg,"\n"));
if ($chgT <= 300) {
$chg_lesThresh++;
}else{
$chg_gtThresh++
}
$chg_total +=$chgT;
$chg_count ++;
# $charging{$chgkey} =($chg_total).",".($chg_count).",".($chg_lesThresh).",".$chg_gtThresh.",".($chg_total/$chg_count);
$charging{$chgkey} =($chg_count).",".($chg_total).",".($chg_total/$chg_count).",".($chg_lesThresh).",".$chg_gtThresh;
}elsif(($f[$i]=~m/RMAC/) && ($f[$i]!~m/RMAC,96/)){
$component="RMAC";
$rmac=$f[$i];
$rmackey="$hour,$component";
if (!exists($remoteAct{$rmackey})) {
$rmac_count=0;
$rmac_total=0;
$rmac_lesThresh=0;
$rmac_gtThresh=0
}
$rmacT = substr($rmac,index($rmac,",T=")+3,index($rmac,"\n"));
if ($rmacT <= 300) {
$rmac_lesThresh++;
}else{
$rmac_gtThresh++
}
$rmac_total +=$rmacT;
$rmac_count ++;
# $remoteAct{$rmackey} =($rmac_total).",".($rmac_count).",".($rmac_lesThresh).",".$rmac_gtThresh.",".($rmac_total/$rmac_count);
$remoteAct{$rmackey} =($rmac_count).",".($rmac_total).",".($rmac_total/$rmac_count).",".($rmac_lesThresh).",".$rmac_gtThresh;
}elsif(($f[$i]=~m/RMD/) && ($f[$i]!~m/RMD,96/)){
$component="RMD";
$rmd=$f[$i];
$rmdkey="$hour,$component";
if (!exists($remoteDct{$rmdkey})) {
$rmd_count=0;
$rmd_total=0;
$rmd_lesThresh=0;
$rmd_gtThresh=0
}
$rmdT = substr($rmd,index($rmd,",T=")+3,index($rmd,"\n"));
if ($rmdT <= 300) {
$rmd_lesThresh++;
}else{
$rmd_gtThresh++
}
$rmd_total +=$rmdT;
$rmd_count ++;
# $remoteDct{$rmdkey} =($rmd_total).",".($rmd_count).",".($rmd_lesThresh).",".$rmd_gtThresh.",".($rmd_total/$rmd_count);
$remoteDct{$rmdkey} =($rmd_count).",".($rmd_total).",".($rmd_total/$rmd_count).",".($rmd_lesThresh).",".$rmd_gtThresh;
}
}
}
print "Balance Check\n";
print "Hour,Task,Total Transactions,Total Processing Time/ms,Average TPS/ms,<300 ms,>300 ms\n";
unless(%CheckBal){
print "No record found for STCK\n";
}
foreach (sort keys %CheckBal){
print $_.",".$CheckBal{$_}."\n";
}
Current Output:
Balance Check
Hour,Task,Total Transactions,Total Processing Time/ms,Average TPS/ms,<300 ms,>300 ms
06,CBAL,17987,13131831,730.073441930283,4295,13692
07,CBAL,17911,13579801,758.182178549495,3970,13941
08,CBAL,228,98643,432.644736842105,100,128
Desired Output:
Balance Check
date,Hour,Task,Total Transactions,Total Processing Time/ms,Average TPS/ms,<300 ms,>300 ms
20140528,06,CBAL,17987,13131831,730.073441930283,4295,13692
20140528,07,CBAL,17911,13579801,758.182178549495,3970,13941
20140528,08,CBAL,228,98643,432.644736842105,100,128
To get the current hour, use Time::Piece
use strict;
use warnings;
use Time::Piece;
print localtime->strftime("%H"), "\n";
How to insert that functionality into your script is an exercise for you.

Perl sub doesn't want to work with passed objects as parameters

I pass two Date::Manip::Date objects, perfectly valid dates to my sub:
sub get_duration {
my $duration;
my #val;
my $from = $_[0]->new_date();
my $to = $_[1]->new_date();
# $from->parse("2012-03-06");
# $to->parse("2012-03-07");
print $from . " ".$to. "<-- <br />";
my #f = $from->value();
if ($f[0] == 2012) {
$from->config("ConfigFile",$HOLIDAYS_2012);
} elsif ($f[0] == 2013) {
$from->config("ConfigFile",$HOLIDAYS_2013);
} elsif ($f[0] == 2014) {
$from->config("ConfigFile",$HOLIDAYS_2014);
} elsif ($f[0] == 2015) {
$from->config("ConfigFile",$HOLIDAYS_2015);
}
my #t = $to->value();
if ($t[0] == 2012) {
$to->config("ConfigFile",$HOLIDAYS_2012);
} elsif ($t[0] == 2013) {
$to->config("ConfigFile",$HOLIDAYS_2013);
} elsif ($t[0] == 2014) {
$to->config("ConfigFile",$HOLIDAYS_2014);
} elsif ($t[0] == 2015) {
$to->config("ConfigFile",$HOLIDAYS_2015);
}
print "from " . #f ." to ". #t."<br>";
my $delta = $from->calc($to, "business");
print $from->calc($to, "business") . " <-";
#val = $delta->value();
if ($to->is_business_day()) {
$duration = $val[3]+1;
} else {
$duration = $val[3];
}
return $duration;
}
I get the output
Date::Manip::Date=HASH(0xacdf7a0) Date::Manip::Date=HASH(0xacdfb50)<--
from 0 to 0
<-
Software error:
Can't call method "value" on an undefined value at '#val = $delta->value();'
That is the two dates are passed all right, I got NO errors when it tries to set their config files, Regardless, the value arrays #t and #f are empty and it breaks down as soon as I try to get the delta.
However if I uncomment the two lines
$from->parse("2012-03-06");
$to->parse("2012-03-07");
(hence ignoring the parameters)
It works just fine as intended.
There's something I'm missing about passing objects in Perl I suspect?
Firstly
&get_overlap_duration($saved[$i][5], $saved[$i][6], $saved[$i][7], $saved[$i][8])
Is called
I've printed the #saved values and they're correct, they're strings:
2012-03-06, 2012-03-08, 2012-03-05, 2012-03-07
Then inside get_overlap_duration those strings are
my $from1 = new Date::Manip::Date;
my $to1 = new Date::Manip::Date;
my $from2 = new Date::Manip::Date;
my $to2 = new Date::Manip::Date;
$from1->parse($_[0]);
$to1->parse($_[1]);
$from2->parse($_[2]);
$to2->parse($_[3]);
Then there's there is a call for get_duration for instance $duration = get_duration($from2, $to1);
I've checked the server error log there were no complaints apart from the software error displayed in the browser.
The problem is that on the following line:
my $delta = $from->calc($to, "business");
It's not returning a valid object. Which likely means that something in the calc() function is failing. Since "business" is not a valid date. And if you read the Date::Manip::Calc man page, the mode parameter is only legal when you pass in two date objects before that and you've only passed one.

What is wrong with this if-elsif-else block in my Perl script?

I'm trying to write a condition for a nested if statement, but haven't found a good example of using or in if statements. The following elsif condition fails and allows the code nested beneath it to fire if $status == 6:
if ($dt1 > $dt2 ) {do one thing}
elsif(($status != 3) || ($status != 6)) { do something else}
else {do something completely different}
I'd like to avoid having another elsif for each condition as the code that actually resides here is several lines long.
Your logic is wrong and your elseif block will always return true. I think you mean to use an AND instead of an OR. Given the following snippet
foreach $status (1 .. 10) {
if (($status != 3) && ($status != 6)) {
print "$status => if\n";
} else {
print "$status => else\n";
}
}
This will output
1 => if
2 => if
3 => else
4 => if
5 => if
6 => else
7 => if
8 => if
9 => if
10 => if
If it helps your thinking, a conditional that is !something || !somethingElse can always be rewritten as !(something && somethingElse). If you apply this to your case above you'd say !(3 && 6), and seeing as a number cannot be 3 and 6 at the same time, it's always false
You said you're asking this because the code is several lines long. Fix that problem. :)
if( $dt1 > $dt2 ) { do_this_thing() }
elsif( ($status != 3) || ($status != 6) ) { do_this_other_thing() }
else { do_something_completely_different() }
Now you don't have several lines in the block and everything is next to each other. You have to figure out what those conditions will be because any value is either not 3 or not 6. :)
Perhaps you meant to use and:
if( $dt1 > $dt2 ) { do_this_thing() }
elsif( $status != 3 and $status != 6 ) { do_this_other_thing() }
else { do_something_completely_different() }
Putting print statements with var names/values into each branch can be helpful.
You could see that the elsif branch is always run, because $status != 3 || $status != 6 is true for any value of $status.