view release on metacpan or  search on metacpan

examples/irc_client  view on Meta::CPAN

open LOG, ">>", "cuirc-debug.log";

# Try to put errors in the window...
$SIG{"__DIE__"} = sub {
    print LOG $_[0];
};
$SIG{"__WARN__"} = sub {
    print LOG $_[0];
};

print "Welcome to Curses::UI::POE's IRC example";

run POE::Kernel;

package IRC::Output;

use strict;
use warnings FATAL => "all";

use POE;
use POSIX qw( strftime cuserid );
use Curses;
use Carp qw( carp );
use constant KEY_TAB => "\t";

my @nicks;

sub addnick {
    my ($nicklist, $curses) = @{ +shift }{qw( -nicks -curses )};
    my $nick = shift;

    push @nicks, $nick;

    $nicklist->values([sort @nicks]);
    $nicklist->draw(1);

    $curses->draw;
}

sub dropnick {
    my ($nicklist, $curses) = @{ +shift }{qw( -nicks -curses )};
    my $nick = shift;

    @nicks = grep $nick ne $_, @nicks;
    $nicklist->values([sort @nicks]);
    $nicklist->draw(1);
    $curses->draw;
}

sub PRINT { 
    our @Channel;

    my $object = shift;
    my ($viewer, $curses) = @$object{qw( -viewer -curses )};

    push @Channel, shift;

    $viewer->text(join "\n", @Channel);
    $viewer->cursor_down(undef, $viewer->canvasheight);
    $viewer->draw;

#    $viewer->{-ypos} = @Channel;
#    $viewer->layout_content;

    $curses->draw;
}

sub PRINTF {
    our @Channel;

    my $object = shift;
    my ($viewer, $curses) = @$object{qw( -viewer -curses )};

    # XXX Hack: Just ignore bunk requests for now...
    if (grep !defined $_, @_) {
        carp "Attempt to print undefined value";
    }

    push @Channel, sprintf shift, @_;

    $viewer->text(join "\n", @Channel);
    $viewer->cursor_down(undef, $viewer->canvasheight);
    $viewer->draw;

#    $viewer->{-ypos} = @Channel;
#    $viewer->layout_content;

    $curses->draw;
}

sub TIEHANDLE { 
    my $curses = $_[-1];

    # Main Menu
    my $menu = $curses->add
        ( 'menu','Menubar', 
          -fg   => "white",
          -bg   => "blue",
          -menu => [
            { -label => 'File', 
              -submenu => [
                { -label => 'Exit      ^Q', -value => sub { exit } }
              ]
            },
            { -label => 'Help', 
              -submenu => [
                { -label => 'about', -value => \&about_dialog }
              ]
            }, 
          ]
        );

    # Create the screen for the editor.
    my $screen = $curses->add
        ( 'screen', 'Window',
          -padtop       => 1, # leave space for the menu
          -border		=> 0,
          -ipad		    => 0,
        );

    # We add the editor widget to this screen.
    my $viewer = $screen->add
        ( 'viewer', 'TextViewer',
          -border 	        => 0,
          -pos              => -1,
          -sfg              => "blue",
          -sbg              => "white",
          -padright         => 11,
          -padtop		    => 0,	
          -padbottom 	    => 2,
          -showlines	    => 0,
          -sbborder	        => 0,
          -vscrollbar	    => 1,
          -hscrollbar	    => 0,
          -showhardreturns  => 0,
          -wrapping         => 1,
        );

    my $nicks = $screen->add
        ( 'nicks', 'Listbox',
          -x            => -1,
          -y            => -1,

examples/irc_client  view on Meta::CPAN

                $CurrentChannel = $Join;
            }
            else {
                $Channel{$Join} = 1;
                $poe_kernel->post( IRC => join => $Join );
                $CurrentChannel = $Join;
            }
        },

        nick => sub { $poe_kernel->post( IRC => nick => $_[1] ) },
        kick => sub { $poe_kernel->post( IRC => kick => @_[1..$#_] ) },
        msg  => sub { $poe_kernel->post( IRC => privmsg => @_[1..$#_] ) },
        
        quote => sub {
            $poe_kernel->post( IRC => sl => join " ", @_[1..$#_] );
        },

        quit => sub {
            $poe_kernel->post( IRC => quit => join " ", @_[1..$#_] );

            print "Have a nice day";
            exit;
        },
    };

    set_binding $editor sub {
        my $input = shift;
        my $line = $input->get;

        push @History, $line;
        $Current = @History;

        $input->text("");

        if (my ($cmd) = ($line =~ m[^/(\w+)])) {
            $cmd = lc $cmd;
            if (defined $execute->{$cmd}) {
                $execute->{$cmd}->($line =~ m[(\S+)]g);
            }
            else {
                print "--- $cmd not registered";
            }
        }
        else {
            if ($CurrentChannel) {
                $poe_kernel->post( IRC => privmsg => $CurrentChannel, $line );
                print "> $line";
            }
            else {
                print "No Current Channel ---";
            }
        }
    }, KEY_ENTER;

    set_binding $editor sub {
        # Do nothing...overload the lose-focus event.
    }, KEY_TAB, KEY_BTAB;

    # Why doesn't this work?
    set_binding $editor sub {
        warn "Calling \$viewer->cursor_pageup";
        $viewer->cursor_pageup;
        $viewer->draw;
    }, KEY_PPAGE;

    set_binding $editor sub {
        warn "Calling \$viewer->cursor_pagedown";
        $viewer->cursor_pagedown;
        $viewer->draw;
    }, KEY_NPAGE;

    set_binding $editor sub { shift->text($History[--$Current]) }, KEY_UP;
    set_binding $editor sub {
        $Current++;
        if ($Current > @History)    { shift->text("") }
        else                        { shift->text( $History[$Current] ) }
    }, KEY_DOWN;

    # Focus on the editor.
    $editor->focus;
    $editor->draw;

    $_[-1] = bless { 
        -curses => $curses,
        -viewer => $viewer,
        -screen => $screen,
        -editor => $editor,
        -menu   => $menu,
        -nicks  => $nicks,
    }, shift;
}

sub about_dialog {
	shift->root->dialog
        ( -title    => "About poco_irc_client",
		  -message  => <<'ABOUT'
Program : Curses::UI::POE IRC Client
Author  : Scott McCoy
          tag@cpan.org

The sole purpose of this client is to demonstrate
new Curses::UI::POE features, as well as provide
an example of how Curses::UI::POE could be used.
This example was crafted specifically for snl20
from #perl, on the freenode network.
ABOUT
	);
}