#!/usr/bin/perl -w
# XChat hooks and hacks
#

my $name = "Waider's XChat hacks";
my $version = "0.3.1";

# constants, which should be in the fricking IRC:: module.
sub IRC::xchat_version { 0 }    # xchat version
sub IRC::my_nickname   { 1 }    # your nickname
sub IRC::channel       { 2 }    # channel
sub IRC::server        { 3 }    # server
sub IRC::xchatdir      { 4 }    # xchatdir
sub IRC::away_status   { 5 }    # away status
sub IRC::network_name  { 6 }    # network name
sub IRC::server_host   { 7 }    # server hostname
sub IRC::channel_topic { 8 }    # channel topic

# Register only if we're not already registered. Durr. Can't do that, can we?
IRC::register( $name, $version, sub { print "shutting down\n" }, "" ); # name, version, shutdown routine, unused
IRC::print( "Loading $name $version\n" );
IRC::print( "Registering handlers..." );

# IRC::add_command_handler( "cmd", "handler" ) cmd is a /cmd
# IRC::add_message_handler( "msg", "handler" ) msg is IRC message/numeric code
# IRC::add_print_handler( "msg", "handler" ) msg is XChat message

IRC::add_message_handler( "PRIVMSG", "privmsg_handler" );
IRC::add_message_handler( "NOTICE", "notice_handler" ); # BAD WAIDER
IRC::add_timeout_handler( 5000, "check_screensaver" );
IRC::add_print_handler( "Notify Online", "notify_handler" );
IRC::print( "Registering handlers...done.\n" );

# state stuff
my %notified;
my $lastsplash = 0;
my $tried_nickserv = 0;

# config
my %conf;

my $xchatdir = IRC::get_info( IRC::xchatdir );
$xchatdir ||= $ENV{'HOME'} . "/.xchat";

# config file:
# [section]
# option = value
if ( open( FILE, "<" . $xchatdir . "/waider.conf" )) {
    my $section = "general";
    while (my $line = <FILE>) {
        next if $line =~ /^([;#].*|\s*)$/; # skip blanks + comments
        if ( $line =~ /^\[(.*)\]\s*$/ ) {
            $section = $1;
            next;
        }
        my ( $option, $value ) = split( /\s*=\s*/, $line, 2 );
        if ( defined( $option ) and defined( $value )) {
            $conf{$section} ||= {};
            $conf{$section}->{$option} = $value;
        }
    }
}

# small amount of sanity
$conf{general} ||= {};
$conf{general}->{timeout} = 20 if !defined( $conf{general}->{timeout}) or
  $conf{general}->{timeout} !~ /^\d+$/;
$conf{general}->{xsplash} =
  "xsplash -geometry -0+0 -font lucidasanstypewriter-24 -text '\%s' -timeout 5";
$conf{general}->{debug} ||= 0;



use Data::Dumper;
if ( $conf{general}->{debug}) {
    print STDERR Dumper( \%conf ) . "\n";
}

# Docs:
# http://www.irchelp.org/irchelp/rfc1459.html
# http://www.irchelp.org/irchelp/ircd/numerics.html
# http://www.irchelp.org/irchelp/ircd/hybrid6.html
sub notify_handler {
    # args: 'user host  ', 'user', 'host'
    my ( $comp, $user, $host ) = @_;

    my $cmd = sprintf( $conf{general}->{xsplash}, "$user is online" );
    system( "sh -c \"$cmd &\"" );
}

sub notice_handler {
    my ( $sender, $type, $channel, $message ) = split( ' ', $_[0], 4 );
    my $user;

    # Now clean things up
    $message =~ s/^://;
    ( $sender, $user ) = parse_sender( $sender );

    # RFC says NEVER EVER send an automated reply to a NOTICE. So
    # we'll just try once, and give up.

    # nickserv auto-identify
    if ( $sender eq "NickServ" ) {
        print STDERR scalar( localtime( time )) . " IRC: NickServ chatter: $message\n"
          if $conf{general}->{debug};
        if ( !$tried_nickserv and
             $message =~ /If this is your nickname, type / ) {
            my $nickservpass = $conf{nickserv}->{password};
            IRC::command( "/msg nickserv identify $nickservpass" )
                if $nickservpass;
            $tried_nickserv = 1;
        }
    }

    return;
}

sub privmsg_handler {
    my ( $sender, $type, $channel, $message ) = split( ' ', $_[0], 4 );
    my $user;

    # Now clean things up
    $message =~ s/^://;
    ( $sender, $user ) = parse_sender( $sender );

    # Ignore "foo is back" messages.
    return if $message =~ /^.ACTION/;

    # bitlbee autologin
    if ( $sender eq "root" and $channel =~ /bitlbee/ ) {
        if ( $message =~ /Welcome to the BitlBee gateway/ ) {
            my $pass = $conf{bitlbee}->{password} if $conf{bitlbee};
            IRC::command( "identify $pass" ) if $pass;

            print STDERR "IRC: bitlbee detected but no passwd configured\n"
              unless $pass;
        }
        return;
    }

    # don't bother with the rest of this if I'm marked away
    if ( IRC::get_info( IRC::away_status )) {
        print STDERR scalar( localtime( time )) . " IRC: you're already away\n" if $conf{general}->{debug};
        return;
    }

    # focus file doesn't update when you swap around tabs within the
    # same window, so we need to check what the current channel in
    # XChat is.
    my $current_channel = IRC::get_info( IRC::channel );

    # Check focus
	# I used use a .focus file, generated by window-switching events in fvwm.
    # new mechanism uses xprop to query the WM directly
    my $id = `xprop -root ' \$0\n' _NET_ACTIVE_WINDOW 2>&1`;
    my $class = "filler";
    my $title;
    if ( $id !~ /0x/ ) {
        $id ||= "unset";
        print STDERR scalar( localtime( time )) .
          " IRC: can't get active window ($id)\n";
        return;
    } else {
        ( undef, $id ) = split( /\s/, $id, 2 );
        chomp( $id );
        $title = `xprop -id $id ' \$0\n' WM_NAME 2>&1`;
        $title ||= "wtf unset";
        chomp( $title );
        ( undef, $title ) = split( /\s/, $title, 2 );
    }
    if (( $title =~ m@/ $channel@i ) or
        ( $title =~ m@Dialog with $sender@i ) or
        ( $title =~ m@X-Chat@i and
          ( lc( $current_channel ) eq lc( $channel )))) {
        return;            # no need, I'm already paying attention
    } else {
        print STDERR scalar( localtime( time )) . " IRC: Apparently you're looking at $title/$class/$id, which doesn't match $sender or $channel, or maybe $current_channel is wrong.\n" if $conf{general}->{debug};
    }

    # focus is wrong, or I'm not looking at the channel I'm being addressed.

    # find out what my nick is (is this per channel?)
    my $nick = IRC::get_info( IRC::my_nickname );

    my $bitlbee_regexp = $conf{bitlbee}->{regexp} if $conf{bitlbee};
    # middle one's a bit bogus, I think, and the third one's definitely bogus.
    if ( $message =~ /^$nick:/i or $channel =~ /$nick/ or
         ( defined( $bitlbee_regexp ) and $channel =~ /$bitlbee_regexp/ )) {
        # check if I'm there
        my $status = screensaving();
        if ( $status eq "blanked" ) {
            system( "xscreensaver-command", "--deactivate" );
        } elsif ( $status eq "locked" ) {
            if ( defined( $notified{$user})) {
                IRC::print( $user . " already knows I'm away" );
            } else {
                IRC::command( "/msg " . $sender . " sorry, I'm apparently away (screen locked)" ) unless $sender =~ /twitter/;
                IRC::command( "/away (screen locked)" );
                $notified{$user} = time;
            }
            return;
        }

        # not more than every 20 seconds
        if ( time - $lastsplash > $conf{general}->{timeout} ) {
            my $cmd = sprintf( $conf{general}->{xsplash}, "$sender/$channel" );
            system( "sh -c \"$cmd &\"" );
            $lastsplash = time;
        } else {
            print STDERR scalar( localtime( time )) .
              " IRC: No xsplash because of frequency\n"
                if $conf{general}->{debug};

        }
    } else {
        # talking to someone else
    }

    # got to here? make sure the notified hash is empty!
    %notified = ();

    return;
}

# split sender into nick / user@host
sub parse_sender {
    my $sender = shift;
    $sender =~ m/^:(.*?)!(.*)$/;
}

sub which_screensaver {
    # XXX
    return "KDE";
}

sub unblank_screen {
    if ( which_screensaver() eq "xscreensaver" ) {
        system( "xscreensaver-command", "--deactivate" );
    } else {
        #system( "dcop kdesktop KScreensaverIface quit, apparently" );
    }
}

sub screensaving {
    return "unknown"; # until I figure out why it's so damned flaky
    if ( which_screensaver() eq "xscreensaver" ) {
        if ( open( FILE, "xscreensaver-command --time 2>&1 |" )) {
            local $/ = undef;
            my $line = <FILE>;
            close( FILE );

            if ( $line =~ /non-blanked/ or $line =~ /no saver status/si or
                 $line =~ /no screensaver is running/ ) {
                # screen's active or hasn't yet slept or you didn't start
                # xscreensaver, disregard
                return "unknown";
            } elsif ( $line =~ /blanked/ ) {
                return "blank";
            } else {
                return "locked";
            }
        }
    } else {
        # KDE doesn't appear to know the difference between blanked and locked.
        if ( open( FILE, "dcop kdesktop KScreensaverIface isBlanked|" )) {
            local $/ = undef;
            my $line = <FILE>;
            close( FILE );
            if ( $line =~ /true/ ) {
                return "locked";
            }
        }
    }

    return "unknown";
}

# this is called on a 5-second timer to see if the screen's locked. It
# would be nicer to run xscreensaver-command -watch on a blocking
# read, but I don't know how well xchat would cope.
sub check_screensaver {
    my $status = screensaving();

    if ( $status eq "locked" ) {
        if ( !IRC::get_info( IRC::away_status )) {
            IRC::print( "Detected locked screen, marking you Away" );
            # ngh. server_list rather daftly returns a list of servers
            # you're not connected to as well as ones you ARE
            # connected to, and there's no way of saying "Am I
            # connected to $srv?"
            # And more stupidly, if you're on multiple channels you
            # get the same server several times.
            my %done;
            for my $srv ( IRC::server_list()) {
                if ( !defined( $done{$srv})) {
                    IRC::command_with_server( "/away (screen locked)",
                                              $srv );
                    $done{$srv} = $srv;
                }
            }
        }
    }

    # reschedule myself
    IRC::add_timeout_handler( 5000, "check_screensaver" );
}