#!/usr/bin/perl -w use strict; $|++; use Net::IRC; ### QUOTEBOT # # Usage: ./quotebot.pl # # Quotebot is an IRC bot that serves up quotes using the 'fortune' program # at a interval of 24 hours. It also responds when it's name is spoken in # a channel by conjuring up a quote. # # Modify the configuration variables below as desired. ### our $SERVER ='localhost'; our $CHANNEL ='#unix-dev'; our $NICK = 'quotebot'; our $FORTUNE_PATH = '/usr/games/fortune'; our $SLEEP_INTERVAL = 24 * 60 * 60; # sleep 24 hours ### END of config variables. our $PARENT_PID = $$; our %PIDS = (); # forked child goes here $SIG{INT} = sub { my $signame = shift; debug("Caught a SIGINT, exiting gracefully"); exit; }; sub pid_to_processname ($) { my $pid = shift; return $PARENT_PID == $pid ? 'parent' : 'child'; } sub debug (@) { my $date = scalar(localtime); my $processname = pid_to_processname($$); warn "[$date] ($processname, pid=$$) ", @_, "\n"; } sub fortune () { my @fortune = `$FORTUNE_PATH`; debug("Conjured up: '@fortune'"); return @fortune; } sub fortunes_every_so_often ($) { my $self = shift; debug("I'm the parent, ungh! I've gotta give birth!"); my $pid; defined($pid = fork) or die "$$: Fork unsuccessful! $!"; if ($pid == 0) { # we're a child process debug("I'm a child."); my $sleep_time = $SLEEP_INTERVAL; while(1) { $self->privmsg($CHANNEL, $_) for fortune(); sleep $sleep_time; } exit; # never reached } else { # we're the parent process $PIDS{$pid} = 1; } } sub on_connect { my $self = shift; print "Joining $CHANNEL as $NICK\n"; $self->join($CHANNEL); $self->privmsg($CHANNEL, 'Fortune Much? Also...'); fortunes_every_so_often($self); } sub on_public { my ($self, $event) = @_; my $mynick = $self->nick; my ($arg) = ($event->args); if ($arg =~ /$mynick/i) { $self->privmsg($CHANNEL, $_) for fortune(); } } my $irc = new Net::IRC; my $conn = $irc->newconn(Nick => $NICK, Server => $SERVER, ) or die $!; $conn->add_global_handler('376', \&on_connect); $conn->add_handler('public', \&on_public); $irc->start(); END { cleanup(); } sub cleanup () { WAITKIDS: while (keys %PIDS) { debug("Trying a wait()."); my $result = wait; debug("wait() returned $result"); if ($result == -1) { debug("All child processes have finished."); warn "\%PIDS NOT empty:\n" . Dumper(\%PIDS) if keys %PIDS; last WAITKIDS; } else { delete $PIDS{$result} or warn "why did I see $result ($?)"; } } }