CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Intermediate:
[HELP] Chat, two routines, Tk

 



acpguedes
Novice

Jun 30, 2012, 2:38 PM

Post #1 of 4 (2656 views)
[HELP] Chat, two routines, Tk Can't Post

Hello Monks,
I have one problem.

I was did a program to be a interface between a chat to desktop, to send and received messages but out of browser.

It's okay to received or send messages if the routines are separate in two programs, but to join both on a one program need some mechanism to manipulate both routines, because the shell (on Windows or Linux) can't receive and send in same time.
To do it I make an interface with Tk, but to receive message have some problem, when Tk make a Loop it receive only one message, to receive next I need to kill just a interface, or restart the program.

In fact, I really didn't know to use the Tk, I'm trying to two weeks but I could not, if someone can help me.

Here's the code:


Code
#!usr/bin/env perl 

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', -foreground => 'green')->pack;
$gmsg->insert('end',"Start External ShoutBox...\nInVaDeRs\n");

my $ww = 1;
while ($ww == 1){
$gmsg->insert('end',&I);
}



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', -foreground => 'green')->pack;
$pmsg->insert('end',"...");






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

$url->submit_form(
fields => {
vb_login_username => 'login',
vb_login_password => 'password',
}
);




if($url->decoded_content !~ /Bem-vindo/gi){$gmsg->insert('end', "Loggin 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;
if ($user =~ />(.+)<\/span/gi) {$name = $1;}
else {$name = $user}
my $now = join(" => ", $name, $msg) . "\n";
if ($num == 0){
$gmsg->insert('end', $now);

push (@old, $now);
$num++;
}
elsif($old[$num - 1] ne $now){
$gmsg->insert('end', $now);

push (@old, $now);
$num++;
}

}

MainLoop;

__END__



FishMonger
Veteran / Moderator

Jul 1, 2012, 8:14 AM

Post #2 of 4 (2636 views)
Re: [acpguedes] [HELP] Chat, two routines, Tk [In reply to] Can't Post

It's been awhile since I've done any Tk scripts and I've never done anything with chat scripts, but why do you have 2 infinite loops (one starting at line 27 and the other at 64)?


acpguedes
Novice

Jul 1, 2012, 8:22 AM

Post #3 of 4 (2634 views)
Re: [FishMonger] [HELP] Chat, two routines, Tk [In reply to] Can't Post

It's actually only one, this code is wrong, what I wanted was this:


Code
#!usr/bin/env perl  

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', -foreground => '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', -foreground => 'green')->pack;
$pmsg->insert('end',"...");


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

$url->submit_form(
fields => {
vb_login_username => 'login',
vb_login_password => 'password',
}
);


if($url->decoded_content !~ /Bem-vindo/gi){$gmsg->insert('end', "Loggin 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;
if ($user =~ />(.+)<\/span/gi) {$name = $1;}
else {$name = $user}
my $now = join(" => ", $name, $msg) . "\n";
if ($num == 0){
$gmsg->insert('end', $now);

push (@old, $now);
$num++;
}
elsif($old[$num - 1] ne $now){
$gmsg->insert('end', $now);

push (@old, $now);
$num++;
}

}

MainLoop;



acpguedes
Novice

Jul 2, 2012, 3:22 PM

Post #4 of 4 (2585 views)
Re: [FishMonger] [HELP] Chat, two routines, Tk [In reply to] Can't Post

I modified the code:

https://github.com/acpguedes/Chat.git

 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives