DZone Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

Brad has posted 1 posts at DZone. View Full User Profile

Tiny Perl IRC Bot

02.12.2010
| 3968 views |
  • submit to reddit
        // Another IRC Bot written in Perl - Here for my reference, and anyone interested. Most parts of the bot are broken into subroutines to make reading and managing the code easier. So far it just ops and voices an admin. This is my first Perl project to help learn it. The bot.conf looks like
// server=localhost
// botnick=blowfish
// botuser=blowfish
// botname=Blowfish Bot
// botchan=#geeksware
// botadmin=serts
// bothost=.my.ip.or.host|another.ip.or.host|.and.another.example.com
// The bothost can contain all or just some of the wanted hostname as it's all regexp. This means you can add others by appending "|"

#!/usr/bin/perl -w

use strict;
use IO::Socket;

my $conf = "bot.conf";
our $server = "irc.geeksware.net";
our $botnick = "bot";
our $botuser = "bot";
our $botname = "bot";
our $botchan = "#geeksware";
our $botadmin = "serts";
our $bothost = ".geeksware.net";
our $irc;

sub ircsend($)
{
	use vars qw($irc);
	my $string = shift;
	print $irc $string . "\r\n";
}
sub ircmsg($$)
{
	my @string = @_;
	ircsend("PRIVMSG " . $string[0] . " :" . $string[1]);
}

sub ircnotice($$)
{
	my @string = @_;
	ircsend("NOTICE " . $string[0] . " :" . $string[1]);
}

sub trim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

sub botjoin
{
	use vars qw($server $botnick $botuser $botname $botchan $botadmin $bothost);
	my $usernick = $_[0];
	my $username = $_[1];
	my $userhost = $_[2];
	if ($userhost =~ /$bothost/) {
		ircsend("MODE " . $botchan . " +o " . $usernick);
	}
}

sub botcmd
{
	use vars qw($server $botnick $botuser $botname $botchan $botadmin $bothost);
	my $usernick = $_[0];
	my $username = $_[1];
	my $userhost = $_[2];
	my $cmd = $_[3];
	for ($cmd) {
		if ($cmd eq "uptime") {
			my $up = `uptime`;
			chomp($up);
			ircmsg($botchan, $usernick . ", " . $up); }
		elsif ($cmd eq "op") {
			if ($userhost !~ /$bothost/) { ircnotice($usernick, "You are not an admin."); }
			else { ircsend("MODE " . $botchan . " +o " . $usernick); } }
		elsif ($cmd eq "voice") {
			if ($userhost !~ /$bothost/) { ircnotice($usernick, "You are not an admin."); }
			else { ircsend("MODE " . $botchan . " +v " . $usernick); } }
	}
}

sub logmein {
	use vars qw($server $irc $botnick $botuser $botname $botchan);
	print "Connecting to " . $server . ":6667\n";
	our $irc = IO::Socket::INET->new(
			PeerAddr	=>	$server,
			PeerPort	=>	6667,
			Proto		=>	'tcp'
	) or die "Could not connect to " . $server . "\n";
	print "Connected!\n";
	print $irc "USER " . $botuser . " " . $botuser . " blah blah :" . $botname . "\r\n";
	print $irc "NICK " . $botnick . "\n";
	while (<$irc>) {
		for (trim($_)) {
			if (/^PING (.+)$/i) { ircsend("PONG $1"); }
			elsif (/^:(.+)!(.+)\@(.+) PRIVMSG $botnick :join$/i) {
				ircsend("NOTICE " . $1 . " :Joining " . $botchan);
				ircsend("JOIN :" . $botchan); }
			elsif (/^:(.+) 376/) { ircsend("JOIN :" . $botchan); }
			elsif (/^:(.+)!(.+)\@(.+) PRIVMSG $botchan :$botnick,\s+?(.+)$/) { botcmd($1,$2,$3,$4); }
			elsif (/^:(.+)!(.+)\@(.+) JOIN :$botchan$/) { botjoin($1,$2,$3); } 
			else { print $_ . "\n"; }
		}
	}
	close($irc);
}

sub filecheck {
	use vars qw($server $botnick $botuser $botname $botchan $botadmin $bothost);
	my $f = shift;
	open(CONF, $f);
	while (<CONF>) {
		chomp;
		next if $_ eq '';
		my(@word) = split(/=/,$_);
		if ($word[0] eq "server") {
			our $server = $word[1];
		} elsif ($word[0] eq "botnick") {
			our $botnick = $word[1];
		} elsif ($word[0] eq "botuser") {
			our $botuser = $word[1];
		} elsif ($word[0] eq "botname") {
			our $botname = $word[1];
		} elsif ($word[0] eq "botchan") {
			our $botchan = $word[1];
		} elsif ($word[0] eq "botadmin") {
			our $bothost = $word[1];
		} elsif ($word[0] eq "bothost") {
			our $bothost = $word[1];
		}
	}
	close(CONF);
	logmein();
}

if (not -e $conf) {
	die "Could not find '" . $conf . "'\n";
} else {
	filecheck($conf);
}