This question is about Perl DBI (I use it with MySQL).
I want the following code:
{
local $dbh->{AutoCommit} = 0;
...
if(...) {
$dbh->rollback;
}
...
}
Will it work as expected? (I mean no superfluous commit after rollback) Is $dbh->{AutoCommit} compatible with $dbh->begin_work and $dbh->rollback?
Yes, you can do that but why would you want to. Why not just call begin_work and then commit or rollback. They work fine even if AutoCommit is on.
use strict;
use warnings;
use DBI;
use Data::Dumper;
my $h = DBI->connect();
eval {
$h->do(q/drop table mje/);
};
$h->do(q/create table mje (a int)/);
my $s = $h->prepare(q/insert into mje values(?)/);
foreach my $it(1..2) {
{
local $h->{AutoCommit} = 0;
$s->execute($it);
if ($it == 2) {
$h->rollback;
} else {
$h->commit;
}
}
}
my $r = $h->selectall_arrayref(q/select * from mje/);
print Dumper($r);
outputs:
$VAR1 = [
[
1
]
];
but the following looks better to me:
foreach my $it(1..2) {
$h->begin_work;
$s->execute($it);
if ($it == 2) {
$h->rollback;
} else {
$h->commit;
}
}
Related
It is unclear to me why the piece of code below gives me the error:
Use of uninitialized value in addition (+) at combined_op_test.pl line 12.
I expect the value of $success_count to increment by the value returned from the subroutine on each iteration.
Here is the code:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.014;
use Try::Tiny;
my $success_count = 0;
for ( 1..10 ) {
$success_count += error_causing_sub();
}
sub error_causing_sub {
try {
die ("Error.");
} catch {
} finally {
if (#_) {
say "Error occured.";
return 0;
}
else {
say "Error did not occur.";
return 1;
}
};
}
Any help is appreciated.
As explained in the CAVEATS section of the documentation, the return does not return from the sub, it returns from finally:
return returns from the try block, not from the parent sub (note that this is also how eval works, but not how TryCatch works):
sub parent_sub {
try {
die;
}
catch {
return;
};
say "this text WILL be displayed, even though an exception is thrown";
}
As #simbabque notes, the return value of finally is ignored. If the try fails, the return value of catch is relevant, and it's empty:
The return value of the catch block is not ignored, so if testing the result of the expression for truth on success, be sure to return a false value from the catch block: ...
The following code looks more logical to me:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.014;
use Try::Tiny;
my $success_count = 0;
for ( 1..10 ) {
$success_count += error_causing_sub();
}
say $success_count;
sub error_causing_sub {
my $ret;
try {
die ("Error.") if rand(1) < 0.5;
say "Error did not occur.";
$ret = 1;
} catch {
say "Error occured.";
$ret = 0;
};
return $ret;
}
In addition, AFAIK, the issues with eval that made Try::Tiny relevant were fixed in 5.14. So, you may be better off just using it:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.014;
my $success_count = 0;
$success_count += error_causing_sub() for 1 .. 10;
say $success_count;
sub error_causing_sub {
my $ret;
eval {
die ("Error.") if rand(1) < 0.5;
say "Error did not occur.";
$ret = 1;
} or do {
say "Error occured.";
$ret = 0;
};
return $ret;
}
I have inherited a perl code base. Consider the following subroutine;
sub getSysRTable
{
my $iface = shift;
return if not length($iface);
my %ip_routes;
my #routes = `/usr/bin/netstat -rn`;
foreach my $route(#routes) {
if ($route =~ /([\S.]+)\s+([\d.]+.[\d.]+.[\d.]+.[\d.]+)\s+(UGS|UGHS)\s+($iface)/ )
{ $ip_routes {$1} = $2 }
}
return %ip_routes;
}
I want to write unit tests for this code. The testing I have in mind will use sample output from netstat -rn and check for expected behaviour. The sub as is, invokes a command, so injecting my test data is problematic with this implementation.
What is the idiomatic perlish approach to refactoring this sub for testability?
First, change your code as follows:
sub getDataForSysRTable {
return `/usr/bin/netstat -rn`;
}
sub getSysRTable
{
my $iface = shift;
return if not length($iface);
my %ip_routes;
my #routes = getDataForSysRTable();
foreach my $route(#routes) {
if ($route =~ /([\S.]+)\s+([\d.]+.[\d.]+.[\d.]+.[\d.]+)\s+(UGS|UGHS)\s+($iface)/ )
{ $ip_routes {$1} = $2 }
}
return %ip_routes;
}
Then for your test, you can do
local *getDataForSysRTable = sub {
... return known data ...
};
my $ip_routes = getSysRTable($iface);
This program throws an error. The problem is that I have to use switch case. How can I do this in Perl?
#use strict;
#use warnings;
my $input = print "Enter the number";
$input = <STDIN>;
switch($input){
case "1" {print "UPC"}
case "2" {print "ES"}
case "3" {print "MS"}
else {print "Enter the correct value"}
}
You need to import Switch to use it:
use Switch;
However, Switch has been deprecated. See this question: Why is the Switch module deprecated in Perl?
Some alternatives (and their experimental status) are discussed here: http://perldoc.perl.org/perlsyn.html#Switch-Statements
In summary, if you're using Perl >5.10.1, you can use the following for a non-deprecated, non-experimental switch:
use v5.10.1;
for ($var) {
when (/^abc/) { $abc = 1 }
when (/^def/) { $def = 1 }
when (/^xyz/) { $xyz = 1 }
default { $nothing = 1 }
}
Perl's built in version of the case statement is a little different:
use feature "switch";
given ($foo) {
when (/^abc/) { $abc = 1; }
when (/^def/) { $def = 1; }
when (/^xyz/) { $xyz = 1; }
default { $nothing = 1; }
}
You can add a more traditional case statement with use Switch;, but this is deprecated as RobEarl points out.
Also, never comment out use strict; use warnings; as an attempt to fix problems!
I have the following code:
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
BEGIN {
my $supported = undef;
*compute_factorial = sub { if (eval { require bignum; bignum->import(); 1;}) {
my $num = shift;
my $factorial = 1;
foreach my $num (1..$num) {
$factorial *= $num;
}
return $factorial;
} else {
undef;
} };
};
my $f = compute_factorial(25);
say $f;
I'm just testing something, not really a production code...
I do have bignum pragma on my machine (perfectly loadable using use), I was wondering why require doesn't work as it should be (I'm getting exponential numbers rather then "big numbers") in this case?
Thanks,
bignum's import needs to be called before compilation of the code it is intended to effect, or it doesn't work. Here, the BEGIN makes it called before your actual compute_factorial call, but not before the critical my $factorial = 1; is compiled.
A better approach for cases like this is just to directly use Math::Big*:
if (eval { require Math::BigInt }) {
my $num = shift;
my $factorial = Math::BigInt->new(1);
foreach my $num (1..$num) {
$factorial *= $num;
}
return $factorial;
} else {
undef;
}
BEGIN {
require bignum;
import bignum;
my $x = 1;
}
and
require bignum;
import bignum;
my $x = 1;
are the same because require and import are executed after my $x = 1; is already compiled, so bignum never has a chance to make my $x = 1; compile into my $x = Math::BigInt->new(1);. Keep in mind that
use bignum;
my $x = 1;
is actually
BEGIN {
require bignum;
import bignum;
}
my $x = 1;
and not
BEGIN {
require bignum;
import bignum;
my $x = 1;
}
The solution would be
BEGIN {
my $sub;
if (eval { require bignum; }) {
$sub = eval(<<'__EOI__') or die $#;
use bignum;
sub {
my ($num) = #_;
my $factorial = 1;
$factorial *= $_ for 2..$num;
return $factorial;
}
__EOI__
} else {
$sub = sub { croak "Unsupported" };
}
*factorial = $sub;
}
Of course, since you can simply eliminate the pragma, that would be best.
BEGIN {
my $sub;
if (eval { require Math::BigInt; }) {
require Math::BigInt;
$sub = sub {
my ($num) = #_;
my $factorial = Math::BigInt->new(1);
$factorial *= $_ for 2..$num;
return $factorial;
};
} else {
$sub = sub { croak "Unsupported" };
}
*factorial = $sub;
}
As many other pragmas, in newer versions of Perl bignum is only active in scope where you imported it. However, unlike many it also does some funky messing up with upgrading scoped numbers that doesn't quite work with just require. You will have to break check for its existence and use in two different files to isolate scope and still let it do its magic.
big.pl
if (eval { require bignum; 1 }) {
require big_loader;
}
print big_loader::big_num_returner();
print "still ok\n";
big_loader.pm
package big_loader;
use bignum;
sub big_num_returner {
return 2**512
}
1;
Is there a neat way of making a case or switch statement in Perl 5?. It seems to me they should include a switch on version 6..
I need this control structure in a script, and I've heard you can import a "switch module". But how can I achieve it without imports to minimize dependencies and acquire portability?
If you are using Perl 5.10 you have given/when which is a switch statement (note, it can do more than compare with regexes, read the linked docs to see its full potential):
#or any of the dozen other ways to tell 5.10 to use its new features
use feature qw/switch/;
given($string) {
when (/^abc/) { $abc = 1; }
when (/^def/) { $def = 1; }
when (/^xyz/) { $xyz = 1; }
default { $nothing = 1; }
}
If you are using Perl 5.8 or earlier you must make do with if/elsif/else statements:
if ($string =~ /^abc/) { $abc = 1; }
elsif ($string =~ /^def/) { $def = 1; }
elsif ($string =~ /^zyz/) { $xyz = 1; }
else { $nothing = 1; }
or nested condition operators (?:):
$string =~ /^abc/ ? $abc = 1 :
$string =~ /^def/ ? $def = 1 :
$string =~ /^xyz/ ? $xyz = 1 :
$nothing = 1;
There is a module in Core Perl (Switch) that gives you fake switch statements via source filters, but it is my understanding that it is fragile:
use Switch;
switch ($string) {
case /^abc/ {
case /^abc/ { $abc = 1 }
case /^def/ { $def = 1 }
case /^xyz/ { $xyz = 1 }
else { $nothing = 1 }
}
or the alternate syntax
use Switch 'Perl6';
given ($string) {
when /^abc/ { $abc = 1; }
when /^def/ { $def = 1; }
when /^xyz/ { $xyz = 1; }
default { $nothing = 1; }
}
The suggestion in Programming Perl is:
for ($string) {
/abc/ and do {$abc = 1; last;};
/def/ and do {$def = 1; last;};
/xyz/ and do {$xyz = 1; last;};
$nothing = 1;
}
Just a short comment about the core Switch module that's been mentioned a couple of times in answers. The module in question relies on source filters. Among other things, that may result in wrong lines reported for errors. It's so bad that none of the core developers really remembers or cares to remember why it was accepted into the perl core in the first place.
Furthermore, Switch.pm will be the first Perl module ever to be removed from the perl core. The next major release of perl, 5.12.0, will still have it, albeit with a deprecation warning. That deprecation warning will go away if you explicitly install Switch.pm from CPAN. (You get what you ask for.) In the next release down the road, 5.14, Switch.pm will be entirely removed from core.
An equivalent solution that I like is a dispatch table.
my $switch = {
'case1' => sub { print "case1"; },
'case2' => sub { print "case2"; },
'default' => sub { print "unrecognized"; }
};
$switch->{$case} ? $switch->{$case}->() : $switch->{'default'}->();
print("OK : 1 - CANCEL : 2\n");
my $value = <STDIN>;
SWITCH: {
($value == 1) && last(SWITCH);
($value == 2) && do {print("Cancelled\n"); exit()};
print("??\n");
}