#!/usr/bin/perl
#
# pic.pl
#
# A GUI Perl IRC Client
#
# AUTHOR: Dan Hetrick
# LICENSE: GPL
# VERSION: alpha-0.4
# REQUIREMENTS: Perl, POE, POE::Component::IRC, Perl/Tk, Getopt::Mixed
#

use warnings;
use strict;

use Tk;
use POE;
use POE::Component::IRC;
use Getopt::Mixed "nextOption";

# ====================
# Application Settings
# ====================
my $APPNAME = 'pic';
my $VERSION = 'alpha-0.3';

# ====================
# Default IRC Settings
# ====================
my $SERVER  = '';
my $PORT    = 6667;
my $NICK    = $ENV{USER};
my $CHANNEL = '#pic';

# =================
# Internal Settings
# =================
my $CONFIG_FILE     = '';
my $CONNECTED       = 0;
my $TOPIC           = 'No topic.';
my $CHANNEL_DISPLAY = 'No channel.';
my $TIMESTAMP       = 0;
my $LOGGING         = 0;
my @USERS;
my $KERNEL;
my $option;
my $value;

# ========================
# GUI Widgets and Settings
# ========================
my $ENTRY;
my $TEXT_BOX;
my $USERLIST;
my $BACKGROUND  = 'white';
my $FOREGROUND  = 'black';
my $SIMPLE_MODE = 0;
my $TBOX_WIDTH  = 80;
my $UBOX_WIDTH  = 20;
my $BOX_HEIGHT  = 20;

# =======
# History
# =======
my $MAX_HISTORY      = 4;
my $HISTORY_POINTER  = 0;
my $INTERNAL_POINTER = 0;
my @HISTORY          = ( '' x ( $MAX_HISTORY + 1 ) );

# ===========
# MAIN SCRIPT
# ===========

# Process commandline arguments
Getopt::Mixed::init(
'h help>h v version>v s=s server>s p=s port>p n=s nick>n c=s channel>c C=s config>C T=i text>T U=i userlist>U H=i height>H S simple>S B=s background>B F=s foreground>F t timestamp>t l log>l'
);

while ( ( $option, $value ) = nextOption() ) {
    if ( $option =~ /h/ ) {
        print "$APPNAME $VERSION\n";
        print "Usage: $0 OPTIONS\n";
        print "Options:\n";
        print "-h,--help              Display this text.\n";
        print "-v,--version           Display version and exit.\n";
        print "-C,--config FILE       Load settings from config file.\n";
        print "-t,--timestamp         Turn on timestamping.\n";
        print "-l,--log               Turn on logging.\n";
        print "IRC Options:\n";
        print "-s,--server HOST       Sets the IRC server.\n";
        print "-p,--port PORT         Sets the server port.\n";
        print "-n,--nick NICK         Sets the user nick.\n";
        print "-c,--channel CHANNEL   Sets the starting channel.\n";
        print "GUI Options:\n";
        print
          "-T,--text NUMBER       Sets the width of the main textbox (80).\n";
        print
"-U,--userlist NUMBER   Sets the width of the userlist display (20).\n";
        print
          "-H,--height NUMBER     Sets the height of the main display (20).\n";
        print
"-S,--simple            Turns on simple mode (no topic/channel name display).\n";
        print "-B,--background COLOR  Sets the background color (white).\n";
        print "-F,--foreground COLOR  Sets the foreground color (black).\n";
        exit;
    }
    if ( $option =~ /v/ ) { print "$VERSION\n"; exit; }
    if ( $option =~ /s/ ) { $SERVER      = $value; }
    if ( $option =~ /p/ ) { $PORT        = $value; }
    if ( $option =~ /n/ ) { $NICK        = $value; }
    if ( $option =~ /c/ ) { $CHANNEL     = $value; }
    if ( $option =~ /C/ ) { $CONFIG_FILE = $value; }
    if ( $option =~ /T/ ) { $TBOX_WIDTH  = $value; }
    if ( $option =~ /U/ ) { $UBOX_WIDTH  = $value; }
    if ( $option =~ /H/ ) { $BOX_HEIGHT  = $value; }
    if ( $option =~ /S/ ) { $SIMPLE_MODE = 1; }
    if ( $option =~ /B/ ) { $BACKGROUND  = $value; }
    if ( $option =~ /F/ ) { $FOREGROUND  = $value; }
    if ( $option =~ /t/ ) { $TIMESTAMP   = 1; }
    if ( $option =~ /l/ ) { $LOGGING     = 1; }
}

Getopt::Mixed::cleanup();

# Load config file if one's been passed to us
# on the commandline
if ( $CONFIG_FILE ne '' ) {
    load_config($CONFIG_FILE);
}

# Create the IRC Session
POE::Component::IRC->new("irc_client");

# Create the GUI session, and set up events
POE::Session->create(
    inline_states => {
        _start           => \&start_gui,        # GUI Creation
        irc_001          => \&on_connect,       # Connection Event
        irc_public       => \&on_public,        # Public Message Event
        irc_msg          => \&on_private,       # Private Message Event
        irc_352          => \&on_who,           # WHO Data Event
        irc_315          => \&end_who,          # End WHO Data Event
        irc_join         => \&on_join,          # Join Event
        irc_part         => \&on_part,          # Part Event
        irc_disconnected => \&on_disconnect,    # Disconnect Event
        irc_notice       => \&on_notice,        # Notice Event
        irc_ctcp_action  => \&on_action,        # CTCP Action Event
        irc_kick         => \&on_kick,          # Kick Event
        irc_433          => \&on_nick_taken,    # Nick Taken Event
        irc_332          => \&on_topic,         # Topic Event
        irc_331          => \&no_topic,         # No Topic Event
        irc_nick         => \&on_nick,          # Nick Event
        irc_mode         => \&on_mode,          # Mode Event
    }
);

# Run
$poe_kernel->run();
exit 0;

# ===============
# END MAIN SCRIPT
# ===============

# ===
# GUI
# ===

# =========
# start_gui
# =========
# Creates the Tk GUI and connects to the IRC
# server if the program's been passed the
# appropriate commandline arguments
sub start_gui {
    my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];

    # Set the application icon
    my $icon =
      $poe_main_window->Photo( 'image', -data => icon(), format => 'gif' );
    $poe_main_window->iconimage($icon);

    # Set the window title
    $poe_main_window->title("Not connected.");

    # Turn off resizing
    $poe_main_window->resizable( 0, 0 );

    if ( $SIMPLE_MODE == 0 ) {

        # Channel/Topic Display
        my $status_frame = $poe_main_window->Frame()->pack(
            -expand => 1,
            -fill   => 'x'
        );
        my $topic_frame = $status_frame->Frame()->pack(
            -expand => 1,
            -fill   => 'x',
            - side  => 'left'
        );
        my $topic_label = $topic_frame->Label(
            -textvariable => \$TOPIC,
            -relief       => 'sunken',
            -width        => $TBOX_WIDTH + 3,
            '-background' => $BACKGROUND,
            '-foreground' => $FOREGROUND
        )->pack( -side => 'left' );
        my $channel_frame = $status_frame->Frame()->pack(
            -expand => 1,
            -fill   => 'x',
            -side   => 'right'
        );
        my $channel_label = $channel_frame->Label(
            -textvariable => \$CHANNEL_DISPLAY,
            '-width'      => $UBOX_WIDTH + 3,
            -relief       => 'sunken',
            '-background' => $BACKGROUND,
            '-foreground' => $FOREGROUND
        )->pack( -side => 'right' );

    }

    # Main Display
    my $main_frame = $poe_main_window->Frame()->pack(
        -fill   => 'both',
        -expand => 1,
        -fill   => 'x'
    );
    $TEXT_BOX = $main_frame->Scrolled(
        'Text',
        '-scrollbars' => 'e',
        '-width'      => $TBOX_WIDTH,
        '-height'     => $BOX_HEIGHT,
        '-background' => $BACKGROUND,
        '-foreground' => $FOREGROUND
    )->pack( -fill => 'both', -expand => 1, -side => 'left' );

    # Userlist
    $USERLIST = $main_frame->Scrolled(
        'Listbox',
        '-scrollbars' => 'e',
        '-width'      => $UBOX_WIDTH,
        '-height'     => $BOX_HEIGHT,
        '-background' => $BACKGROUND,
        '-foreground' => $FOREGROUND
    )->pack( -fill => 'both', -expand => 1, -side => 'right' );

    # Text Entry
    my $entry_frame = $poe_main_window->Frame()->pack( -fill => 'x' );
    $ENTRY = $entry_frame->Entry()->pack(
        -side   => 'right',
        -fill   => 'both',
        -expand => 1
    );

    # Set up GUI Events
    $ENTRY->bind( '<Key-Return>', \&send_text );
    $ENTRY->bind( '<Key-Up>',     \&backinHistory );
    $ENTRY->bind( '<Key-Down>',   \&upinHistory );

    # Center the window
    $poe_main_window->withdraw;
    $poe_main_window->Popup;

    $KERNEL = $kernel;

    display_text( Startup(), 0 );

    # Register the IRC session events
    $kernel->post( irc_client => register => "all" );

    # Connect to IRC if we've been passed the -s argument
    if ( ( $SERVER ne '' ) && ( $PORT ne '' ) ) {
        $KERNEL->post(
            irc_client => connect => {
                Nick     => $NICK,
                Username => "pic-$NICK",
                Ircname  => "$APPNAME $VERSION",
                Server   => $SERVER,
                Port     => $PORT,
            }
        );
        $poe_main_window->title('Connecting...');
        display_text( "*** Connecting to $SERVER:$PORT...", 1 );
    }

}

# =======
# END GUI
# =======

# ==========
# GUI EVENTS
# ==========

# =========
# send_text
# =========
# This sub is bound to the ENTRY widget on the GUI;
# it handles command parsing and message sending.
sub send_text {
    my $text = $ENTRY->get();
    $ENTRY->delete( '0', 'end' );

    # Parse commands
    if ( index( $text, '/' ) == 0 ) {    # Commands start with /

        # /server <host> <port>
        if ( index( $text, '/server' ) == 0 ) {
            my @ln = split( ' ', $text );
            if ( $#ln == 2 ) {
                $SERVER = $ln[1];
                $PORT   = $ln[2];
                if ( $CONNECTED == 1 ) {
                    $KERNEL->post( irc_client => quit => 'QUIT' );
                    $USERLIST->delete( '0', 'end' );    # Clear the list
                    @USERS = ();
                    sleep(1);
                }
                $KERNEL->post(
                    irc_client => connect => {
                        Nick     => $NICK,
                        Username => "pic-$NICK",
                        Ircname  => "$APPNAME $VERSION",
                        Server   => $SERVER,
                        Port     => $PORT,
                    }
                );
                $poe_main_window->title('Connecting...');
                display_text( "*** Connecting to $SERVER:$PORT...", 1 );
            }
            else {
                display_text( "*** Usage: /server <host> <port>", 0 );
            }
        }

        # /nick <nickname>
        if ( index( $text, '/nick' ) == 0 ) {
            my @n = split( ' ', $text );
            if ( $#n == 1 ) {
                $NICK = $n[1];
                if ( $CONNECTED == 1 ) {
                    doUserlist();
                    $KERNEL->post( irc_client => nick => $NICK );
                    $poe_main_window->title("$NICK - $SERVER:$PORT");
                }
            }
            else {
                display_text( "*** Usage: /nick <nickname>", 0 );
            }
        }

        # /help
        if ( index( $text, '/help' ) == 0 ) {
            display_text( Help(), 0 );

        }

        # /exit
        if ( index( $text, '/exit' ) == 0 ) {
            exit;

        }

        # /quit <msg>
        if ( index( $text, '/quit' ) == 0 ) {
            if ( $CONNECTED == 0 ) {
                display_text( "*** Not connected.", 0 );
                return;
            }
            if ( length($text) > 6 ) {
                my $msg = substr( $text, 6 );
                $KERNEL->post( irc_client => quit => $msg );
            }
            else {
                $KERNEL->post( irc_client => quit => 'QUIT' );
            }
        }

        # /join <channel>
        if ( index( $text, '/join' ) == 0 ) {
            if ( $CONNECTED == 0 ) {
                display_text( "*** Not connected.", 0 );
                return;
            }
            if ( length($text) > 6 ) {
                my $newchan = substr( $text, 6 );
                $KERNEL->post( irc_client => part => $CHANNEL );
                $CHANNEL = $newchan;
                doUserlist();
                display_text( "*** Joining $CHANNEL...", 1 );
                $KERNEL->post( irc_client => join => $CHANNEL );
                $KERNEL->post( irc_client => topic => $CHANNEL );
                $poe_main_window->title("$NICK - $SERVER:$PORT");
                $CHANNEL_DISPLAY = "$CHANNEL";
            }
            else {
                display_text( "*** Usage: /join <channel>", 0 );
            }
        }

        # /msg <target> <msg>
        if ( index( $text, '/msg' ) == 0 ) {
            if ( $CONNECTED == 0 ) {
                display_text( "*** Not connected.", 0 );
                return;
            }
            my @ln = split( ' ', $text );
            if ( $#ln >= 2 ) {
                my $target = $ln[1];
                my $msg    =
                  substr( $text, length( $ln[0] ) + length( $ln[1] ) + 2 );
                $KERNEL->post( irc_client => privmsg => $target, $msg );
                display_text( "<$NICK> $target: $msg", 1 );
            }
            else {
                display_text( "*** Usage: /msg <channel|nick> <msg>", 0 );
            }
        }

        # /notice <target> <msg>
        if ( index( $text, '/notice' ) == 0 ) {
            if ( $CONNECTED == 0 ) {
                display_text( "*** Not connected.", 0 );
                return;
            }
            my @ln = split( ' ', $text );
            if ( $#ln >= 2 ) {
                my $target = $ln[1];
                my $msg    =
                  substr( $text, length( $ln[0] ) + length( $ln[1] ) + 2 );
                $KERNEL->post( irc_client => notice => $target, $msg );
                display_text( "*$NICK* $target: $msg", 1 );
            }
            else {
                display_text( "*** Usage: /notice <channel|nick> <msg>", 0 );
            }
        }

        # /me <desrciption>
        if ( index( $text, '/me' ) == 0 ) {
            if ( $CONNECTED == 0 ) {
                display_text( "*** Not connected.", 0 );
                return;
            }
            my @ln = split( ' ', $text );
            if ( $#ln >= 1 ) {
                my $msg = substr( $text, length( $ln[0] ) + 1 );
                $KERNEL->post( irc_client => ctcp => $CHANNEL, "action:$msg" );
                display_text( "> $NICK $msg", 1 );
            }
            else {
                display_text( "*** Usage: /me <description>", 0 );
            }
        }
    }
    else {
        if ( $CONNECTED == 0 ) {
            display_text( "*** Not connected.", 0 );
            return;
        }
        $KERNEL->post( irc_client => privmsg => $CHANNEL, $text );
        display_text( "<$NICK> $text", 1 );
    }
    addHistory($text);
}

# =============
# backinHistory
# =============
# Moves 'backward' in the history and displays
# the stored command
sub backinHistory {
    $ENTRY->delete( '0', 'end' );
    $ENTRY->insert( 'end', upHistory() );
}

# ===========
# upinHistory
# ===========
# Moves 'forward' in the history and displays
# the stored command
sub upinHistory {
    $ENTRY->delete( '0', 'end' );
    $ENTRY->insert( 'end', downHistory() );
}

# ==============
# END GUI EVENTS
# ==============

# ==========
# IRC EVENTS
# ==========

# ==========
# on_connect
# ==========
# Triggered when the client first connects to an
# IRC server.
sub on_connect {
    $CONNECTED       = 1;
    $CHANNEL_DISPLAY = "$CHANNEL";
    display_text( "*** Connected to $SERVER:$PORT!", 1 );
    $poe_main_window->title("$NICK - $SERVER:$PORT");
    display_text( "*** Joining $CHANNEL...", 1 );
    doUserlist();
    $_[KERNEL]->post( irc_client => join => $CHANNEL );
    $_[KERNEL]->post( irc_client => topic => $CHANNEL );
}

# =========
# on_public
# =========
# Triggered whenever the client receives a 'public' message.
sub on_public {
    my ( $kernel, $who, $where, $MESSAGE ) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
    my $eNICK     = ( split /!/, $who )[0];
    my $eHOSTMASK = ( split /!/, $who )[1];
    my $eCHANNEL  = $where->[0];

    display_text( "<$eNICK> $MESSAGE", 1 );

}

# ==========
# on_private
# ==========
# Triggered whenever the client receives a 'private' message.
sub on_private {
    my ( $kernel, $who, $where, $MESSAGE ) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
    my $eNICK     = ( split /!/, $who )[0];
    my $eHOSTMASK = ( split /!/, $who )[1];
    my $eCHANNEL  = $where->[0];

    display_text( ">$eNICK< $MESSAGE", 1 );
}

# =======
# on_join
# =======
# Triggered whenever someone joins the client's IRC channel.
sub on_join {
    my ( $kernel, $nd, $eCHANNEL ) = @_[ KERNEL, ARG0, ARG1 ];
    my $eNICK = ( split /!/, $nd )[0];
    doUserlist();
    display_text( "*** $eNICK joined $eCHANNEL.", 1 );
}

# =======
# on_part
# =======
# Triggered whenever someone parts the client's IRC channel.
sub on_part {
    my ( $kernel, $nd, $eCHANNEL ) = @_[ KERNEL, ARG0, ARG1 ];
    my $eNICK     = ( split /!/, $nd )[0];
    my $eHOSTMASK = ( split /!/, $nd )[1];
    doUserlist();
    display_text( "*** $eNICK left $eCHANNEL.", 1 );
}

# ======
# on_who
# ======
# Triggered whenever 'who' data is received by the client.
# Builds the userlist for display.
sub on_who {
    my ( $kernel, $serv, $data ) = @_[ KERNEL, ARG0, ARG1 ];
    my $nick = ( split / /, $data )[4];
    my $code = ( split / /, $data )[5];
    if ( $code =~ /\@/ ) { $nick = '@' . $nick; }
    if ( $code =~ /\+/ ) { $nick = '+' . $nick; }
    push( @USERS, $nick );
}

# =======
# end_who
# =======
# Triggered when the server sends an 'end of who data' message.
# Takes the data built by on_who() and displays it.
sub end_who {
    my ( $kernel, $serv ) = @_[ KERNEL, ARG0 ];
    @USERS = sortNicks(@USERS);
    $USERLIST->delete( '0', 'end' );    # Clear the list
    foreach my $u (@USERS) {
        $USERLIST->insert( 'end', $u );
    }
}

# =============
# on_disconnect
# =============
# Triggered when the client disconnects from the server.
sub on_disconnect {
    my ( $kernel, $serv ) = @_[ KERNEL, ARG0 ];
    $CONNECTED = 0;
    $USERLIST->delete( '0', 'end' );    # Clear the list
    @USERS = ();
    display_text( "*** Disconnected.", 1 );
}

# =========
# on_notice
# =========
# Triggered whenever the server sends the client a notice.
sub on_notice {
    my ( $kernel, $who, $where, $MESSAGE ) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
    my $eNICK     = ( split /!/, $who )[0];
    my $eHOSTMASK = ( split /!/, $who )[1];
    my $eCHANNEL  = $where->[0];

    display_text( "*$eNICK* $MESSAGE", 1 );
}

# =========
# on_action
# =========
# Triggered whenever the server sends the client a CTCP 'action' message.
sub on_action {
    my ( $kernel, $who, $where, $msg ) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
    my $nick     = ( split /!/, $who )[0];
    my $hostmask = ( split /!/, $who )[1];
    my $channel  = $where->[0];

    display_text( "> $nick $msg", 1 );
}

# =======
# on_kick
# =======
# Triggered whenever someone is kicked from the channel.
sub on_kick {
    my ( $kernel, $who, $where, $target, $reason ) =
      @_[ KERNEL, ARG0, ARG1, ARG2, ARG3 ];
    my $nick     = ( split /!/, $who )[0];
    my $hostmask = ( split /!/, $who )[1];
    my $channel  = $where;

    doUserlist();
    display_text( "*** $nick kicked $target from $where ($reason)", 1 );
}

# =============
# on_nick_taken
# =============
# Triggered whenever the client's nick is already in use.
# A random number is added to the client's nick.
sub on_nick_taken {
    my ($kernel) = $_[KERNEL];

    $NICK = $NICK . $$ % 1000;
    $kernel->post( irc_client => nick => $NICK );
    doUserlist();
}

# ========
# on_topic
# ========
# Triggered whenever the client gets channel topic data.
sub on_topic {
    my ( $kernel, $serv, $data ) = @_[ KERNEL, ARG0, ARG1 ];
    my $stuff = ( split /:/, $data )[0];
    $TOPIC = substr( $data, length($stuff) + 1 );
    trim_topic();
}

# ========
# no_topic
# ========
# Triggered whenever the client receives blank topic data.
sub no_topic {
    my ( $kernel, $serv, $data ) = @_[ KERNEL, ARG0, ARG1 ];
    $TOPIC = 'No topic.';
}

# =======
# on_nick
# =======
# Triggered whenever someone in the same channel as the client
# changes their nick.
sub on_nick {
    my ( $kernel, $who, $newnick ) = @_[ KERNEL, ARG0, ARG1 ];
    my $nick     = ( split /!/, $who )[0];
    my $hostmask = ( split /!/, $who )[1];
    display_text( "*** $nick is now known as $newnick", 1 );
    doUserlist();
}

# =======
# on_mode
# =======
# Triggered whenever a mode change is made, applying
# to the client or the client's channel.
sub on_mode {
    my ( $kernel, $who, $target, $mode, $arg ) =
      @_[ KERNEL, ARG0, ARG1, ARG2, ARG3 ];
    my $nick     = ( split /!/, $who )[0];
    my $hostmask = ( split /!/, $who )[1];
    if ( ( $mode =~ /o/ ) || ( $mode =~ /v/ ) ) {
        doUserlist();
    }
    if ($arg) {
        display_text( "*** $nick sets mode $mode $arg", 1 );
    }
    else {
        display_text( "*** $nick sets mode $mode", 1 );
    }
}

# ==============
# END IRC Events
# ==============

# ===================
# SUPPORT SUBROUTINES
# ===================

# ============
# display_text
# ============
# Arguments: Scalar, Integer
# Returns: Nothing
# Description:  Displays text and/or logs it
sub display_text {
    my ( $data, $dotimestamp ) = @_;

    if ( $dotimestamp == 0 ) {
        $TEXT_BOX->insert( 'end', "$data\n" );
        $TEXT_BOX->see('end');
        return;
    }

    if ( $TIMESTAMP == 1 ) {
        my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
          localtime(time);
        $TEXT_BOX->insert( 'end', "[$hour:$min:$sec] $data\n" );
        $TEXT_BOX->see('end');
        if ( $LOGGING == 1 ) {
            open( LOG, ">>$SERVER.$PORT.$CHANNEL.log" )
              or die "Error writing to log.";
            print LOG "[$hour:$min:$sec] $data\n";
            close LOG;
        }
    }
    else {

        $TEXT_BOX->insert( 'end', "$data\n" );
        $TEXT_BOX->see('end');

        if ( $LOGGING == 1 ) {
            open( LOG, ">>$SERVER.$PORT.$CHANNEL.log" )
              or die "Error writing to log.";
            print LOG "$data\n";
            close LOG;
        }

    }
}

# ==========
# trim_topic
# ==========
# Arguments: None
# Returns: Nothing
# Description:  Trims the topic if it's too long
sub trim_topic {
    if ( length($TOPIC) >= $TBOX_WIDTH ) {
        my $NEW_TOPIC = substr( $TOPIC, 0, ( $TBOX_WIDTH - 3 ) );
        $TOPIC = "$NEW_TOPIC...";
    }
}

# ==========
# doUserList
# ==========
# Arguments: None
# Returns: Nothing
# Description:  Clears out the local userlist and
#               requests fresh user data from the
#               server.
sub doUserlist {
    @USERS = ();
    $KERNEL->post( irc_client => who => $CHANNEL );
}

# =========
# sortNicks
# =========
# Arguments: List
# Returns: List
# Description:  Sorts an array containing user
#               data for display.  Ops come first,
#               voiced users second, and normal users
#               third.
sub sortNicks {
    my (@nicks) = @_;

    my @ops    = ();
    my @voiced = ();
    my @normal = ();
    my @list   = ();

    foreach my $n (@nicks) {
        if ( $n =~ /\@/ ) { push( @ops,    $n ); next; }
        if ( $n =~ /\+/ ) { push( @voiced, $n ); next; }
        push( @normal, $n );
    }

    push( @list, sort( keys %{ { map { $_, 1 } @ops } } ) );
    push( @list, sort( keys %{ { map { $_, 1 } @voiced } } ) );
    push( @list, sort( keys %{ { map { $_, 1 } @normal } } ) );

    return @list;
}

# =======
# Startup
# =======
# Arguments: None
# Returns: Scalar
# Description: Text to be displayed at client start up.
sub Startup {
    my $START = <<"EOS";
$APPNAME $VERSION

Use the /server command to connect to IRC.   
Use the /help command to get a list of commands. 
EOS
    return $START;
}

# ====
# Help
# ====
# Arguments: None
# Returns: Scalar
# Description:  Text to be displayed when using the
#               /help command.
sub Help {
    my $HELP = <<'EOH';
/quit <message>
Disconnects from the IRC server.
The quit message is optional.
            
/join <channel>
Parts the current channel, and joins a new channel.
            
/msg <nick|channel> <message>
Sends a private message to a nick or channel.
            
/notice <nick|channel> <message>
Sends a notice to a nick or channel.
            
/me <message>
Sends a CTCP action message to the current channel.    

/server <host> <port>
Connects to an IRC server.      

/nick <nickname>
Changes your nick.

/exit
Exits the program.
EOH
    return $HELP;
}

# ====
# icon
# ====
# Arguments: None
# Returns: GIF Image
# Description: Returns a BASE-64 encoded GIF image
#              for use as the application icon.
sub icon {
    my $binary_data = <<EOD;
R0lGODdhIAAgAOdLAAAAAAEBAQICAgMDAwQEBAUFBQYGBgcHBwgICAkJCQoKCgsLCwwMDA0NDQ4O
Dg8PDxAQEBERERISEhMTExQUFBUVFRYWFhcXFxgYGBkZGRoaGhsbGxwcHB0dHR4eHh8fHyAgICEh
ISIiIiMjIyQkJCUlJSYmJicnJygoKCkpKSoqKisrKywsLC0tLS4uLi8vLzAwMDExMTIyMjMzMzQ0
NDU1NTY2Njc3Nzg4ODk5OTo6Ojs7Ozw8PD09PT4+Pj8/P0BAQEFBQUJCQkNDQ0REREVFRUZGRkdH
R0hISElJSUpKSktLS0xMTE1NTU5OTk9PT1BQUFFRUVJSUlNTU1RUVFVVVVZWVldXV1hYWFlZWVpa
WltbW1xcXF1dXV5eXl9fX2BgYGFhYWJiYmNjY2RkZGVlZWZmZmdnZ2hoaGlpaWpqamtra2xsbG1t
bW5ubm9vb3BwcHFxcXJycnNzc3R0dHV1dXZ2dnd3d3h4eHl5eXp6ent7e3x8fH19fX5+fn9/f4CA
gIGBgYKCgoODg4SEhIWFhYaGhoeHh4iIiImJiYqKiouLi4yMjI2NjY6Ojo+Pj5CQkJGRkZKSkpOT
k5SUlJWVlZaWlpeXl5iYmJmZmZqampubm5ycnJ2dnZ6enp+fn6CgoKGhoaKioqOjo6SkpKWlpaam
pqenp6ioqKmpqaqqqqurq6ysrK2tra6urq+vr7CwsLGxsbKysrOzs7S0tLW1tba2tre3t7i4uLm5
ubq6uru7u7y8vL29vb6+vr+/v8DAwMHBwcLCwsPDw8TExMXFxcbGxsfHx8jIyMnJycrKysvLy8zM
zM3Nzc7Ozs/Pz9DQ0NHR0dLS0tPT09TU1NXV1dbW1tfX19jY2NnZ2dra2tvb29zc3N3d3d7e3t/f
3+Dg4OHh4eLi4uPj4+Tk5OXl5ebm5ufn5+jo6Onp6erq6uvr6+zs7O3t7e7u7u/v7/Dw8PHx8fLy
8vPz8/T09PX19fb29vf39/j4+Pn5+fr6+vv7+/z8/P39/f7+/v///ywAAAAAIAAgAAAI/gD/CRwo
0J2zUZa+8SPIsKHDge1qBUmx5saTV/4cflNTJtzDgeouUaEBxIoQICYCNfT2hYidHn9qTRrnEFgc
Gi1+4BihAQOIXwwnVaFC5AUoSHe84GsIBoiQMG9AXNgggUKObAOxqTBBgw6iVnOeONrH8NiMIlRI
5XHxwYMIF0VGbFp6DYeIGrHQJFmVLyNBdFWcOEG2LA+YGiCQxJlCIkMUde9o/FDxxEmKPA4Bndnz
CpsySIJK9TFUC1SbGhy+lJsyxcqRGS040CTobciYIXoUfUHzpMcVWtjWacoxYgIsRCBO3Ngj5UQy
hqc2qRl0iccSLXnEoBIlbR+lP3Iw/nxh5qMFjSxCQLQiWC1II1LXyHEy08kVI2neyPE7dgTLBxuu
3HHDKEo0ocEyA83zhRCVhNKPP+rIwgkaiZjyBzHdPLMTB2h0wkcSlRhxgQbiDGTHD13ggQQx7twC
iBdr3FHHH3WA80YJGbSQBzFTtBHKDBcYoY5A+BBRCBdRWBCDHXMU4YQbdDDDxw+VRDHBCkYsAs0r
qNzBljIJBvGII0pcEIFPKKRAwharIDLDI2BM8AIJZSjDTR43oECJPgOlg4MpwYwBAgZUqFBCCiBs
gUkpU0QxggQfcHABHVtIUQIn8RDkzw26aKNEEDp808EINxiJhyAxTIABBRNQsAQd/kQsQks+DRGi
RjoiqHHHP4lYQAEpeMxwAw1+UDICDRZk8s9SD80TCDgjGKHLP+BoQEEskpzQgQWj/MOEBhVg9pFA
9wjDgg31CMQCCbKs48QGHvjxjxoTaKDHuAPRssElAwEBAzT/yEFCBzrUQ00IFTCCr0DRgGDOQHpx
8880UuxQwy/7TAHEJwv/U8sJ7gjEDyh/PPdPO60EIss/cNCQS8ejhFEiuc8MI5A/sgCBzj+GIdNx
NUD0Q1A7kKzzDzFwvCPQKDM80/E/bzR0TCnzIMKnQPZQ0c3TgCzEXjxopEvQILs8zQdWA6GzxxJJ
XMOQM8ourI8ntxBkDA+sUIEFNSH3DMTOK0Pim00Yg9gzEDee4KONNshkKlA9tmDi10fOTNEFwB0j
4gkYdT/dMTTi/GJ4QwEBADs=
EOD
    return ($binary_data);
}

# ==========
# addHistory
# ==========
# Argument: Scalar
# Returns: Nothing
# Description:  Adds commands to the history.
sub addHistory {
    my ($data) = @_;
    $HISTORY[$INTERNAL_POINTER] = $data;
    $INTERNAL_POINTER++;
    if ( $INTERNAL_POINTER >= $MAX_HISTORY ) { $INTERNAL_POINTER = 0; }
}

# =========
# upHistory
# =========
# Argument: None
# Returns: Scalar
# Description:  Moves 'forward' in the history
#               and returns a stored commandline
sub upHistory {
    my $cmd = $HISTORY[$HISTORY_POINTER];
    $HISTORY_POINTER++;
    if ( $HISTORY_POINTER >= $MAX_HISTORY ) { $HISTORY_POINTER = 0; }
    return $cmd;
}

# ===========
# downHistory
# ===========
# Argument: None
# Returns: Scalar
# Description:  Moves 'backward' in the history
#               and returns a stored commandline
sub downHistory {
    my $cmd = $HISTORY[$HISTORY_POINTER];
    $HISTORY_POINTER--;
    if ( $HISTORY_POINTER < 0 ) { $HISTORY_POINTER = $MAX_HISTORY; }
    return $cmd;
}

# ===========
# load_config
# ===========
# Arguments: Filename
# Returns: Nothing
# Description:  Loads settings from a text file.
sub load_config {
    my ($file) = @_;
    if ( ( -e $file ) && ( -f $file ) ) {
        open( FILE, "<$file" ) or die "Error loading config file.";
        foreach my $line (<FILE>) {
            chomp $line;
            if ( index( $line, '#' ) == 0 ) { next; }
            my @l = split( '=', $line );
            if ( $#l != 1 ) { next; }
            if ( $l[0] =~ /server/i )     { $SERVER      = $l[1]; }
            if ( $l[0] =~ /port/i )       { $PORT        = $l[1]; }
            if ( $l[0] =~ /nick/i )       { $NICK        = $l[1]; }
            if ( $l[0] =~ /channel/i )    { $CHANNEL     = $l[1]; }
            if ( $l[0] =~ /text/i )       { $TBOX_WIDTH  = $l[1]; }
            if ( $l[0] =~ /userlist/i )   { $UBOX_WIDTH  = $l[1]; }
            if ( $l[0] =~ /height/i )     { $BOX_HEIGHT  = $l[1]; }
            if ( $l[0] =~ /simple/i )     { $SIMPLE_MODE = $l[1]; }
            if ( $l[0] =~ /background/i ) { $BACKGROUND  = $l[1]; }
            if ( $l[0] =~ /foreground/i ) { $FOREGROUND  = $l[1]; }
            if ( $l[0] =~ /timestamp/i )  { $TIMESTAMP   = $l[1]; }
            if ( $l[0] =~ /log/i )        { $LOGGING     = $l[1]; }
        }
    }
}

# =======================
# END SUPPORT SUBROUTINES
# =======================

# =================
# POD DOCUMENTATION
# =================

=head1 NAME

pic - Perl IRC Client

=head1 VERSION

alpha-0.2

=head1 DESCRIPTION

A GUI IRC Client written in Perl, using Perl/Tk for the GUI, and POE::Component::IRC for the networking.  The client can only chat in one channel at a time;  if the client uses the /join command to join another channel, the channel it is currently in will be parted.

=head1 USAGE

C<$ perl pic.pl [ OPTIONS ]>

Options:

B<-v,--version>

Print version and exit.

B<-h,--help>

Print help text.

B<-C,--config FILE>

Loads settings from a text file.  Settings are in the format of I<SETTING=VALUE>, one setting per line.  Avaliable settings are B<server>, B<port>, B<nick>, B<channel>, B<text> (same as the -T option), B<userlist> (the same as the -U option), B<height> (the same as the -H option), B<simple> (set it to '1' to turn simple mode on), B<background> (the same as the -B option), B<foreground> (the same as the -F option), B<timestamp> (set it to '1' to turn timestamping on), and B<log> (set it to '1' to turn logging on).

Here's an example config file, containing all the default settings:

C<server=irc.gamesurge.net>

C<port=6667>

C<nick=PerlIRCClient>

C<channel=#shogomad>

C<text=80>

C<userlist=20>

C<height=20>

C<simple=0>

C<background=white>

C<foreground=black>

C<timestamp=0>

C<logging=0>

B<-s,--server HOST>

Sets the server to connect to.  If the B<-p> option isn't also used, the default port of 6667 is used.  The client will automatically connect to IRC on startup.

B<-p,--port NUMBER>

Sets the connection port.  Use with the B<-s> option if the server you want to connect to uses a port other than 6667.

B<-n,--nick NICKNAME>

Sets the default nick.

B<-c,--channel CHANNEL>

Sets the default channel.  This channel will be joined automatically when the client connects to IRC.

B<-T,--text NUNBER>

Sets the width of the main textbox display.  The default is '80'.

B<-U,--userlist NUNBER>

Sets the width of the user list listbox display.  The default is '20'.

B<-H,--height NUNBER>

Sets the height of the main textbox and the user list.  The default is '20'.

B<-S,--simple>

Turns on 'simple mode', which turns off topic and channel name display.

B<-B,--background COLOR>

Sets the textbox/listbox background color.  Default is 'white'.

B<-F,--foreground COLOR>

Sets the textbox/listbox foreground (text) color.  The default is 'black'.

B<-t,--timestamp>

Turns on timestamping.

B<-l,--log>

Turns on logging.  A file is created in the current working directory named I<SERVER.PORT.CHANNEL-NAME.log>.

=head1 COMMANDS

To get a list of avaliable commands, use B</help>.

=head1 CHANGELOG

B<alpha-0.4>

* Fixed a bug causing the the program to error out on newer versions of Perl.

B<alpha-0.3>

* Refined the text display.

* Added a timestamp option.

* Added a logging option.

* Added more options to the configuration files.

B<alpha-0.2>

* Fixed a topic diplay bug
(topics that contained a ':' were truncated).

* Limited the length of topic text.

* Added some GUI commandlist configuration options.

B<alpha-0.1>

* Initial release.

=head1 LICENSE

(c) Copyright Dan Hetrick 2004

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2 of the License, or (at your option)
any later version.

This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc.,
59 Temple Place, Suite 330, Boston, MA 02111-1307 USA