#!/usr/bin/perl -w
#
# oolong -- LiveJournal support notification IRC bot
#
# Copyright 2003, Rich Lafferty <rich@lafferty.ca>
#
# This is free software with ABSOLUTELY NO WARRANTY. You may reproduce
# and use this software under the same terms as Perl itself -- specifically,
# either under the Artistic License of Perl 5.8, or the General Public
# License, version 2 or later.
#
# $Id: notifybot.pl,v 1.12 2003/08/06 04:14:08 rich Exp rich $ 

use lib qw(/home/users/rich/bots/oolong/lib/perl5/site_perl/);

use strict;
use POE;
use POE::Component::IRC;
use POE::Component::Server::TCP;
use Storable;
use vars qw($subs $users);

my $VERSION = "0.91";

$|++;

# ------------------------------------------------------------
#  Configurable parts below
# ------------------------------------------------------------

my $mynick       = 'oolong';
my $mychannel    = '#lj_support'; 
my $myserver     = 'cerebellum.or.us.lazynet.org';
my $myusername   = 'oolong';
my $myircname    = 'Support notification bot (see mendel)';
my $subfile      = './subscriptions';
my $nickservpass = 'identify ********';
my %admin = (
   nickre     => 'mendel',
   uhre       => '~?rich@.*',
   password   => '******'
);

my $listen_port = 16667;

my %cats2tags = (
   'Clients' => 'clients',
   'Communities' => 'comms',
   'Embedding' => 'embedding',
   'General/Unknown' => 'gunk',
   'Syndication (RSS)' => 'syn',
   'User Picture Icons' => 'upi',
   'Web Interface' => 'web-ui',
   'Style Systems' => 'styles'
);

my @help = (
  "I'm $mynick, the LiveJournal support notification bot. I'll tell you about new support requests in whatever categories you subscribe to.",
  "Here are my commands, which I accept via /msg:",
  "   subscribe category    -- start sending you notifications for that category.",
  "   unsubscribe category  -- stop sending you notifications for that category.",
  "   show                  -- tell you what categories you are subscribed to.",
  "Available categories are: all " . join (" ", values %cats2tags)
);


# ------------------------------------------------------------
#  IRC client
# ------------------------------------------------------------

restoredata();

my %tags2cats;
for (keys %cats2tags) {
    $tags2cats{ $cats2tags{$_} } = $_;
}

sub _start {
  my ($kernel) = $_[KERNEL];

  $kernel->post( 'client', 'register', 'all');
  $kernel->post( 'client', 'connect', { Debug    => 1,
					 Nick     => $mynick,
					 Server   => $myserver,
					 Port     => 6667,
					 Username => $myusername,
					 Ircname  => $myircname, }
	       );

  $kernel->sig( INT => "sigint" );
  
}

sub irc_001 {
  my ($kernel) = $_[KERNEL];

  if ($nickservpass) {
      $kernel->post( 'client', 'privmsg', 'nickserv', $nickservpass );
  }
  $kernel->post( 'client', 'join', $mychannel );
}

sub irc_401 {
    my ($kernel, $error) = @_[KERNEL, ARG1];
    my $nick = ( split(' ', $error) )[0];

    print "[IRC] $nick not available, unsubscribing.\n";
    my @cats = keys %tags2cats;
    unsubscribe ($nick, @cats);   
}

sub irc_nick {
    my ($kernel, $who, $newnick) = @_[KERNEL, ARG0, ARG1];
    $who =~ /^(.*)!(.*)$/ or die "Weird-ass who: $who";
    my ($oldnick, $uh) = ($1, $2);

    if (exists $subs->{$oldnick}) {
        print "[IRC] Switching subscriptions for $oldnick to $newnick\n";
        my @cats = keys %{$subs->{$oldnick}};
        unsubscribe ($oldnick, @cats);
        subscribe ($newnick, @cats);
    }
    verify_subs();
}
    
sub irc_disconnected {
  my ($server) = $_[ARG0];
  print "[IRC] Lost connection to server $server.\n";
  $_[KERNEL]->post( "client", "unregister", "all" );
}

sub irc_error {
  my $err = $_[ARG0];
  print "[IRC] Server error occurred! $err\n";
}

sub irc_socketerr {
  my $err = $_[ARG0];
  print "[IRC] Couldn't connect to server: $err\n";
}

sub sigint {
  my $kernel = $_[KERNEL];
  $kernel->post( 'client', 'quit', 'Regrouping, brb' );
  $kernel->post( 'listener', 'shutdown');
  $kernel->sig_handled();
}

sub _stop {
  my ($kernel) = $_[KERNEL];
  print "[IRC] Control session stopped.\n";
  writedata();
}

sub irc_public {
  my ($kernel, $who, $chan, $msg) = @_[KERNEL, ARG0 .. ARG2];
  $who =~ /^(.*)!(.*)$/ or die "Weird-ass who: $who";
  my ($nick, $uh) = ($1, $2);

  if ($msg =~ /^\s*${mynick}\s*[,:] /i) {
      $kernel->post( 'client', 'privmsg', $nick,
          "$nick: I like to keep it to /msg. Try ``/msg $mynick help''.");
  }
}

sub irc_msg {
    my ($kernel, $who, $msg) = @_[KERNEL, ARG0, ARG2];
    $who =~ /^(.*)!(.*)$/ or die "Weird-ass who: $who";
    my ($nick, $uh) = ($1, $2);
    $nick = lc($nick);
    $msg =~ s/^\s*(.*)\s*$/$1/;
    $msg =~ s/\s+/ /g;
    $msg = lc($msg);

    if ($msg =~ /help/) {
        for (@help) {
            $kernel->post( 'client', 'privmsg', $nick, "$_");
        }
    }
    
    elsif ($msg =~ /^sub(scribe)?\s(.*)$/) {
        my $cat = $2;
        my @cats = split(' ', $cat);

        @cats = keys %tags2cats if $cat eq 'all';

        my ($ok, $msg) = subscribe ($nick, @cats);

        if ($ok) {
            print "[IRC] Subscribed $nick to $cat:\n";
        }
        else {
            print "[IRC] Failed subscribing $nick to $cat\n";
        }
        $kernel->post( 'client', 'privmsg', $nick, $msg);
    }
    
    elsif ($msg =~ /^unsub(scribe)?\s(.*)$/) {
        my $cat = $2;
        my @cats = split(' ', $cat);

        @cats = keys %tags2cats if $cat eq 'all';

       my ($ok, $msg) = unsubscribe ($nick, @cats);
       
       if ($ok) {
           print "[IRC] Unsubscribed $nick from: $cat\n";
       }
       else {
           print "[IRC] Failed unsubscribing $nick from $cat\n";
       }
       $kernel->post( 'client', 'privmsg', $nick, $msg);
    }

    elsif ($msg eq 'show') {
        my $msg = show_by_user($nick);
        print "[IRC] Showed $nick his categories\n";
        $kernel->post( 'client', 'privmsg', $nick, $msg);
    }

    # admin commands
    elsif ($msg =~ /^auth\s(\S+)\s(.*)$/) {
        my ($pass, $cmd) = ($1, $2);
        
        if ( is_admin($nick, $uh, $pass) ) {
            
            if ($cmd eq 'die') {  
                print "[IRC] Shutdown from $nick!$uh\n";
                kill( 'INT', $$ );
            }
            elsif ($cmd =~ /^unsub\s(\S+)$/) { 
                my $user = $1;
                print "[IRC] Admin unsubscribed $user from all\n";
                my @cats = keys %tags2cats;
                my ($ok, $msg) = unsubscribe ($user, @cats);   
                $kernel->post( 'client', 'privmsg', $nick,
                    "($user) $msg" );
            }
            elsif ($cmd =~ /^cat(egory)?\s(\S+)$/) {
                my $cat = $2;
                my ($ok, $msg) = show_by_cat($cat);
                print "[IRC] Admin listed category $cat\n";
                $kernel->post( 'client', 'privmsg', $nick, "($cat) $msg" );
            }
            elsif ($cmd =~ /^user\s(\S+)$/) {
                my $user = $1;
                my ($ok, $msg) = show_by_user($user);
                print "[IRC] Admin listed user $user\n";
                $kernel->post( 'client', 'privmsg', $nick,
                     "($user) $msg" );
            }
            elsif ($cmd =~ /^notice\s(.*)$/) {
                my $notice = $1;
                print "[IRC] notice: $notice\n";
                notice_all($kernel, $nick, $notice);
            }
            elsif ($cmd =~ /^me\s(.*)$/) {
                my $value = "\cAACTION " . $1 . "\cA";
                $kernel->post( 'client', 'privmsg', $mychannel, $value );
            }
            elsif ($cmd =~ /^msg\s(\S+)\s(.*)$/) {
                my $target = $1;
                my $value = $2;
                $kernel->post( 'client', 'privmsg', $target, $value );
            }
            elsif ($cmd =~ /^verify$/) {
                verify_subs();
                $kernel->post( 'client', 'privmsg', $nick,
                     "Verification run, see process logfile." );
             }
            else {
                $kernel->post( 'client', 'privmsg', $nick,
                     "Whatchu talkin' about, Willis?" );
            }
        }
        else { # isn't admin
            print "[IRC] Unauthorized admin command from $nick!$uh\n";
            $kernel->post( 'client', 'privmsg', $nick,
                         "I can't do that, Dave.");
        }
    }
    else {
        $kernel->post( 'client', 'privmsg', $nick,
                      "Whatchu talkin' about, Willis?" );
    } 

    verify_subs();
}
        
POE::Component::IRC->new( 'client' ) or
  die "Can't instantiate new IRC component!\n";
POE::Session->new( 'main' => [qw(_start _stop sigint irc_001 irc_401 
                                 irc_disconnected irc_socketerr irc_error 
                                 irc_public irc_msg irc_nick)
                                 ] );

# -----------------------------------------------------------
#  notifybotclient listener
# -----------------------------------------------------------

my %listen_tmp;

POE::Component::Server::TCP->new
  ( Alias => 'listener',
    Port => $listen_port,
    Address => '127.0.0.1',
   
    ClientConnected => \&listener_connect,
    ClientDisconnected => \&listener_disconnect,
    ClientInput => \&listener_input
  );

sub listener_connect {
    my ($session, $heap, $input) = @_[ SESSION, HEAP, ARG0 ];
    my $sessid = $session->ID();
    print "[RPC] Listener session $sessid initiated from $heap->{remote_ip}\n";
};
   
sub listener_disconnect {
    my ($session, $heap, $input) = @_[ SESSION, HEAP, ARG0 ];
    my $sessid = $session->ID();

    print "[RPC] Listener session $sessid ended\n";
    delete $listen_tmp{$sessid} if exists $listen_tmp{$sessid};
}

sub listener_input {
    my ($kernel, $session, $heap, $input) = @_[ KERNEL, SESSION, HEAP, ARG0 ];
    my $sessid = $session->ID();

    if ($input =~ /^([^:]+):\s+(.*)$/) {
        my ($type, $data) = ($1, $2);
        print "[RPC] Stored |$type|$data|\n";

        $listen_tmp{$sessid}{ lc($type) } = $data;
    }
    elsif ($input eq 'end') {

        if (exists $listen_tmp{$sessid}) {
            if ( process_input($kernel, $listen_tmp{$sessid}) ) {
                print "[RPC] Listener session $sessid: data accepted\n";
                $heap->{client}->put("200 Accepted");
            }
            else {
                print "[RPC] Listener session $sessid: data rejected\n";
                $heap->{client}->put("400 Rejected");
            }

            delete $listen_tmp{$sessid};
            $kernel->yield( 'shutdown' );
        }
    }
    else {
        $heap->{client}->put("500 Unrecognized");
        print "[RPC] Invalid input on session $sessid: $input\n";
    } 
  
}

sub process_input {
    my $kernel  = shift;
    my $dataref = shift;

    return 0 unless exists $dataref->{subject}
                and exists $dataref->{category}
                and exists $dataref->{request};

    my $cat = $cats2tags{$dataref->{category}};
    
    return 0 unless $cat;
    
    my @targets = keys %{$users->{$cat}};

    print "[IRC] Notifying users in $cat: [$dataref->{request}] $dataref->{subject}\n";

    while (@targets) {
        my @batch = splice(@targets, 0, 10);

        my $target = join (',', @batch);
        
        $kernel->post( 'client', 'privmsg', $target, 
        qq|$dataref->{category}: "$dataref->{subject}" ( | .
        "http://www.livejournal.com/support/see_request.bml?id=$dataref->{request} )");
    }
    return 1;
}

# ------------------------------------------------------------
#  Non-event subroutines
# ------------------------------------------------------------

sub is_admin {
    my ($nick, $uh, $pass) = @_;
    return 0 unless $pass eq $admin{password};
    return 0 unless $nick =~ /^$admin{nickre}$/;
    return 0 unless $uh   =~ /^$admin{uhre}$/;
    return 1;
}

sub subscribe {
    my ($nick, @cats) = @_;

    my @scats;
    for my $cat (@cats) {    
        return (0, "Sorry, I don't know about the category '$cat'.")
            unless exists $tags2cats{$cat};

        $subs->{$nick}{$cat} = 1;
        $users->{$cat}{$nick} = 1;
        push @scats, $tags2cats{$cat};
    }
    my $clist = join (", ", sort @scats);   
    return (1, "Notifications enabled for: $clist");
}

sub unsubscribe {
    my ($nick, @cats) = @_;

    my @ucats;
    for my $cat (@cats) {
        return (0, "Sorry, I don't know about that category.")
            unless exists $tags2cats{$cat};
        
        push @ucats, $tags2cats{$cat} if $subs->{$nick}{$cat} == 1;
        delete $subs->{$nick}{$cat};
        delete $users->{$cat}{$nick};
    }
    my $clist = join (", ", sort @ucats);
    return (1, "Notifications disabled for: $clist");
};

sub show_by_user {
    my $nick = shift;

    my @clist;
    if (exists $subs->{$nick} and keys %{$subs->{$nick}}) {
        for (keys %{$subs->{$nick}}) {
            push @clist, $tags2cats{$_};
        }

        return(1, "Current subscriptions: " . join(", ", sort @clist) );
    }
    else {
        return(0, "Current subscriptions: (none)")
    }
}

sub show_by_cat {
    my $cat = shift;
 
    my @ulist;
    return (0, "Category $cat does not exist.") unless exists $tags2cats{$cat};

    if (exists $users->{$cat}) {
        for (keys %{$users->{$cat}}) {
            push @ulist, $_;
        }

        return (1, "Subscribed: " . join (", ", sort @ulist) );
    }
    else {
        return (0, "No subscribers");
    }
}

sub notice_all {
    my ($kernel, $nick, $message) = @_;
    my @targets = keys %{$subs};

    while (@targets) {
        my @batch = splice(@targets, 0, 10);

        my $target = join (',', @batch);

        $kernel->post( 'client', 'privmsg', $target, "Notice from admin '$nick': $message" );
    }                                                
} 

sub writedata {
    store $subs, "$subfile.subs" or die "Can't restore subs";
    store $users, "$subfile.users" or die "Can't restore users";
    print "[INT] Subscription data stored.\n";
}

sub restoredata {
    if (-e "$subfile.subs" and -e "$subfile.users") {
        $subs = retrieve "$subfile.subs";
        $users = retrieve "$subfile.users";
        print "[INT] Subscription data retrieved.\n";
    }
}

sub verify_subs {
    print "[INT] Verifying subscription data consistency\n";

    my $error = 0;
    
    for my $thisuser (keys %{$subs}) {
        my @cats = keys %{$subs->{$thisuser}};
        
        for my $thiscat (@cats) {
            unless ( exists $users->{$thiscat}{$thisuser} ) {
                warn "[INT] ** INCONSISTENCY: \$subs->{$thisuser}{$thiscat} exists but \$users->{$thiscat}{$thisuser} does not\n";
                $error = 1;
            }
        }
    }
    
    for my $thiscat (keys %{$users}) {
        my @users = keys %{$users->{$thiscat}};

        for my $thisuser (@users) {
            unless ( exists $users->{$thiscat}{$thisuser} ) {
                warn "[INT] ** INCONSISTENCY: \$users->{$thiscat}{$thisuser} exists but \$subs->{$thisuser}{$thiscat} does not\n";
                $error = 1;
            }
        }
    }

    if ($error == 1) {
        print "[INT] Consistency check FAILED\n";
        kill( 'INT', $$ );
    }
    else {
        print "[INT] Consistency check OK\n";
    }
}

# ------------------------------------------------------------
#  GO!
# ------------------------------------------------------------

print "Starting...\n";
$poe_kernel->run();

exit 0;
