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.
Related
I have the following Perl code:
sub merge_xml {
foreach my $repository ('repo1', 'repo2') {
my #xml_files;
sub match_xml {
my $filename = $File::Find::dir . '/' . $_;
if ($filename =~ m%/(main|test)\.xml$%) {
push(#xml_files, $filename);
}
}
find(\&match_xml, $repository);
print Dumper(\#xml_files);
}
}
And I am getting the warning:
Variable "#xml_files" will not stay shared at ./script/src/repair.pl line 87.
How does one fix this?
PS find as in File::Find
"Nested" named subs in fact aren't -- they're compiled as separate subroutines, and so having them written as "nested" can only be misleading.
Further, this creates a problem since the "inner" subroutine supposedly closes over the variable #xml_files that it uses, which gets redefined on each new call, being lexical. But the sub, built at compile-time and not being a lexical closure, only keeps the refernce to the value at first call and so it works right only upon the first call to the outer sub (merge_xml here).
We do get the warning though. With use diagnostics; (or see it in perldiag)
Variable "$x" will not stay shared at -e line 1 (#1)
(W closure) An inner (nested) named subroutine is referencing a
lexical variable defined in an outer named subroutine.
When the inner subroutine is called, it will see the value of
the outer subroutine's variable as it was before and during the first
call to the outer subroutine; in this case, after the first call to the
outer subroutine is complete, the inner and outer subroutines will no
longer share a common value for the variable. In other words, the
variable will no longer be shared.
This problem can usually be solved by making the inner subroutine
anonymous, using the sub {} syntax. When inner anonymous subs that
reference variables in outer subroutines are created, they
are automatically rebound to the current values of such variables.
So pull out that "inner" sub (match_xml) and use it normally from the "outer" one (merge_xml). In general you'd pass the reference to the array (#xml_files) to it; or, since in this case one cannot pass to File::Find's find, can have the array in such scope so to be seen as needed.
Or, since the purpose of match_xml is to be find's "wanted" function, can use an anonymous sub for that purpose so there is no need for a separate named sub
find( sub { ... }, #dirs );
Or store that coderef in a variable, as shown in Ed Heal's answer
my $wanted_coderef = sub { ... };
find( $wanted_coderef, #dirs );
With help from zdim I came up with:
sub merge_xml {
foreach my $repository ('repo1', 'repo2') {
my #xml_files;
my match_xml = sub {
my $filename = $File::Find::dir . '/' . $_;
if ($filename =~ m%/(main|test)\.xml$%) {
push(#xml_files, $filename);
}
};
find($match_xml, $repository);
print Dumper(\#xml_files);
}
}
Might I suggest another alternative. By using a factory function, you can eliminate the need to hand write a find subroutine each time.
A factory is a function that generates another function (or subroutine in this case). You feed it some parameters and it creates a custom subroutine with those parameters bolted in. My example uses a closure but you could also build it with a string eval if the closure is costly for some reason.
sub match_factory {
my ($filespec, $array) = #_;
# Validate arguments
die qq{File spec must be a regex, not "$filespec"\n}
unless ref $filespec eq "Regexp";
die qq{Second argument must be an array reference, not "$array"\n}
unless ref $array eq "ARRAY";
# Generate an anonymous sub to perform the match check
# that creates a closure on $filespec and $array
my $matcher = sub {
# Automatically compare against $_
m/$filespec/ and
push(#$array, $File::Find::name);
};
return $matcher;
}
sub merge_xml {
my #repos = #_ # or qw/foo bar .../;
foreach my $repository (#repos) {
my #matched_files;
find(
match_factory( qr/\/(main|test)\.xml$/, \#matched_files ),
$repository
);
print Dumper(\#matched_files);
}
}
HTH
First off, apologies if this question is ill-posed; I don't actually know a heck of a lot of perl.
I'm trying to debug some existing code that is supposed to send grades from our online homework system called WeBWorK to an LMS. I'm running into a weird error where I think something isn't getting initialized right, or perhaps isn't the right class. I suspect that the problem might be here:
sub go {
my $self = shift;
my $r = $self->r;
my $ce = $r->ce;
# If grades are begin passed back to the lti then we peroidically
# update all of the grades because things can get out of sync if
# instructors add or modify sets.
if ($ce->{LTIGradeMode}) {
my $grader = WeBWorK::Authen::LTIAdvanced::SubmitGrade->new($r);
my $post_connection_action = sub {
my $grader = shift;
# catch exceptions generated during the sending process
my $result_message = eval { $grader->mass_update() };
if ($#) {
# add the die message to the result message
$result_message .= "An error occurred while trying to update grades via LTI.\n"
. "The error message is:\n\n$#\n\n";
# and also write it to the apache log
$r->log->error("An error occurred while trying to update grades via LTI: $#\n");
}
};
if (MP2) {
$r->connection->pool->cleanup_register($post_connection_action, $grader);
} else {
$r->post_connection($post_connection_action, $grader);
}
}
... # a bunch of other stuff happens in the "go" sub
I kinda suspect that the issue is with the $grader variable; in particular, I don't know what my $grader = shift; does inside an anonymous sub. Like, if the sub had a name, it would be more clear that shift is giving the first argument passed to the sub. But since it's anonymous, I don't know what it thinks its arguments are.
Further, I'm not really sure why that line is needed at all. Like, from my googling, I'm given to understand that the point of an anonymous sub is to keep all the variables from the surrounding environment in scope. So why do we need to redefine $grader inside the anonymous sub in the first place?
Thanks for helping a perl noob out! :)
There's nothing special about anon subs in this regard.
my $cr = sub {
my $arg = shift;
say $arg;
};
$cr->("foo"); # Prints "foo"
$cr->("bar"); # Prints "bar"
In your case, you pass $post_connection_action and $grader to cleanup_register or post_connection with the expectation that it will result in a call to &$post_connection_action with $grader as its first argument. Whether the expectation is correct or not depends on the implementation of cleanup_register and post_connection, of which I know nothing.
Note that another solution presents itself here. Subs have access to the lexicals that were in scope when the sub operator was evaluated.
my $prefix = "> ";
my $cr = sub {
my $arg = shift;
say "$prefix$arg"; # Captures $prefix from sub{} scope.
};
$cr->("foo"); # Prints "> foo"
The above is true even if captured lexicals would otherwise no longer exist by the time the sub is called.
my $cr;
{
my $prefix = "> ";
$cr = sub {
my $arg = shift;
say "$prefix$arg"; # Captures $prefix from sub{} scope.
};
} # $prefix would normally stop existing here.
$cr->("foo"); # Prints "> foo"
That means you don't need to pass $grader as an argument. It can simply be captured. Just leave out my $grader = shift; (and don't pass $grader to
cleanup_register or post_connection).
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.
Hello I am trying to understand Perl better. I come from Ruby and trying to wrap my head around Perl for fun. Let's say I have this code block here.
$self->doSomething(
{ record => $record,
listing => [ $foo, $bar, $baz ],
passedargs => { something => $val, another => $val2 },
}
);
What exactly is defined as $args? My thought process from reading Perl docs is something like my ($self, $args) = #_; Meaning everything within the doSomething block is considered $args and if I wanted to access it. I would my $args = #_[0];
Just curious if I am thinking about this correctly? if not care to explain?
Since you are invoking doSomething as a method call, the first argument will be the object you are calling the method on (i.e. that which is on the left hand side of the arrow operator: $self).
The second argument will be the hashref you are passing between the ( and the ).
You access a particular member of the hashref just as you would for any other hashref.
sub doSomething {
my ($self, $args) = #_;
my $record = $args->{record};
I'm a bit messed up with the following:
I have a function that calls subroutines in the following way:
sub someFunction {
my $self = shift;
my $type = $self->{'type'};
if($type eq 'one_subroutine') {
$self->updateOneSubroutine();
}
elsif($type eq 'another_one_sub') {
$self->updateAnotherOneSub();
}
(...)
else {
die "Unsupported '$type'";
}
I have to change this to let each subroutine be coded in its own file, include all available files, and automagically call the subroutine inside.
I did this in a test file with the following code:
# Assume a routines subdir with one_subroutine.pm file with
sub updateOneSubroutine(){
$self = shift;
$self->doSomeThings();
(...) #my code
}
1;
test.pl
# Saves in routines hash_ref a pair of file_name => subRoutineName for each file in routines subdir.
# This will be used later to call subroutine.
opendir(DIR,"lib/routines") or die "routines directory not found";
for my $filename (readdir(DIR)) {
if($filename=~m/\.pm$/){
# includes file
require "lib/routines/$filename";
# get rid of file extension
$filename=~s/(.*)\.pm/$1/g;
my $subroutine = "update_${file}";
# camelizes the subroutine name
$subroutine=~s/_([a-z0-9])/\u$1/g;
$routine->{ $filename } = $subroutine;
}
}
{
no strict "refs";
$routine->{$param}();
}
where param is something like "one_subroutine", that matches with a filename available.
Since each subroutine receives $self in the call, I should call the routine by $self->something();
I've tried $self->$routine->{$param}() , $self->${routine->${param}}() and many other things without success. I've checked chapter 9 "dynamic subroutines" of mastering perl, and a similar question to perl monks, but I can't still figure out how to reference the subroutine in a way that represents $self->updateAnotherOneSub() , or something similar that lets $self be read as a param in those subroutines.
Thanks in advance, Keber.
This seems a bit like an X/Y problem. What exactly are you trying to do? If it is to reduce loading time, then modules like AutoSplit/AutoLoader might be of interest to you.
If it is to create some sort of data structure of subroutines, you should be installing anonymous subs into a hash, rather than giving them all names.
Given a subroutine reference:
my $code = sub {...};
you would call it as:
$self->$code(...);
If instead you have a subroutine name, you can lookup the coderef:
my $code = 'Package::With::The::Subroutines'->can('method_name');
and if that succeeds (check it), then you can use $self->$code(...) to call it.
Given this code:
{
no strict "refs";
$routine->{$param}();
}
You would pass $self to the routine with:
{
no strict "refs";
$routine->{$param}($self);
}
Or you could approach it the way I did above with can:
'package'->can($routine->{$param})->($self)
if you don't want to turn off strict 'refs'
Try to extract the method name first, then it should work. I did a small test script that may do something like you want to, so:
my $method = $routine->{$param};
$self->$method->();
You can and of course should check, if the desired method exists like Eric said:
if ($self->can($method)) {
$self->$method->();
}
The important part here is, that you extract the method name so you have it in a single variable; otherwise perl won't figure that out for you - and as far as I know there is no way of setting parens or braces to do so.