Using List::Util first on an array of Moose objects - arrays

I have an array called aTestCaseList which is initialized and filled with (Moose) objects of type "Testcase". As expected I can print out the Attribute TestName of every Testcase Object in aTestCaseList. But when I try to find the first Object in the list named "Test4" using https://perldoc.perl.org/List/Util.html#first I get the following error
Can't call method "TestName" on an undefined value
Why are the objects in the array suddenly undefined?
use Testcase;
my #aTestcaseList=();
for (my $i=1; $i <= 9; $i++) {
push(#aTestcaseList,Testcase->new("Test".$i));
}
my $sTestcase="Test4";
foreach my $sTestDummy(#aTestcaseList)
{
#Works as expected and prints: Test1 Test2 Test3 ... Test9
print $sTestDummy->TestName." ";
}
# throws the error:
my $sFindTest=first {$_->TestName eq $sTestcase} #aTestcaseList;
package Testcase;
use Moose;
use namespace::autoclean;
has 'TestName' => (is =>'ro',isa=>'Str');
around BUILDARGS => sub
{
my $orig = shift;
my $class = shift;
if ( #_ == 1 && ! ref $_[0] ) {
return $class->$orig(TestName => $_[0]);
}
else {
return $class->$orig(#_);
}
};
__PACKAGE__->meta->make_immutable;
1;

You forgot to import the function first from List::Util like
use List::Util qw(first);

Related

Unable to find if one item exists in array of items and return the necessary message in Perl

I have array of IDs. I have one ID which I want to find if that ID exists in the array of IDs in Perl
I tried the following code:
my $ids = [7,8,9];
my $id = 9;
foreach my $new_id (#$ids) {
if ($new_id == $id) {
print 'yes';
} else {
print 'no';
}
}
I get the output as:
nonoyes
Instead I want to get the output as only:
yes
Since ID exists in array of IDs
Can anyone please help ?
Thanks in advance
my $ids = [7,8,9];
my $id = 9;
if (grep $_ == $id, #ids) {
print $id. " is in the array of ids";
} else {
print $id. " is NOT in the array";
}
You just need to remove the else part and break the loop on finding the match:
my $flag = 0;
foreach my $new_id (#$ids) {
if ($new_id == $id) {
print 'yes';
$flag = 1;
last;
}
}
if ($flag == 0){
print "no";
}
Another option using hash:
my %hash = map { $_ => 1 } #$ids;
if (exists($hash{$id})){
print "yes";
}else{
print "no";
}
use List::Util qw(any); # core module
my $id = 9;
my $ids = [7,8,9];
my $found_it = any { $_ == $id } #$ids;
print "yes" if $found_it;
The following piece of code should cover your requirements
use strict;
use warnings;
my $ids = [7,8,9];
my $id = 9;
my $flag = 0;
map{ $flag = 1 if $_ == $id } #$ids;
print $flag ? 'yes' : 'no';
NOTE: perhaps my #ids = [7,8,9]; is better way to assign an array to variable

NOT an array reference error in Perl

I'm getting an error in Perl and I can't work out why.
Error: Not an ARRAY reference at Service.pm, line 20
my $array = [ { name => 'George', surname => 'Marley' } ];
my $helper = CustMessage->new();
$helper = CustMessage->getMessage($array);
then in my utility file I have:
sub getMessage {
my ($self, $args) = #_;
my $stringsArray = shift;
my $strings = Service->new({
serviceId => $self->_serviceId(),
});
return unless $strings;
$strings->getStrings($stringsArray);
}
and then in the Service method is:
sub getStrings {
my ($stringsArray, $self) = shift;
my #keys = map({ $_->{'name'} } #{$stringsArray});
my $key = join('', #keys);
$key = MIME::Base64::encode($key);
my %results;
$results{$key} = $self->_callStrings->($stringsArray);
$results{$key}->initialize();
$results{$key} = $self->{serviceCalls}->{getStrings};
return $self->{serviceCalls}->{getStrings};
}
The error is on line 2 of the getStrings method in Service.pm:
my #keys = map({ $_->{'name'} } #{$stringsArray});
The lines
my $helper = CustMessage->new();
$helper = CustMessage->getMessage($array);
are very odd. You are creating a new CustMessage object in $helper and immediately discarding it and overwriting it with the result of
CustMessage->getMessage($array);
which, apart from any inheritance that may be going on, is identical to
getMessage('CustMessage', $array);
and I am suspecting that you don't have a real class defined as you call it your "utility file"
Because getMessage receives its arguments like this
my ($self, $args) = #_;
my $stringsArray = shift;
you are left with
($self, $args) = ('CustMessage', $array)
$stringsArray = 'CustMessage'
and you never use $args again so your array reference is lost.
I cannot be sure what it is you actually want, because, as I said, I suspect that you don't have a proper CustMessage.pm file. But you could try
my $helper = CustMessage->new;
my $message = $helper->getMessage($array);
and then
sub getMessage {
my ($self, $stringsArray) = #_;
...
}
RE: I'm getting an error in Perl and I can't work out why. Error: Not an ARRAY reference at Service.pm, line 20
Try
my ($self, $stringsArray) = #_;
instead of
my ($stringsArray, $self) = shift;
# $self is always undef here due one element list assignment
since getStrings() is object method and object instance is always first element in #_ array.

Passing an array into Perl subroutine

I have a subroutine that should take an array as input, make it into a CSV, and POST it to a URL. Here's what I've got so far:
An example array:
[ 2823383062, 1411691539, 1411691541, 'outgoing',
'SIP/fr', 'user#2000', '2000', 'SIP/2000-000000a2',
undef, '6125551234', 'SIP/fr-000000a3', undef,
undef, 8, 'Answered', 2,
1, 'nada'
];
The subroutine:
sub send_http {
my #http = #_;
my $h = LWP::UserAgent->new;
$h->timeout(15);
$h->agent(undef);
my $testkey = "1234";
my $apikey = "4567";
my $posting;
foreach my $v ( \#http ) {
if ( defined $v ) {
$posting = join( ',', $posting, $v );
} else {
$posting = join( ',', $posting, "" );
}
}
my $api_response = $h->post( 'http://url.com/v1/post.cfm',
[ key => $testkey, method => 'pushCalls', rawdata => $posting ] );
}
Forgive all the horrible things I've done; this is my first time using Perl and I'm still learning all sorts of stuff. My issue is that I can't seem to get the values from the array I pass into it past the first array variable declaration (#http). I've read something about getting a reference of the array, but am not sure where/how to do so. Any help is appreciated.
Edit:
Here's the entire script. It does (or should) two things; send some string of data to a TCP socket, and some other data gets POST'ed to a URL. Thanks everyone for your help.
#!/usr/bin/perl
use EV;
use Asterisk::AMI;
use Net::Telnet;
use HTTP::Request::Common;
use LWP::UserAgent;
use strict;
use warnings;
use Data::Dumper;
my %call;
my $t = new Net::Telnet (
Timeout => 10,
Port => '1234',
Telnetmode => 1
);
my $astman = Asterisk::AMI->new(PeerAddr => '127.0.0.1',
PeerPort => '5038',
Username => 'secret',
Secret => 'user',
Events => 'on',
Handlers => {
# default => \&eventhandler,
Dial => \&dialcheck,
Bridge => \&bridgecheck,
Newchannel => \&newchannel,
Newexten => \&newexten,
Hangup => \&hangup,
Newstate => \&outring
}
);
die "Unable to connect to asterisk" unless ($astman);
sub send_pos {
my ($pos_string,$telnet) = #_;
$telnet->open('127.0.0.1');
printf $t $pos_string;
$telnet->close()
}
sub send_http {
my $http = shift; ##_;
my $h = LWP::UserAgent->new;
$h->timeout(15);
$h->agent(undef);
my $testkey = "1234";
my $apikey = "5678";
my $posting;
foreach my $v ( #http ) {
if ( defined $v ) {
$posting = join(',', $posting,$v);
} else {
$posting = join(',', $posting,"");
}
}
my $api_response = $h->post( 'http://url.com/v1/post.cfm',[key => $testkey,method => 'pushCalls',rawdata => $posting]);
}
sub eventhandler {
# Default event handler, not used
my ($ami, $event) = #_;
print 'Got Event: ',$event->{'Event'},"\r\n";
}
sub newchannel {
my ($ami, $event) = #_;
my $unique_id = $event->{'Uniqueid'};
if ( not exists $call{$unique_id} ) {
my $this_call = $call{$unique_id};
if ( (not defined $this_call->{'gravityfree'}[3]) ) {# || ($this_call->{'gravityfree'}[3] !~ /incoming|outgoing/) ) {
if ( $event->{'Context'} =~ /from-trunk/ ) {
# Call is inbound
$this_call->{'caller_name'} = $event->{'CallerIDName'};
$this_call->{'caller_number'} = substr $event->{'CallerIDNum'}, -10;
$this_call->{'dnis'} = substr $event->{'Exten'}, -10;
$this_call->{'status'} = "remote";
$this_call->{'holdstart'} = time();
# Data required for Gravity Free
$this_call->{'gravityfree'}[0] = int($event->{'Uniqueid'})+int(time());
$this_call->{'gravityfree'}[3] = "incoming";
$this_call->{'gravityfree'}[5] = $event->{'CallerIDName'};
$this_call->{'gravityfree'}[6] = substr $event->{'CallerIDNum'}, -10;
$this_call->{'gravityfree'}[7] = $event->{'Channel'};
$this_call->{'gravityfree'}[11] = substr $event->{'Exten'}, -10;
# Can't remember why this is here:
$call{$unique_id} = $this_call;
} elsif ( $event->{'Context'} =~ /from-internal/ ) {
# Call is outbound
# Separate from calls to stations
if( length($event->{'CallerIDNum'}) < length($event->{'Exten'}) ) {
$this_call->{'status'} = "remote";
# Data required for Gravity Free
$this_call->{'gravityfree'}[0] = int($event->{'Uniqueid'})+int(time());
$this_call->{'gravityfree'}[9] = substr $event->{'Exten'}, -10;
$this_call->{'gravityfree'}[3] = "outgoing";
$this_call->{'gravityfree'}[6] = $event->{'CallerIDNum'};
$this_call->{'gravityfree'}[5] = $event->{'CallerIDName'};
$call{$unique_id} = $this_call;
} elsif ( length($event->{'CallerIDNum'}) == length($event->{'Exten'}) ) {
# Call is station to station
$this_call->{'status'} = "station-to-station";
}
}
}
}
}
sub newexten {
my ($ami, $event) = #_;
my $unique_id = $event->{'Uniqueid'};
my $this_call = $call{$unique_id};
# Handles inbound calls only
if ( defined $this_call->{'status'} && $this_call->{'status'} ne "station-to-station" ) {
# Call is not station to station
# Check if the DID has been defined
if ( not defined $this_call->{'gravityfree'}[13] ) {
if ( $event->{'Context'} eq 'ext-group' ) {
# Data required for Gravity Free
$this_call->{'gravityfree'}[13] = $event->{'Extension'};
}
}
}
}
sub dialcheck {
my ($ami, $event) = #_;
my $unique_id = $event->{UniqueID};
if ( exists $call{$unique_id} ) {
my $this_call = $call{$unique_id};
if ( defined $this_call->{'status'} && $this_call->{'status'} ne "station-to-station" ) {
# Call is not station to station
if ( $event->{'SubEvent'} eq 'Begin' && $this_call->{'gravityfree'}[3] =~ "incoming" ) {
# Call is inbound
$this_call->{'system_extension'} = $event->{'Dialstring'};
$this_call->{'dest_uniqueid'} = $event->{'DestUniqueID'};
# Data required for Gravity Free
$this_call->{'gravityfree'}[4] = $1 if $event->{'Channel'} =~ /(.+(?=\-\w+)).*/;
# Telnet data to Prodigy
my $sending = "R|$this_call->{'caller_name'}|$this_call->{'caller_number'}|$this_call->{'system_extension'}||$this_call->{'dnis'}|";
send_pos($sending,$t);
$this_call->{'status'} = "ringing";
} elsif ( $event->{SubEvent} eq 'Begin' && $this_call->{'gravityfree'}[3] =~ "outgoing" ) {
# Call is outbound
# Data required for Gravity Free
$this_call->{'gravityfree'}[4] = $1 if $event->{'Destination'} =~ /(.+(?=\-\w+)).*/;
$this_call->{'gravityfree'}[10] = $event->{'Destination'};
$this_call->{'gravityfree'}[7] = $event->{'Channel'};
}
}
}
}
sub outring {
my ($ami, $event) = #_;
my $unique_id = $event->{'Uniqueid'};
my $this_call = $call{$unique_id};
if ( defined $this_call->{'status'} && $this_call->{'status'} ne "station-to-station" ) {
# Call is not station to station
if ( not defined $this_call->{'holdstart'} && $this_call->{'gravityfree'}[3] eq "outgoing" ) {
# Call is outbound
$this_call->{'holdstart'} = time();
}
}
}
sub bridgecheck {
my ($ami, $event) = #_;
my $unique_id = $event->{'Uniqueid1'};
my $this_call = $call{$unique_id};
if ( defined $this_call->{'status'} && $this_call->{'status'} ne "station-to-station" ) {
# Call is not station to station
if ( $event->{'Bridgestate'} eq "Link" && length($event->{'CallerID2'}) <= 4 ) {
# Call is inbound
$this_call->{'dest_uniqueid'} = $event->{Uniqueid2};
# Data required for Gravity Free
$this_call->{'gravityfree'}[1] = time();
$this_call->{'gravityfree'}[10] = $event->{Channel2};
my $sending = "A|$this_call->{caller_name}|$this_call->{caller_number}|$event->{CallerID2}||$this_call->{dnis}|";
send_pos($sending,$t);
$this_call->{'status'} = "answered";
} elsif ( $event->{'Bridgestate'} eq "Link" && length($event->{'CallerID2'}) >= 4 ) {
# Call is outbound
$this_call->{'gravityfree'}[1] = time();
$this_call->{'gravityfree'}[13] = $this_call->{'gravityfree'}[1]-$this_call->{holdstart};
}
}
}
sub hangup {
my ($ami, $event) = #_;
my $unique_id = $event->{'Uniqueid'};
my $this_call = $call{$unique_id};
if ( defined $this_call->{'status'} && not defined $this_call->{'gravityfree'}[16] && $this_call->{'status'} ne "station-to-station" ) {
# Call is not station to station
if ( $event->{'Cause-txt'} eq "Normal Clearing" ) {
# Call was hungup normally
$this_call->{'dest_uniqueid'} = $event->{Uniqueid};
# Call has ended, get date/time
$this_call->{'gravityfree'}[2] = time();
# Mark call 'completed'
$this_call->{'gravityfree'}[16] = 1;
# Set notes to nothing
$this_call->{'gravityfree'}[17] = 'nada';
if ( defined $this_call->{'gravityfree'}[3] && $this_call->{'gravityfree'}[3] eq "incoming") {
# Call was inbound
if ( defined $this_call->{'gravityfree'}[1] ) {
# Call was answered
$this_call->{'gravityfree'}[13] = $this_call->{'gravityfree'}[1]-$this_call->{holdstart};
$this_call->{'gravityfree'}[14] = "Answered";
$this_call->{'gravityfree'}[15] = $this_call->{'gravityfree'}[2]-$this_call->{'gravityfree'}[1];
$this_call->{'gravityfree'}[8] = $event->{'ConnectedLineName'};
$this_call->{'gravityfree'}[9] = substr $event->{'ConnectedLineNum'}, -10;
# POST data to gravity free
send_http(\$this_call->{'gravityfree'});
} else {
# Call was abandoned
$this_call->{'gravityfree'}[14] = "Abandoned";
$this_call->{'gravityfree'}[13] = $this_call->{'gravityfree'}[2]-$this_call->{holdstart};
$this_call->{'gravityfree'}[15] = 0;
# POST data to gravity free
send_http(\$this_call->{'gravityfree'});
}
} elsif ( defined $this_call->{'gravityfree'}[3] && $this_call->{'gravityfree'}[3] eq "outgoing" ) {
# Call is outbound
if ( defined $this_call->{'gravityfree'}[1] ) {
# Call was bridged at some point
$this_call->{'gravityfree'}[15] = $this_call->{'gravityfree'}[2]-$this_call->{'gravityfree'}[1];
$this_call->{'gravityfree'}[14] = "Answered";
# POST data to gravity free
send_http(\$this_call->{'gravityfree'});
} else {
# Call was hung up before anyone answered
$this_call->{'gravityfree'}[15] = 0;
$this_call->{'gravityfree'}[14] = "Abandoned";
$this_call->{'gravityfree'}[13] = $this_call->{'gravityfree'}[2]-$this_call->{holdstart};
# POST data to gravity free
send_http(\$this_call->{'gravityfree'});
}
}
}
}
}
EV::loop
First question, where are you getting the array you're passing into the subroutine?
I ask because your example array is actually an array reference.
That is:
#array = (1, 2, 3); # This is an array
$ref = [1, 2, 3]; # This is an array reference
If you want to pass an array reference to your subroutine, change the beginning to:
sub send_http {
my $http = shift;
Next, let us consider how to iterate over the elements of an array. This is the proper way to do so:
foreach my $element ( #array ) {
# do stuff ...
}
When you do \# on an array, you are actually creating a reference to the array. Thus, if you truly are passing an array to your subroutine, you should change your loop to the following:
foreach my $v ( #http ) {
However, if you decide to pass your array as a reference, you can dereference the pointer and iterate over its elements like this:
foreach my $v ( #$http ) {
Hope this helps!
EDIT: For the newly uploaded code...
You're very close but we have a couple of small issues:
$this_call->{'gravityfree'} is actually already an array reference, I'm not certain why it's allowing you to address the array elements with $this_call->{'gravityfree'}[INDEX], so perhaps someone more knowledgeable than me can enlighten us all. I will note that the correct way to deference an array is the following:
\#{$this_call->{'gravityfree'}}
Regardless, you can simply pass the reference to your subroutine, no need to create a reference. That is:
send_http($this_call->{'gravityfree'});
Now, inside of your subroutine, you have an array reference. You are correctly reading the subroutine argument, but you need to dereference the reference in your foreach loop. Like so:
foreach my $v ( #$http ) {
# ... loop body
}
Does this make sense? Please let me know if anything is unclear (or not working!)
I'm not entirely sure what you're trying to do but everything depends on how you pass the array to your subroutine. You have two choices, either pass it as an array:
send_http(#array)
or as a reference to an array:
send_http(\#array)
As others have noted, your array is already a reference since you're defining it in square brackets [ ].
Which one you want will depend on what exactly you're doing but the syntax is different. To pass an array and iterate through it:
sub send_http {
my #http = #_;
foreach my $v (#http) {
print "v is $v\n";
}
}
my #aa=("cc","dd");
send_http(#aa);
To pass a reference and iterate through the array it points to:
sub send_http {
## Remove the first value from the #_ array.
my $http = shift #_;
## Dereference it to an array. You could also use #{$http}
foreach my $v (#$http) {
print "v is $v\n";
}
}
my #aa=("cc","dd");
send_http(\#aa);
The main difference is that when you use send_http(\#aa); what you're passing is not an array so you can't treat it as one. It is instead a reference to an array. Something like
send_http(ARRAY(0x1d34030));
So, the contents of #_ are just a single reference, ARRAY(0x1d34030). To treat it as an array, you need to dereference it to get to what it points to.
So, into your send_http, the argument you received is array_ref which is scalar variable, so when you used it you need to dereference to the right type.
NB: square bracket is array_reference
So, please change as below:
my $http = shift;
And please use that as :
foreach my $v ( #$http ) {
Example:
my $array_ref = [1,2,3];
print "Reference: ", $array_ref,"\n";
print "Array: ", #$array_ref,"\n";
Output:
Reference: ARRAY(0x7f8e1c004ee8)
Array: 123

Warning message in older perl version

I have the following code in my script:
while (my ($key, $value) = each #values) {
if ( $key < $arraySize-1) {
if ( $values[$key+1] eq "user") {
$endcon=1;
}
}
if ( ( $startcon == 1 ) && ( $endcon != 1 ) ) {
$UptimeString .= $value;
}
if ( $value eq "up") {
$startcon=1;
}
if ( $value eq "average:") {
$LoadMinOne=$values[$key+1];
}
}
While compiling it, in perl 5.14, I have no warnings, but in perl 5.10.1, I have this warning: Type of arg 1 to each must be hash (not private array) at ./uptimep.pl line 21, near "#values) "
Line 21 is while (my ($key, $value) = each #values) {
What does this mean?
As said in error message, each must have a hash for parameter, but you give it an array.
You could replace this line:
while (my ($key, $value) = each #values) {
by:
for my $key(0 .. $#values) {
my $value = $values[$key];
According to the doc each accepts array as parameter from perl 5.12.0
as it says, each expects a hash as an argument, not an array.
you can populate a hash first ( my %hash = #values; ) and use it as an argument ( while (my ($key, $value) = each %hash) ).

Is there a function pointer or array of functions in PowerShell?

I would like to do something like this. Index into an array of functions and apply the appropriate function for the desired loop index.
for ($i = 0; $i -lt 9; $i++)
{
$Fields[$i] = $Fields[$i] | $($FunctionTable[$i])
}
#F1..F9 are defined functions or rather filter functions
$FunctionTable = {F1},
{F2},
{F3},
{F4},
{F5},
{F6},
{F7},
{F8},
{F9}
Here's an example of how to do this using the call (&) operator.
# define 3 functions
function a { "a" }
function b { "b" }
function c { "c" }
# create array of 3 functioninfo objects
$list = #(
(gi function:a),
(gi function:b),
(gi function:c)
)
0, 1, 2 | foreach {
# call functions at index 0, 1 and 2
& $list[$_]
}
-Oisin
p.s. this means your pipeline should bve amended to something like:
$Fields[$i] = $Fields[$i] | & $FunctionTable[$i]
Here is something similar also using the & operator:
function f1
{ "Exec f1" }
function f2
{ "Exec f2" }
function f3
{ "Exec f3" }
function f4
{ "Exec f4" }
function UseFunctionList ( [string[]]$FunctionList )
{
foreach ( $functionName in $functionList )
{
& $FunctionName
}
}
function Go
{
'List 1'
$FunctionList = 'f1','f2','f3','f4'
UseFunctionList $FunctionList
'List 2'
$FunctionList = 'f4','f3','f2'
UseFunctionList $FunctionList
}

Resources