Pass variables around the around method modifier - perl

Is it possible to pass variables between multiple calls to the around MethodModier? example (that doesn't work but hopefully conveys what I want to do)
sub mysub { ... };
around 'mysub' => sub {
my $orig = shift;
my $self = shift;
my $value = get_value;
$self->orig(#_);
};
around 'mysub' => sub {
my $orig = shift;
my $self = shift;
my $value = shift;
my $output
= "sometext $value"
. $self->orig(#_);
. 'someothertext $value'
;
};
I'd eventually like to have these 'arounds' placed in pluggable traits, where I won't really know which ones are loaded beforehand but the final output will be neatly formatted.
It's possible that I'm thinking about this completely wrong, so other suggestions welcome.

What you are trying to do don't have logic.
"An around modifier receives the
original method as its first argument,
then the object, and finally any
arguments passed to the method."
https://metacpan.org/pod/Moose::Manual::MethodModifiers#BEFORE-AFTER-AND-AROUND

Use an instance variable:
$self->{value} = get_value;
...
my $value = $self->{value};
(See question commments for an actual answer. I'm just reiterating it here, so I can accept an answer, thanks to:
)

Related

What happens if you call shift inside an anonymous sub?

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).

perl -- call method from hash

I have a hash table of methods:
my %makefileMacroSimplifiers = (
"or" => \&makefileSimplifyOr,
"and" => \&makefileSimplifyAnd,
"strip" => \&makefileSimplifyStrip,
);
sub makefileSimplifyStrip {
my $self = shift;
my $prefix = shift;
my $paramsRef = shift;
...
}
where each method requires $self. What I have is:
$makefileMacroSimplifiers{$macroName}->($self, $macroName.$ws1, \#parms);
This seems to work, but it seems a bit odd to me to explicitly pass in $self to a method. Is there a better way of doing this, or is this considered a normal coding practice? (I didn't find any better ways to do this on the web, but I thought I would ask in case I'm not using the right search criteria).
You can also call a code ref on an object. That way the thing on the left will be passed in.
my $coderef = sub { ... };
$self->$coderef(#args);
Using a hash element does not work like this.
$self->$dispatch{foo}(1, 2, 3); # BOOM
This is a syntax error. So you need to grab the code reference first. Borodin also explains this above in their comment.
my %dispatch = (
foo => sub { print "#_" },
);
require HTTP::Request;
my $obj = HTTP::Request->new;
my $method = $dispatch{foo};
$obj->$method(1, 2, 3);
I've used HTTP::Request here as an example of an arbitrary class/object.

Strict vs non-strict: Which instance of a named variable gets used?

I am trying to find the problem and propose a solution for the following Perl code.
A file without strict nor warnings on it has a function that uses a $variable without declaring it. So that variable is global to the file and the changes for that variable in this specific function are used outside of it (since it is global for the file).
Due to a recent update, this old_file now requires a modified version of itself (new_file) in which the same function is defined. But this new version has strict and warnings, so the same variable is defined, but this time as 'my' in the new function, and is returned in the end.
The tricky thing is that the code in the old_file did not change so it still expects the variable to be changed as its own global variable.
Since I don't know Perl well enough to be able to determine which version of this function is used (and since I can't test it, due to IT restrictions) I need an explanation of the behavior, possibly a link to a good paper about that topic.
Code: (I think the problem is in the variable LISTEREPONSE from the function start_handler.)
old_file:
use XML::Parser;
my $parser = new XML::Parser( ErrorContext => 2 );
$parser->setHandlers(
Start => \&start_handler,
End => \&end_handler,
Char => \&char_handler
);
$parser->parse(<$remote>);
close $remote;
...
sub start_handler {
my $expat = shift;
my $element = shift;
print;
while (#_) {
my $att = shift;
my $val = shift;
$LISTEREPONSE .= "$att=$val&";
}
}
new_file:
sub start_handler {
my $expat = shift;
my $element = shift;
print;
my $LISTEREPONSE;
while (#_) {
my $att = shift;
my $val = shift;
$LISTEREPONSE .= "$att=$val&";
}
return $LISTEREPONSE;
}
In strict mode, if you need $LISTEREPONSE become a global variable in package(file) scope.
Just declare (my $LISTEREPONSE;) in the beginning of file (after use).
In second case, $LISTEREPONSE is declare in sub, it's lexical scope and only available in sub.
my $LISTEREPONSE;
# ...
sub some_sub {
$LISTEREPONSE .= $some_stuff;
}

In Perl, how can a subroutine get a coderef that points to itself?

For learning purposes, I am toying around with the idea of building
event-driven programs in Perl and noticed that it might be nice if a
subroutine that was registered as an event handler could, on failure,
just schedule another call to itself for a later time. So far, I have
come up with something like this:
my $cb;
my $try = 3;
$cb = sub {
my $rc = do_stuff();
if (!$rc && --$try) {
schedule_event($cb, 10); # schedule $cb to be called in 10 seconds
} else {
do_other_stuff;
}
};
schedule_event($cb, 0); # schedule initial call to $cb to be performed ASAP
Is there a way that code inside the sub can access the coderef to that
sub so I could do without using an extra variable? I'd like to
schedule the initial call like this.
schedule_event( sub { ... }, 0);
I first thought of using caller(0)[3], but this only gives me a
function name, (__ANON__ if there's no name), not a code reference
that has a pad attached to it.
__SUB__ has been added in 5.16, providing this usability.
I think Sub::Current will fix your problem.
To get a reference to the current subroutine without using an extra variable, you can use a tool from functional programming, the Y-combinator, which basically abstracts away the process of creating the closure. Here is a perlish version:
use Scalar::Util qw/weaken/;
sub Y (&) {
my ($code, $self, $return) = shift;
$return = $self = sub {$code->($self, #_)};
weaken $self; # prevent a circular reference that will leak memory
$return;
}
schedule_event( Y { my $self = shift; ... }, 0);
If you don't change $cb's value again, you can use that. If not, define a scalar to hold that and don't change it ever again. For example:
my $cb = do {
my $sub;
$sub = sub { contents using $sub here }
}
Using a fixed-point combinator, you can write your $cb function as if the first argument was the function itself:
sub U {
my $f = shift;
sub { $f->($f, #_) }
}
my $cb = sub {
my $cb = shift;
...
schedule_event(U($cb), 10);
...
}
schedule_event(U($cb), 0);

Can I overload Perl's =? (And a problem while use Tie)

I choose to use tie and find this:
package Galaxy::IO::INI;
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {']' => []}; # ini section can never be ']'
tie %{$self},'INIHash';
return bless $self, $class;
}
package INIHash;
use Carp;
require Tie::Hash;
#INIHash::ISA = qw(Tie::StdHash);
sub STORE {
#$_[0]->{$_[1]} = $_[2];
push #{$_[0]->{']'}},$_[1] unless exists $_[0]->{$_[1]};
for (keys %{$_[2]}) {
next if $_ eq '=';
push #{$_[0]->{$_[1]}->{'='}},$_ unless exists $_[0]->{$_[1]}->{$_};
$_[0]->{$_[1]}->{$_}=$_[2]->{$_};
}
$_[0]->{$_[1]}->{'='};
}
if I remove the last "$[0]->{$[1]}->{'='};", it does not work correctly.
Why ?
I know a return value is required. But "$[0]->{$[1]};" cannot work correctly either, and $[0]->{$[1]}->{'='} is not the whole thing.
Old post:
I am write a package in Perl for parsing INI files.
Just something based on Config::Tiny.
I want to keep the order of sections & keys, so I use extra array to store the order.
But when I use " $Config->{newsection} = { this => 'that' }; # Add a section ", I need to overload '=' so that "newsection" and "this" can be pushed in the array.
Is this possible to make "$Config->{newsection} = { this => 'that' };" work without influence other parts ?
Part of the code is:
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {']' => []}; # ini section can never be ']'
return bless $self, $class;
}
sub read_string {
if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
$self->{$ns = $1} ||= {'=' => []}; # ini key can never be '='
push #{$$self{']'}},$ns;
next;
}
if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
push #{$$self{$ns}{'='}},$1 unless defined $$self{$ns}{$1};
$self->{$ns}->{$1} = $2;
next;
}
}
sub write_string {
my $self = shift;
my $contents = '';
foreach my $section (#{$$self{']'}}) {
}}
Special Symbols for Overload
lists the behaviour of Perl overloading for '='.
The value for "=" is a reference to a function with three arguments, i.e., it looks like the other values in use overload. However, it does not overload the Perl assignment operator. This would go against Camel hair.
So you will probably need to rethink your approach.
This is not exactly JUST operator overloading, but if you absolutely need this functionality, you can try a perl tie:
http://perldoc.perl.org/functions/tie.html
Do you know about Config::IniFiles? You might consider that before you go off and reinvent it. With some proper subclassing, you can add ordering to it.
Also, I think you have the wrong interface. You're exposing the internal structure of your object and modifying it through magical assignments. Using methods would make your life much easier.