#!/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;
In reply to Re^4: Perl - TK - Listbox insertion problem
by k0rn
in thread Perl - TK - Listbox insertion problem
by k0rn
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |