I created this function.
When I print my variable my $bios_current, it shows $VAR1 = '200';
But my condition if ( $bios_current->responseCode() ne 200) considers that it is not 200.
Could you help me ? Is it a type problem ?
sub check_thermalshutdown_settings {
my $host = shift;
if ($host->get_property('summary.hardware.model') eq "ProLiant DL360 Gen9") {
my $error="";
my $bios="";
try {
my $ilo = get_ilo_address($host->name);
my $client = REST::Client->new();
$client->setHost("https://$ilo");
$client->addHeader("Authorization", "Basic blabla==");
eval {
local $SIG{ALRM} = sub { };
alarm 3;
#$client->GET("/redfish/v1/Systems/1/Bios/");
my $bios_current = $client->GET("/redfish/v1/Systems/1/Bios/");
print Dumper $bios_current->responseCode;
alarm 0;
};
if ( $bios_current->responseCode() ne 200) {
$bios = "none";
$error = "Redfish API returned code ".$client->responseCode();
print Dumper $client->responseCode();
} else {
my $json = decode_json($client->responseContent());
#print Dumper $client->responseContent();
#$bios = $json->{'Bios'}->{'Settings'}->{'ThermalShutdown'};
$bios = $json->{'ThermalShutdown'};
#print Dumper $bios;
print Dumper $json->{'ThermalShutdown'};
print "API call is ok\n";
print Dumper $client->setHost("https://$ilo");
}
} catch {
$bios = "none";
$error=$_;
};
You problem has nothing to do with type.
The first thing every Perl coder should learn is the following two statements should appear at the top of every script.
use strict;
use warnings;
These two statements catch a multitude of errors one of which is the cause of your problem.
If you take a look at your eval block
eval {
local $SIG{ALRM} = sub { };
alarm 3;
#$client->GET("/redfish/v1/Systems/1/Bios/");
my $bios_current = $client->GET("/redfish/v1/Systems/1/Bios/");
print Dumper $bios_current->responseCode;
alarm 0;
};
You will see that the variable $bios_current is introduced with the my modifier this restricts the lifetime of the variable to the current scope, in this case the eval block.
So by the time your if statement is run the variable no longer exists and Perl helpfully creates a new empty one for you, Perl then tries to call responseCode() on the empty variable, this fails and normally would terminate the program, however you are inside a try() block at this point so instead of displaying the error the code jumps to the catch bloc instead.
Related
This question is based on the observed behavior of patch running with a certain version of perl. When running a command like:
$ patch -N -p0 -u -b .bak < my.patch
I occasionally got output like:
print() on unopened filehandle NULL at patch line 715, <IN> line 12330.
When looking into the code, I see that the NULL filehandle is localized and saved in the object hash:
sub new {
# ....
local *NULL;
tie *NULL, 'Dev::Null';
$self->{o_fh} = \*NULL; # output filehandle
# ....
}
Since this behavior (the output of the message print() on unopened filehandle NULL) only occured for certain versions of perl and (maybe certain version of the patch program) I wondered if this is a bug? To me it looks like one should not localize NULL since we are saving a reference to it and the value of reference (*NULL) will be restored to its previous value when returning from new().
Here is a minimal example:
use feature qw(say);
use strict;
use warnings;
my $p = Patch->new();
$p->apply();
package Patch;
sub new {
my ( $class ) = #_;
my $self = bless {}, $class;
local *NULL;
tie *NULL, 'Dev::Null';
$self->{null} = \*NULL;
local *OUT;
my $out = 'out.txt';
open OUT, ">$out" or die "Couldn't open '$out': $!\n";
$self->{out} = \*OUT;
return $self;
}
sub apply {
my ( $self ) = #_;
my $null = $self->{null};
say $null "This should be discarded..";
my $out = $self->{out};
say $out "This is output to the file..";
}
package Dev::Null;
sub TIEHANDLE { bless \my $null }
sub PRINT {}
sub PRINTF {}
sub WRITE {}
sub READLINE {''}
sub READ {''}
sub GETC {''}
The output when I run this is:
say() on unopened filehandle NULL at ./p.pl line 34.
say() on unopened filehandle OUT at ./p.pl line 36.
It's a bug in patch.
$self->{...} = \*NULL;
should be
$self->{...} = *NULL;
Let's look at these four snippets:
my $r; $s = "abc"; $r = \$s; say $$r;
my $r; { local $s; $s = "abc"; $r = \$s; } say $$r;
my $r; *F = \*STDOUT; $r = \*F; say $r "abc";
my $r; { local *F; *F = \*STDOUT; $r = \*F; } say $r "abc";
Given that the first three work, we would expect the fourth to work too, but it doesn't.
We can't really talk in terms of variables and values in Perl. Perl's model is far more complex than C's where a variable is just a name that represents a location. Globs are even more complex because they're both a variable type (*FOO) something that can be found in a scalar ($foo = *FOO;). The above difference is related to this.
The following does work while still properly localizing *F:
my $r; { local *F; *F = \*STDOUT; $r = *F; } say $r "abc";
patch already uses this approach for *OUT, but it needs to use it for *NULL too. It probably went unnoticed because *NULL is used as a sink, and using an undefined handle also acts as a sink (if you disregard the warning and the error returned by print).
Is it possible in Perl to use a function's return value as the expression in an "if" statement? For example; in C I can write
if (!myFunction()){
printf("myFunction returned false.\n");
} else {
printf("myFunction returned true\n");
}
But in perl I find I must go through the pain of ..
$ret = myFunction();
if (!$ret){
print "myFunction returned false.\n";
}
I know as soon as I post this someone will redirect me to several other posts of this question. But, obviously, I could not find what I'm looking for or I would not write this!
So spare me the "have you tried searching for ...." messages!
Here is what myFunction() looks like.
sub myFunction
{
my ($run, $runTime) = #_;
my ($code);
eval {
$SIG{ALRM} = sub {die "Operation Timed Out";};
alarm($run_time);
$EXIT_STR = `$run`; # Execute $run and save output in EXIT_STR
$code = $?; # Save cmd exit code.
$EXIT_CODE = $code; # Set a global value (EXIT_CODE)
alarm(0);
return($code);
};
if ($#) {
if ($# =~ /Operation Timed Out/) {
print "Time out\n";
return(10);
}
}
}
After everyone's feedback I went back to the books to learn more about eval. After a bit of reading it was clearer that "eval" "returned" a value to the function it was part of. It was then up to me to decide what to do with the eval results. With that in mind I made some changes and the function works as I had hoped. Thanks to all!
Yup.
Wait. I can't give such a short answer...
Yes. If a function is inside an if statement, Perl will take the return value of the function as a boolean value. If the return value is zero, a blank string, a null value, a null string, or an undef, the if statement will be considered false. Otherwise, the if statement will be considered true.
Here's an easy to understand example:
if ( not is_odd( $number ) ) {
print "$number is divisible by two\n";
}
sub is_odd {
my $number = shift;
return $number % 2; # Modulo arithmetic
}
In the above $number % 2 will return zero on even numbers and one on odd numbers.
It's a good question. The best thing to do is to write a small script to try it out. Play around with it a bit:
For example. Let's add a second function we can use:
sub is_even {
my $number = shift;
return not is_odd( $number );
}
What does this return? How does this work in an if statement?
This will work fine.
The only caveat is that using it in an if-statement will provide scalar context to the return value so if something non-scalar is returned, it will get scalarized before the if condition is evaluated.
You may need to explicitly return a false value in cases where you don't want the function to return True. Remember that perl functions will return the last evaluated statement in the absence of a real return value. So, take this example:
#!/usr/bin/perl
use warnings;
use strict;
my $x = 4;
my $y = 1;
if ( ! myFunction($x,$y) ) {
print "myFunction returned false\n";
} else {
print "myFunction returned true\n";
}
sub myFunction {
my ($x,$y) = #_;
my $response;
if ( $x + $y == 2 ) {
$response = "fun";
} else {
$response = "no fun";
}
}
This will always print 'myFunction returned true' since either branch of the conditional is technically a true response. However, if you add a return value to the negative branch of the conditional, it will now work:
#!/usr/bin/perl
use warnings;
use strict;
my $x = 4;
my $y = 1;
if ( ! myFunction($x,$y) ) {
print "myFunction returned false\n";
} else {
print "myFunction returned true\n";
}
sub myFunction {
my ($x,$y) = #_;
my $response;
if ( $x + $y == 2 ) {
$response = "fun";
return 1; # technically not really needed
} else {
$response = "no fun";
return 0;
}
}
$ perl test_funct.pl
myFunction returned false
You're attempting to call return for your subroutine from inside an eval. This will not perform as you expect as explained in the docs for return:
return EXPR
return
Returns from a subroutine, eval, or do FILE with the value given in EXPR. ...
The bug you're facing can be demonstrated in the following example:
sub myFunction {
eval {
return "inside eval";
};
return "outside eval";
}
print myFunction();
Outputs:
outside eval
To fix your subroutine, assign your return value inside the eval, but actually return it from outside. Also, be sure to localize your alarm signal handler.
sub myFunction {
my ($run, $runTime) = #_;
my $code;
eval {
local $SIG{ALRM} = sub {die "Operation Timed Out";};
alarm($run_time);
$EXIT_STR = `$run`; # Execute $run and save output in EXIT_STR
alarm(0);
$code = $?; # Save cmd exit code.
};
if ($#) {
if ($# =~ /Operation Timed Out/) {
print "Time out\n";
$code = 10;
}
}
return $code;
}
I've written a script that takes a command line argument -s, and allows me to add a search term after it.
It then feeds that into my first function, connects to a SQL database, searches for the term, and returns the results in an array.
It then calls the second function, prints the array, and outputs a -1 or a 0 depending on whether any results were found.
Finally it is supposed to check if the result is not equal to 0, and if so print out that no results were found.
Everything is working but my results are printing twice. Any idea why?
#!/usr/bin/perl -w
use warnings;
use DBI;
use Getopt::Std;
use strict;
getopt('s:');
our ($opt_s);
my $search = $opt_s;
my #array = function1($search);
&function1($search);
&function2(#array);
if (&function2(#array) != 0) {
print "No results found for '$search'", "\n";
}
sub function1 {
my $search = $_[0];
our $dbh = DBI->connect("dbi:mysql:dbname=database", "root", "password")
or die $DBI::errstr;
my $sql = $dbh->selectall_arrayref(
"SELECT Player from Players_Sport where Sport like '$search'")
or die $DBI::errstr;
my #array = map { $_->[0] } #$sql;
$dbh->disconnect
or warn "Disconnection failed: $DBI::errstr\n";
return #array;
}
sub function2 {
my #array = #_;
my $arrayvalue;
print("\n", "#array", "\n");
if (scalar(#array) == 0) {
$arrayvalue = -1;
}
else {
$arrayvalue = 0;
}
return $arrayvalue;
}
You're calling &function2(#array); twice, which causes "\n", "#array", "\n" to be printed twice. Just call the function once, store the return value in a variable, and test the variable rather than calling the function again — or, even better, in this specific instance you could just dispense with the first call entirely.
This question already has an answer here:
Closed 10 years ago.
Possible Duplicate:
Perl + POO and “Can't call method ”prepare"
I learned poo and i got to play with perl, create this module but when I call the segudno method I skip the following error 'Use of uninitialized value $database in concatenation ( .) ... ' Followed by 'Can't call method 'prepare' mm i don't really understand, any suggestions?
#!/usr/bin/perl
use warnings;
use strict;
use DBI;
use DBD::mysql;
package MysqlTest;
sub new{
my $class = shift;
my $query={};
bless($query, $class);
}
sub conexion{
my $self=shift;
my($database, $hostname, $user, $pwd)=#_;
$self->{"host"}=$hostname;
$self->{"database"}=$database;
$self->{"user"}=$user;
$self->{"pass"}=$pwd;
our $connect = DBI->connect("DBI:mysql:database=$database;host=$hostname;", $user, $pwd) or die $DBI::errstr;
my $mysqlopen = 1;
return;
}
sub consulta{
my $self=shift;
if (!my $mysqlopen) { &conexion(); }
my $id = "SELECT * FROM save_bookmarks WHERE id='123'";
our $result = my $connect->prepare($id);
$result->execute();
my #resultado = $result->fetchrow_array();
print "#resultado\n";
return;
}
sub datos{
my $self=shift;
print "::DATOS DE ACCESO::\n";
while ((my $key, my $value)=each(%$self)){
print "$key => $value\n";
}
}
1;
in other file for call msg and created objected.
#!/usr/bin/perl
use MysqlTest;
use warnings;
use strict;
my $mysqltest = MysqlTest->new();
$mysqltest->conexion("bookmarks", "localhost", "root", "pass");
$mysqltest->consulta();
this output in console.
Use of uninitialized value $database in concatenation (.) or string at MysqlTest.pm line 23.
Use of uninitialized value $hostname in concatenation (.) or string at MysqlTest.pm line 23.
Can't call method "prepare" on an undefined value at MysqlTest.pm line 31.
any idea?
thanks.
Your code includes this line:
if (!my $mysqlopen) { &conexion(); }
You call your conexion sub with no arguments. However, this sub expects several arguments, including a blessed object, that you don't provide. You might want to fix that. $database and $hostname also are expected in the arguments.
Your call to conexion will always be executed, because my $var creates a new variable and initializes it with undef—and the negation of undef is a true value.
Then you have this statement:
our $result = my $connect->prepare($id);
my creates a new variable $connect on which you try to call the method prepare. This doesn't work, as the created variable is no blessed reference but simply undef.
Scope in Perl
Here is a verbose example on how lexical scope with my works in Perl
# $var doesn't exist
sub foo {
# $var doesn't exist
my $var;
# $var exists
bar();
# $var exists
}
# $var doesn't exist
sub bar {
# $var doesn't exist
return;
}
# $var doesn't exist
You define a my variable mysqlopen in conexion, then redefine it in consulta. It is, however, not the same variable, as these variables reside in different scope.
Instead, you are likely to add fields mysqlopen and connect in the object you are passing around, as this is object data. You can then use this information just like the host or database fields.
Also, do not call the method conexion without an object. Objects are usually created with new.
Edit
It is quite difficult for me to debug your code and parse your English at the same time, so here is your code with the worst bugs removed. However, I have no experience with DBI, so it may not work directly:
sub conexion{
my $self=shift;
die "I need args!" unless #_;
my($database, $hostname, $user, $pwd)=#_;
$self->{host} = $hostname;
$self->{database} = $database;
$self->{user} = $user;
$self->{pass} = $pwd;
$self->{connect} = DBI->connect(
"DBI:mysql:database=$database;host=$hostname;",
$user,
$pwd,
) or die $DBI::errstr;
$self->{mysqlopen}= 1;
return;
}
sub consulta{
my $self = shift;
if (not $self->{mysqlopen}) {
die "This object wants to be conexioned before you consulta anything";
# you could also do
# $self->conexion(DEFAULT_VALUES);
# but then you would really *have* to provide defaults!
}
my $id = "SELECT * FROM save_bookmarks WHERE id='123'";
my $result = $self->{connect}->prepare($id);
$result->execute();
my #resultado = $result->fetchrow_array();
print "#resultado\n";
return;
}
How do you either:
have a sub return a sub
or
execute text as code
in Perl?
Also, how do I have an anonymous function store state?
A sub returns a sub as a coderef:
# example 1: return a sub that is defined inline.
sub foo
{
return sub {
my $this = shift;
my #other_params = #_;
do_stuff();
return $some_value;
};
}
# example 2: return a sub that is defined elsewhere.
sub bar
{
return \&foo;
}
Arbitrary text can be executed with the eval function: see the documentation at perldoc -f eval:
eval q{print "hello world!\n"};
Note that this is very dangerous if you are evaluating anything extracted from user input, and is generally a poor practice anyway as you can generally define your code in a coderef as in the earlier examples above.
You can store state with a state variable (new in perl5.10), or with a variable scoped higher than the sub itself, as a closure:
use feature 'state';
sub baz
{
state $x;
return ++$x;
}
# create a new scope so that $y is not visible to other functions in this package
{
my $y;
sub quux
{
return ++$y;
}
}
Return a subroutine reference.
Here's a simple example that creates sub refs closed over a value:
my $add_5_to = add_x_to(5);
print $add_5_to->(7), "\n";
sub add_x_to {
my $x = shift;
return sub { my $value = shift; return $x + $value; };
}
You can also work with named subs like this:
sub op {
my $name = shift;
return $op eq 'add' ? \&add : sub {};
}
sub add {
my $l = shift;
my $r = shift;
return $l + $r;
}
You can use eval with an arbitrary string, but don't do it. The code is hard to read and it restarts compilation, which slows everything down. There are a small number of cases where string eval is the best tool for the job. Any time string eval seems like a good idea, you are almost certainly better off with another approach.
Almost anything you would like to do with string eval can be achieved with closures.
Returning subs is easy by using the sub keyword. The returned sub closes over the lexical variables it uses:
#!/usr/bin/perl
use strict; use warnings;
sub mk_count_from_to {
my ($from, $to) = #_;
return sub {
return if $from > $to;
return $from ++;
};
}
my $c = mk_count_from_to(-5, 5);
while ( defined( my $n = $c->() ) ) {
print "$n\n";
}
5.10 introduced state variables.
Executing text as Perl is accomplished using eval EXPR:
the return value of EXPR is parsed and executed as if it were a little Perl program. The value of the expression (which is itself determined within scalar context) is first parsed, and if there weren't any errors, executed in the lexical context of the current Perl program, so that any variable settings or subroutine and format definitions remain afterwards. Note that the value is parsed every time the eval executes
Executing arbitrary strings will open up huge gaping security holes.
You can create anonymous subroutines and access them via a reference; this reference can of course be assigned to a scalar:
my $subref = sub { ... code ... }
or returned from another subroutine
return sub { ... code ... }
If you need to store states, you can create closures with lexical variables defined in an outer scope like:
sub create_func {
my $state;
return sub { ... code that can refer to $state ... }
}
You can run code with eval