Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Curses Chatterbox Client

by {NULE} (Hermit)
on Oct 08, 2001 at 05:23 UTC ( #117372=sourcecode: print w/ replies, xml ) Need Help??

Category: Chatterbox Clients
Author/Contact Info {NULE}
Description: This is a client for the PerlMonks chatterbox which uses ZZamboni's PerlMonksChat2 module. You will also need Curses and Curses::Widgets.

Supports most basic PerlMonksChat features with a primitive help system (type /help for all commands). Also uses a configurable buffer size and opens a separate sub-window to scroll through the old messages (type /log to see what I mean). I want to add more fun features, so tell me what you want to see!

Note that it doesn't use colors in this version, because I want it to be "non-descript" on my desktop. I also want it to be very simple so it is not nearly as fancy as some of the excellent clients out there.

Let me know what you think!
{NULE}

Todo:
- Do some name high-lighting and other niceties.
- The way PerlMonksChat2 works this requires you to have a ~/.netscape/cookies file. Must fix this behaviour.
- Must finish the personal messages handling as well.

Update:
20011007 - There was a request to actually post the code here. I will do so, but prefer that you get it from nule.org - it will be updated there first.

20011009 - Small bug squished where the buffer would display the line about to be deleted (which could be hours old). That's fixed, and some other visual stuff is, but I think you may see a line doubled when the end of the buffer is reached. I'm off to Atlanta for a week, I'll fix it when I get back.

20011010 - Figured out the "Lag" Problem, but can't fix it until the 15th. Curses::Widgets handles keystrokes differently than I thought. For a workaround set /freq to something very high, like /freq 200

20011015 - The "Lag" problem is squished with a timer that uses "time()" not callback counts. I still want to use "fork()" and do this the right way. By the way, if you have trouble with the current version, my site has all previous versions. Update - /me is fixed now.

20011022 - The lag is gone for good now with a version that forks! I've been testing this for about a week so I have confidence that it works well. I could see this more complicated version not running on a system where it ran before so I'll keep a non-forking version on my web site.

20011031 - Fixed a bug with IPC. Added timestamps, save chat buffer to a file, some handling private messages, and ccb will now try to guess when you have mis-typed a command and give you a chance to retype it before submitting. The ability to delete personal messages will be added soon.

20011105 - More tweaks to IPC. Hopefully it will work better with 5.6.0 now.

See also http://www.nule.org/?tale=6 to download the latest and archival versions.

#! /usr/bin/perl -w
####################################################################
# ccb.pl - a Chatterbox client written in Perl Curses              #
####################################################################
# Abstract: ccb is a simple curses interface to the chatterbox     #
#         : feature of the PerlMonks.org website.                  #
#         : Some functionality is missing, but it is designed to   #
#         : to meet some very specific goals - and should be easy  #
#         : to enhance.                                            #
#                                                                  #
# Thanks  : Go to Shendal for his Perk/Tk client,                  #
#         : Zzamboni for the PerlMonks modules and the sample code #
#         : Vroom for creating PerlMonks.org                       #
#         : ybiC for saying "A curses CB client would be mondo++!" #
#         : and merlyn, for not turning me into a frog             #
#         : Lots of other people that deserve mention              #
#                                                                  #
# History : 20011004 - mbl - Initial version.                      #
#         : 20011006 - mbl - Some primitive functionality is here. #
#         : 20011007 - mbl - Created the chat buffer object.       #
#         :                - I guess I pretty much made the whole  #
#         :                - thing work - all options and stuff.   #
#         : 20011008 - mbl - Fixed a little big in the log buffer  #
#         :                - and some other screen bugs.           #
#         : 20011015 - mbl - Removed some of the lag by correcting #
#         :                - the timing and help in a window.      #
#         : 20011016 - mbl - Forking code added.                   #
#         : 20011018 - mbl - More things to make the behavior      #
#         :                - match the CB spec.                    #
#         : 20011021 - mbl - Added support for ignore/unignore     #
#         : 20011022 - mbl - Adjusted IPC timing to reduce errors. #
#         : 20011024 - mbl - Added support for timestamps.         #
#         : 20011025 - mbl - Added confirm odd message dialog.     #
#         : 20011026 - mbl - Added support to save message buffer. #
#         : 20011027 - mbl - Fixed a bug when the child lags.      #
#         :                - Some private message handling.        #
#         : 20011104 - mbl - Some more tweaks to IPC.              #
#                                                                  #
# To-do   : More fun stuff, like colors.                           #
#         : Get personal messages checkoff to work.                #
#         : Improvements to the IPC performance might be possible. #
#         : I *still* like the idea of a PM minibrowser...         #
####################################################################
# Boring, pointless crap:                                          #
# This is free software that may be distributed under the same     #
# license as Perl itself.  This software comes with no warranty.   #
#                                                                  #
# I suppose that it's Copyright (C) 2001 M. Litherland             #
#                                                                  #
# Get the latest version from http://www.nule.org/ which is also   #
# where the author can be reached.                                 #
####################################################################
my $VERSION = "1.0pre2a"; 

# change your @INC if you have weird module locations.
use lib "/home/litherm/lib/perl5/site_perl/5.6.1/PerlMonksChat2";

use strict;
use Curses;
use Curses::Widgets;
use IO::Handle qw(autoflush);
use Socket;
use Text::Wrap;

# PM Modules
use PerlMonks::Chat;
use PerlMonks::Users;

# Record separator for IPC
use constant RSEPARATOR => "MiKeIsDaUbErCoDeR"; #:)

#############
# Variables #
#############

# Widgets
my ($main, $input, $display, $dialog);

# Variables for dealing with curses widgets
my ($text, $test);

# Handles for our PM objects
my ($chat, $monks, $buffer, $pid);

# More variables
my ($username, $password);

###########################
# Initialize chat package #
###########################

# I'm a newbie when it comes to OO Perl too - be gentle...
{ package Chat;

# Object constructor
sub new
{
    my $self = {};
    shift; # Package name

    # Counter for updating the buffer
    $self->{COUNTER}   = time();
    $self->{MCOUNTER}  = 20; # Max time

    # Flag for time stamps
    $self->{TIMESTAMP} = 1;  # 0 is off

    # Variables for working with the buffer
    $self->{POSITION}  = 0;
    $self->{LENGTH}    = 500;
    $self->{BUFFER}    = []; # Message buffer

    bless($self);
    return $self;
}

# Provide a method for changing the buffer size
sub length 
{
    my $self = shift;
    
    if (@_)
    {
        $self->{LENGTH} = shift;
    }

    return $self->{LENGTH};
}

# Provide a method for toggling the time stamp
sub show_time
{
    my $self = shift;
    
    if (@_)
    {
        $self->{TIMESTAMP} = shift;
    }

    return $self->{TIMESTAMP};
}

# A simple counter to set the chat request interval.
# Passing a value instead sets the Max Counter interval,
# returns the time remaining (0 if done);
sub counter
{
    my $self = shift;
    my $delta;
    
    if (@_)
    {
        $self->{MCOUNTER} = shift;
    }

    $delta = ($self->{COUNTER} + $self->{MCOUNTER}) - time();

    if ($delta <= 0)
    {
        $self->{COUNTER} = time();

        return 0;
    }
    else
    {
        return $delta;
    }
}

# Add lines into the scrollback buffer
sub addlines
{
    my $self = shift;
    my $line;

    if (@_)
    {
        foreach $line (@_)
        {
            # Attempt to remove empty lines.
            next if ($line =~ /^\s*$/);

            # Add the line in the next available position
            # in the buffer
            $self->{BUFFER}[$self->{POSITION}] = $line;

            # If we are at the last available position in
            # the buffer, reset and start over.
            if ($self->{POSITION} >= $self->{LENGTH})
            {
                $self->{POSITION} = 0;
            }
            else
            {
                $self->{POSITION}++;
            }
        }
    }
}

# Return an array with the number of lines requested.
sub getlines
{
    my $self = shift;
    my ($rows, $i, $position);
    my (@return);

    if (@_)
    {
        $rows = shift;
        # POSITION is one past the current line (ahem, bug? :-)
        $position = $self->{POSITION} - $rows - 1;
        $position += $self->{LENGTH} if ($position < 0);

        for ($i = 0; $i < $rows; $i++)
        {
            # Set the position ahead, but rewind if hit the
            # end.
            $position++;
            $position = 0 if ($position >= $self->{LENGTH});

            # When first initialized Much of the buffer may
            # be empty.
            if (defined($self->{BUFFER}[$position]))
            {
                push @return, $self->{BUFFER}[$position];
            }
            else
            {
                push @return, "";
            }
        }
    }

    return @return;
}

} # Back to the main package

################
# Main Routine #
################

# Create a new main window
$main = new Curses;

# Configure some options
noecho();         # Disable echoing from the console.
$main->keypad(1); # Map special keys.
halfdelay(10);    # This works like Poll when a function is passed
                  # to a widget. Redraws the chat window every 2
          # seconds, and gets new messages per /freq
$main->erase();
select_colour($main, 'black');
$main->attrset(0);

&header();

# Prompt for username and pass
($text, $test) = input_box(
    'title' => "Logon",
    'prompt' => "Enter your PM username",
    'border' => "white",
    'cursor_disable' => 1,
    'function' => \&header
);

if (($test == 1) && ($text ne ""))
{
    $username = $text;
}
else
{
    &handle_error("Username required and not provided");
}

($text, $test) = input_box(
    'title' => "Logon",
    'prompt' => "Enter your PM password",
    'border' => "white",
    'cursor_disable' => 1,
    'password' => 1,
    'function' => \&header
);

if (($test == 1) && ($text ne ""))
{
    $password = $text;
}
else
{
    &handle_error("Password required and not provided");
}

# Get rid of the login boxes while we wait
$main->erase();
$main->addstr(0, 1, "Attempting to log in, please wait...");
$main->refresh();

# Log in (all your password are belong to us)
$chat = PerlMonks::Chat->new();
$chat->add_cookies;

$chat->login($username, $password)
    or &handle_error("Could not login: $!");

$monks = PerlMonks::Users->new();
$monks->add_cookies;

# Produce a child to handle the transactions.
$main->addstr(1, 1, "Starting child process...");
$main->refresh();

# Create a socketpair
socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
    or &handle_error("Socket could not be created.");
CHILD->autoflush(1);
PARENT->autoflush(1);

# Fork here
if ($pid = fork())
{
    close PARENT;

    # Create a chat buffer
    $buffer = new Chat;
    print CHILD $buffer->counter . "\n";
}
else
{
    close CHILD;

    &child();

    exit 0;
}

# Clear the screen
$main->erase();
$main->refresh();

# From now on the &message subroutine and the chat $buffer handle
# all screen draws.
$buffer->addlines("{CCB} - Curses Chatterbox client, Type '/help' for 
+available commands.");

# Main loop
while (1)
{
    ($test, $text) = txt_field(
        'window' => $main,
        'regex' => "\n",
        'xpos' => 0,
        'ypos' => $LINES - 3,
        'lines' => 1,
        'cols' => $COLS - 2,
        'border' => "white",
        'cursor_disable' => 1,
        'function' => \&messages
    );

    chomp $text;
    
    # Begin processing the message entered
    if ($text =~ /^\/help/i)
    {
        &help_popup($buffer);
    }
    elsif ($text =~ /^\/who/i)
    {
        &list_users($buffer);
    }
    elsif ($text =~ /^\/xp/i)
    {
        &show_xp($buffer);
    }
    elsif ($text =~ /^\/log/i)
    {
        &show_log($buffer, "SHOW");
    }
    elsif ($text =~ /^\/save/i)
    {
        &show_log($buffer, "SAVE");
    }
    elsif ($text =~ /^\/msgs/i)
    {
        &show_msgs($buffer);
    }
    #elsif ($text =~ /^\/(?:checkoff|co)\s+/i)
    #{
        # Don't quite have this figured out...
    #}
    elsif ($text =~ /^\/freq\s*(\d*)/i)
    {
        # This is used to set an alarm and shouldn't be
        # too small.
        my $min = 5;
        if ($1 > $min)
        {
            $buffer->counter($1);
            $buffer->addlines("{CCB} - Interval set to $1");
        }
        else
        {
            $buffer->addlines("{CCB} - Interval must be greater than $
+min");
        }
    }
    elsif ($text =~ /^\/time/i)
    {
        if ($buffer->show_time)
        {
            $buffer->show_time(0);
            $buffer->addlines("{CCB} - Time stamps disabled");
        }
        else
        {
            $buffer->show_time(1);
            $buffer->addlines("{CCB} - Time stamps enabled");
        }
    }
    elsif ($text =~ /^\/(?:msg|tell)\s+(\S+)\s+(.+)$/i)
    {
        # A private message is being sent
        $chat->send($text);

        $buffer->addlines(split "\n", wrap("", "\t", "{CCB} - private 
+message sent to $1: $2"));
    }
    elsif ($text =~ /^\/(ignore|unignore)\s+(\S+)/i)
    {
        my $action = lc($1);
        my $user = $2;

        $action =~ s/.$/ing/;

        # A private message is being sent
        $chat->send($text);

        $buffer->addlines(split "\n", wrap("", "\t", "{CCB} - $action 
+user $user"));
    }
    elsif ($text =~ /^\/me\s*/i)
    {
        # /me emotes.
        $chat->send($text);
    }
    elsif ($text =~ /^\/quit/i)
    {
        # Ask the child to exit then quit.
        $main->erase();
        $main->addstr(0, 1, "Ending child process...");
        $main->refresh();

        # Code to exit.
        print CHILD "-1\n";

        waitpid($pid, 0);
        exit 0;
    }
    elsif (($text =~ /^\s{0,1}\//) || ($text =~ /^.{0,2]msg/i))
    {
        # All valid forms of commands are accounted for,
        # here we can handle near misses.
        
        ($text, $test) = input_box(
            'title' => "Vague response",
            'prompt' => "Please confirm, cancel or change your message
+:",
            'border' => "white",
            'content' => "$text",
            'cursor_disable' => 1
        );

        if (($test == 1) && ($text ne ""))
        {
            # Text was confirmed to send.
            $chat->send($text);
        }
        else
        {
            $buffer->addlines("{CCB} - message not sent");
        }
    }
    else
    {
        # Try to send whatever message was entered.
        if ($text ne "")
        {
            $chat->send($text);
        }
    }
}

END
{
    # Ask Curses to exit cleanly.
    endwin();
}

exit 0;

###############
# Subroutines #
###############

sub header
{
    # Display a nice header whilst we perform various tasks
    $main->standout();
    $main->addstr(0, 1, "{CCB} - Curses ChatterBox Client by {NULE} v.
+ $VERSION");
    $main->standend();
    $main->refresh();
}

sub child
{
    my ($request, $text);

    # Listen for a timing value from the parent.
    # Request the resource from
    while (1)
    {
        chomp($request = <PARENT>);

        if ($request == -1)
        {
            # We have been asked to exit
            return 1;
        }
        else
        {
            # The parent is expecting a response
            # in this many seconds or we will
            # send a lag error message
            eval
            {
                local $SIG{ALRM} = sub { die "ALARM\n" };
                alarm ($request - 1);
                $text = join "\n", $chat->getnewlines(1);
                alarm 0;
            };

            if ($@)
            {
                # Timeouts are different from other problems
                print PARENT "{CCB} - ERROR with child: $@" unless $@ 
+eq "ALARM\n";
                # Request timed out
                print PARENT "{CCB} - Lag problem, try setting /freq h
+igher..."
                    . RSEPARATOR;
            }
            else
            {
                print PARENT "$text" . RSEPARATOR;
            }
        }
    }
}

sub messages
{
    # Note that our handles are global here because Curses::Widgets 
    # doesn't seem amenable to passing arguments ($buffer, $main)
    my ($chat, @chat, @prechat, $line, $length);
    my $i = 0;

    if ($buffer->counter == 0)
    {
        local $/ = RSEPARATOR;

        eval
        {
            local $SIG{ALRM} = sub { die "ALARM\n" };
            alarm 2;
            chomp ($chat = <CHILD>);
            alarm 0;
        };

        if ($@)
        {
            $buffer->addlines("{CCB} - ERROR with parent: $@") unless 
+$@ eq "ALARM\n";
            $buffer->addlines("{CCB} - May have lost sync with child. 
+(1)");
        }

        eval
        {
            local $SIG{ALRM} = sub { die "ALARM\n" };
            alarm 2;
            print CHILD $buffer->counter . "\n";
            alarm 0;
        };

        if ($@)
        {
            $buffer->addlines("{CCB} - ERROR with parent: $@") unless 
+$@ eq "ALARM\n";
            $buffer->addlines("{CCB} - May have lost sync with child. 
+(2)");
        }

        @chat = map { "$_\n" } split "\n", $chat;

        $Text::Wrap::columns = $COLS - 2;

        foreach $line (@chat)
        {
            if ($buffer->show_time)
            {
                $line = &time_stamp . " $line";
            }

            $buffer->addlines(split "\n", wrap("", "\t", $line));
        }
    }

    @chat = $buffer->getlines($LINES - 3);

    # Start drawing from the bottom of the screen
    $i = $LINES - 4;
    foreach $line (reverse @chat)
    {
        # Not the best way to do this, but length()
        # doesn't handle tabs correctly. # TODO? #
        $line =~ s/^\t/        /;
        $length = $COLS - length($line) - 2;

        $line = " ".$line." "x$length;
        $main->addstr($i, 0, "$line");

        $i--;

        last if $i < 0;
    }
    
    $main->refresh();

    return 1;
}

sub help_popup
{
    # Display a window with help information in it.
    my $buffer = shift;
    my ($line, $help);

    my @help = (
        "Curses ChatterBox Client v. $VERSION",
        " ",
        "Commands available:",
        "- /help     - displays this message",
        "- /who      - shows the monks logged on",
        "- /xp       - shows some quick information about you",
        "- /log      - show the chat log",
        "- /freq <#> - sets the refresh interval to # seconds",
        "- /time     - toggles time stamps on messages",
        "- /save     - dump buffer to a save file",
        "- /quit     - exits the Chatterbox client",
        "Supported Chatterbox Commands",
        "- /me ...          - emote a message.",
        "- /msg <user> ...  - send a message to <user>.",
        "- /tell <user> ... - same thing.",
        "- /msgs            - show all private messages.",
        #"- /co ###<,###...> - check off private messages.",
        #"- /checkoff ###    - same thing.",
        "- /ignore <user>   - Ignore <user>.",
        "- /unignore <user> - Unignore <user>.",
        "To-do:",
        "- Colors",
        "- I keep having imaginings of building a mini-browser in...",
        "  if winamp can do it, so can I!",
        "- Tell me what features you would like!"
    );

    foreach $line (@help)
    {
        chomp $line;

        if ($line ne "")
        {
            $help .= "$line\n";
        }
    }

    txt_field(
        'window' => $main,
        'title' => "{CCB} Help - PGUP and PGDOWN to scroll, ENTER to e
+xit.",
        'regex' => "\n",
        'xpos' => 0,
        'ypos' => 0,
        'lines' => $LINES - 2,
        'cols' => $COLS - 2,
        'border' => "white",
        'edit' => 0,
        'cursor_disable' => 1,
        'content' => $help
    );

    # Clear the screen before returning.
    $main->erase();
    $main->refresh();
}

sub list_users
{
    my $buffer = shift;
    my (%users, $users);

    %users = $monks->users;

    if (%users)
    {
        $Text::Wrap::columns = $COLS - 2;

        $users  = "{CCB} - " . (scalar(keys(%users)) + 1);
        $users .= " users logged in: " . join " ",sort keys(%users);
        $buffer->addlines(split "\n", wrap("", "\t", $users));
    }
    else
    {
        $buffer->addlines("No users logged in (oddly enough)");
    }
}

sub show_msgs
{
    # Retrieve and display all personal messages
    my $buffer = shift;
    my (%msgs, $msg);

    %msgs = $chat->personal_messages;

    if (%msgs)
    {
        $Text::Wrap::columns = $COLS - 2;

        foreach $msg (sort keys(%msgs))
        {
            $buffer->addlines(split "\n", wrap("", "\t", "($msg) $msgs
+{$msg}"));
        }
    }
    else
    {
        $buffer->addlines("Could not get personal messages");
    }
}

sub show_xp
{
    # Print a display of current XP information
    my $buffer = shift;
    my (%xp, $xp);

    %xp = $monks->xp;

    if (%xp)
    {
        $Text::Wrap::columns = $COLS - 2;

        $xp  = "{CCB} - User: $xp{user}, Level: $xp{level}, XP: $xp{xp
+}, ";
        $xp .= "Votes: $xp{votesleft}, Next level in: $xp{xp2nextlevel
+} XP";
        $buffer->addlines(split "\n", wrap("", "\t", $xp));
    }
    else
    {
        $buffer->addlines("Could not get XP information");
    }
}

sub show_log
{
    my ($buffer, $mode) = @_;
    my (@chat, $line, $chat, $length, $filename);

    # If mode is SAVE then prompt for a file name
    if ($mode eq "SAVE")
    {
        my ($text, $test) = input_box(
            'title' => "Save log",
            'prompt' => "Please enter a path and filename to save your
+ message:",
            'border' => "white",
            'edit' => 0,
            'cursor_disable' => 1
        );

        if (($test == 1) && ($text ne ""))
        {
            $filename = $text;
        }
        else
        {
            $buffer->addlines("{CCB} - log not saved.");
            return 0;
        }
    }

    $length = $buffer->length;

    # Retrieve all the lines.
    @chat = $buffer->getlines($length);
    $chat = "";
    foreach $line (@chat)
    {
        chomp $line;

        if ($line ne "")
        {
            $chat .= "$line\n";
        }
    }

    if ($mode eq "SAVE")
    {
        open (FILEHANDLE, ">$filename");
        print FILEHANDLE $chat;
        close FILEHANDLE;
        $buffer->addlines("{CCB} - log saved as $filename");
    }
    else
    {
        txt_field(
            'window' => $main,
            'title' => "{CCB} Chat log - PGUP and PGDOWN to scroll, EN
+TER to exit (max $length lines).",
            'regex' => "\n",
            'xpos' => 0,
            'ypos' => 0,
            'lines' => $LINES - 2,
            'cols' => $COLS - 2,
            'border' => "white",
            'cursor_disable' => 1,
            'content' => $chat
        );
    }

    # Clear the screen before returning.
    $main->erase();
    $main->refresh();
}

sub time_stamp
{
    # Produce a time stamp
    my ($sec, $min, $hour) = localtime;

    $sec  = "0".$sec if $sec < 10;
    $min  = "0".$min if $min < 10;
    $hour = "0".$hour if $hour < 10;
    return ("$hour:$min:$sec")
}

sub handle_error
{
    my $message = shift;

    msg_box(
        'message' => "$message",
        'title' => "Error"
    );

    die "$message\n";
}

Comment on Curses Chatterbox Client
Download Code
Replies are listed 'Best First'.
Improved Curses Chatterbox Client
by {NULE} (Hermit) on Oct 22, 2001 at 17:42 UTC
    Hi all,

    For those who have had problems with this client lagging - it has now been rewritten with a fork and some alerts. In normal working mode it should not ever lag.

    The non-forking version will remain on my website for those who may wish to still use it.

    Any problems or desired features please let me know. Thanks!
    {NULE}
    --
    http://www.nule.org

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://117372]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (8)
As of 2015-07-31 01:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (274 votes), past polls