`eval { $constant_name }` gives the name, not the value - perl

I have defined several Perl constants like use constant LVL_FATAL => 1; (perl 5.18.2).
When trying to create a function that needs the name and the value of the constant, I tried:
my $level = eval { 'LVL_' . $_ };
When $_ is FATAL, then $level contains LVL_FATAL, but not the value of LVL_FATAL.
I also tried the variants eval { $level }, eval { ($level) }, eval { my x = $level }, and eval { print $level }.
They all use LVL_FATAL.
However when I use eval "$level", then I get 1.
Also when i use eval { LVL_FATAL } I get 1, too.
Can I use the block variant instead of the string variant for robustness and performance reasons?
Remark
Remembering that Perl constants are basically functions, I tried eval ${level}(), but that did not work; eval { $level->() } seemed to do the job in the debugger, but when I used it in my program code, it did not work, however.
(When not using eval, LVL_FATAL->() will give an error ("Undefined subroutine &main::1 ..."), but LVL_FATAL() is OK.)

eval BLOCK and eval EXPR are very different.
eval BLOCK catches exceptions thrown by the code in the block. It is known as try in some other languages.
eval EXPR compiles and executes the string returned by EXPR. (Exceptions are also caught.)
You want the latter.
my $level = eval("LVL_$_");
die $# if $#;
But since constants can be used as subs, you could also use
my $level = do { no strict qw( refs ); "LVL_$_"->() };
You could also call this "sub" as a method.
my $name = "LVL_$_";
my $level = __PACKAGE__->$name();
I prefer the second-last version because it makes it obvious that you are doing something weird and dangerous (and it doesn't pretend that a sub that isn't a method is a method).

The following seems to work:
my $level = eval { my $name = "LVL_$_"; __PACKAGE__->$name() };
According to the documentation :
Constants belong to the package they are defined in. [...]
Constants may be exported by modules, and
may also be called as either class or instance methods, that is, as
Some::Package->CONSTANT or as $obj->CONSTANT where $obj is an instance
of Some::Package. Subclasses may define their own constants to
override those in their base class.

Related

Perl :: Accessing Members of an Object with `use strict` Set?

I'm a Java/C/C#/python coder who is attempting his first Perl script, and I have what is prob a Perl OOO 101 question: What is the syntax to access an object's members when use strict is required?
Let me speak Java for a moment. I have this little program, all in one class file:
class Dude{
public String name;
public Dude(String name){
this.name = name;
}
public void IntroduceYourself(){
System.out.println("Hi, I'm "+this.name);
}
}
public toy(){
Dude fred = new Dude("Fred");
fred.IntroduceYourself();
}
Output on my Ubuntu machine:
me#ubuntu01:~/$ java toy
Hi, I'm Fred
me#ubuntu01:~/$
What could be simpler? I create a Dude object, then later call method Dude.IntroduceYourself(), which accesses a class member.
Okay: I have to do the exact same thing, but now in Perl (v5.26.1). Again, use strict; is required. Here's my miserable attempt:
#!/usr/bin/perl
use warnings;
use strict;
# Define a "Dude" class
package Dude;
sub new
{
my $class = shift;
my $self = {
_name => shift,
};
bless $self, $class;
return $self;
}
sub IntroduceYourself
{
print("Hi, I'm $object->{name}\n"); # Compilation Error here!
}
my $object = new Dude("Fred");
$object->IntroduceYourself();
Output on the same Ubuntu machine:
me#ubuntu01:~/$ ./toyPerl.pl
Global symbol "$Dude" requires explicit package name (did you forget to declare "my $Dude"?) at ./toyPerl.pl line 18.
Execution of ./toyPerl.pl aborted due to compilation errors.
me#ubuntu01:~/$
Ugh. I've been reading a few Perl tutorials, and I see examples on how to write that IntroduceYourself() subroutine, but none with use strict as a global directive. Can anyone see what I'm doing wrong?
Also: I'm really confused about what I'll call "member functions" in Perl. In my Java example, Dude.IntroduceYourself() was defined as a method of class Dude. I intend (if possible) for IntroduceYourself() to be a function of Object/Class Dude in the Perl code. But its unclear to me how to define that. Am I misunderstanding how Perl objects handle member functions? Thank you.
This doesn't have to do with OO, just Perl's normal strict behavior. strict forces you to declare variables, like in other languages. Without strict, undeclared objects are globals. $object is never declared, so it violates strict.
To solve this, $object must be declared. Perl's this is passed in as the first argument to a method. You need to get that argument. Perl calls this the "invocant". Typically it is called $self.
What is the syntax to access an object's members
Perl doesn't have object members like Java. A Perl object is just a reference. It doesn't even need to be a hash reference. $self->{key} is just using a hash reference, so the key has to match. $self->{_name} not $self->{name}.
sub IntroduceYourself {
# Get the invocant off the list of arguments.
my $self = shift;
# Use it as a hash reference with the correct key.
print("Hi, I'm $self->{_name}\n");
}
I intend (if possible) for IntroduceYourself() to be a function of Object/Class Dude in the Perl code. But its unclear to me how to define that.
You did it. A class is just a package. A method is just a subroutine in a package. The language does not make a distinction between subroutines and methods, nor between class and object methods. It's just how you use them.
#!/usr/bin/perl
use strict;
use warnings;
package Foo {
sub new {
my $class = shift;
my($name) = #_;
return bless { name => $name }, $class;
}
sub hello {
my $self = shift;
print "Hello my name is $self->{name}\n";
}
}
my $foo = Foo->new("Pete");
# Called as an object method.
$foo->hello;
# Called as a subroutine.
# It works, but don't do it; it bypasses inheritance.
Foo::hello($foo);
# Called as a class method.
# It "works", but since the method expects $self to be a
# reference, not a package name, $self->{name} is... it's complicated.
Foo->hello;
Perl's OO is extremely basic. You get classes (via packages), multiple-inheritance (via #ISA), and methods (via subroutines with the invocant passed in) and that's about it. No accessors, no public, no private, no members, not even this.
If you want that, you have to write it yourself, or use an existing library. If you want all the bells and whistles and a full marching band, install Moose.
...use strict as a global directive...
use strict is not global, it is local to the current scope. The current scope is the whole file, but you can put it in a block.
{
# strict is on in this block
use strict;
my $foo = 42;
print "$foo\n";
}
# strict is off everywhere else
$bar = 23;
print "$bar\n";
Things like strict and warnings are referred to as "pragmas".
See "What's the difference between dynamic and lexical (static) scoping? Between local() and my()?".
sub IntroduceYourself {
my $self = shift;
print( "Hi, I'm $self->{ _name }\n" );
}
See perlootut.
In OOP, the invocant (the value of the expression before the ./->) is passed to the method as an argument. In Java, this argument is made available as this. In Perl, this argument is made available as a leading parameter.
This means that
$o->foo( $x, $y )
is equivalent to
my $method = $o->can( 'foo' );
$method->( $o, $x, $y )
And the method looks like this:
sub foo {
my $self = shift;
my $x = shift;
my $y = shift;
$self->{ x } = $x;
$self->{ y } = $y;
}

How to create static variable in perl so that I can access in from another script

I have one script (A.pl) and one package (B.pm), I want to create a static variable in B.pm so that it can accessible to A.pl.
A.pl
use lib 'path/to/B_Package';
for loop 10 times {
fun(age);
}
if ($count>0) {
print "script fails";
}
B.pm
package B {
fun() {
my $age_given = shift;
my $count;
eval {
result = someFileHandling;
} or die {
$count++;
}
}
}
I'd question such design, and some alternatives are offered below.
But yes it can be done -- a variable declared as our can be accessed by its fully qualified name.
In the package file Pack.pm
package Pack;
use warnings;
use strict;
use Exporter qw(import);
our #EXPORT_OK = qw(func);
our $count = 7;
sub func { ++$count }
1;
and in its user
use warnings;
use strict;
use feature 'say';
use Pack qw(func);
for (1..2) {
func();
say "Current value of a global in 'Pack': ", $Pack::count;
}
$Pack::count = 123;
say "Current value of a global in 'Pack': ", $Pack::count;
So changes to $count made in Pack::func() are seen in the calling program. More to the point, $Pack::count can be directly written by any code in the interpreter.
The package globals that are meant to be used directly, like $count above,† are tricky creatures that can be hard to use sensibly but are very easy to end up abusing.
In general you don't want them: their use runs contrary to the critical idea of dividing software in components that communicate via clearly defined interface, they introduce uncontrolled coupling and thus defeat scope, etc. With such variables in use distinct components in the code get entangled.
But they can of course be useful and are used in libraries, mostly for constants and parameters.
Now, having them change as well? That can get out of control, and even though that, too, is used in libraries (to control their behavior by setting parameters) it veers closer to an analogue of a "God Class," an all-controlling entity. At that point I would flatly call it flawed and a trouble-maker.
Why not have subs handle the counting and return updated values? They can keep values using state pragma for instance. Or even using a file-scoped variable, as long as that is internal to its business and outsiders aren't allowed to poke at it.
Here's a sample for the two mentioned approaches in revised Pack.pm
package Pack;
use warnings;
use strict;
use feature qw(state);
use Exporter qw(import);
our #EXPORT_OK = qw(count func1 func2);
my $count = 7;
sub func1 { ++$count } # sets counter while doing its other work
sub count { # add check that input is numeric
$count += shift for #_; # Set count if values passed,
return $count; # return value in either case
}
sub func2 {
state $count = 0; # keeps count (its own $count)
return $count += shift // 1; # demo: add some and return
}
1;
Demo for its use:
use warnings;
use strict;
use feature 'say';
use Pack qw(count func1 func2);
say "Call func2(), using 'state' feature, with its own counter: ";
for (1..2) { say "func2($_): ", func2($_) }
say '';
say "Set value for a file-wide counter, retrieve using count(): ";
for (1..2) { func1() }
say "Count is: ", count();
say "Use count() to set values as well: ";
for (1..2) { say "For #$_: ", count($_) }
This prints
Call func2(), using 'state' feature, with its own counter:
func2(1): 1
func2(2): 3
Set value for a file-wide counter, retrieve using count():
Count is: 9
Use count() to set values as well:
With 1: 10
With 2: 12
The next step up is to make this a class, and then you can implement any and all kinds of counters in very natural ways.
For more on variables, see this post and this post and this Effective Perler article, for starters.
† An our variable is strictly speaking not a global, but a lexical that is aliased to a package variable (a "true" global) with the same name.
I think there's a better way to do what I'm guessing that you want to do. I think that you want to try something a certain number of times and give up if you can't acheive that goal.
When you call your subroutine, you want it to know how many times to try. Also, you want to know when it fails.
You don't need to share a variable for this. The die is going to take care of that for you. Call the sub as many times as you like, and each time you don't get back a value from eval, count that as an error:
my $errors = 0;
foreach ( 1 .. 10 ) {
my $result = eval { do_this($age) };
$errors++ unless defined $result;
}
print "Script fails" if $errors > 0;
In the subroutine, you don't need to worry about how many times this has been done because that's happening at the higher level for you. You look at the result of the subroutine to decide if it failed and adjust a counter at the higher level. Now the subroutine can focus on it's small part instead of thinking about why you are calling it. You also don't need the eval at this level because you already have it at the higher level.
sub do_this {
my( $age ) = #_;
... some file handling ...
}
Factories
But let's say that there is some good reason for a lower subroutine to know its count. I don't want to pollute that subroutine for everyone—suppose that 10 other places in the program also call this subroutine and they all fail. Should that count against your call? You probably don't want that. But, there's a way around this. You can create a new version of the subroutine when you need to. A factory is a subroutine that makes other subroutines.
Let's say you want to try something a certain number of times. But, you might want to do that multiple times too. Make a new subroutine every time that you want to try this. Tell that subroutine how many tries it gets:
sub some_factory {
my( $max_tries ) = #_;
sub anon_thingy {
my( $age ) = #_;
for ( 1 .. $max_tries ) {
... file handling ... or die ...
}
}
}
Your program would then look something like:
my $try_this = some_factory( 10 );
my $result = eval { $try_this->($age) };
print "Script fails" unless defined $result;
In the same program, you can do it again, and each generated code reference tracks its own use and doesn't bother other subs:
foreach $age ( list_of_ages() ) {
my $new_sub = some_factory( 10 );
my $result = eval { $new_sub->($age) };
print "Script fails" unless defined $result;
}
I spend quite a bit of time on this sort of stuff in Intermediate Perl and Mastering Perl.

Mojolicious: Can't call method "render" on an undefined value

I'm getting this error and cannot understand why this happens. It happens when I jump to another subroutine. Perhaps there is something I need to understand about Mojolicious on why this happens.
Here is the source code of my program:
#!/usr/bin/perl
use Mojolicious::Lite;
get '/' => sub { &start_home; };
app->start;
sub start_home {
my $d = shift;
my $something = $d->param('something');
### Do things with $something.... etc.. etc..
&go_somewhere_else; ### Go somewhere else
}
sub go_somewhere_else {
my $c = shift;
$c->render(text => "Hello World!");
### End of program
}
I am passing a value on to the renderer and there is a value - Why would it say it is undefined? My understanding is that this only happens if you jump to a subroutine and try to render output.
My operating system is Windows and I am using Strawberry Perl.
You need to pass the context object $c/$d to your second function. The undefined value is your $c in go_somewhere_else, because you call it without a parameter.
Initially, to make it work, do this.
sub start_home {
my $d = shift;
my $something = $d->param('something');
go_somewhere_else($d);
}
You are now passing the context, which you named $d (that's not the conventional name), to the other function, and the warning will go away.
That's because the form &subname; without parenthesis () makes #_ (that's the list of arguments to the function) available inside of go_somewhere_else, but because you shifted $d off, #_ is now empty, and hence your $c inside go_somewhere_else is undef.
Alternatively, you could also change the shift to an assignment with #_. But please, don't do that!
sub start_home {
my ( $d ) = #_;
my $something = $d->param('something');
&go_somewhere_else;
}
There are more things odd to the point of almost wrong here.
get '/' => sub { &start_home; };
You are currying the the start_home function, but you are not actually adding another parameter. I explained above why this works. But it's not great. In fact, it's confusing and complicated.
Instead, you should use a code reference for the route.
get '/' => \&start_home;
Inside of start_home, you should call your context $c as is the convention. You should also not use the ampersand & notation for calling functions. That changes the behavior in a way you most certainly do not want.
sub start_home {
my $c = shift;
my $something = $c->param('something');
# ...
go_somewhere_else($c);
}
To learn more about how function calls work in Perl, refer to perlsub.

Check if a subroutine is being used as an lvalue or an rvalue in Perl

I'm writing some code where I am using a subroutine as both an lvalue and an rvalue to read and write database values. The problem is, I want it to react differently based on whether it is being used as an lvalue or an rvalue.
I want the subroutine to write to the database when it is used as an lvalue, and read from the database when it is used as an rvalue.
Example:
# Write some data
$database->record_name($subscript) = $value;
# Read some data
my $value = $database->record_name($subscript);
The only way I can think of the make this work is to find a way for the subroutine to recognize whether it is being used as an lvalue or an rvalue and react differently for each case.
Is there a way to do this?
Deciding how to behave on whether it was called as an lvalue or not is a bad idea since foo(record_name(...)) would call it as an lvalue.
Instead, you should decide how to behave on whether it is used as an lvalue or not.
You can do that by returning a magical value.
use Variable::Magic qw( cast wizard );
my $wiz = wizard(
data => sub { shift; \#_ },
get => sub { my ($ref, $args) = #_; $$ref = get_record_name(#$args); },
set => sub { my ($ref, $args) = #_; set_record_name(#$args, $$ref); },
);
sub record_name :lvalue {
cast(my $rv, $wiz, #_);
return $rv;
}
A little test:
use Data::Dumper;
sub get_record_name { print("get: #_\n"); return "val"; }
sub set_record_name { print("set: #_\n"); }
my $x = record_name("abc", "def"); # Called as rvalue
record_name("abc", "def") = "xyz"; # Called as lvalue. Used as lvalue.
my $y_ref = \record_name("abc", "def"); # Called as lvalue.
my $y = $$y_ref; # Used as rvalue.
$$y_ref = "xyz"; # Used as lvalue.
Output:
get: abc def
set: abc def xyz
get: abc def
set: abc def xyz
After seeing this, you've surely learned that you should abandon the idea of using an lvalue sub. It's possible to hide all that complexity (such as by using sentinel), but the complexity remains. The fanciness is not worth all the complexity. Use separate setters and getters or use an accessor whose role is based on the number of parameters passed to it ($s=acc(); vs acc($s)) instead.
For this situation you might like to try my Sentinel module.
It provides a function you can use in the accessor, to turn it into a more get/set style approach. E.g. you could
use Sentinel qw( sentinel );
sub get_record_name { ... }
sub set_record_name { ... }
sub record_name
{
sentinel get => \&get_record_name,
set => \&set_record_name,
obj => shift;
}
At this point, the following pairs of lines of code are equivalent
$name = $record->record_name;
$name = $record->get_record_name;
$record->record_name = $new_name;
$record->set_record_name( $new_name );
Of course, if you're not needing to provide the specific get_ and set_ prefixed versions of the methods as well, you could inline them as closures.
See the module docs also for further ideas.
In my opinion, lvalue subroutines in Perl were a dumb idea. Just support ->record_name($subscript, $value) as a setter and ->record_name($subscript) as a getter.
That said, you can use the Want module, like this
use Want;
sub record_name:lvalue {
if ( want('LVALUE') ) {
...
}
else {
...
}
}
though that will also treat this as an LVALUE:
foo( $database->record_name($subscript) );
If you want only assignment statements to be treated specially, use want('ASSIGN') instead.

Is it possible to safely access data in a nested data structure like Template Toolkit does?

Is there a module that provides functionality like Template Toolkit does when accessing a deeply nested data structure? I want to pull out something like $a = $hash{first}[0]{second}{third}[3] without having to test each part of the structure to see if it conforms to what I expect. If %hash = {} I want $a = undef, not produce an error.
Perl will do exactly what you described
This feature is called autovivification. Which means that container objects will spring into existence as soon as you use them. This holds as long as you don't violate any precedent you set yourself.
For example, trying to dereference something as a hash when you have already used it as an array reference is an error. More generally, if the value is defined, it can only be dereferenced as a particular type if it contains a reference to that type.
If you want protection against misuse as well, you can wrap the nested lookup in an eval block:
my $x = eval{ $hash{first}[0]{second}{third}[3] };
This will return undef if the eval fails. Note that this is NOT a string eval, which would be written eval '....';. In block form, Perl's eval is like the try {...} construct in other languages.
To determine if the eval failed or if the value in that position really is undef, test to see if the special variable $# is true. If so, the eval failed, and the reason will be in $#. That would be written:
my $x = eval{ $hash{first}[0]{second}{third}[3] };
if (!$x and $#) { die "nested dereference failed: $#" }
Or you can use the module Try::Tiny which abstracts away the implementation details and protects against a few edge cases:
use Try::Tiny;
my $x;
try {
$x = $hash{first}[0]{second}{third}[3];
} catch {
die "nested dereference failed: $_";
};
Your error likely comes from wrong level of indirection, not because you don't have a value.
Note that your hash variable is a scalar reference to hash, not a hash. So it should be defined as $hash = {}, not %hash = {}. Then, you access the elements there as $hash->{first}, not $hash{first}. And so on. If you define hash properly and try something like $hash->{first}->[0]->{second}->{third}->[3], you will get exactly undef, as you wanted, no errors.
Note: always use strict!
Check out Data::Diver.
You can access an arbitrary nested structure by key name (it doesn't matter if a layer is a hash or array). The Dive() subroutine will return an empty list if there is an error or it will return a matching value.
use strict;
use warnings;
use Data::Diver qw( Dive );
my $a = Dive( \%hash, 'first', 0, 'second', 'third', 3 );
if( defined $a ) {
print "Got '$a'.\n";
}
else {
print "Got no match.\n";
}
Something like this?
use strict;
use warnings;
my %hash;
my $elem = _eval( '$hash{first}[0]{second}{third}[3]' );
sub _eval {return (eval shift) // undef}
Of course you might as well do:
my $elem = eval {$hash{first}[0]{second}{third}[3] // undef};