Hi, just by looking at the code itself, it almost looks like you could get the Mechanize network code to co-exist with Tk for multiple updates. It probably would be best to put your Mechanize code into a separate thread, but with Tk, you cannot update a Tk widget from the thread. If you wanted to use Gtk2 instead of Tk, you CAN update a Gtk2 widget from a thread.

But lets just look at Tk. If you put your whole Mechanize sub into a thread, and run it from a timer or button press, you will need to find a way thru shared variables or a shared fileno to get the results from the thread, and update your Tk Text widget. See Re: Perl/Tk threading and/or cron job? for a simple demonstration of how to do it.

If you just want to hack around, just to get where you can have multiple runs of the Mechanize sub, just put the Mechanize code into a Button callback, and sprinkle it with $mw->update, so as not to unduely block the responsiveness of the Tk eventloop.

I havn't tested the following, and I emphasize you are better off putting the Mechanize code into a thread, but this will help you get multiple runs going. You also will probably need to work out a scheme for disabling the Button by setting it's state=>disabled after each button press, and return to state=>normal after Mechanize is done. This is to prevent you from running it twice in rapid succession. You will also probably notice that while Mechanize is running, the Tk window may become unresponsive, that is why there are a bunch of $mw->update lines in there. In a thread based solution, you wouldn't need those lines. So look closely at Re: Perl/Tk threading and/or cron job? and you should be able to move the network code into a thread. 

#!/usr/bin/perl  
use warnings;
use strict;  
use Tk;  
use common::sense;  
use WWW::Mechanize;   
use WWW::Mechanize::DecodedContent;   
use JSON -support_by_pp;  
use HTTP::Cookies;  
use URI::Escape;  
  
  
my $mw = new MainWindow(-background => 'blue');   
$mw->geometry("600x400");  
$mw->minsize(qw(400 650));  
$mw->maxsize(qw(800 750));   
$mw->title("Invaders External ShoutBox");  
  
my $getmsg = $mw -> Frame(-background => 'red', -relief=>'raised',  
  -borderwidth=>1,  
  ) ->place(-x =>70, -y =>25);  
my $gmsg = $getmsg->Scrolled ('Text',   
            -width=> 60, -height => 20, -background => 'black', -foreg
+round => 'green')->pack;  
$gmsg->insert('end',"Start External ShoutBox...\nInVaDeRs\n");  
  
my $putmsg = $mw -> Frame(-background => 'red', -relief=>'raised',  
  -borderwidth=>1,  
  ) ->place(-x => 70, -y => 450);  
my $pmsg = $putmsg->Scrolled ('Text',   
            -width=> 60, -height => 5, -background => 'black', -foregr
+ound => 'green')->pack;  
$pmsg->insert('end',"...");  
  
my $button = $mw->Button( -text => 'Update',
            -command => \&update_me)->pack();
  
  
MainLoop;


sub update_me{

my $url = WWW::Mechanize->new();  
$url->get("http://www.forum-invaders.com.br/vb/login.php");  

$mw->update();
  
$url->submit_form(  
    fields => {   
        vb_login_username => 'login',  
        vb_login_password => 'password',  
    }  
);  
  
  
    if($url->decoded_content !~ /Bem-vindo/gi){$gmsg->insert('end', "L
+oggin Error\n");}  
        else {$gmsg->insert('end', "Login OK!\n");}  
          
        my $work = 1;  
        my @old;  
        my $num = 0;  
    while ($work == 1){  
        my $r = $url->get("http://www.forum-invaders.com.br/vb/vbshout
+.php?type=activeusers&do=ajax&action=fetch&instanceid=2");  
        my $json = JSON->new->relaxed;  
        my $s = $json->decode($r->decoded_content);  
        my $msg = $s->{"shouts"}->{0}->{"message_raw"};  
        my $user = $s->{"shouts"}->{0}->{"musername"};  
        my $name;  
    
         $mw->update();
    
        if ($user =~ />(.+)<\/span/gi) {$name = $1;}  
        else {$name = $user}  
        my $now = join(" => ", $name, $msg) . "\n";  
        if ($num == 0){  
            $gmsg->insert('end', $now);  
         $mw->update();          
            push (@old, $now);  
            $num++;  
        }  
        elsif($old[$num - 1] ne $now){  
            $gmsg->insert('end', $now);  
              
            push (@old, $now);  
            $num++;  
        }  
          $mw->update();      
    }  
$mw->update();
}

[download]
I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

In reply to Re: [HELP] Chat, two routines, Tk by zentara
in thread [HELP] Chat, two routines, Tk by acpguedes

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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, details, 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, summary, 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.