Error in perl

[Krush[LM]]

I'm using murphybob 's bot that is supposed to connect from irc to bnet through javaop and send msgs back and forth but i get the following error:

Can't use string ("") as a subroutine ref while "strict refs" in use at C:/Perl/site/lib/Net/IRC.pm line 150.

here's the code:

Code Select Expand


#!/usr/bin/perl

$|=1;

# Load some perl modules i need. 

use strict;#keep things neat
use Net::IRC;#for all the irc stuff
use IO::Socket::INET;#for the socket i connect to
use Digest::MD5;#for the `recode' thing.  use a hash to check if recode is necessary, so people can't do it all day long to piss me off
use DBI;#for database work

# Important vars
my $botname = "BattleNet[Chat]";
my $channel = "#lostminions";
my $profile_primary = "BNet";
my $profile_all = "BNet";
my $filename = "bnet.pl";#suspect perl has a variable already for that, but i cba to look it up.

# Testing purposes
my $count = 1;

print "Opening socket ... ";

# Make the connection to JavaOp running on localhost.
my $sock;
sub conn
{
$sock = IO::Socket::INET->new(
PeerPort  => 8322,
PeerAddr  => 'localhost',
Proto     => 'tcp',
#Blocking  => 1,
Timeout   => 1,#if timeout /really/ worked i wouldn't need to do the fork crap :/
)

or die "failed!\n";
     
}

conn();
print "done.\n";

# Sends a message to bnet.
sub bnet
{
my $sock = shift;
my $msg  = shift;

# all lines sent to the bot should start with
# profilename:
# and then the message just as you would type it in bnet

#print "bnet called \"$profile: $msg\"\n";

print $sock $profile_primary.': '.$msg."\n"; # don't forget to put the newline character on or you will spend ages wondering why its not working. i did.
}

print "Creating connection to database server ... ";

sub db_conn
{
return DBI->connect(
"DBI:mysql:database=database;host=host",
"user",
"pass",
);
}

my $dbh = db_conn();

print "done.\n";

print "Creating connection to IRC server ... ";

# Connect to IRC here.
my $irc = new Net::IRC;
my $conn = $irc->newconn(
Server   => ('irc.gamesurge.net'),
Port     => 6667,
Nick     => $botname,
Ircname  => 'BattleNet',
Username => 'BattleNet'
)

or die "failed!\n";

print "done.\n";

# Everything below here is IRC handlers.  Check out Net::IRC; docs (they suck, sorry) to understand all this.

sub on_connect
{
my $self = shift;

#join the channels i want to join (defined up in 'important vars').
print "Joining $channel ... ";
$self->join($channel);
print "done.\n";

# identify my nickname
print "Authing $botname ... ";
my $password = "pass";
chomp($password);
$self->privmsg('authserv', 'auth '.$password);
print "done.\n";

# Ok, here is where things get a little shitty.  Right, I can not make perl read from a socket to the end of available data, and then timeout.
# the timeout flag on the socket connection i made earlier has no effect.  This sucks, it means any attempt to read all the data from the
# socket will result in the program halting.  So, what i am forced to do is fork() off a separate process and do all the reading from socket
# stuff in here, while the parent keeps IRC side stuff ticking over.  Its lame.  The reason it forks from inside an IRC handler sub is so it
# can inherit the variables necessary for it to send stuff to IRC.

my $pid = fork();
if($pid != 0)
{
# EVERYTHING IN HERE IS IN A SEPARATE PROCESS

#send a password, i hope
print $sock "pasties\n";

my $byte;
my $stuff;

sub reply
{
open REPLY, '>reply';
if($_[0])
{
print REPLY $_[0]
};

close REPLY;
}

reply();

while(read($sock, $byte, 1)) # keep reading the socket a byte at a time and adding the byte to $stuff
{
$stuff .= $byte;
if($byte eq chr(10)) # when the last byte read was a newline character we have enough in $stuff to do something with
{
# Ok so we have a line, we examine it to see what it say:
# All lines start with the name of the profile used when loading JavaOp (in this case `warcraft'), then a colon and space
# so here `warcraft: '.
# I suggest you log into bnet using warcraft, and use the unix program `nc' to
# connect to the socket on JavaOp, then type some stuff on Bnet and see what the output from JavaOp looks like.
# I found that the easiest way.

$stuff = substr($stuff, 0, length($stuff) - 2);

print $stuff."\n";

if($stuff =~ /^$profile_all: <From: (.+)> Your friend .+ entered a Warcraft III The Frozen Throne game called (.*)\./)
{
#  Entered a game, whisper
if(!$dbh)
{
$dbh = db_conn();
}

$dbh->do("DELETE FROM bnet WHERE name=\"$2\"");
$dbh->do("INSERT INTO bnet VALUES (\"$2\", \"$3\", ".time().")");

reply($2);

$self->privmsg($channel, chr(03)."4*".chr(03)." $2 entered a game called \"$3\"");
}
elsif($stuff =~ /^$profile_all: <From: (.+)> Your friend .+ has entered Battle.net\.$/)
{
# Entered Battle.net, whisper
reply($2);

$self->privmsg($channel, chr(03)."9*".chr(03)." $2 entered Battle.net");
}
elsif($stuff =~ /^$profile_all: <From: (.+)> Your friend .+ has exited Battle.net\.$/)
{
# Exited Battle.net, whisper
reply($2);

$self->privmsg($channel, chr(03)."2*".chr(03)." $2 exited Battle.net");
}
elsif($stuff =~ /^$profile_primary: <From: (.+)> (.*)$/)
{
# Recieved whisper
reply($1);

$self->privmsg($channel, chr(03)."9*".chr(03)." $1 whispers: $2");
}
elsif($stuff =~ /^$profile_primary: <To: (.+)> (.+: ){0,1}(.*)$/)
{
# Sends a whisper
$self->privmsg($channel, chr(03)."10*".chr(03)." Whispered to $1: $3");
}
elsif($stuff =~ /^$profile_primary: Error: (.*)/)
{
# error
$self->privmsg($channel, chr(03)."7*".chr(03)." an error occurred: $1");
}
elsif($stuff =~ /^$profile_all: (\d{1,2}): (.*)$/)
{
my $number = $2;
my $where = $3;

if($where =~ /(.+),( \(mutual\)){0,1} using Warcraft III The Frozen Throne in (.*)\.$/)
{
my $person = $1;
my $msg = $3;

if($msg =~ /^the channel (.*)$/)
{
$self->privmsg($channel, $person.' is in channel '.$1);
}
elsif($msg =~ /^the game (.*)$/)
{
my $game = $1;

if($game =~ /(.+) \(private\)$/)
{
$game = $1;
}

my $sth = $dbh->prepare("SELECT * FROM bnet WHERE name=? AND game=?");
$sth->execute($person, $game);

my $since = '';

if(my @row = $sth->fetchrow_array)
{
my ($s,$m,$h) = localtime($row[2]);
$m = sprintf("%02d", $m);
$since = " (since $h:$m)";
}

$self->privmsg($channel, $person.' is in game "'.$1.'"'.$since);
}
elsif($msg =~ /^a private channel$/)
{
$self->privmsg($channel, $person.' is in a private channel');
}
else
{
$self->privmsg($channel, $person." is in an unknown location called \"$msg\"");
}
}

if($number == 25)
{
$self->privmsg($channel, "end of friends list");
}
}
elsif($stuff =~ /^$profile_primary: Stats for (.+) using Warcraft III The Frozen Throne:$/)
{
my $person = $1;
$self->privmsg($channel, "Stats for $person:");
}
elsif($stuff =~ /^$profile_primary: - (.*)/)
{
$self->privmsg($channel, $1);
}
elsif($stuff =~ /^$profile_primary: <(.+) (.*)>/)
{
# Emote, public
$self->privmsg($channel, chr(03)."14*".chr(03)." $1 $2") unless $stuff =~ /^$profile_primary: <WarB0T>/i;
}
elsif($stuff =~ /^$profile_primary: <(.+)> (.+)$/)
{
# message, public
my $bloke = $1;
my $msg = $2;
$self->privmsg($channel, "<$1> $2") unless $stuff =~ /^$profile_primary: <WarB0T>/i;

if($msg =~ /^!announce$/i)
{
$self->privmsg($channel, chr(03)."13* * ".chr(03)."Ladies and Gentlemen, $bloke cordially invites you to a game of Warcraft 3! ".chr(03)."13* * ".chr(03));
}
}
elsif($stuff =~ /^$profile_primary: (.+) joined the channel.$/)
{
# joins channel, protocol
$self->privmsg($channel, chr(03)."3*".chr(03)." $1 joined the channel");
}
elsif($stuff =~ /^$profile_primary: (.+) left the channel.$/)
{
# joins channel, protocol
$self->privmsg($channel, chr(03)."2*".chr(03)." $1 left the channel");
}

$stuff = '';# get rid of that line, and we are ready to read another one
}
}
}
}

# more IRC handlers, none of them do anything except on_msg/on_public
sub on_init
{
my ($self, $event) = @_;
my (@args) = ($event->args);
}

# when we get a line of chat in a channel we are in, send it to the func msg() to be dealt with (using a separate func so i can easily deal with private
# and public messages in a similar way without copy/pasting.
sub on_public
{
my ($self, $event) = @_;

my $thing = ($event->args)[0];
my $from = ($event->to)[0]; # this handy variable has in it the channel from which the message came.

msg($self, $from, $event->nick, $thing);
}

sub on_msg
{
my ($self, $event) = @_;
}

sub on_action
{
my ($self, $event) = @_;
my ($nick, @args) = ($event->nick, $event->args);

my $from = ($event->to)[0];
bnet($sock, " * ".$event->nick." ".$args[0]);
}

sub msg
{
my $self = shift;
my $from = shift;
my $nick = shift;
my $arg  = shift;

print "$from: <".$nick."> $arg\n";

if($arg =~ /^!w ([\w\-]+) (.+)$/i || $arg =~ /^!whisper (\w+) (.+)$/i)
{
# here the message to the socket is:
# profilename: /w jim murphybob: hi jim hows it going?
# and jim would get a whisper saying:
# From WarB0T: murphybob: hi jim hows it going?

bnet($sock, "/w $1 $nick: $2");
#$self->privmsg($from, "whisper sent");
}

if($arg =~ /^!r (.+)$/i || $arg =~ /^!reply (.+)$/i)
{
open REPLY, '<reply';
my $reply = <REPLY>;
close REPLY;

bnet($sock, "/w $reply $nick: $1");
}
elsif($arg =~ /^!f$/i || $arg =~ /^!friends$/i)
{
bnet($sock, "/f list");
#bnet($sock, "/f list", "WarB1T");
}
elsif($arg =~ /^!s (.+)$/i || $arg =~ /^!stats (.+)$/i)
{
bnet($sock, "/stats $1 W3XP");
}
else
{
# make the bot say stuff, the actual line transmitted by bnet() to the socket would look like:
# profilename: murphybob: hello test message
# in the channel the bot lives in the bot would say:
# murphybob: hello test message

bnet($sock, $nick.': '.$arg);
#$self->privmsg($from, "message sent");
}
}

# Reconnect to the server when we die.
sub on_disconnect
{
my ($self, $event) = @_;

print "Disconnected from ", $event->from(), " (",($event->args())[0], "). Attempting to reconnect...\n";
$self->connect();
}

print "Installing handler routines ... ";

$conn->add_handler('msg',    \&on_msg);
$conn->add_handler('public', \&on_public);
$conn->add_handler('caction', \&on_action);

$conn->add_global_handler([ 251,252,253,254,302,255 ], \&on_init);
$conn->add_global_handler(376, \&on_connect);
$conn->add_global_handler('disconnect', \&on_disconnect);

print " done.\n";

print "Starting ...\n";

while(1)
{
#print $count;
#print "\n";

$irc->do_one_loop();

#$count++;
}


any idea where it would be passing null is much help

[MyndFyre]

My first reaction was: why don't you ask murphybob first?

The second: just turn off "use strict" -- is that possible?  You might be able to find out what the interpreter thinks is a function, then.

[Krush[LM]]

My first reaction was: why don't you ask murphybob first?

The second: just turn off "use strict" -- is that possible?  You might be able to find out what the interpreter thinks is a function, then.

I asked him, and he don't know, nor does he particularly want to try and find out, i think he wrote this all for linux.

turning off "use strict" just generates another error at the same line:

Undefined subroutine $main:: called at C:/Perl/site/lib/Net/IRC.pm line 150.

[Kp]

Check if it runs OK on Linux?  If so, stop worrying and just use it there.

[Krush[LM]]

Check if it runs OK on Linux?  If so, stop worrying and just use it there.

I don't have a linux machine to run it on -.-

what now?

this is the line in IRC.pm that the error points to:

$conn->

• ->($conn->[1] ? ($conn->[1], $sock) : $sock;
  
  i assume somehow $conn->
• is becoming null

[warz]

Code Select Expand


$conn->[0]->($conn->[1] ? ($conn->[1], $sock) : $sock;


Try closing the parenthesis.

Code Select Expand


$conn->[0]->($conn->[1] ? ($conn->[1]), $sock) : $sock;


or removing the parenthesis.

Code Select Expand


$conn->[0]->($conn->[1] ? $conn->[1], $sock) : $sock;


That might not fix it. I don't know what perl is looking for. It's still a nice thing to do.

Edit: What that's doing is a quick if-then style statement. Returns a sort of 0 and 1 answer. If the first argument is true, the second argument is returned; if the first arg. is false, the second arg. is returned.

[Krush[LM]]

Code Select Expand


$conn->[0]->($conn->[1] ? ($conn->[1], $sock) : $sock;


Try closing the parenthesis.

Code Select Expand


$conn->[0]->($conn->[1] ? ($conn->[1]), $sock) : $sock;


or removing the parenthesis.

Code Select Expand


$conn->[0]->($conn->[1] ? $conn->[1], $sock) : $sock;


That might not fix it. I don't know what perl is looking for. It's still a nice thing to do.

Edit: What that's doing is a quick if-then style statement. Returns a sort of 0 and 1 answer. If the first argument is true, the second argument is returned; if the first arg. is false, the second arg. is returned.

it's correct in the code i just forgot to put the 2nd ) in my thing when i posted it

[Kp]

Check if it runs OK on Linux?  If so, stop worrying and just use it there.

I don't have a linux machine to run it on -.-

Then go install one!  Also, when posting code that doesn't work, it's considered good style to copy the code directly from vim to the posting box.  Retyping it introduces the possibility that you'll fix the error (or introduce a new one) during transcription, and send everyone off down the wrong path.

[dyslexify]

what version of IRC.pm do you have?

[MyndFyre]

I THINK I KNOW WHAT IT IS!!! hehe

Now I could be wrong because I don't use Perl, but I noticed this earlier and thought "I wonder if he knows Windows uses two characters to indicate EOL" but ignored it.

Code Select Expand


if($byte eq chr(10)) # when the last byte read was a newline character we have enough in $stuff to do something with
{
# Ok so we have a line, we examine it to see what it say:
# All lines start with the name of the profile used when loading JavaOp (in this case `warcraft'), then a colon and space
# so here `warcraft: '.
# I suggest you log into bnet using warcraft, and use the unix program `nc' to
# connect to the socket on JavaOp, then type some stuff on Bnet and see what the output from JavaOp looks like.
# I found that the easiest way.

$stuff = substr($stuff, 0, length($stuff) - 2);

(the last line is #150).

Anyway, it only checks to see if the last character is 10.  But Windows doesn't just use the LF character to indicate the end of the line, as Linux does, but rather indicates the end of a line with a CRLF, carraige return-line feed.

If the line is only one character long -- CR but not LF -- the code
length($stuff) - 2
will return -1, and so somewhere somehow, you're getting an error.

I don't really know how you can fix it other than to remove BOTH the CR and the LF from the string before you attempt to parse it.

[dyslexify]

Code Select Expand


if($byte eq chr(10))


if i'm following this right, you would just change it to the value of CR/LF
but that's 13,10.
so $byte would still equal chr(10) at some point.
because you can't really change it to

Code Select Expand


if($byte eq chr(13,10))

can you?

[Krush[LM]]

what version of IRC.pm do you have?

from ppm:

Net-IRC 0.75: up to date;

but in the actual file a part commented out says 1.3

[Krush[LM]]

i threw that eol thing at murphybob and am awaiting his thoughts, but if you guys have any idea what i can do to fix feel free to tell me i'll test it out.

[dyslexify]

Code Select Expand


if ($byte == "\n")

that might work.
I haven't done any real perl work in quite a while, so my perl skills are rather rusty.

[Krush[LM]]

I THINK I KNOW WHAT IT IS!!! hehe

Now I could be wrong because I don't use Perl, but I noticed this earlier and thought "I wonder if he knows Windows uses two characters to indicate EOL" but ignored it.

Code Select Expand


if($byte eq chr(10)) # when the last byte read was a newline character we have enough in $stuff to do something with
{
# Ok so we have a line, we examine it to see what it say:
# All lines start with the name of the profile used when loading JavaOp (in this case `warcraft'), then a colon and space
# so here `warcraft: '.
# I suggest you log into bnet using warcraft, and use the unix program `nc' to
# connect to the socket on JavaOp, then type some stuff on Bnet and see what the output from JavaOp looks like.
# I found that the easiest way.

$stuff = substr($stuff, 0, length($stuff) - 2);

(the last line is #150).

Anyway, it only checks to see if the last character is 10.  But Windows doesn't just use the LF character to indicate the end of the line, as Linux does, but rather indicates the end of a line with a CRLF, carraige return-line feed.

If the line is only one character long -- CR but not LF -- the code
length($stuff) - 2
will return -1, and so somewhere somehow, you're getting an error.

I don't really know how you can fix it other than to remove BOTH the CR and the LF from the string before you attempt to parse it.

murphybob reply:

[04:25] <murphybob> you could replace "$stuff = substr($stuff, 0, length($stuff) - 2);" with "chomp($stuff);" chomp is a perl function that removes any CRs or LFs from the end of a string
[04:26] <murphybob> (it actually affects the variable passed to it, so no need for $stuff=chomp($stuff); just chomp($stuff);
[04:26] <murphybob> )
[04:34] <murphybob> but i don't think thats the problem btw.
[04:34] <murphybob> not that i know what /is/ the problem of course