Update scalar variable globally inside if statement in Perl? - perl

I'm trying to update a variable declared and used outside of a series of if / elsif / else statements, and updating it within the series. Is there a functional way to make this sorting/updating variable work?
my $daterange = 'initial';
if ($in{from_date} & $in{to_date}) {
my $daterange=~"AND (date BETWEEN '$fromdate' and '$todate')";
}
elsif ($in{from_date}) {
my $daterange=~"AND (date > '$fromdate')";
}
elsif ($in{to_date}) {
my $daterange=~"AND (date < '$todate')";
}
else {
my $daterange=~"blank";
}
print $daterange;

my creates a new variable. That means that inside your "then` clauses, you create a new variable, then assign a string to it. You never use that variable again!
You want to assign to the existing variable, so stop creating new ones with the same name.
There are numerous other problems with your code:
Your code suffer from SQL injection bugs.
You used =~ to assign to a variable when the assignment operator is =.
You used & to check if two value are true when the logical-AND operator is &&.
You used "blank" to create an empty string when it doesn't.
You sometimes use $in{from_date} and sometimes $fromdate.
You sometimes use $in{to_date} and sometimes $todate.
You assign an initial value (initial) to $daterange that you never end up using.
You have some useless parentheses in your SQL.
Fixed:
my $daterange;
if ($in{from_date} && $in{to_date}) {
$daterange = " AND (date BETWEEN ".$dbh->quote($in{from_date})." AND ".$dbh->quote($in{to_date}).")";
} elsif ($in{from_date}) {
$daterange = " AND date > ".$dbh->quote($in{from_date});
} elsif ($in{to_date}) {
$daterange = " AND date < ".$dbh->quote($in{to_date});
} else {
$daterange = "";
}

Delete all my except the first one.
This prevents one local variable being introduced for each {}, which is then unknown outside.
That way, the accesses inside the {} will affect your global variable.
As c3st7n noted (thanks), you will also have to doublecheck what you actually do to your variable, it is likely that it is not what you intended. I.e. you probably want to use = instead of =~.

Related

How to compare two perl object values?

I need to compare two Perl object values, one is from a variable and another one is from an array value
ImmediateParent and data contain path directive values(C:\Users\Public\Documents)
while (length(basename(dirname(($immediateParent)))) > 1)
{
$immediateParent = (dirname(($immediateParent)));
my ($dictionaryitem) = $';
my $boolean =0;
foreach $dictionaryitem (#data)
{
if ($immediateParent eq $dictionaryitem->[0])
{
$boolean = 1;
last;
}
}
if ($boolean)
{
last;
}
}
I attempted to compare the values of two paths directories, but the condition always returned true, so it was ineffective. Would you kindly advise me on how to compare two path values?
If Data::Dumper shows
$immediateParent = 'C:\\Users\\Public';
$dictionaryitem = 'C:\\Users\\Public';
then you should compare them directly without array dereference, i.e. remove the ->[0]:
if ($immediateParent eq $dictionaryitem)
The fact that Perl let you dereference a string is weird. Are you not using strict?

how to combine two next if together

I have a script that run on the list of files to do some of the changes, each file of them has a call event and the call event details contains 4 elements so i just want to do the changes on 2 of them only here I'm stuck with how to combine two next if in one loop, here I have used 2 loops to do the job but it takes more time , is there any idea about how to do that ?
my $calleventtag = $struct->{'transferBatch'}->{'callEventDetails'};
my #indexes = reverse (grep { exists $calleventtag->[$_]->{'supplServiceEvent'} } 0..$#$calleventtag);
my $sup_event_cnt = $#indexes;
foreach my $index (#indexes)
{
splice (#$calleventtag , $index,1);
}
foreach (0..$#$calleventtag)
{
next if ( ! exists $calleventtag->[$_]->{'mobileOriginatedCall'}) ;
if ( exists $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'destinationNetwork'} )
{
delete $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'destinationNetwork'};
}
if ( exists $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'chargeableSubscriber'}->{'simChargeableSubscriber'}->{'msisdn'}
&& $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'chargeableSubscriber'}->{'simChargeableSubscriber'}->{'msisdn'} !~ m/^96279/
)
{
delete $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'chargeableSubscriber'}->{'simChargeableSubscriber'}->{'msisdn'};
}
}
foreach (0..$#$calleventtag)
{
next if ( ! exists $calleventtag->[$_]->{'gprsCall'});
if ( exists $calleventtag->[$_]->{'gprsCall'}->{'gprsBasicCallInformation'}->{'gprsDestination'}->{'accessPointNameOI'} )
{
delete $calleventtag->[$_]->{'gprsCall'}->{'gprsBasicCallInformation'}->{'gprsDestination'}->{'accessPointNameOI'};
}
}
for (...) {
next if ...;
...
}
can also be written as
for (...) {
if (!...) {
...
}
}
You could use the following:
use Data::Diver qw( Dive );
my $call_event_details = Dive($struct, qw( transferBatch callEventDetails ));
for my $call_event_detail (#$call_event_details) {
next if !$call_event_detail->{supplServiceEvent};
if ( my $bci = Dive($call_event_detail, qw( mobileOriginatedCall basicCallInformation )) ) {
delete $bci->{destinationNetwork};
if ( my $scs = $bci->{simChargeableSubscriber} ) {
my $msisdc = $scs->{msisdn};
delete $scs->{msisdn} if $msisdc && $msisdc !~ /^96279/;
}
}
if ( my $dest = Dive($call_event_detail, qw( gprsCall gprsBasicCallInformation gprsDestination )) ) {
delete $dest->{accessPointNameOI};
}
}
Notes:
The quotes around string literals aren't needed in hash indexes if the string is valid valid identifier. For example, $hash->{'foo'} can be written as $hash->{foo}.
-> isn't needed between two indexes. For example, $hash->{foo}->{bar} can be written as $hash->{foo}{bar}.
If a hash element is either a reference or doesn't exist, you don't need to use exists to check if you have a reference; you can use a simple truth test since references are always true.
[BUG FIX] $hash->{foo}{bar} can autovivify $hash->{foo} (cause a reference to be assigned to it), so your tests to check if stuff exists could actually be causing things to be created. To fix this, you can replace
if ($hash->{foo}{bar})
with
if ($hash->{foo} && $hash->{foo}{bar})
or
if (Dive($hash, qw( foo bar )))
Using the same long chain of indexes (->{foo}{bar}{baz}) repeatedly is error prone.
It's best to use plural names for arrays. First, it's more descriptive, but it also makes choosing names for loop variables easier.
Speaking of variable names, why would use $calleventtag for the name of the variable containing callEventDetails nodes?
You don't need to check if a hash element exists before trying to delete it; delete can be passed an element that doesn't exist.
No need to loop over the indexes of an array if you don't need the indexes.
grep was a good choice, but splice was not. You should have used: $calleventtag = [ grep { ... } #$calleventtag ];. I moved the check into the loop.

Iterating the results returned from fetchall_arrayref

I have a sql wherein I am fetching few records, sorted by full name.
My requirement is to extract chunks of similar names and then do some operation on it.
Say, the sql returns some records containing names like [name1,name1,name2,name3,name3]
I need to split them to [name1,name1] , [name2] , [name3,name3]
I am able to do it, but I am not happy with my implementation as I have to call doSomethingWithNames()twice.
while (my $paRecs = $pStatementHandle->fetchall_arrayref({}, 3)){
foreach my $phRec(#{$paRecs}){
my $pCurrentName = $phRec->{'FULL_NAME'};
if ((scalar(#aParentRecords) eq 0) or ($aParentRecords[-1] eq $pCurrentName)){
push(#aParentRecords, $pCurrentName);
} else {
doSomethingWithNames(\#aParentRecords);
#aParentRecords= ();
push(#aParentRecords, $pCurrentName);
}
}
};
doSomethingWithNames(\#aParentRecords); # This should be inside while loop
I believe am running into this issue because while doesn't go into the loop for
the last iteration as fetch* returns undef.
Sounds basic PERL stuff, but tried many loop constructs with no luck.
Any pointer will be a great help
The trick is to postpone existing the loop by converting it into an infinite loop. This requires checking the loop-terminating condition (!$rows) twice, though.
my $rows = [];
my $prev_name = '';
my #group;
while (1) {
$rows = $sth->fetchall_arrayref({}, 3) if !#$rows;
if (!$rows || $rows->[0]->{FULL_NAME} ne $prev_name)
if (#group) {
do_something(\#group);
#group = ();
}
last if !$rows;
}
$prev_name = $rows->[0]->{FULL_NAME};
push #group, shift(#$rows);
}

Return empty strings in woocommerce checkout form

I'd like to return empty strings on all checkout form field but one (the billing_country one).
I already know how to do it with all fields :
add_filter('woocommerce_checkout_get_value','__return_empty_string', 1, 1);
And how to do it with only one field:
add_filter('woocommerce_checkout_get_value','custom_checkout_get_value_ship_ville', 10, 2);
function custom_checkout_get_value_ship_ville( $value, $imput ){
if($imput == 'shipping_city')
$value = '';
return $value;
}
But for all but one ... I'm a little stucked.
I succeed by duplicating and adapting the previous function, but it's a lot of code for just returning empty strings.
I tried with else, elsif, switch and with logical operators, but no result.
So if someone have some clue ...
Thanks
If you want to return empty strings on every value of $imput except for one specific value you need to reverse the comparison of your second code snippet. So instead of comparing wether the $imput is equal to a value you compare wether the $imput is NOT equal to a value.
You can read up on this comparison here: http://php.net/manual/en/language.operators.comparison.php
You can also just return an empty string directly without assigning it to a variable:
add_filter('woocommerce_checkout_get_value','custom_checkout_get_value_ship_ville', 10, 2);
function custom_checkout_get_value_ship_ville( $value, $imput ){
if($imput != 'billing_country') {
return '';
}
}

How can I cleanly handle error checking in Perl?

I have a Perl routine that manages error checking. There are about 10 different checks and some are nested, based on prior success. These are typically not exceptional cases where I would need to croak/die. Also, once an error occurs, there's no point in running through the rest of the checks.
However, I can't seem to think of a neat way to solve this issue except by using something analogous to the following horrid hack:
sub lots_of_checks
{
if(failcond)
{
goto failstate:
}
elsif(failcond2)
{
goto failstate;
}
#This continues on and on until...
return 1; #O happy day!
failstate:
return 0; #Dead...
}
What I would prefer to be able to do would be something like so:
do
{
if(failcond)
{
last;
}
#...
};
An empty return statement is a better way of returning false from a Perl sub than returning 0. The latter value will actually be true in list context:
sub lots_of_checks {
return if fail_condition_1;
return if fail_condition_2;
# ...
return 1;
}
Perhaps you want to have a look at the following articles about exception handling in perl5:
perl.com: Object Oriented Exception Handling in Perl
perlfoundation.com: Exception Handling in Perl
You absolutely can do what you prefer.
Check: {
last Check
if failcond1;
last Check
if failcond2;
success();
}
Why would you not use exceptions? Any case where the normal flow of the code should not be followed is an exception. Using "return" or "goto" is really the same thing, just more "not what you want".
(What you really want are continuations, which "return", "goto", "last", and "throw" are all special cases of. While Perl does not have full continuations, we do have escape continuations; see http://metacpan.org/pod/Continuation::Escape)
In your code example, you write:
do
{
if(failcond)
{
last;
}
#...
};
This is probably the same as:
eval {
if(failcond){
die 'failcond';
}
}
If you want to be tricky and ignore other exceptions:
my $magic = [];
eval {
if(failcond){
die $magic;
}
}
if ($# != $magic) {
die; # rethrow
}
Or, you can use the Continuation::Escape module mentioned above. But
there is no reason to ignore exceptions; it is perfectly acceptable
to use them this way.
Given your example, I'd write it this way:
sub lots_of_checks {
local $_ = shift; # You can use 'my' here in 5.10+
return if /condition1/;
return if /condition2/;
# etc.
return 1;
}
Note the bare return instead of return 0. This is usually better because it respects context; the value will be undef in scalar context and () (the empty list) in list context.
If you want to hold to a single-exit point (which is slightly un-Perlish), you can do it without resorting to goto. As the documentation for last states:
... a block by itself is semantically identical to a loop that executes once.
Thus "last" can be used to effect an early exit out of such a block.
sub lots_of_checks {
local $_ = shift;
my $all_clear;
{
last if /condition1/;
last if /condition2/;
# ...
$all_clear = 1; # only set if all checks pass
}
return unless $all_clear;
return 1;
}
If you want to keep your single in/single out structure, you can modify the other suggestions slightly to get:
sub lots_of_checks
{
goto failstate if failcond1;
goto failstate if failcond2;
# This continues on and on until...
return 1; # O happy day!
failstate:
# Any clean up code here.
return; # Dead...
}
IMO, Perl's use of the statement modifier form "return if EXPR" makes guard clauses more readable than they are in C. When you first see the line, you know that you have a guard clause. This feature is often denigrated, but in this case I am quite fond of it.
Using the goto with the statement modifier retains the clarity, and reduces clutter, while it preserves your single exit code style. I've used this form when I had complex clean up to do after failing validation for a routine.