Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/local/perl/bin/perl -- # -*-Perl-*- # NOTE: I always use -w, but I'm not here because there's a bug # in Win32::GUI which constantly spits out warnings. It's # annoying, so I'm not using -w. Get over it. # # monkchat # Shendal, June 2000 # # Special thanks to zzamboni who created PerlMonksChat.pm # Very special thanks to vroom for creating PerlMonks.org # Oh, and Larry Wall's okay in my book for making perl # # Notes: # - When I output to the chatterbox window, the script needs # to append the output to the end of the buffer. Currently, # Win32::GUI doesn't have a nice way to do this. Instead, # I have to select the end of the buffer and then do a # ReplaceSel. It's kludgy, but it works. # # To-do: # - userlist could be double-clickable to get info # on selected user (by launching a browser?) # # Version history: # 1.0 6/21/00 # - Added File->About to show version information # - Chatterbox now automatically scrolls on every insert! *phew* # 0.9.4 6/20/00 # - Hitting return now sends whatever is in the input box. I simply # changed the Win32::Window to Win32::DialogBox and it worked. # Go figure. # - Tabbing around the userinfo/password box now works as well. # 0.9.3 6/20/00 # - Spawn new process to alleviate gui locking during updates # 0.9.2 6/16/00 # - XP progress bar is more accurate: now reports % of way # from current level to next # 0.9.1 6/16/00 # - fixed private message formatting # - text now inserted at bottom of buffer # - added /checkoff, /co for checking off private messages # - added /msgs to re-print unchecked private messages # - sent private messages now appear in chatterbox buffer # - added color # 0.9 6/15/00 # - initial release # use strict; use Getopt::Long; use Win32::GUI; use IPC::Open2; use Symbol; use PerlMonksChat; # Process command-line options use vars '$opt_server'; # launch in server mode use vars '$opt_close'; # close dos parent window use vars '$opt_debug'; # debug &GetOptions("server","close","debug") or die "Bad options!"; # Since we're communicating line by line, we want everything unbuffere +d select STDERR; $|=1; select STDOUT; $|=1; # Version info my($version) = '1.0'; my($status_idle) = "monkchat version $version is idle"; # Polling itervals (in millisecs) # set to 0 to disable my($interval_chat) = 15000; # 15 secs my($interval_xp) = 30000; # 30 secs my($interval_userlist) = 30000; # 30 secs # refreshes all caches at the expense of occasional gui locks # not really needed, unless you REALLY want to be up to date my($interval_caches) = 0; # Colors my($text_default) = 0x010101; # black my($text_private) = 0x880088; # purple my($text_username) = 0xFF0000; # blue my($text_message) = 0x888800; # aqua my($text_error) = 0x0000FF; # red # perlmonk levels # the xp xml ticker doesn't return this, so we'll have to hard code it my(%perlmonk_levels) = (1 => 0, 2 => 20, 3 => 50, 4 => 100, 5 => 200, 6 => 500, 7 => 1000, 8 => 1600, 9 => 2300, 10 => 3000); # This is the beast that drives everything my($p); # perlmonkschat object # user information my($user,$passwd); # Server Objects my($serverProcess); # server process object my($toServer) = gensym(); # send data glob to server my($fromServer) = gensym(); # read data glob from server # GUI Objects my($Window); # The over-all window object my($Chatfield); # object that displays all the chat text my($Userlist); # userlist listbox my($UserlistLabel); # displays number of users logged in my($Inputfield); # object that allows the user to type their own me +ssage my($SayButton); # send text button my($Progress); # progress bar intended to show xp & next level my($XPLabel); # displays XP information on the screen my($Status); # well, a status bar my($userinfo_w); # userinformation window my($menu); # Globally declare menu since it affects some user # Thanks to httptech for this one if ($opt_server) { # launch as server process &runServer; } else { # launch as client process # Hide the DOS window that created me, if you want to # Warning: This can create a 'zombie' process &closeDOSParent if ($opt_close); &initWindow; &initServer; &initChat; Win32::GUI::Dialog(); } ###################################################################### +########## # # initServer # # Initialize the server process # sub initServer { $Status->Text("Initializing server process..."); my($flags) = '-s'; $flags .= ' -d' if ($opt_debug); $serverProcess = open2($fromServer,$toServer,"$^X","$0","$flags"); while (<$fromServer>) { if (/server started/) { printMessage("Server process started successfully ($serverProc +ess)."); last; } else { printMessage("Failed to start server process."); } } select $toServer; $|=1; select STDOUT; $Status->Text("$status_idle"); } ###################################################################### +########## # # initChat # # Initialize the chat process # sub initChat { $Status->Text("Initializing client..."); $Window->AddTimer("updChatterbox",$interval_chat) if ($interval_ +chat); $Window->AddTimer("updXP",$interval_xp) if ($interval_ +xp); $Window->AddTimer("updUserlist",$interval_userlist) if ($interval_ +userlist); $Window->AddTimer("refreshCaches",$interval_caches) if ($interval_ +caches); &updChatterbox_Click; # seed the chatterbox &updXP_Click; # seed the XP info &updUserlist_Click; # seed the Userlist area $Status->Text("$status_idle"); } ###################################################################### +########## # # runServer # # Run as server # sub runServer { select STDERR; $|=1; select STDOUT; $|=1; # server-only objects my(@chat_cache,%xp_cache,%userlist_cache,@msgs_cache); # caches # init perlmonks chat object $p = PerlMonksChat->new(); $p->add_cookies; $p->login($user,$passwd) if $user; # Seed caches &refreshCaches; # print advisory information so the gui can continue loading print "server started\n"; while (<STDIN>) { s/\r*\n//g; print STDERR "SERVER: received \"$_\"\n" if ($opt_debug); if (/chat/) { foreach (@chat_cache) { print "$_\n"; } print "MeSsAgE_eNd\n"; @chat_cache = (); # flush cache } elsif (/xp/) { foreach ('level','xp','xp2nextlevel','votesleft') { print "$xp +_cache{$_}\n"; } print "MeSsAgE_eNd\n"; } elsif (/userlist/) { foreach (sort keys(%userlist_cache)) { print "$_\n"; } print "MeSsAgE_eNd\n"; } elsif (/msgs/) { my(%msgs) = $p->personal_messages; foreach (sort keys(%msgs)) { print "$msgs{$_}\n"; } print "MeSsAgE_eNd\n"; } elsif (/^upd/) { &updChatCache if (/updChatCache/); &updXPCache if (/updXPCache/); &updUserlistCache if (/updUserlistCache/); } elsif (/^refreshCaches/) { &refreshCaches; } elsif (s/^SEND://) { s/\r*\n//g; print STDERR "SERVER: Sending \"$_\"\n" if ($opt_debug); $p->send("$_"); } elsif (/^CO:(.+)$/) { my(@ids) = split /,/,$1; my(%msgs) = $p->personal_messages; $p->checkoff(map { (sort keys %msgs)[$_-1] } @ids); } elsif (/^LOGIN (\S+) (\S+)$/) { $p->login($1,$2); } else { print STDERR "Un-oh -- shouldn't ever get here: $_\n"; } } print STDERR "server exited abnormally\n"; sub updChatCache { foreach ($p->getnewlines(1)) { push @chat_c +ache, $_; } } sub updXPCache { %xp_cache = $p->xp; } sub updUserlistCache { %userlist_cache = $p->users; } sub refreshCaches { &updChatCache; &updXPCache; &updUserlistCache; } } ###################################################################### +########## # # getFromServer # # Interface for client to get information from server # sub getFromServer { my($what) = shift; my(@result) = (); print STDERR "CLIENT: requesting $what\n" if ($opt_debug); print $toServer "$what\n"; while (<$fromServer>) { last if (/MeSsAgE_eNd/); s/\r?\n//g; push @result, $_; } print STDERR "CLIENT: received @result\n" if ($opt_debug); return @result; } ###################################################################### +########## # # initWindow # # Initialize the GUI window # sub initWindow { $menu = Win32::GUI::MakeMenu ( "&File" => "File", "> &About" => "About", "> E&xit" => "Exit", "&Update" => "Update", "> Force update on &chatterbox" => "updChatterbox", "> Force update on &XP" => "updXP", "> Force update on &userlist" => "updUserlist", "> -" => 0, "> Change username and password" => "updUsername", ); $Window = new Win32::GUI::DialogBox( -title => "Perlmonks Chat", -left => 100, -top => 100, -width => 600, -height => 400, -name => "Window", -style => WS_MINIMIZEBOX | WS_CAPTION | WS_SYSMENU, -menu => $menu, ); $Chatfield = $Window->AddRichEdit( -name => "Chatfield", -left => 5, -top => 5, -text => "", -width => $Window->ScaleWidth-105, -height => $Window->ScaleHeight-70, -readonly => 1, -style => WS_CHILD | WS_VISIBLE | ES_AUTOVSCROLL | WS_VSCROLL | ES_LEFT | ES_MULTILINE | ES_READONLY, -exstyle => WS_EX_CLIENTEDGE, ); $Userlist = $Window->AddListbox( -name => "Userlist", -text => "Userlist", -left => $Window->ScaleWidth-100, -top => 5, -width => 95, -height => $Window->ScaleHeight-65, -multisel => 0, -sort => 1, ); $UserlistLabel = $Window->AddLabel( -text => "Getting userlist...", -sunken => 1, -name => "UserlistLabel", -left => $Window->ScaleWidth-100, -top => $Window->ScaleHeight-86, -width => 95, -height => 21, ); $Inputfield = $Window->AddTextfield( -name => "input", -left => 5, -top => $Window->ScaleHeight-60, -text => "", -width => $Window->ScaleWidth-50, -height => 22, -foreground => [0,0,0], -background => [255,255,255], -tabstop => 1, ); $Inputfield->SetFocus; $SayButton = $Window->AddButton( -name => "Say", -left => $Window->ScaleWidth-40, -top => $Window->ScaleHeight-60, -width => 35, -height => 22, -text => "Say", -tabstop => 1, -default => 1, -ok => 1, ); $Progress = $Window->AddProgressBar( -name => "Progress", -left => $Window->ScaleWidth/2, -top => $Window->ScaleHeight-34, -width => ($Window->ScaleWidth/2)-5, -height => 10, -smooth => 1, ); $XPLabel = $Window->AddLabel( -text => "Getting XP info...", -sunken => 1, -name => "XPLabel", -left => $Window->ScaleWidth/2, -top => $Window->ScaleHeight-22, -width => ($Window->ScaleWidth/2)-5, -height => 20, ); $Status = $Window->AddLabel( -name => "Status", -text => "$status_idle", -sunken => 1, -left => 5, -top => $Window->ScaleHeight-22, -width => ($Window->ScaleWidth/2)-10, -height => 20, ); $Window->Show(); } ###################################################################### +########## # # Window_Terminate # # What to do when the user closes the window # sub Window_Terminate { if (kill('KILL',$serverProcess)) { print "Successfully shutdown server.\n"; } else { print "An error occurred shutting down server ($serverProcess).\n" +; } return -1; } ###################################################################### +########## # # Timers # # Checks for new message or updates info on timers # sub updChatterbox_Timer { &updChatterbox_Click; print $toServer "updCh +atCache\n"; } sub updXP_Timer { &updXP_Click; print $toServer "updXP +Cache\n"; } sub updUserlist_Timer { &updUserlist_Click; print $toServer "updUs +erlistCache\n"; } sub refreshCaches_Timer { print $toServer "refreshCaches\n"; } ###################################################################### +########## # # Say_Click # # What to do when the user clicks the say button # sub Say_Click { $Status->Text("Sending data..."); my($text) = $Inputfield->Text(); $Inputfield->Text(""); $text =~ s/\r*\n//g; if ($text =~ /^\s*\/msg\s+(\S+)\s*(.+)$/i) { print $toServer "SEND:$text\n"; printMessage("Sent private msg to $1: $2"); } elsif ($text =~ /^\/?(checkoff|co)\s+/ && (my @ids=($text=~/(\d+ +)/g))) { my($list) = join ',',@ids; print $toServer "CO:" . join ',',@ids . "\n"; printMessage("* Checked off private msgs"); } elsif ($text =~ /^\s*\/msgs\s*$/) { my(@msgs) = &getFromServer('msgs'); printMessage("* No personal messages") unless @msgs; my($msg_num) = 1; foreach (@msgs) { printMessage("($msg_num) $_",$text_private); $msg_num++; } } else { print $toServer "SEND:$text\n"; } $Status->Text("$status_idle"); } ###################################################################### +########## # # Exit_Click # # What to do when the user clicks the exit menu option # sub Exit_Click { if (kill('KILL',$serverProcess)) { print "Successfully shutdown server.\n"; } else { print "An error occurred shutting down server ($serverProcess).\n" +; } exit(0); } ###################################################################### +########## # # About_Click # # What to do when the user clicks the about menu option # sub About_Click { my($gui_ver) = $Window->Version(); printMessage("monkchat version $version"); printMessage("Win32::GUI version $gui_ver"); printMessage("by Shendal, copyleft 2000"); } ###################################################################### +########## # # updChatterbox_Click; # # Checks for new chat messages # sub updChatterbox_Click { $Status->Text("Checking for new chat messages..."); my($msg_num) = 1; foreach (&getFromServer('chat')) { $Chatfield->Select(999999,999999); # See note above on this kludge if (s/^\(\d+\)/\($msg_num\)/) { $msg_num++; printMessage("$_",$text_private); } elsif (s/^<(\S+)>//) { printuser($1); printMessage("$_",$text_default); } else { printMessage("$_",$text_default); } } $Status->Text("$status_idle"); sub printuser { my($user) = shift; printMessage('<',$text_default,1); printMessage("$user",$text_username,1); printMessage('>',$text_default,1); } } ###################################################################### +########## # # updXP_Click # # Find user's current XP level and what the next level will be # sub updXP_Click { $Status->Text("Checking for new XP information..."); my($level,$xp,$xp2next,$votesleft) = &getFromServer('xp'); if ($level =~ /^\s*$/) { $XPLabel->Text("Error accessing your XP node"); } else { my($position) = int(( ($xp-$perlmonk_levels{$level}) / ($xp-$perlmonk_levels{$level}+$xp2next)) * 100) ; $Window->Progress->SetPos($position); my($XPLabelStr) = "Level: $level, XP: $xp, " . "To next: $xp2next ($position%), Votes left: $votesleft"; $XPLabel->Text("$XPLabelStr"); } $Status->Text("$status_idle"); } ###################################################################### +########## # # updUserlist_Click # # Updates the userlist listbox # sub updUserlist_Click { $Status->Text("Checking userlist..."); $Userlist->Clear; my($num_users) = 0; foreach (&getFromServer('userlist')) { $Userlist->AddString("$_"); $num_users++; } $UserlistLabel->Text("# Users: $num_users"); printError("Ack! Noone's logged in!") unless $num_users; $Status->Text("$status_idle"); } ###################################################################### +########## # # updUsername_Click # # Updates the username/password cookie # sub updUsername_Click { $Status->Text("Updating user information..."); my($unField,$pwField,$confField); if (!$userinfo_w) { $userinfo_w = new Win32::GUI::DialogBox( -title => "Update user info", -left => 200, -top => 200, -width => 250, -height => 150, -name => "userinfo_w", -style => WS_CAPTION, ); $unField = $userinfo_w->AddTextfield( -name => "username", -prompt => "Username:", -left => 5, -top => 5, -height => 22, -width => 150, -tabstop=> 1, ); $pwField = $userinfo_w->AddTextfield( -name => "password", -prompt => "Password:", -left => 5, -top => 32, -height => 22, -width => 150, -password => 1, -tabstop=> 1, ); $confField = $userinfo_w->AddTextfield( -name => "confirm", -prompt => "Confirm:", -left => 5, -top => 56, -height => 22, -width => 150, -password => 1, -tabstop=> 1, ); my($cancelButton) = $userinfo_w->AddButton ( -name => "Cancel", -text => "Cancel", -left => 5, -top => 83, -height => 30, -width => ($userinfo_w->ScaleWidth/2)-5, -tabstop=> 1, ); my($okButton) = $userinfo_w->AddButton ( -name => "Ok", -text => "Ok", -left => ($userinfo_w->ScaleWidth/2)+5, -top => 83, -height => 30, -width => ($userinfo_w->ScaleWidth/2)-5, -tabstop=> 1, ); $unField->SetFocus; } $userinfo_w->Show(); $Status->Text("$status_idle"); sub userinfo_w_Terminate { return -1; } sub Cancel_Click { $userinfo_w->Hide; } sub Ok_Click { unless ($unField->Text && $pwField->Text && $confField->Text) { printError("All fields required. Nothing changed."); $userinfo_w->Hide; return; } if ($pwField->Text ne $confField->Text) { printError("Password and confirmation did not match. Nothing c +hanged."); $userinfo_w->Hide; } else { print $toServer 'LOGIN ' . $unField->Text . ' ' . $pwField->Te +xt . "\n"; printMessage("Logged in as " . $unField->Text); $userinfo_w->Hide; } } } ###################################################################### +########## # # Userlist_DblClick # # What to do when a user double-clicks someone in the user list # sub Userlist_DblClick { printMessage("Detected double click in userlist!"); my($selected) = $Userlist->GetString($Userlist->SelectedItem); if ($selected) { printMessage("Launch browser to look at user $selected."); } } ###################################################################### +########## # # printMessage and printError # # Prints an error or message to the chatterbox # sub printMessage { my($msg) = shift; my($color) = shift || $text_message; my($omit_return) = shift; $msg .= "\n" unless $omit_return; $Chatfield->SetFocus(); $Chatfield->Select(999999,999999); # See hack message above setColor($color); $Chatfield->ReplaceSel("$msg",1); setColor($text_default); $Inputfield->SetFocus(); } sub printError { my($error) = shift; printMessage("ERROR: $error","$text_error") } ###################################################################### +########## # # setColor # # sets text color for chatterbox # sub setColor { my($color) = shift; $Chatfield->SetCharFormat(-color => "$color"); } ###################################################################### +########## # # closeDOSParent # # Closes the dos prompt that created this process # sub closeDOSParent { my($DOShwnd, $DOShinstance) = Win32::GUI::GetPerlWindow(); # either close it or hide it, but it's gonna be around when you qu +it this # program! Win32::GUI::CloseWindow($DOShwnd); Win32::GUI::Hide($DOShwnd); }

In reply to Win32::GUI Chatterbox client by Shendal

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others browsing the Monastery: (7)
    As of 2015-07-04 08:55 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 (58 votes), past polls