#!/usr/bin/perl
########################################################################
# Xscript install instructions:
#  place xscript.pl in your ~/.xchat directory.
#
# Xscript provides a CTCP PAGE and SEEN response, aggressive nick 
#  reclamation, auto away/back functions, and a seen command.
#
# Programming notes: All 'global' variables are in hash form for
#  easier tracking. If xchat saves prefs on exit, so does this
#  script, however, manual xchat saves do not affect us.  Use
#  /saveconfig to manually save Xscript prefs.
#
# Copyright (C) 2000-2001 Gatewood Green
########################################################################

##### use declarations #################################################
package Xscript;
use warnings;
use IO::Handle;

##### Global variables #################################################
# Global variables containers
%config     = (); # Script configuration data
%scriptinfo = (); # Misc sript information
%away       = (); # Away state data (per server)
%myLastMsg  = (); # Time last PRIVMSG command sent (per server)
%seen       = (); # Data storage for seen feature
%reclaim    = (); # Nick reclaims in process (per server)
%errors     = (); # Script error conditions
%temp       = (); # Scratch pad

# Global variables for option control (This small group constitutes the default 'preferences')
$config{'xscriptlog'}   = 0;      # Log script events:    1 == ON, 0 == OFF (Mainly for script debugging)
$config{'logvars'}      = 0;      # Log script variables: 1 == ON, 0 == OFF (Mainly for script debugging)
$config{'autoaway'}     = 1;      # Use autoaway:         1 == ON, 0 == OFF
$config{'autoback'}     = 1;      # Use autoback:         1 == ON, 0 == OFF (only relevant if autoaway is on)
$config{'autoawaytime'} = 600;    # Timeout in secs that we go into away mode (600 secs == 10 minutes)
$config{'page'}         = 0;      # Respond to CTCP PAGE: 1 == ON, 0 == OFF
$config{'pagesound'}    = "";     # Sound to play when a CTCP PAGE is received
$config{'pageplayer'}   = "play"; # Program to play sound when a CTCP PAGE is received (I recomend esdplay if you use esound)
$config{'idlecheck'}    = 5000;   # How often in msecs we check our idle time (5000 msecs == 5 seconds) 
                                  #    - let's not burn up a cpu

# Global variables containing script info
$scriptinfo{'name'}     = "Xscript";
$scriptinfo{'version'}  = "0.5.4";
$scriptinfo{'author'}   = "Woody Green";
$scriptinfo{'email'}    = "woody\@linif.org";
$scriptinfo{'URL'}      = "http://woody.linif.org/xchat/";

# Global variables for holding state data (Leave these as is)
$errors{'log'}          = 0;
$errors{'config'}       = 0;
$errors{'seen'}         = 0;

# Read in the user's saved preferences
$temp{'configfile'}     = IRC::get_info( 4 ) . "/xscript.config";
$temp{'seenfile'}       = IRC::get_info( 4 ) . "/xscript.seen";
&Xscript::readconfig( );
&Xscript::readseen( );

# Global variables for *generating* an away reason (use /awayreason to change this)
$temp{'autoawaytag'}    = "Autoaway, idle > " . ( $config{'autoawaytime'} / 60 ) . 
                          " minutes. (" . $scriptinfo{'name'} . " " . $scriptinfo{'version'}  . ")";

##### Script setup #####################################################
# Log tools
open LOG, ">>" . IRC::get_info( 4 ) . "/xscript.log" or &Xscript::logerror( );
LOG->autoflush( 1 ); # Causes the log entries to occur immediately
&Xscript::xscriptlog( "Starting log..." );
&Xscript::xscriptlog( "Loading " . $scriptinfo{'name'} . " version: " . $scriptinfo{'version'} . "." );

# Initialize %myLastMsg fopr each already connected server
&Xscript::initAway( );

# Register script with xchat
IRC::register( $scriptinfo{'name'}, $scriptinfo{'version'}, "Xscript::cleanup", "" );

# Command handlers (external - action)
IRC::add_command_handler( "xscripthelp"  , "Xscript::handler_command_xscripthelp"   );
IRC::add_command_handler( "xscriptlog"   , "Xscript::handler_command_xscriptlog"    ); 
IRC::add_command_handler( "reclaimnick"  , "Xscript::handler_command_reclaimNick"   ); 
IRC::add_command_handler( "reclaimcancel", "Xscript::handler_command_reclaimCancel" ); 
IRC::add_command_handler( "reclaimstatus", "Xscript::handler_command_reclaimStatus" ); 
IRC::add_command_handler( "autoaway"     , "Xscript::handler_command_autoaway"      ); 
IRC::add_command_handler( "autoback"     , "Xscript::handler_command_autoback"      ); 
IRC::add_command_handler( "allaway"      , "Xscript::handler_command_allaway"       ); 
IRC::add_command_handler( "allback"      , "Xscript::handler_command_allaway"       ); 
IRC::add_command_handler( "showidle"     , "Xscript::handler_command_showidle"      ); 
IRC::add_command_handler( "showaway"     , "Xscript::handler_command_showaway"      ); 
IRC::add_command_handler( "page"         , "Xscript::handler_command_page"          );
IRC::add_command_handler( "seen"         , "Xscript::handler_command_seen"          );
IRC::add_command_handler( "saveconfig"   , "Xscript::handler_command_saveconfig"    ); 
IRC::add_command_handler( "pubeval"      , "Xscript::handler_command_evalPerl"      ); 

# Command handlers (external - monitor)
IRC::add_command_handler( ""             , "Xscript::handler_command_privmsg"       ); # Covers implied PRIVMSG commands
IRC::add_command_handler( "msg"          , "Xscript::handler_command_privmsg"       ); # Technically also a PRIVMSG command
IRC::add_command_handler( "privmsg"      , "Xscript::handler_command_privmsg"       ); # The PRIVMSG command is usually implied 
IRC::add_command_handler( "set"          , "Xscript::handler_command_set"           ); # Used for setting our own config values too
IRC::add_command_handler( "away"         , "Xscript::handler_command_away"          ); # Monitors manual away requests

# Diagnostic command handlers
IRC::add_command_handler( "setvar"   , "Xscript::handler_command_diagnostic_setvar"    ); 
IRC::add_command_handler( "eval"     , "Xscript::handler_command_diagnostic_evalPerl"  ); 
IRC::add_command_handler( "dumpvars" , "Xscript::handler_command_diagnostic_dumpvars"  ); 

# Nick Message handlers
IRC::add_message_handler( "001"    , "Xscript::handler_message_connect"     ); # Connect indicator /* on xchat load, the first 1 or 2 connects 
IRC::add_message_handler( "002"    , "Xscript::handler_message_connect"     ); # Connect indicator    connects msgs might beat the script load. */
IRC::add_message_handler( "003"    , "Xscript::handler_message_connect"     ); # Connect indicator
IRC::add_message_handler( "004"    , "Xscript::handler_message_connect"     ); # Connect indicator
IRC::add_message_handler( "433"    , "Xscript::handler_message_433"         ); # Nick in use
IRC::add_message_handler( "NICK"   , "Xscript::handler_message_nick"        ); # Nick change successful
IRC::add_message_handler( "PRIVMSG", "Xscript::handler_message_privmsg"     ); # Catches channel messages, personal messages and CTCPs.
IRC::add_message_handler( "JOIN"   , "Xscript::handler_message_join"        ); # Track users for seen function (as they join channels)
IRC::add_message_handler( "352"    , "Xscript::handler_message_352"         ); # Track users for seen function (users in a channel when you join)
IRC::add_message_handler( "PART"   , "Xscript::handler_message_part"        ); # Track users for seen function (as they part channels)
IRC::add_message_handler( "QUIT"   , "Xscript::handler_message_quit"        ); # Track users for seen function (as they quit)

# Always on timers
IRC::add_timeout_handler( 5000     , "Xscript::handler_timeout_autoaway"    ); #  5 seconds
IRC::add_timeout_handler( 1800000  , "Xscript::handler_timeout_maintenance" ); # 30 minutes

# Confirm load
&Xscript::printLine( );
IRC::print ( "Loading \002" . $scriptinfo{'name'} . "\002 version: \002" . $scriptinfo{'version'} . "\002\n" .
             "  By: " . $scriptinfo{'author'} . " \002<\002" . $scriptinfo{'email'} . "\002>\002\n" .
             "  " . $scriptinfo{'URL'} . "\n" .
             "  For help: \002/xscripthelp\002\n" );
&Xscript::printLine( );

##### Script functions #################################################
sub handler_command_xscripthelp ( ) {
# Xscript provides a CTCP PAGE response, aggressive nick reclamation
#  and auto away/back functions.
        IRC::print ( "Xscript provides a CTCP PAGE response, aggressive\n" .
                     "   nick reclamation and auto away/back functions.\n\n" .
                     "Xscript has the following (documented) commands:\n" .
                     "   reclaimnick reclaimcancel reclaimstatus\n" .
                     "   autoaway autoback\n" .
                     "   allaway allback\n" .
                     "   showidle showaway\n" .
                     "   page \n" .
                     "   seen \n" .
                     "   saveconfig\n\n" .
                     "For help: \002/<command> help\002\n" );
        return 1;
}

sub handler_command_xscriptlog ( $ ) {
        if ( $_[0] =~ /ON/i ) {
                $config{'xscriptlog'} = 1;
                &Xscript::xscriptlog( "Turned Xscript logging on." );
        } elsif ( $_[0] =~ /OFF/i ) {
                &Xscript::xscriptlog( "Turned Xscript logging off." );
                $config{'xscriptlog'} = 0;
                if ( !$errors{'log'} ) { close (LOG); };
        } elsif ( $_[0] =~ /SHOW/i ) {
                my $status;
                ( $config{'xscriptlog'} ) ? ( $status = "ON" ) : ( $status = "OFF" );
                IRC::print( "Current Xscript log status is $status.\n" );
        } else {
                IRC::print( "/xscriptlog <ON|OFF>\n" .
                            "     Turns the Xscript logging feature on or off.\n" .
                            "     /xscriptlog show  <-- View current value.\n" );
        }
        return 1;
}

sub handler_command_reclaimNick ( $ ) {
        # Changes your nick to $_[0]
        if ( $_[0] =~ /HELP/i ) {
                IRC::print( "/reclaimnick <nickname>\n" .
                            "     Will try on 30 second intervals to change your IRC nick.\n" );
        } else {
                my $server  = IRC::get_info( 3 );
                my $curNick = IRC::get_info( 1 );
                my $newNick = shift;
                if ( exists( $reclaim{$server} ) ) {
                        &Xscript::xscriptlog( "Nick reclaimation attempted while already in progress." );
                        return 1;
                } else {
                        $reclaim{$server} = $newNick;
                }
                if ( uc( $curNick ) eq uc( $newNick ) ) {
                        # Call the user an idiot
                        &Xscript::xscriptlog( "Nick reclaimation attempted on your current nick ($curNick).  Aborting..." );
                        &Xscript::printLine( $server, $server );
                        IRC::print_with_channel( "You're already $curNick.\nIf you want to do cosmetic changes (case), use /nick\n",$server, $server );
                        &Xscript::printLine( $server, $server );
                        delete( $reclaim{$server} );
                } else {
                        # Start nick reclaimation
                        &Xscript::printLine( $server, $server);
                        IRC::print_with_channel( "Current Nick: $curNick \n" .
                                                 "    New Nick: $newNick \n" .
                                                 "Nick reclaimation started...\n", $server, $server );
                        &Xscript::printLine( $server, $server);
                        &Xscript::xscriptlog( "Nick reclaimation started.  Attempting to reclaim $newNick." );
                        IRC::command( "/NICK $newNick" ); # Quick try
                        IRC::add_timeout_handler( 30000, "Xscript::handler_timeout_reclaimnick" ); # Start the reclaim loop
                }
        }
        return 1;
}

sub handler_command_reclaimCancel ( ) {
        if ( $_[0] =~ /HELP/i ) {
                IRC::print ( "/reclaimcancel\n" .
                             "     Cancels /reclaimnick command.\n" );
        } else {
                my $server = IRC::get_info( 3 );
                if ( exists( $reclaim{$server} ) ) {
                        &Xscript::xscriptlog( "Nick reclaimation of " . $reclaim{$server} . " on $server canceled.  Cleaning up." );
                        &Xscript::printLine( );
                        IRC::print ( "Nick reclaimation " . $reclaim{$server} . " on $server canceled.\n" );
                        &Xscript::printLine( );
                        delete( $reclaim{$server} );
                } else {
                        &Xscript::xscriptlog( "Cancelation of nick reclaimation on $server attempted (no nick reclaimation in progress)." );
                        IRC::print( "No nick reclaimation on $server is in progress.\n" );
                }
        }
        return 1;
}

sub handler_command_reclaimStatus ( ) {
        if ( $_[0] =~ /HELP/i ) {
                IRC::print ( "/reclaimstatus\n" .
                             "     Shows the status of the /reclaimnick command.  (Active or not)\n" );
        } else {
                my $count = 0;
                foreach $server ( keys %reclaim ) {
                        $count++;
                }
                &Xscript::printLine( );
                IRC::print ( "Nick reclaimation status:\n" );
                if ( $count ) { 
                        foreach $server ( keys %reclaim ) {
                                IRC::print ( "  Nick reclaimation for " . $reclaim{$server} . " on $server in progress.\n" );
                        }
                } else {
                        IRC::print ( "  Nick reclaimation NOT active.\n" );
                }
                &Xscript::printLine( );
        }
        return 1;
}

sub handler_command_autoaway ( $ ) {
        # Accepts 1 of 3 possible arguments: ON|OFF|<auto away time>
        if ( $_[0] =~ /ON/i ) {
                $config{'autoaway'} = 1;
                IRC::print( "Turned autoaway on.\n" );
                &Xscript::xscriptlog( "Turned autoaway on." );
        } elsif ( $_[0] =~ /OFF/i ) {
                $config{'autoaway'} = 0;
                IRC::print( "Turned autoaway off.\n" );
                &Xscript::xscriptlog( "Turned autoaway off." );
        } elsif ( $_[0] > 0 ) {
                $config{'autoawaytime'} = $_[0] * 60;
                $temp{'autoawaytag'}    = "Autoaway, idle > " . ( $config{'autoawaytime'} / 60 ) . 
                                          " minutes. (" . $scriptinfo{'name'} . " " .  $scriptinfo{'version'} . ")";
                IRC::print( "Set autoaway time to " . $_[0] . "minutes.\n" );
                &Xscript::xscriptlog( "Set autoaway time to " . ( $_[0] * 60 ) . "seconds." );
        } elsif ( $_[0] =~ /SHOW/i ) {
                my $status;
                ( $config{'autoaway'} ) ? ( $status = "ON" ) : ( $status = "OFF" );
                IRC::print( "Current auto away status is $status.\n" .
                            "Current auto away timeout is " . ( $config{'autoawaytime'} / 60 ) . " minutes.\n" );
        } else {
                IRC::print( "/autoaway <ON|OFF|TIME>\n" .
                            "     Turns the autoaway feature on or off or sets the auto away timeout to TIME.\n" .
                            "     /autoaway show  <-- View current value.\n" );
        }
        return 1;
}

sub handler_command_autoback ( $ ) {
        # Accepts 1 of 2 possible arguments: ON|OFF
        if ( $_[0] =~ /ON/i ) {
                $config{'autoback'} = 1;
                IRC::print( "Turned autoback on.\n" );
                &Xscript::xscriptlog( "Turned autoback on." );
        } elsif ( $_[0] =~ /OFF/i ) {
                $config{'autoback'} = 0;
                IRC::print( "Turned autoback off.\n" );
                &Xscript::xscriptlog( "Turned autoback off." );
        } elsif ( $_[0] =~ /SHOW/i ) {
                my $status;
                ( $config{'autoback'} ) ? ( $status = "ON" ) : ( $status = "OFF" );
                IRC::print( "Current auto back status is $status.\n" );
        } else {
                IRC::print( "/autoback <ON|OFF>\n" .
                            "     Turns the autoback feature on or off.\n" . 
                            "     /autoback show  <-- View current value.\n" );
        }
        return 1;
}

sub handler_command_allaway ( ) {
        if ( $_[0] =~ /^HELP$/i ) {
                IRC::print ( "/allaway <away msg>\n" .
                             "     Sends /away to all connected servers with the supplied away msg.\n" .
                             "/allback\n" .
                             "     Unsets /away on all connected servers.\n" );
        } else {
                my @servers = IRC::server_list( );
                foreach $server ( @servers ) {
                        if ( ( !$away{$server} ) && $_[0] ) {
                                IRC::command_with_server( "/away " . $_[0] , $server );
                        } elsif ( $away{$server} && !$_[0] ) {
                                IRC::command_with_server( "/away", $server );
                        }
                }
        }
        return 1;
}

sub handler_command_showidle ( ) {
        if ( $_[0] =~ /HELP/i ) {
                IRC::print ( "/showidle\n" .
                             "     Shows idle time in seconds on all currently connected servers.\n" .
                             "     Note: May be slightly inaccurate.\n" );
        } else {
                IRC::print ( "Listing idle time...\n" );
                my $time = time( );
                foreach ( keys %myLastMsg ) { IRC::print( "   $_ = " . &Xscript::convertsecs( $time - $myLastMsg{$_} ) . "\n" ); }
                IRC::print ( "End idle time listing.\n" );
        }
        return 1;
}

sub handler_command_showaway ( ) {
        if ( $_[0] =~ /HELP/i ) {
                IRC::print ( "/showaway\n" .
                             "     Shows on which servers you are set as away.\n" );
        } else {
                IRC::print ( "You are away on the following servers:\n" );
                foreach ( keys %away ) {
                        if      ( $away{$_} == 1 ) {
                                IRC::print( "   $_ (Auto away)\n" );
                        } elsif ( $away{$_} == 2 ) {
                                IRC::print( "   $_ (Manual away)\n" );
                        } else {
                                IRC::print( "   $_ (Error)\n" );
                        }
                }
                IRC::print ( "End away listing.\n" );
        }
        return 1;
}

sub handler_command_page ( $ ) {
        # Accepts 1 of many possible arguments: ON|OFF|SHOW|HELP|NONE|PLAY|<soundfile>|PLAYER <play program>
        my $arg = shift;
        $arg =~ s/^\s+?//; # Remove leading spaces
        if ( $arg =~ /^ON/i ) {
                $config{'page'} = 1;
                IRC::print( "Turned CTCP PAGE on.\n" );
                &Xscript::xscriptlog( "Turned CTCP PAGE on." );
        } elsif ( $arg =~ /^OFF/i ) {
                $config{'page'} = 0;
                IRC::print( "Turned CTCP PAGE off.\n" );
                &Xscript::xscriptlog( "Turned CTCP PAGE off." );
        } elsif ( $arg =~ /^HELP/i ) {
                IRC::print( "/page ON|OFF|SHOW|HELP|NONE|PLAY|<soundfile>|PLAYER <play program> \n" .
                            "     Turns the CTCP PAGE feature on or off or sets the PAGE sound to <soundfile>.\n" .
                            "     /page show  <-- View current CTCP PAGE settings.\n" );
        } elsif ( $arg =~ /^SHOW/i ) {
                my $status;
                ( $config{'page'} ) ? ( $status = "ON" ) : ( $status = "OFF" );
                IRC::print( "Current CTCP PAGE status is $status.\n" .
                            "Current CTCP PAGE sound is " . $config{'pagesound'} . "\n" .
                            "Current CTCP PAGE player is " . $config{'pageplayer'} . "\n" );
        } elsif ( $arg =~ /^NONE/i ) {
                $config{'pagesound'} = "";
                IRC::print( "Set CTCP PAGE sound to nothing.\n" );
                &Xscript::xscriptlog( "Set CTCP PAGE sound to nothing." );
        } elsif ( $arg =~ /^PLAYER/i ) {
                $arg =~ s/player/PLAYER/i;
                my ( $player ) = ( $arg =~ /PLAYER (.+)/ );
                $config{'pageplayer'} = $player;
                IRC::print( "Set CTCP PAGE player to $player.\n" );
                &Xscript::xscriptlog( "Set CTCP PAGE player to $player." );
        } elsif ( $arg =~ /^PLAY/i ) {
                IRC::print( "Playing CTCP PAGE sound...\n" );
                IRC::add_timeout_handler( 0, "Xscript::handler_timeout_page" );
        } elsif ( length( $arg ) > 0 ) {
                $config{'pagesound'} = $arg;
                IRC::print( "Set CTCP PAGE sound to $arg.\n" );
                &Xscript::xscriptlog( "Set CTCP PAGE sound to $arg." );
        } else {
                IRC::print( "/page ON|OFF|SHOW|HELP|NONE|PLAY|<soundfile>|PLAYER <play program> \n" .
                            "     Turns the CTCP PAGE feature on or off or sets the PAGE sound to <soundfile>.\n" .
                            "     /page show  <-- View current CTCP PAGE settings.\n" );
        }
        return 1;
}

sub handler_command_seen ( $ ) {
        my $nick = shift;
        if ( length( $nick ) > 0 ) {
                IRC::print( &Xscript::seen( $nick ) );
        } else {
                IRC::print( "Who is it that you are curious about?" );
        }
        return 1;
}

sub handler_command_saveconfig ( ) {
        if ( $_[0] =~ /HELP/i ) {
                IRC::print ( "/saveconfig\n" .
                             "     Saves the current script configuration and seen data.\n" );
        } else {
                &Xscript::writeconfig( );
                &Xscript::writeseen( );
        }
        return 1;
}

sub handler_command_evalPerl ( $ ) {
        # Execute ad-hoc Perl code - Print code and results publicly
        # Think of this as a *simple* Perl shell inside xchat
        # !NOTE! this is a dangerous command, I am not responsible 
        #        for your ignorance or stupidity.  Use with care.
        my $code = shift;
        IRC::command( "$code" );
        # Replace print and IRC::print with IRC::command
        #  This is what causes the results to appear publicly
        $code =~ s/^print/IRC::command/g;
        $code =~ s/( |;)print/IRC::command/g;
        $code =~ s/^IRC::print/IRC::command/g;
        $code =~ s/( |;)IRC::print/IRC::command/g;
        eval $code;
        if ($@) {
                IRC::print( "Perl error (not printed publicly):\n$@" );
        }
        return 1;
}

sub handler_command_set ( $ ) {
        # This is a way to hijack xchat's set command to work for us too.
        my ( $var, $val ) = ( $_[0] =~ /(\S*)\s(.*)/ ); 
        my $localvar = 0;
        if ( exists( $config{lc( $var )} ) ) {
                $config{lc( $var )} = $val;
                $localvar = 1;
                #&Xscript::writeconfig;
        }
        if ( $localvar ) {
                return 1; # It's one of ours, keep xchat out.
        } else {
                return 0; # Pass onto xchat for further processing
        }
}

sub handler_command_away ( ) {
        my $server = IRC::get_info( 3 );
        if ( length($_[0]) == 0 ) {
                if ( IRC::get_info( 5 ) == -1 ) {
                        &Xscript::xscriptlog( "Canceled away. ($server)" );
                        if ( exists( $away{$server} ) ) {
                                delete( $away{$server} );
                        }
                        my $idletime = &Xscript::convertsecs( time( ) - $myLastMsg{$server} );
                        IRC::print_with_channel( "Welcome back, idle time was: " . $idletime . "\n" , $server, $server );
                        $myLastMsg{$server} = time( );
                } else {
                        $away{$server} = 2;
                        &Xscript::xscriptlog( "Set away. ($server)" );
                }
        } else {
                &Xscript::xscriptlog( "Set away: " . $_[0] . " ($server)" );
                my $autoawaytag = $temp{'autoawaytag'};
                if ( $_[0] =~ /\Q$autoawaytag\E/ ) {
                        # Auto away
                        $away{$server} = 1;
                } else {
                        # Manual away
                        $away{$server} = 2;
                }
        }
        return 0;
}

sub handler_command_privmsg ( $ ) {
        my ( $nick ) = split " ", shift; 
        my $server = IRC::get_info( 3 );
        &Xscript::xscriptlog( "Caught PRIVMSG on $server." );
        if ( $config{'autoback'} && ( exists( $away{$server} ) ) ) {
                if ( ( $away{$server} == 1 ) && !( $nick =~ /^(nick|chan)serv$/i ) ) {
                        #Unset away only if away and the msg is not to nick/chanserv
                        IRC::command( "/away" );
                }
        }
        if ( !( $nick =~ /^(nick|chan)serv$/i ) ) { $myLastMsg{$server} = time( ); }
        return 0;
}

sub handler_command_diagnostic_setvar ( $ ) {
        # Diagnostic - Set Perl variable
        my ( $var, $val, $hash ) = split " ", shift;
        if ( length($hash) > 0 ) {
                $$var[$hash] = $val;
                IRC::print ( "Set \$$var [$hash] to $val\n" );
        } elsif ( length($hash) > 0 ) {
                $$hash{$var} = $val;
                IRC::print ( "Set \$$hash {\'$var\'} to $val\n" );
        } else {
                $$var = $val;
                IRC::print ( "Set \$$var to $val\n" );
        }
        return 1;
}

sub handler_command_diagnostic_evalPerl ( $ ) {
        # Diagnostic - Execute ad-hoc Perl code
        # Think of this as a *simple* Perl shell inside xchat
        # !NOTE! this is a dangerous command, I am not responsible 
        #        for your ignorance or stupidity.  Use with care.
        my $code = shift;
        # Replace print with IRC::print
        $code =~ s/^print/IRC::print/g;
        $code =~ s/( |;)print/IRC::print/g;
        eval $code;
        if ($@) {
                IRC::print( "/eval error:  $@\n" );
        }
        return 1;
}

sub handler_command_diagnostic_dumpvars ( ) {
        # Diagnostic - Show current global variable values
        IRC::print( "Dumping variables...\n" );
        foreach $var ( "config", "scriptinfo", "errors", "myLastMsg", "away", "reclaim", "temp" ) {
                foreach $key ( keys %$var ) {
                        IRC::print( "  \$$var { $key } = " . $$var{$key} . "\n" );
                }
        }
        IRC::print( "Finished dumping variables.\n" );
        return 1;
}

sub handler_message_connect ( ) {
        # Initialize the autoaway system
        my $server = IRC::get_info( 3 );
        $myLastMsg{$server} = time( );
        if ( exists( $away{$server} ) ) { delete( $away{$server} ); }
        if ( exists( $reclaim{$server} ) ) { delete( $reclaim{$server} ); }
        return 0;
}

sub handler_message_nick ( $ ) {
        # This deals with your nick change notices
        # Note:  you get nick change notices when anyone in any 
        #        channel you are in or in msg/query with changes their nick
        my $arg = $_[0];
        my ( undef, undef, $nick ) = split " ", shift; # What nick was just claimed?
        $nick =~ s/^://; # Clean the colon from in front of the 'captured' nick
        my $server = IRC::get_info( 3 ); # Get server context
        if ( exists( $reclaim{$server} ) ) { # Are we attempting to reclaim a nick on this server?
                # Is this the nick we are trying to reclaim and did we succeed?
                if ( ( $reclaim{$server} eq $nick ) && ( IRC::get_info( 1 ) eq $nick ) ) {
                        # We got our nick, end the reclaim attempt and clean up
                        delete( $reclaim{$server} );
                        &Xscript::xscriptlog( "Reclaimation of $nick on $server succeeded." );
                        &Xscript::printline( );
                        IRC::print_with_channel( "Reclaimation of $nick succeeded.",$server ,$server  );
                        &Xscript::printline( );
                }
        }
        # Get data for Seen function
        my ( $oldnick, $mask, $newnick ) = ( $arg =~ /^:(.+)!(.+) NICK :(.+)$/ );
        my $channel = IRC::get_info( 2 );
        # Old nick data
        $seen{uc( $oldnick )}[0] = $mask;
        $seen{uc( $oldnick )}[1] = $channel;
        $seen{uc( $oldnick )}[2] = $server;
        $seen{uc( $oldnick )}[3] = time( );
        $seen{uc( $oldnick )}[4] = "newnick:$newnick";
        # New nick data
        $seen{uc( $newnick )}[0] = $mask;
        $seen{uc( $newnick )}[1] = $channel;
        $seen{uc( $newnick )}[2] = $server;
        $seen{uc( $newnick )}[3] = time( );
        $seen{uc( $newnick )}[4] = "oldnick:$oldnick";
        return 0; # Pass info on to xchat for further processing
}

sub handler_message_433 ( $ ) {
        # Sub to hide Nick in use messages when doing a /reclaimnick
        my $server = IRC::get_info( 3 ); # Get server context
        if ( exists( $reclaim{$server} ) ) { # Are we attempting to reclaim a nick on this server?
                return 1; # Don't polute our status window with nick change denied messages
        } else {
                return 0; # Pass onto xchat
        }
}

sub handler_message_privmsg ( $ ) {
        my $privmsg = shift;
        if ( $privmsg =~ /\001PAGE\001/i ) {
                # Deal with CTCP PAGE requests
                my ( $sender ) = ( $privmsg =~ /:(.+)!/ );
                &Xscript::xscriptlog( "Received CTCP PAGE from $sender." );
                if ( $config{'page'} ) {
                        # Acknowledge the page
                        IRC::command( "/NOTICE $sender PAGE received.  (" . 
                                       $scriptinfo{'name'} . " " . $scriptinfo{'version'} . ")" );
                        # Spawns instead of waits
                        IRC::add_timeout_handler( 0, "Xscript::handler_timeout_page" ); 
                } else {
                        my $nick = IRC::get_info( 1 );
                        IRC::command( "/NOTICE $sender $nick has CTCP PAGE disabled.  (" . 
                                       $scriptinfo{'name'} . " " . $scriptinfo{'version'} . ")" );
                }
        } elsif ( $privmsg =~ /\001SEEN/i ) {
                # Deal with CTCP SEEN requests
                my ( $sender ) = ( $privmsg =~ /:(.+)!/ );
                my ( $nick )   = ( $privmsg =~ /SEEN (.+)\001$/ );
                $nick =~ s/\s//g;
                if ( IRC::get_info( 1 ) ne $nick ) {
                        IRC::command( "/NOTICE $sender " . &Xscript::seen( $nick ) );
                } else {
                        IRC::command( "/NOTICE $sender Why are you asking if I've seen myself?" );
                }
        } elsif ( $privmsg =~ /PRIVMSG #/ ) {
                # Capture data for seen function
                my $server = IRC::get_info( 3 );
                my ( $nick, $mask, $channel ) = ( $privmsg =~ /^:(.+)!(.+) PRIVMSG (\S+) :.*$/ );
                $seen{uc( $nick )}[0] = $mask;
                $seen{uc( $nick )}[1] = $channel;
                $seen{uc( $nick )}[2] = $server;
                $seen{uc( $nick )}[3] = time( );
                $seen{uc( $nick )}[4] = "talking";
        }
        return 0;
}

sub handler_message_join ( ) {
        # Capture user data for seen function
        my $arg    = shift;
        my $server = IRC::get_info( 3 );
        my ( $nick, $mask, $channel ) = ( $arg =~ /:(.+)!(.+) JOIN :(.+)/ );
        $seen{uc( $nick )}[0] = $mask;
        $seen{uc( $nick )}[1] = $channel;
        $seen{uc( $nick )}[2] = $server;
        $seen{uc( $nick )}[3] = time( );
        $seen{uc( $nick )}[4] = "joining";
        return 0;
}

sub handler_message_352 ( ) {
        # Capture user data for seen function
        my $arg    = shift;
        my $mynick = IRC::get_info( 1 );
        my ( $channel, $user, $host, $server, $nick ) = ( $arg =~ /.+$mynick (\S+) (\S+) (\S+) (\S+) (\S+) .+/ );
        $seen{uc( $nick )}[0] = "$user\@$host";
        $seen{uc( $nick )}[1] = $channel;
        $seen{uc( $nick )}[2] = $server;
        $seen{uc( $nick )}[3] = time( );
        $seen{uc( $nick )}[4] = "in";
        return 0;
}

sub handler_message_part ( ) {
        # Capture user data for seen function
        my $arg    = shift;
        my $server = IRC::get_info( 3 );
        my ( $nick, $mask, $channel ) = ( $arg =~ /:(.+)!(.+) PART :(.+)/ );
        $seen{uc( $nick )}[0] = $mask;
        $seen{uc( $nick )}[1] = $channel;
        $seen{uc( $nick )}[2] = $server;
        $seen{uc( $nick )}[3] = time( );
        $seen{uc( $nick )}[4] = "leaving";
        return 0;
}

sub handler_message_quit ( ) {
        # Capture user data for seen function
        my $arg     = shift;
        my $server  = IRC::get_info( 3 );
        my $channel = IRC::get_info( 2 );
        my ( $nick, $mask ) = ( $arg =~ /:(.+)!(.+) QUIT :/ );
        $seen{uc( $nick )}[0] = $mask;
        $seen{uc( $nick )}[1] = $channel;
        $seen{uc( $nick )}[2] = $server;
        $seen{uc( $nick )}[3] = time( );
        $seen{uc( $nick )}[4] = "quitting";
        return 0;
}

sub handler_timeout_autoaway ( ) {
        &Xscript::checkIdle;
        IRC::add_timeout_handler( $config{'idlecheck'}, "Xscript::handler_timeout_autoaway" ); 
        return 0;
}

sub handler_timeout_maintenance ( ) {
        # Loop to do misc periodic tasks
        if ( $config{'logvars'} ) {
                # Write variable for diagnostics
                &Xscript::xscriptlog( "Dumping variables..." );
                foreach $var ( "config", "scriptinfo", "errors", "myLastMsg", "away", "reclaim", "temp" ) {
                        foreach $key ( keys %$var ) {
                                &Xscript::xscriptlog( "  \$$var { $key } = " . $$var{$key}  );
                        }
                }
                &Xscript::xscriptlog( "Finished dumping variables." );
        }
        # Backup seen database
        &Xscript::writeseen;
        IRC::add_timeout_handler( 1800000, "Xscript::handler_timeout_maintenance" );
        return 0;
}

sub handler_timeout_reclaimnick ( ) {
        my $continue = 0; # Used to indicate that we should (or should not) reinstall the reclaimnick timer
        my %nicks = ();   # List of out current nicks on all connected servers
        &Xscript::cleanHashServerKeys( "reclaim" ); # Make sure we aren't wasting CPU cycles reclaiming a nick on a disconnected server
        &Xscript::getnicks( \%nicks );
        foreach $server ( keys %reclaim ) {
                if ( $nicks{$server} ne $reclaim{$server} ) {
                        &Xscript::xscriptlog( "Attempting reclaimation of " . $reclaim{$server} . " on $server. (Current nick: " . $nicks{$server} . ")" );
                        IRC::command_with_server( "/NICK " . $reclaim{$server}, $server );
                        $continue = 1;
                } else {
                        # We have reclaimed the nick we wanted, end the reclaim and clean up.
                        delete( $reclaim{$server} );
                        &Xscript::xscriptlog( "Reclaimation of " . $nicks{$server} . " on $server succeeded." );
                }
        }
        if ( $continue ) {
                # We have not confirmed a successful nick reclaimation, so reinstall the timer for another attempt.
                IRC::add_timeout_handler( 30000, "Xscript::handler_timeout_reclaimnick" ); 
        }
        return 0;
}

sub handler_timeout_page ( ) {
        # If a page sound exists, play it.
        if ( $config{'pagesound'} ) {
                if ( -e $config{'pagesound'} ) {
                        system( $config{'pageplayer'} . " " . $config{'pagesound'} );
                } else {
                        IRC::print( "Configured CTCP PAGE sound file not found.\n" .
                                    "  For CTCP PAGE sound, try /page HELP\n" );
                }
        } else {
                IRC::print( "CTCP PAGE received, but no sound configured.\n" .
                            "  For CTCP PAGE sound, try /page HELP\n" );
                &Xscript::xscriptlog( "CTCP PAGE received, but no sound configured." );
        }
        return 0;
}

##### Script Support functions #########################################
sub readconfig ( ) {
        if ( -e $temp{'configfile'} ) {
                open CONFIG, "<" . $temp{'configfile'} or &Xscript::configerror( "READ" );
                if ( !$errors{'config'} ) {
                        while ( <CONFIG> ) {
                                $_ =~ s/=/ /g;
                                $_ =~ s/\s+/ /g;
                                $_ =~ s/^\s//;
                                $_ =~ s/#.*$//;
                                if ( length( $_ ) > 1 ) {
                                        my ( $var, $val )  = split " ", $_;
                                        $config{$var} = $val;
                                }
                        }
                        close (CONFIG);
                        &Xscript::xscriptlog( "Read config file." );
                }
        }
        # This is dependent on config file values ($autoawaytime)
        $temp{'autoawaytag'}  = "Autoaway, idle > " . ( $config{'autoawaytime'} / 60 ) . 
                                " minutes. (" . $scriptinfo{'name'} . " " .  $scriptinfo{'version'} . ")";
        return 0;
}

sub writeconfig ( ) {
        if ( !$errors{'config'} ) {
                open  CONFIG, ">" . $temp{'configfile'} or &Xscript::configerror( "WRITE" );
                if ( !$errors{'config'} ) {
                        print CONFIG "# Xscript config file.\n"; 
                        print CONFIG "# Line style: variable = value\n";
                        print CONFIG "# #'s indicate coments.\n\n";
                        foreach $key ( keys %config ) { print CONFIG "$key = " . $config{$key} . "\n"; }
                        close (CONFIG);
                        &Xscript::xscriptlog( "Wrote config file." );
                }
        }
        return 0;
}

sub readseen ( ) {
        if ( -e $temp{'seenfile'} ) {
                open SEEN, "<" . $temp{'seenfile'} or &Xscript::seenerror( "READ" );
                if ( !$errors{'seen'} ) {
                        while ( <SEEN> ) {
                                $_ =~ s/^#.*$//;
                                if ( length( $_ ) > 1 ) {
                                        my ( $nick, $mask, $channel, $server, $date, $action ) = ( /^(\S+) (\S+) (\S+) (\S+) (\S+) (\S+)$/ );
                                        $seen{uc( $nick )}[0] = $mask;
                                        $seen{uc( $nick )}[1] = $channel;
                                        $seen{uc( $nick )}[2] = $server;
                                        $seen{uc( $nick )}[3] = $date;
                                        $seen{uc( $nick )}[4] = $action;
                                }
                        }
                        close (SEEN);
                        &Xscript::xscriptlog( "Read seen file." );
                }
        }
        return 0;
}

sub writeseen ( ) {
        if ( !$errors{'seen'} ) {
                open  SEEN, ">" . $temp{'seenfile'} or &Xscript::seen( "WRITE" );
                if ( !$errors{'seen'} ) {
                        print SEEN "# Xscript seen file.\n";
                        print SEEN "# Do not edit this file.\n";
                        print SEEN "# Format: nick mask channel server time action\n";
                        print SEEN "# mask format: user\@host\n";
                        print SEEN "# channel can also be a server for certain actions\n";
                        print SEEN "# time is in seconds since Jan 1 1970 (UNIX)\n";
                        print SEEN "# action has several formats depending on the situation\n\n";
                        foreach $key ( keys %seen ) {
                                if ( ( ( time( ) - 2592000 )  < $seen{$key}[3] ) && length( $key ) > 0 ) { # Only keep 30 days worth of records
                                        print SEEN "$key ". join( " ", $seen{$key}[0], $seen{$key}[1], $seen{$key}[2], $seen{$key}[3], $seen{$key}[4] ) . "\n";
                                }
                        }
                        close (SEEN); 
                        &Xscript::xscriptlog( "Wrote seen file." );
                }
        }               
        return 0;
}

sub configerror ( $ ) {
        if ( $_[0] =~ /READ/i ) {
                IRC::print( "Config file found but inaccesable.\n" );
                &Xscript::xscriptlog( "Config file found but inaccesable." );
                $errors{'config'} = 1;
        } elsif ( $_[0] =~ /WRITE/i ) {
                IRC::print( "Could not open config file for writing.\n" );
                &Xscript::xscriptlog( "Could not open config file for writing." );
                $errors{'config'} = 2;
        }
        return 0;
}

sub seenerror ( $ ) {
        if ( $_[0] =~ /READ/i ) {
                IRC::print( "Seen file found but inaccesable.\n" );
                &Xscript::xscriptlog( "Seen file found but inaccesable." );
                $errors{'seen'} = 1;
        } elsif ( $_[0] =~ /WRITE/i ) {
                IRC::print( "Could not open seen file for writing.\n" );
                &Xscript::xscriptlog( "Could not open seen file for writing." );
                $errors{'seen'} = 2;
        }
        return 0;
}

sub getnicks ( $ ) {
        my $nickhash = shift;
        my @list = IRC::channel_list( );
        for ( $i = 1; $i <= ( ( $#list + 1 ) / 3 ); $i++ ) {
                my $nick    = pop @list;
                my $server  = pop @list;
                my $channel = pop @list;
                if ( $channel eq $server ) {
                        $$nickhash{$server} = $nick;
                }
                undef $nick;
                undef $server;
                undef $channel;
        }
}

sub initAway ( ) {
        # If the script is loaded after xchat is already running this will initialize the server away times
        my @list = IRC::channel_list( );
        my $time = time( );
        my @servers = ();
        for ( $i = 1; $i <= ( ( $#list + 1 ) / 3 ); $i++ ) {
                my $nick    = pop @list;
                my $server  = pop @list;
                my $channel = pop @list;
                if ( $channel eq $server ) {
                        push @servers, $server;
                }
                undef $nick;
                undef $server;
                undef $channel;
        }
        foreach ( @servers ) { $myLastMsg{$_} = $time; }
        return 0;
}

sub checkIdle ( ) {
        # Checks for idle time and stores it for each server
        # Cleanup first ( looks for old non-connected server references )
        &Xscript::cleanHashServerKeys( "away" );
        &Xscript::cleanHashServerKeys( "myLastMsg" );
        #Carry on...
        my @list = IRC::channel_list( );
        my @servers = ();
        my $cycles = ( $#list + 1 ) / 3; # This doesn't work if put inline with the for statement for some reason
        for ( $i = 1; $i <= $cycles; $i++ ) {
                my $nick    = pop @list;
                my $server  = pop @list;
                my $channel = pop @list;
                if ( $channel eq $server ) {
                        push @servers, $server;
                }
                undef $nick;
                undef $server;
                undef $channel;
        }
        if ( $config{'autoaway'} ) {
                # Is autoaway turned on?
                foreach ( @servers ) { 
                        # Separate away handling for each server connections
                        if ( !$away{$_} ) {
                                # We're not currently away, should we be?
                                my $awayreason   = IRC::get_prefs( "awayreason" );
                                my $time = time();
                                if ( ( $time - $myLastMsg{$_} ) > $config{'autoawaytime'} ) { 
                                        if ( length( $awayreason ) > 0 ) {
                                                IRC::command_with_server( "/away $awayreason : " . $temp{'autoawaytag'}, $_ ); 
                                        } else {
                                                IRC::command_with_server( "/away " . $temp{'autoawaytag'}, $_ ); 
                                        }
                                        &Xscript::xscriptlog( "Automatically set away. (Idle: " . ( $time - $myLastMsg{$_} ) . " Server: $_)" );
                                        $away{$_} = 1;
                                }
                        }
                }
        }
        undef @servers;
        undef @list;
        return 0;
}

sub seen ( $ ) {
        my $nick = shift;
        my $result = "";
        if ( exists( $seen{uc( $nick )} ) ) {
                if ( $seen{uc( $nick )}[4] =~ /^newnick:/ ) {
                        my ( $newnick ) = ( $seen{uc( $nick )}[4] =~ /^newnick:(.+)$/ );
                        $result = sprintf "\002$nick\002 (\002" . $seen{uc( $nick )}[0] . "\002) was last seen \0034changing to $newnick\003" . 
                                    " on server: \002" . $seen{uc( $nick )}[2] . "\002 at \002" . 
                                    &Xscript::getDate( $seen{uc( $nick )}[3] ) . "\002.";
                } elsif ( $seen{uc( $nick )}[4] =~ /^oldnick:/ ) {
                        my ( $oldnick ) = ( $seen{uc( $nick )}[4] =~ /^oldnick:(.+)$/ );
                        $result = sprintf "\002$nick\002 (\002" . $seen{uc( $nick )}[0] . "\002) was last seen \0034changing from $oldnick\003" . 
                                    " on server: \002" . $seen{uc( $nick )}[2] . "\002 at \002" . 
                                    &Xscript::getDate( $seen{uc( $nick )}[3] ) . "\002.";
                } elsif ( $seen{uc( $nick )}[4] =~ /^quitting/ ) {
                        my ( $oldnick ) = ( $seen{uc( $nick )}[4] =~ /^oldnick:(.+)$/ );
                        $result = sprintf "\002$nick\002 (\002" . $seen{uc( $nick )}[0] . "\002) was last seen \0034quitting\003" . 
                                    " on server: \002" . $seen{uc( $nick )}[2] . "\002 at \002" . 
                                    &Xscript::getDate( $seen{uc( $nick )}[3] ) . "\002.";
                } else {
                        $result = sprintf "\002$nick\002 (\002" . $seen{uc( $nick )}[0] . "\002) was last seen \0034" . 
                                    $seen{uc( $nick )}[4] . "\003 \002" . $seen{uc( $nick )}[1] . "\002" . " on server: \002" . 
                                    $seen{uc( $nick )}[2] . "\002 at \002" . &Xscript::getDate( $seen{uc( $nick )}[3] ) . "\002.";
                }
        } else {
                $result = sprintf "I have not seen \002$nick\002.";
        }
        return $result;
}

sub printLine ( ;$$ ) {
        my $server  = shift;
        my $channel = shift;
        if ( $server ) {
                IRC::print_with_channel ( "\0034--------------------------------------------\003\n", $channel, $server );
        } else {
                IRC::print ( "\0034--------------------------------------------\003\n" );
        }
        return 0;
}

sub xscriptlog ( $ ) {
        if ( !$errors{'log'} ) { print LOG &Xscript::getDate( ), " ", $_[0], "\n"; }
        return 0;
}

sub logerror ( ) {
        IRC::print( "ERROR, couldn't open the log file.\n" );
        $errors{'log'} = 1;
        return 0;
}

sub getDate ( ) {
        if ( $_[0] ) {
                $time = $_[0];
        } else {
                $time = time( );
        }
        my ( $sec,$min,$hour,$mday,$mon,$year ) = localtime( $time );
        my $date = sprintf "%04u-%02u-%02u %02u:%02u:%02u", ( $year += 1900 ), ( $mon += 1 ), $mday, $hour, $min, $sec;
        return $date;
}

sub convertsecs ( $ ) {
        my ( $sec, $min, $hour, $time );
        $sec  = shift;
        $min  = $sec / 60;
        $sec  = $sec % 60;
        $hour = $min / 60;
        $min  = $min % 60;
        $hour =~ s/\..*$//;
        $time = "$hour hours, $min minutes.";
        return $time;
}

sub cleanHashServerKeys ( $ ) {
        # Cleans specified hashname of old non-connected server keys
        my $hash = shift;
        my @servers = IRC::server_list( );
        foreach $key ( keys %$hash ) {
                my $serverfound = 0;
                foreach $server ( @servers ) {
                        if ( $server eq $key ) {
                                $serverfound = 1;
                        }
                }
                if ( !$serverfound ) {
                        delete( $$hash{$key} );
                }
        }
        return 0;
}

sub cleanup ( ) {
        &Xscript::xscriptlog( "Closing log." );
        if ( !$errors{'log'} ) { close (LOG); }
        # If xchat autosaves, so do we
        if ( IRC::get_prefs( "autosave" ) ) { &Xscript::writeconfig( ); &Xscript::writeseen( ); }
        return 0;
}