#!/usr/bin/perl -w
use Class::Struct;
use IO::Socket::SSL;
use HTML::TokeParser;
use Gtk;
use strict; # ive tried this without strict and with use vars qw($list
+); and it dosnt work either

## CONFIGURATION ###################
my $host    = shift || "localhost";
my $port     = shift || 2048;
my $ssl_passwd     = shift    || "somepasswd";
## END CONFIGURATION ###############

$SIG{TERM} = \&terminate;

use constant TRUE     => 1;
use constant FALSE     => 0;
use constant VER     => 0.2;

struct( client     => {
    convs    => '@', # array holding references to conv structures
    });

struct(    conv     => {    # conversation structure
    wnd_ref => '$', # reference to window object
    sock     => '$',    # socket for conversation
    });

init Gtk;

my ($subject_name,$issuer_name,$cipher,$buffer);
my $list = "TEST";

my $sock = IO::Socket::SSL->new(PeerAddr     => $host,
                PeerPort     => $port,
                Proto        => 'tcp',
                SSL_use_cert     => 1,
                SSL_verify_mode => 0x01,
                SSL_passwd_cb    => sub { return $ssl_passwd; }
                ) or die "ERROR: $!\n";

if(ref($sock) eq "IO::Socket::SSL") {
    $subject_name = $sock->peer_certificate("subject");
    $issuer_name = $sock->peer_certificate("issuer");
    $cipher = $sock->get_cipher();
}

my $self = client->new();

my $child = fork();
if (!$child) {
    CreateMainWindow();
    
    print "parent=$list\n"; # this displays the right object
    main Gtk;
} else {
    print "child=$list\n"; # whereas this does not
    host_to_user($sock);
}

sub CreateMainWindow {
    my $window = new Gtk::Window('toplevel');
    
    $window->set_usize(150,250);
    $window->set_title("slut");

    $window->signal_connect("destroy",\&terminate);
    
    my $main_vbox = new Gtk::VBox(FALSE,0);
    $window->add($main_vbox);

    my $main_scroll = new Gtk::ScrolledWindow(undef,undef);
    $main_vbox->pack_start($main_scroll,TRUE,TRUE,0);

    # set $list to the Gtk::CList object
        # so we can use it later on in another sub
    $list = new_with_titles Gtk::CList('users online');
    
    $list->signal_connect('select_row',\&main_select);    
    $list->set_shadow_type('out');

    $main_scroll->add($list);

    $window->set_title('slut');

    $main_vbox->show();
    $main_scroll->show();
    $list->show();
    $window->show();

    return $list;
}

sub main_select {
    my ($widget,$row,$column,$event) = @_;
    
    print $widget->get_text($row,$column)."\n";
}

sub host_to_user {
    my $socket = shift;
    my $buf;

    while(my $bytes_in = sysread($socket,$buf,1024)) {
        printf("received %f Kb\n",$bytes_in / 1024);

        chomp($buf);

        proc_xml($socket,$buf); 
    }
}

sub proc_cmd {
    my $data = shift;
    chomp($data);
    
    if (my ($dest,$msg) = ($data =~ /^\/msg ([A-Za-z0-9_\-]+) (.+)/)) 
+{
        # ...send message to user

        $data = sprintf("<slut ver=\"%s\"><msg dest=\"%s\">%s</msg></s
+lut>",VER,$dest,$msg);
        } elsif (my ($nick) = ($data =~ /^\/nick (.*)/)) {
        # ...change nickname        

        $data = sprintf("<slut ver=\"%s\"><nick>%s</nick></slut>",VER,
+$nick);
    } elsif (my ($action) = ($data =~ /^\/me (.*)/)) {
        # ...action

        $data = sprintf("<slut ver=\"%s\"><action>%s</action></slut>",
+VER,$action);
    } elsif (my ($quit_msg) = ($data =~ /^\/quit (.*)/)) {
        $quit_msg = ":slut: `ich will dich`" if ($quit_msg eq undef);

        $data = sprintf("<slut ver=\"%s\"><quit>%s</quit></slut>",VER,
+$quit_msg);
    } else {
        # ...else send the data to everyone as a message
        
        $data = sprintf("<slut ver=\"%s\"><msg dest=\"%s\">%s</msg></s
+lut>",VER,'*',$data);
    }

    return $data;
}

sub proc_xml {
    my ($socket,$xml) = @_;
    my ($buffer,$type,$mesg) = undef;
    
    my $tp = HTML::TokeParser->new(\$xml);

    while (my $token = $tp->get_token) {
        $type = shift @{$token};

        if ($type eq "S") {
            my ($tag,$attr,$attrseq,$rawtxt) = @{$token};

            if ($tag eq "slut") {
                my $ver = $attr->{'ver'};
                
            } elsif ($tag eq "msg") {
                my $src = $attr->{'src'};
                $src =~ s/[^A-Za-z0-9_\-]//g;                

                $mesg = $tp->get_trimmed_text("/$tag");

                print "message from $src stating $mesg\n";
            } elsif ($tag eq "connect") {
                my $id = $attr->{'id'};
                
                my $nick = $tp->get_trimmed_text("/$tag");

                print "$nick is now online!\n";

                AddToList($nick);
            }
        }
    }

    return $buffer;
} 

sub AddToList {
    my $nick = shift;

        # here is where i would use the previously created CLIST objec
+t to add $nick to the list (but $list dosnt have the object in it!)
}

sub ConvExists {
    my $nick = shift;
    my $retval = FALSE;

    foreach (@{$self->convs}) {
        return TRUE if (lc($_->nick) eq lc($nick));
    }
    
    return $retval;
}

sub terminate {
    print "closing...\n";
    
    $sock->close();
    Gtk->exit(0);
    
    exit(0);
}
[download]

edit (broquaint): moved the <div class="pmsig"> tag and added a <readmore> tag