#!/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' pro
+gram
# 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 ($?)";
    }
  }
}

[download]

In reply to Quotebot by meonkeys

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.