in reply to Perl - TK - Listbox insertion problem

Have you tried using fileevent? Something along these lines works for me (though with Attempt to free unreferenced scalar at the end): 
open $STDIN,'-';

$top->fileevent($STDIN,readable => sub {
                  my $line = <$STDIN>;
                  $listboxb->insert('end',$line);
                });

[download]

Replies are listed 'Best First'.
Re^2: Perl - TK - Listbox insertion problem
by k0rn (Acolyte) on Apr 25, 2010 at 12:37 UTC
    I tried this but im not sure that i am implementing it properly heres the code. 
        # Fork it into two process's
    my $kidpid;
    die "Cant Fork: $!" unless defined($kidpid = fork());

    if ($kidpid) {
        
    while (defined ( my $line = <$sock> ) ){
        
        chomp($line);# = $_);
        $line =~ s/(\x0a|\x0d)//g;
        # Display response from server
        
        
        open $STDIN,'-';

        $mainWindow->fileevent($STDIN,readable => sub {
        my $line = <$STDIN>;
        $scrolledText->insert('end',$line);
                });

    [download]
    And heres the Error i get 
    drew@Phantom:~$ perl irc.pl
>> NICK k0rn
>> USER k0rnh0le localhost localhost Andrew
Tk::Error: Can't locate object method "OPEN" via package "Tk::Event::I
+O" at irc.pl line 444, <GEN1> line 2.
 <Key-Return>
 (command bound to event)
perl: ../../src/xcb_io.c:242: process_responses: Assertion `(((long) (
+dpy->last_request_read) - (long) (dpy->request)) <= 0)' failed.
perl: ../../src/xcb_io.c:242: process_responses: Assertion `(((long) (
+dpy->last_request_read) - (long) (dpy->request)) <= 0)' failed.
Aborted

    [download]
    Thank you very much for your help.
[reply]
[d/l]
[select]
      In your case, you should not use STDIN, but the socket as the source of the events (I am not sure whether it is possible, but if not, you can try sending the lines from the socket to a file and use its filehandle...).
[reply]
        I'm not sure why the error message i was receiving was no such file or directory sense all that needs to be done is the text inserts into a listbox widget. What does that have to do with a file or directory. Its a weird error to me.
[reply]
        I understand the produces an empty string but this is not the case when i am using end it is producing a string. Its producing the first response from the server and inserting it into my listbox its not until after that does the program end and give the error. When i remove the or die it does not even do this. It wont even insert the first response from the server it does nothing. So this is why this problem is a weird one to me.
[reply]
        I understand that it inserts into the widget and it is inserting into the widget like i said its only inserting the first response from the server and it works for me on my other routines such as below. 
        
if ($postSplit[0] eq "/join") {
        
        #Check for erros
        if ($postSplit[1] eq "") {
            &error("Incorrect format must me /join #channel");
        }

# Begin Error Routine
# Used to simplify error reporting
sub error {
    my $error = $_[0];
    my $errorMessage = "*** ERROR ***    $error    *** ERROR ***";    
+ # Our standard Error message
    $scrolledText -> insert('end', "$errorMessage");                # 
+Insert the Error into the listbox
}
# End Error Routine

        [download]
        That right their inserts into the listbox at the 'end' every time and its not an empty string! So Why wont it work the same way with the response from the server????
[reply]
[d/l]
        And secondly return; has nothing to do with it. It has to do with inserting into the list box it makes zero difference if return is their or not.
[reply]
        I added the or die to the working code and it still worked just fine. It inserted into the list box over and over and never ended the program. So no i do not know what your talking about sense it worked.
[reply]
        I'm just gonna go ahead and post all of the code. Thanks for trying to help figure this out by the way. Maybe by posting the whole program you might see something I'm not. 
        #!/usr/bin/perl

# This is a irc client useing Tk
# Date started 3-22-10

#

use Tk;
use strict;

# Set some global variables
# Used for the MessageBox sub routines
# As well as the label sub routines.
# Entry, Save routines
use vars qw($message $type $icon $messageBox @mainEntry @settings $soc
+k);

# Our Main Window
my $mainWindow = new MainWindow;

# Title the window
$mainWindow -> title( 'Perl Tk Irc Client' );

# Create a frame for our widgets
my $frameMain = $mainWindow -> Frame(
    -relief => 'sunken',
    );

$frameMain -> pack(
    -expand => '1',
    -fill => 'both'
    );

# Our Options menu
my $menuBar = $mainWindow -> Menu();

$mainWindow -> configure(
    -menu => $menuBar
    );

# The Menu Buttons
my $file = $menuBar -> cascade(
    -label => 'File',
    -underline => '0',
    -tearoff => '0'
    );

my $help = $menuBar -> cascade(
    -label => 'Help',
    -underline => '0',
    -tearoff => '0'
    );
# End Menu Buttons

# File Menu Options

# Settings Option
$file -> command(
    -label => 'Settings',
    -underline => '0',
    -command => \&settings
    );

# Quit Option
$file -> command(
    -label => 'Quit',
    -underline => '0',
    -command =>  \&quit
    );
# End File Menu Options


# Help Menu Options

# About Option
$help -> command(
    -label => 'About',
    -underline => '0',
    -command=> \&about
    );
# End Help Menu Options

# Text entry to chat!
my $textEntry = $frameMain -> Entry(
    -state => 'normal',
    -background => 'white',
    #-foreground => 'black',
    -width => '100'
    );
    
$textEntry -> pack(
    -expand => '0',
    -fill => 'x',
    -side => 'bottom'
    );

# When the return key is hit the routine getData will run
$textEntry -> bind('<Return>' => \&getData); 

# Scrolled text where the chat and status apears
my $scrolledText = $frameMain -> Scrolled(
    'Listbox',
    -scrollbars => 'oe',
    -background => 'white',
    #-foreground => 'black',
    -width => '90',
    -height => '30'
    );
    
$scrolledText -> pack(
    -fill => 'both',
    -expand => '1',
    -side => 'left'
    );

# Scrolled text for the usernames in the chat room
my $scrolledNicks = $frameMain -> Scrolled(
    'Listbox',
    -scrollbars => 'eo',
    -background => 'white',
    #-foreground => 'black',
    -width => '10',
    -height => '30'
    );
    
$scrolledNicks -> pack(
    -fill => 'both',
    -side => 'right',
    );

# Sub Routines To be moved to another file
#MainLoop;

# Sub Routines for the File Menu
sub quit {
    #my $response = $mainWindow -> messageBox(-message => "Would you l
+ike to exit?", -type => 'yesno', -icon => 'question');
    $message = "Would you like to exit?";
    $type = 'yesno';
    $icon = 'question';
    
    &messageBox($message,$type,$icon);
    
    if ($messageBox eq "Yes") {
        exit;

    }
}

# Sub routine to run our settings dialog box.
sub settings {
    # Make our top level window for the settings dialog box
    my $settingsTopLevel = $mainWindow -> Toplevel();
    
    # Title the Top Level Window
    $settingsTopLevel -> title( 'User Settings' );
    
    # Set the defualt size of our Top Level Window
    # Use Geometry
    $settingsTopLevel -> geometry("500x300");
    
    # Button To close our Dialog
    my $closeButton = $settingsTopLevel -> Button(
            -text => 'Cancel',
            -command => sub { destroy $settingsTopLevel; }
            );
    $closeButton -> grid(
        -column => 1,
        -row => 3,
        -pady => 10,
        -sticky => 's'
        );

    # Button to save our settings
    my $saveButton = $settingsTopLevel -> Button(
            -text => 'Save',
            -command => \&saveSettings
            );
    $saveButton -> grid(
        -column => 2,
        -row => 3,
        -pady => 10,
        -sticky => 's'
        );
        
        # Create our labels
        # Options go in this order
        # Title, Window, Column, Row
        
        &Label("Nickname:", $settingsTopLevel, 0, 0);
        &Label("Username:", $settingsTopLevel, 0, 1);
        &Label("Real Name:", $settingsTopLevel, 0, 2);

        # Create our Entries
        # Options go in this order
        # Window, Column, Row

        &Entry($settingsTopLevel, 2, 0);
        &Entry($settingsTopLevel, 2, 1);
        &Entry($settingsTopLevel, 2, 2);

}
# End Settings Routine

# End Sub Routines for the File Menu



# Sub Routines for the Help Menu

sub about {
    $message = "Tk Irc Script v1.0\nWritten by: Andrew Medeiros\nE-mai
+l: amedeiros0920\@gmail.com";
    $type = 'ok';
    $icon = 'info';
    &messageBox($message,$type,$icon);
}

# End Sub Routines for Help Menu


# Sub routine to get the data from the text entry field when the retur
+n key is hit. 
# For the moment it just prints the text. But we will need to clear th
+e text entry and take the text and run it against potential commands.

sub getData {
    my $post = $textEntry -> get();             # Get the entered data
+ from the text entry
    $textEntry -> delete(0, 'end');            # Clear the text entry]

    my @postSplit = split(/ /, $post);            # Split the entry in
+to an array removing the white spaces. For checking commnads
    
    if ($post eq "") {                        # If blank dont post
        return;
        #print "Empty\n";                    # Testing purposes
        
    }
    
    if ($postSplit[0] eq "/server") {
        
        # Check for blanks
        if ($postSplit[1] eq "" or $postSplit[1] != /[^0-9]/) {
            &error("Incorrect format either server name is missing or 
+is just a number!");
        }
        
        elsif ($postSplit[2] eq "" or $postSplit[2] == /[^0-9]/ ) {
            &error("Incoreect format either port number is missing or 
+is not a number!");
        }
        
        else {
            &connection($postSplit[1], $postSplit[2]);
        }
        
    }
    
    if ($postSplit[0] eq "/join") {
        
        #Check for erros
        if ($postSplit[1] eq "") {
            &error("Incorrect format must be /join #channel");
        }
        # If good join the channel
        else {
            &raw("JOIN $postSplit[1]");
        }
    }
    
    $scrolledText -> see('end');                # So the scrolledText 
+will auto scroll allowing to see the conversation
}

# End Get Data Routine



# Sub routine to create Custom labels by passing some options through
# This will make it so we dont have to make a new label for every reas
+on

sub Label {
    # The options we need to create some basic labels
    my $label = $_[0];
    my $window = $_[1];
    my $column = $_[2];
    my $row = $_[3];
    
    # Lets make them shits
    my $mainLabel = $window -> Label( -text => "$label" );
    $mainLabel -> grid(
        -column => $column,
        -row => $row,
        -pady => 20,
        -sticky => 'w'
        );
}
# End Label Routine

# Create a entry routine to make our entrys 
# For the settings

my $num = 0;        # This is so we can define each entry differently 
+and get-> them each
sub Entry {
    my $window = $_[0];
    my $column = $_[1];
    my $row = $_[2];
    # Lets make them shits
    $mainEntry[$num] = $window -> Entry(
        -state => 'normal',
        -background => 'white',
        #-foreground => 'black',
        -width => '40'
        );

    $mainEntry[$num] -> grid(
        -column => $column,
        -row => $row,
        -pady => 20,
        -sticky => 'e'
        );
        $num++;

}

# Sub routine to save our settings
use Config::General qw(SaveConfig);
sub saveSettings {
    my $num = 0;
    while ($num != 3) {
        
        my $settings = $mainEntry[$num] ->get();
        $settings[$num] = $settings;


        if ( $settings eq "" ) {

            $num = 2;
            
            # Send our error box for an empty entry
            # Message, Type, Icon
            &messageBox("You are missing an entry!", 'ok', 'error');
        }
            
        else {
            
            # Open the configuration file
            my $conf = new Config::General("settings.conf");
            
            # Create our database in a hash
            my %database = (
                    database => {
                        nickname => "$settings[0]",
                        username => "$settings[1]",
                        realname => "$settings[2]"
                    }
                );

            # Save our database
            SaveConfig("settings.conf", \%database);
        }
        $num++;
    }
}

# End Save Settings Routine


# Sub Routine to create Custom Message Box's by passing the options th
+rough.
# This will make it so i do not have to make a new message box for eve
+ry reason.

sub messageBox {
    
    my $message = $_[0];
    my $type = $_[1];
    my $icon = $_[2];
    
    $messageBox = $mainWindow -> messageBox(
            -message => $message,
            -type => $type,
            -icon => $icon
            );
    return;
}
# End messageBox Routine


# Begin Error Routine
# Used to simplify error reporting
sub error {
    my $error = $_[0];
    my $errorMessage = "*** ERROR ***    $error    *** ERROR ***";    
+ # Our standard Error message
    $scrolledText -> insert('end', "$errorMessage");                  
+  # Insert the Error into the listbox
}
# End Error Routine
    
# Begin Connection routine
# This will connect us to our server
use IO::Socket;
sub connection {
    # Get our server and port from the /server server port command.
    my $server = $_[0];
    my $port = $_[1];
    
    
    # Open the configuration file
    my $conf = new Config::General("settings.conf");
    
    # Get all the information from the settings file
    my %config = $conf ->getall();
    
    # Store the nickname from the settings
    my $nick = $config{'database'}->{'nickname'};
    
    # Store the username from the settings
    my $username = $config{'database'}->{'username'};
    
    # Store the realname from the settings
    my $realname = $config{'database'}->{'realname'};
    
    # Print results for testing purposes
    #print "$nick\n$username\n$realname";
    
    # Make our Connection to the server port given
    $sock = IO::Socket::INET->new(PeerAddr => "$server",
                              PeerPort => "$port",
                              Proto => 'tcp',
                              Timeout => '30') or die("Can Not Connect
+: $!\n");
    
    # Setup some extra information to be sent
    my $hostname = "localhost";
    my $servername = "localhost";
    
    # Send our basic information to the irc server
    &raw("NICK $nick");
    &raw("USER $username $hostname $servername $realname");
    
    # Fork it into two process's
    my $kidpid;
    die "Cant Fork: $!" unless defined($kidpid = fork());

    if ($kidpid) {
        
    while (defined ( my $line = <$sock> ) ){
        
        chomp($line);# = $_);
        $line =~ s/(\x0a|\x0d)//g;
        # Display response from server

        &show($line);
        #print "<< $line\n";
        
        
        $line =~ s/^://;
        my ($pre, $tag) = split(/ :/, $line, 2);
        
        my @parts = split(/ /, $pre);
        my @user = split(/!/, $parts[0]);    #    This is going to get
+ the users nick who posted to the channel for a command or did a ctcp
+ and so fourth. So the bot can reply to that user.
        my @phrase = split(/ /, $tag);    #    This is going to be use
+d do split up the users text to pick it a part for specific things
        
        # Check for ping request
        if ($parts[0] eq 'PING') {
            # Reply with proper PONG response
            &raw("PONG :$tag");
        }

        my $event = uc($parts[1]);
        
        if ($event eq "PRIVMSG" && $phrase[0] eq "VERSION") {
            my $response = "Is useing Perl Tk Irc Client by k0rn";
            &raw("VERSION $user[0] $nick $response");
            print "Got version request!\n";
        }
    }
}
}

# Begine raw subroutine
# Used to send data to the server
sub raw {
    my($l) = @_;
        print ">> $l\n";
        print $sock "$l\n";

}
# End Connection Sub Routine

# Begin Show Sub Routine
# To Display data from server
sub show {
    my $line = shift;
    print "<< $line\n";

    $scrolledText ->insert('end',"<< $line");    # Insert the text int
+o the Listbox $scrolledText
        return;
}
# End Show Sub Routine

MainLoop;

        [download]
[reply]
[d/l]
        So basically what your saying is i need to rewrite how i handle the connection to the server to make this work and use fileevent.
[reply]

In Section Seekers of Perl Wisdom