Perl subroutine array and scalar variable parameters - perl

How exactly can I pass both scalar variables and array variables to a subroutine in Perl?
my $currVal = 1;
my $currValTwo = 1;
my #currArray = ('one','two','three');
my #currArrayTwo =('one','two','three');
&mysub($currVal, $currValTwo,\#currArray, \#currArrayTwo);
sub mysub() {
# That doesn't work for the array as I only get the first element of the array
my($inVal, $inValTwo, #inArray, #inArrayTwo) = #_;
}

You need to fetch them as references because you've already passed them as references (by using the \ operator):
my($inVal, $inValTwo, $inArray, $inArrayTwo) = #_;
and then use the references as arrays:
#{$inArray}

You pass the arguments as references, so you need to dereference them to use the values. Be careful about whether you want to change the original array or not.
sub mysub {
my($inVal, $inValTwo, $inArray, $inArrayTwo) = #_;
#{$inArrayTwo} = ('five','six','seven');
}
This will change the original #currArrayTwo, which might not be what you want.
sub mysub {
my($inVal, $inValTwo, $inArray, $inArrayTwo) = #_;
my #ATwo = #{$inArrayTwo};
#ATwo = ('five','six','seven');
}
This will only copy the values and leave the original array intact.
Also, you do not need the ampersand in front of the sub name, from perldoc perlsub:
If a subroutine is called using the &
form, the argument list is optional,
and if omitted, no #_ array is set up
for the subroutine: the #_ array at
the time of the call is visible to
subroutine instead. This is an
efficiency mechanism that new users
may wish to avoid.
You do not need empty parens after your sub declaration. Those are used to set up prototypes, which is something you do not need to do, unless you really want to.

So, for example: This is a using statement to search something in an array:
use List::Util qw(first);
This is the sub declaration:
sub GetIndex($$$);
This is the call to the sub (last parameter is: Default index value to give back if not found)
$searchedIndex = GetIndex(\#theArr, "valuesearched", 1);
This is the routine:
sub GetIndex($$$)
{
my $inArray=shift;
my #theArray= #{$inArray};
my $searchedTag= shift;
my $defaultVal= shift;
my $retVal = first { $theArray[$_] eq $searchedTag} 0 .. $#theArray;
if ((! defined $retVal)|| ($retVal<0)||($retVal>#theArray))
{
$retVal = $defaultVal;
}
return $retVal;
}

Related

Is there a way to distinguish error and empty array returned from subroutine when it is called in list context?

I have script:
#!/usr/bin/env perl
sub t0 {
return; # We return nothing for ERROR
}
sub t1 {
#z = ();
return #z; # We return array (which maybe empty) for no ERROR
}
In scalar context I can distinguish error and OK status:
my $x1 = t0(); # undef
my $x2 = t1(); # 0
Is there a way to distinguish error and empty array returned from subroutine when it is called in list context?
my #x1 = t0(); # empty list
my #x2 = t1(); # empty list
I am feeling that I need "0E0" (Zero but TRUE) but for list context.
A way to distingish between the empty list and an error in this case would be to return an array reference, e.g.
sub t0 {
return undef; # We return undef for ERROR
}
sub t1 {
#z = ();
return \#z; # We return array (which maybe empty) for no ERROR
}
So basically the functions do not behave differently in list context. They always return a single scalar, which may be undef, which indicates an error, or return a reference to an array.
No.
Return an array reference if successful (which the caller will have to dereference) and undef on failure.
Or throw an exception on failure (which the calling code could catch).
In list context a sub will return a list, even if it only has one element which is undef. If you must return data in a flat list – if it is not feasible to change the callers, say in a large codebase -- you can die on error and eval somewhere at a top level. (As die is an exception it "bubbles.")
The other option for the flat list is rather unappealing, and it still requires changes to callers. You can return an empty list or an undef and then test accordingly -- but see the comment below.
sub test {
# set #z (but not with undef!), $error
return undef if $error;
return #z;
}
my #ret = test();
if (not #ret) {
# empty list
}
else {
foreach my $elem (#ret) {
if (not defined $elem) {
warn "Undefined";
last
}
# ...
}
}
However, as pointed out by ikegami, if #z gets assigned an undef legitimately (without error), for example a variable that happens to be undefined, this code can't tell the difference. So the function would have to be changed further to deal with that.

Preserve a variable's value across multiple subroutine calls in perl

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

Irssi Loop Through Users in Channel

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};
}

Using completion function in Term::ReadLine::Gnu

I want to make a console and change the automatic completion function when I press tab but I want to differentiate between two cases:
If I press tab and the beginning of the command matches a list I supplied in an array, the auto complete will be according to this array.
If I press tab and the command isn't recognized from the list I supplied, I want the generic completion function to work, so t hat it will auto complete directories and file names in the current directory.
Is it possible?
Thanks a lot.
Edit: I'm trying to do it inside a perl script. I saw this example:
rl_attempted_completion_function
A reference to an alternative function to create matches.
The function is called with TEXT, LINE_BUFFER, START, and END. LINE_BUFFER is a current input buffer string. START and END are indices in LINE_BUFFER saying what the boundaries of TEXT are.
If this function exists and returns null list or undef, or if this variable is set to undef, then an internal function rl_complete() will call the value of $rl_completion_entry_function to generate matches, otherwise the array of strings returned will be used.
The default value of this variable is undef. You can use it as follows;
use Term::ReadLine;
...
my $term = new Term::ReadLine 'sample';
my $attribs = $term->Attribs;
...
sub sample_completion {
my ($text, $line, $start, $end) = #_;
# If first word then username completion, else filename completion
if (substr($line, 0, $start) =~ /^\s*$/) {
return $term->completion_matches($text,
$attribs->{'username_completion_function'});
} else {
return ();
}
}
...
$attribs->{attempted_completion_function} = \&sample_completion;
completion_matches(TEXT, ENTRY_FUNC)
What I want to do is that in case when tab is pressed it recognizes a substring from an array I provide, the auto completion will be from that array (if there are multiple matches it will give all of them like a regular unix console).
Otherwise, I want the auto completion to be file recognition.
The subroutine used internally by Term::ReadLine::Gnu to provide the default completion is filename_completion_function, which you can call directly from your custom subroutine:
use Term::ReadLine;
my $term = new Term::ReadLine 'MyTerm';
$term->Attribs->{'completion_entry_function'} = \&my_completion;
my $ans = $term->readline('How can I help you? ');
sub my_completion {
my ($text, $state) = #_;
if (my_test) {
return my_custom_stuff;
}
else {
return Term::ReadLine::Gnu->filename_completion_function($text, $state);
}
}

How to store a reference in perl that is itself not a reference

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.