Given a CODE ref, is it possible to:
Access the parse tree of that CODE ref
Create a new CODE ref by specifying the parse tree of the CODE ref which can contain elements of the parse tree returned in 1
Normally we create subroutines in perl by specifying source code which is then parsed and converted into a parse tree.
I would like to write a perl function which can create a subroutine by specifying its parse tree, and that parse tree could be derived from another parse tree of some other subroutine.
Possible?
I don't know the full answer to your question, but I know that Data::Dumper can deparse a code reference. Looking at its documentation, I see that it uses B::Deparse to do the heavy lifting (the B:: modules are the ones that interact with the compiler). Unfortunately it seems that this only results in a textual representation of the coderef.
Instead I searched for Op on metacpan and got many more interesting possibilities. Since I am now far out of my depth in the deepest Perl magic, I will leave it to you to look over those results. Perhaps something will be useful.
This has nothing to do with opcodes, but it does enclose the same two variables in three different closures. The variables are enclosed within subroutines reminiscent of class get/set routines, and those closed vars are then shared by other closures via their access routine.
This is a response to the comment: I'm sure it will be necessary to access the underlying nodes in the parse tree so that I can create new closures which are closed over the same variables.
use strict;
use warnings;
use v5.14;
# create closed vars
my $v1 = access_closure(6);
my $v2 = access_closure(42);
# play with them
say "v1 ", &$v1;
say "v2 ", &$v2;
say "v1 ", &$v1(5);
say "v2 ", &$v2(43);
say "v1 ", &$v1;
say "v2 ", &$v2;
# create silly closures that use them
my $test1 = test_closure(2);
my $test2 = test_closure(17);
my $test3 = test_closure(50);
# play with those
&$test1;
&$test2;
&$test3;
# create the get/set routine for a closed var
sub access_closure {
my $val = shift;
return sub {
$val = shift if #_;
return $val;
}
}
# create a silly closure that encloses a control var and uses the two other vars
sub test_closure {
my $val = shift;
return sub {
say "\nval is $val";
printf "v1 is %2d, v2 is %2d\n",
&$v1, &$v2;
if (&$v1 < $val) {
say "Increment v1";
&$v1(&$v1+1);
}
if (&$v2 > $val) {
say "Decrement v2";
&$v2(&$v2-1);
}
printf "v1 is %2d, v2 is %2d\n",
&$v1, &$v2;
}
}
Related
In visudo Ubuntu I whitelist this program (I doing this way for security purpose, parameterized all commands)
myuser ALL=(root) NOPASSWD:/App/Filter_Parameters_Wrap.pm *
In program.pl
my $capture = qx("/usr/bin/sudo /App/Filter_Parameters_Wrap.pm kernel_version");
In the module Filter_Parameters_Wrap:
my $fuction = $ARGV[0];
print filters_dispatch($fuction) if defined $fuction;
sub filters_dispatch {
my $filter = shift;
my $dispatch = {
kernel_version => \&filter_kernel_version,
};
return $dispatch->{$filter}->();
}
sub filter_kernel_version {
my $command = '/bin/uname -a';
my $sudo = App::Sudo::Main_Sudo->root($command);
utf8::decode($sudo);
return $sudo;
}
This approach is working , but I have to do print in print filters_dispatch (print directly a variable string), so I can get the output of return of function filter_kernel_version in the variable $capture
In some cases inside the function filter_kernel_version I want to create a hash and return as anonymous hash without print directly, but this way is not working
can you recommend a better approach?
No matter what option you use to communicate between processes, you'll be limited to sending a sequence of bytes. This means that you will need to serialize your hash somehow. Encoding it using JSON (e.g. using Cpanel::JSON::XS) might be a simple way of doing that.
I am getting a warning as:
Use of uninitialized value in numeric eq (==) at script.pl line 53; line 53 isif statement`
My code snippet:
foreach(#array)
{
push #gene2refseq, $_;
}
foreach(#::ids)
{
if($_ == $gene2refseq[1])
{
push #::prot_gi, $gene2refseq[6];
}
}
Now if I declare $gene2refseq[1] before foreach(#::ids) the same error persists; but if I initialize it before foreach(#::ids) viz. $gene2refseq[1] = 0 it didn't give the error but also no results; as the value is initialized to 0.
I think I am initializing it at a wrong place, but then where have I to initialize it? As I can't initialize it before or in foreach(#array)
Disclaimer: I am not very good with use warnings and use strict
Edit: Solved
Thanks for the help; I just declared the #gene2refseq and initialized $gene2refseq[1] = 0 before the foreach(#array), and it worked fine.
Also thanks for correcting me on foreach usage.
A question:
What if I have to access multiple indexes of an array? Do I have to initialize them all? As here I need to access only a single index, so I initialized it.
If #gene2refeq is empty and #array is empty before the start of that code snippet, then #gene2refeq will be empty by line 53.
To find out, print the contents of #array and #gene2refeq. It's also possible #::ids contains uninitialized values, check that too. Add a separator so you can see what's in them.
print "\#array is ".join(", ", #array)."\n";
print "\#gene2refeq is ".join(", ", #gene2refeq)."\n";
print "\#::ids is ".join(", ", #::ids)."\n";
As to your question about when to initialize things, there's a difference between declaring a variable and initializing it. my and our declare a variable to exist lexically and globally respectively. Then you can populate (initialize) it.
The basic pattern of your program might look something like this.
my #ids;
...code to populate #ids...
my #gene2refeq;
...code to populate #gene2refeq...
my #array;
...code to populate #array...
push #gene2refeq, #array;
die "\#gene2refeq is not long enough, ".join(", ", #gene2refeq)
unless #gene2refeq >= 7;
my #prot_gi;
foreach my $id (#ids) {
if($id == $gene2refseq[1])
{
push #prot_gi, $gene2refseq[6];
}
}
A few other points. That first foreach loop is better written as simply...
push #gene2refseq, #array;
Using #::ids and #::prot_gi is odd. That's shorthand for getting the global variable #ids in the main package. It shouldn't be necessary and smells like cargo culting.
Just wanted to know what was the best way to reserve the value of a variable across multiple calls to the same subroutine . i.e
$someList = &someRoutine(100, 200);
$someList2 = &someRoutine(100, 200);
sub someRoutine {
$someAddition = 0;
foreach $someSum (#_){
$someAddition += $someSum;
}
return $someAddition
}
print $someList;
print $someList2;
Basically, someList should print 300 and someList2 should print 600. How do i make it so that someList2 prints 600? i want $someAddition to be preserved across multiple subroutine calls.
There are several ways to do it. I'll demonstrate two of them:
First, in modern versions of Perl you can use state:
use feature qw/state/;
print someRoutine(100,200), "\n";
print someRoutine(100,200), "\n";
sub someRoutine {
state $someAddition = 0;
foreach my $someSum ( #_ ) {
$someAddition += $someSum;
}
return $someAddition;
}
In this version, the $someAddition variable will be initialized to zero once, and only once. From that point on, the value will be retained between calls.
Another version is using a lexical closure. Here's an example:
my $summer = makeSummer();
print $summer->(100,200), "\n";
print $summer->(100,200), "\n";
sub makeSummer {
my $someAddition = 0;
return sub {
$someAddition += $_ foreach #_;
return $someAddition;
}
}
The second version is a little more complex, but has two advantages. First, you can start a fresh summation simply by calling the makeSummer routine to manufacture a new closure. Second, it will work on any version of Perl 5, not just versions recent enough to have the newer state keyword.
If you are not concerned with initializing the stateful variable before the sub is declared, you can also do this:
my $someAddition;
sub someRoutine {
$someAddition = 0 unless defined $someAddition;
foreach my $someSum( #_ ) {
$someAddition += $someSum;
}
return $someAddition;
}
A fourth method makes use of package globals. I save this one for last because it's the most prone to abuse and mistakes. But here you go;
our $someAddition = 0;
someRoutine(100,200);
print "$someAddition\n";
someRoutine(100,200);
print "$someAddition\n";
sub someRoutine {
$someAddition += $_ foreach #_;
}
In this last version, $someAddition is a package global, and its global scope makes it available both inside and outside of any subroutines living within the same namespace.
I assume you're at least using a variant of Perl 5? It has been bad practice to use ampersands & on subroutine calls since the first version of Perl 5 twenty-two years ago.
It is also vital that you use strict and use warnings at the top of every Perl program, and declare your variables ay their first point of use with my. It is a measure that will uncover many simple coding errors that you can otherwise easily overlook.
Perl variable names should use only lower-case letters, digits, and underscores. Capital letters are reserved for global identifiers such as package names.
By far the simplest and most common way of creating a static variable is just to declare it outside the subroutine. Like this
use strict;
use warnings;
my $some_list = some_routine(100, 200);
my $some_list2 = some_routine(100, 200);
my $some_addition;
sub some_routine {
$some_addition += $_ for #_;
return $some_addition
}
print $some_list, "\n";
print $some_list2, "\n";
output
300
600
If you want to protect the variable from being accessed by any following code other than the subroutine, then just enclose them in braces, like this
{
my $some_addition;
sub some_routine {
$some_addition += $_ for #_;
return $some_addition
}
}
Take a look at Persistent Private Variables in "man perlsub".
I am trying to piece together other scripts i have seen to be able to loop through a list of users on the channel.
Here is what i have come up with
my $channel = #_;
foreach my $nick ($channel->nicks()) {
$server->command("msg $chatchannel $nick->{nick}");
}
But all i get from that is
Can't call method "nicks" without a package or object reference at
/root/.irssi/scripts/test.pl line 64.
which is referring to
$channel->nicks()
Am i going about this the wrong way? or should this be working? I have seen many other scripts using $channel->nicks() so i know it must work?
Edit
I should also mention that this is already define further up in the code
my ($server, $msg, $target, $channel, $chatnet) = #_;
But when i try it with that $channel variable i get
Can't locate object method "nicks" via package
"mattigins#mattigins.tmi.twitch.tv" (perhaps you forgot to load
"mattigins#mattigins.tmi.twitch.tv"?) at /root/.irssi/scripts/test.pl
line 64.
Since the left hand side (LHS) of my $channel = #_; is a scalar it imposes scalar context on the #_ array. This means that the length of the array gets assigned to $channel. You want to assign with my ($channel) = #_; so that the LHS is in list context and that the first element in the #_ array gets assigned to your scalar.
Ref:
What is the difference between the scalar and list contexts in Perl?
Scalar and List context in Perl
I figured out how to do it.
$chan = $server->channel_find('#channel');
foreach my $nick ($chan->nicks()) {
$nickname = $nick->{nick};
}
I have a recursive function that uses ref to walk down a data structure recursively. If ref returns an empty string, then a callback is called. My problem is that I need to store a hash-ref in my data structure that will be treated as a scalar by my function.
In essence, what I need is to do something like this;
my %hash = fillHash();
$hash{'abc'}{'def'} = \%hash;
I was wondering if there was some way of storing \%hash in such a way that it would be treated as a scalar and not a reference. possibly like/
$hash{'abc'}{'def'} = scalar \%hash;
I am simply looking a way to add a link to the parent node of my data structure, yet still being able to recursively walk it.
Thanks
You could use what I did to differentiate values from structure, I call them "indirect arrays" (in my case).
In your case it would look like this:
$hash{'abc'}{'def'} = scalar \\%hash;
ref( $hash{'abc'}{'def'} ) is 'REF', in case you're wondering. And you can then decide that you need to dereference it twice:
$hash_ref = ${ $hash{'abc'}{'def'} };
I think #MarkCanlas has the right solution in his suggestion to consider a different way to structure your data. Barring that, you could take a double reference.
my $scalar_ref = \%hash;
$other_hash{abc}{def} = \$scalar_ref;
Now, when you check the ref of that you'll get back "REF" and can do something different.
First of all, you should realize that all references are scalars by definition.
What you want is something that works as a reference everywhere but inside your walking function. That's not really achievable by any kind of magic reference. The walking function is where the logic is going to have to be added. You can make it keep track of things it has already seen:
my %h = (
foo => "bar",
inner => {
foo => 42
}
);
$h{inner}{parent} = \%h;
sub walk
{
my ($h, $cb, $path, $seen) = #_;
$path //= "";
$seen //= {};
$seen->{$h}=1;
while(my ($k, $v) = each %$h) {
if(ref($v)) {
walk($v, $cb, "$path/$k", $seen) if !$seen->{$v};
} else {
$cb->($k, $v, "$path/$k");
}
}
}
walk(\%h, sub {
my ($key, $value, $path) = #_;
print "walker found $key ($path) => $value\n";
});
Or you could just make it recognize certain keys like parent as special and skip them.