Foro - Perl en Español

por **BigBear** » 2009-10-25 10:15 @468

Hola.

Ando programando un pequeño programa que trabaja con Tk. Éste espía canales IRC e imprime lo sucedido en un ROtext.

El problema es que cuando minimizo la ventana es como si se tildara y está se volviera blanca y aparece "no responde".

¿Alguien me podría explicar por qué pasa eso y cómo lo soluciono?

#usr/perl/bin
 
##############MÓDULOS A USAR############################3
use Tk;
use LWP::UserAgent;
use HTTP::Request;
use LWP::Simple;
use Tk::ROText;
use IO::Socket;
######################################################3
 
################DISEÑO TK#################################3
$mw = MainWindow->new( -background => "black", -cursor=>"crosshair");
$mw->geometry("600x325+100+100");
$mw->title("IRC-SPY by Guason");
 
$tiempo = "1";
 
$mw->resizable(0,0);
 
$statusbar = "Status <NONE>";
$statusbottom = $mw->Label(-textvariable => \$statusbar, -relief => 'flat', -background => "black", -foreground => "red", -font => "Verdana 7", -width => 120)->place(-x => 50, -y => 307);
 
$mw->Label(-background => "black", -foreground => "black")->pack();
$stat = "Log extraido";
$sta = $mw->Label(-textvariable => \$stat, -relief => 'flat', -background => "black", -foreground => "yellow", -font => "Verdana 9")->place(-x => 380, -y => 10);
 
   my $espacio = $mw->Scrolled('ROText', -scrollbars => 'oe', -font => "Verdana 8", -background => "black", -foreground => "yellow", -selectbackground => "yellow", -insertbackground => "yellow", -relief => "ridge", -width => 55, -height=> 20)->pack(-side => 'right', -anchor => 'e');
$mw->Label(-background => "black", -foreground => "black")->pack();
$mw->Label(-background => "black", -foreground => "black")->pack();
$mw->Label(-background => "black", -foreground => "black")->pack();
 
############################ESPACIOS A COMPLETAR#########################################3
 
$mw->Label(-background => "black", -foreground => "yellow", -font => "Verdana 9", -text => "Servidor IRC")->pack(-anchor => 'nw');
my $ent_google = $mw->Entry(-background => "black", -foreground => "yellow", -selectbackground => "black", -insertbackground => "yellow", -width => 40, -relief => "ridge", -textvariable=>\$server)->pack(-anchor=> 'nw');
 
$mw->Label(-background => "black", -foreground => "yellow", -font => "Verdana 9", -text => "Canal")->pack(-anchor => 'nw');
my $ent_string = $mw->Entry(-background => "black", -foreground => "yellow", -selectbackground => "black", -insertbackground => "yellow", -width => 40, -relief => "ridge", -textvariable => \$canal)->pack(-anchor => 'nw');
 
$mw->Label(-background => "black", -foreground => "yellow", -font => "Verdana 9", -text => "Nombre del bot")->pack(-anchor => 'nw');
my $ent_num = $mw->Entry(-background => "black", -foreground => "yellow", -selectbackground => "black", -insertbackground => "yellow", -width => 40, -relief => "ridge", -textvariable => \$nick)->pack(-anchor => 'nw');
 
$mw->Label(-background => "black", -foreground => "black")->pack();
$mw->Label(-background => "black", -foreground => "black")->pack();
####################################################################################3
###############BOTONES###################################################################3
$mw->Button(-activebackground => "yellow",  -activeforeground => "black",  -background => "black", -foreground => "yellow", -font => "Verdana 7", -relief => "groove", -text => "Start", -width => 5, -command => \&ven)->place(-x => 80, -y => 250);
 
$mw->Button(-activebackground => "yellow",  -activeforeground => "black",  -background => "black", -foreground => "yellow", -font => "Verdana 7", -relief => "groove", -text => "Ver Log", -width => 8, -command => \&log)->place(-x => 40, -y => 40);
 
$mw->Button(-activebackground => "yellow",  -activeforeground => "black",  -background => "black", -foreground => "yellow", -font => "Verdana 7", -relief => "groove", -text => "Clear",  -width => 5, -command => \&cls)->place(-x => 130, -y => 40);
 
$mw->Button(-activebackground => "yellow",  -activeforeground => "black",  -background => "black", -foreground => "yellow", -font => "Verdana 7", -relief => "groove", -text => "Help/About", -width => 9, -command => \&about)->place(-x => 50, -y => 300);
 
$mw->Button(-activebackground => "yellow",  -activeforeground => "black",  -background => "black", -foreground => "yellow", -font => "Verdana 7", -relief => "groove", -text => "Exit",  -width => 5, -command => sub { exit })->place(-x => 133, -y => 300);
 
#################################################################################################3
 
MainLoop;
 
##########################FIN DEL DISEÑO#################################################33
sub about {
$about = $mw->Toplevel(-background => "black", -cursor=>"crosshair");
$about->geometry("500x422+425+250");
$about->title("Google-search by Guason");
$about->resizable(0,0);
$about->Label(-background => "black", -foreground=>"yellow")->pack();
$about->Label(-background => "black", -foreground=>"yellow", -font=> "Cambria 10", -text => "IRC BOT\n")->pack();
$about->Label(-background => "black", -foreground=>"yellow", -font=> "Cambria 10",  -text => " Este programa fue escrito por Guason\n")->pack();
$about->Label(-background => "black", -foreground=>"yellow", -font=> "Cambria 10",  -text => " Con esta hermosura espiaras al canal que quieras\n\nEspero que te sirva\n\n")->pack();
$about->Label(-background => "black", -foreground=>"yellow", -font=> "Cambria 10",  -text => "Si necesitan contactarme mi email es chairface_darkhat[dot]hotmail.com ")->pack();
$about->Label(-background => "black", -foreground=>"yellow")->pack();
 
$about->Label(-background => "black",-foreground => "yellow",-font => "wingdings 22", -text => "7")->pack();
$about->Label(-background => "black", -foreground=>"yellow", -font=> "Cambria 11",  -text => "Written By Guason || 2009")->pack();
 
$about->Button(-activebackground => "yellow",  -activeforeground => "black",  -background => "black", -foreground => "yellow", -relief => "groove", -font=> "Verdana 7", -text => "Exit", -command => [$about => 'destroy'])->pack(-fill => "both");
 
}
 
########################################START##################################
sub ven {
 
$port = "6667";
$file = "irc-spy.txt";
 
my $server =  $ent_google -> get();
my $canal =  $ent_string -> get();
my $nick =  $ent_num -> get();
 
my $connection = new IO::Socket::INET(   PeerAddr =>$server,
                                                                     PeerPort => $port,
                                                                      Proto => 'tcp' );
 
if (!$connection) {
print "\nNo se puedo conectar en  $server $port\n";
exit 1;
}
 
print $connection "NICK $nick\r\n";
print $connection "USER $nick 1 1 1 1\r\n";
 
print "\nDentro!\n\n";
 
print FILE "#####Canal $canal#######\n\n";
 
while($response = <$connection>) {
 
 if($response =~ m/^PING (.*?)$/gi){print $connection "PONG ".$1."\r\n";}
 if($response =~ m/:(.*) 00(.*) (.*) :/){print $connection "JOIN $canal\r\n";
}
 
if ( $response =~ m/:(.*)!(.*):(.*)/ig) {
 
my $nicke = $1;
my $texto = $3;
 
if ($texto ne $canal) {
 
$statusbottom->update();
 
 open (R , ">>$file");
 
$espacio -> insert('end', "$nicke = $texto\n");
print "$nicke = $texto\n";
}
 
}
 
}
 
}
 
################################BOTÓN PARA LIMPIAR LA PANTALLA#########################################
sub cls {
 
  $espacio -> delete('0.1', 'end');
 
}
 
####################VER LOG###################################
sub log {
system ("irc-spy.txt");
}
###########################################################
Coloreado en 0.011 segundos,  usando GeSHi 1.0.8.4

por **explorer** » 2009-10-26 17:15 @760

Es que... yo no veo que llames por ninguna parte al método iconify() para que la ventana se esconda...

por **BigBear** » 2009-10-26 20:49 @909

¡Ah, no!, me expresé mal; no me refiero a que quiero minimizar la ventana con una función Tk, sino que cuando le doy clic al botón "start" el programa se tilda y aparece "no responde". Por eso ni cuando le doy al botón minimizar todavía queda tildado. Ahora que lo pienso bien, necesito una constante actualización de la ventana Tk. Vi que se usa $mw->update pero aún no sé cómo hacerlo porque todavía queda como tildado.

La parte que tendría que arreglar sería esta:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#
if ( $response =~ m/:(.*)!(.*):(.*)/ig) {
 
$mw->update;   
 
my $nicke = $1;
#
my $texto = $3;
#
 
#
if ($texto ne $canal) {
#
a
 open (R , ">>$file");
#
 
#
$espacio -> insert('end', "$nicke = $texto\n");
#
print "$nicke = $texto\n";
#
}
#
 
#
}
#
 
#
 
}
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Lo que tendría que hacer es que cada vez que entre más texto del chat, esta ventana se actualice. ¿Cómo lo haría?

por **explorer** » 2009-10-27 04:55 @246

Efectivamente, al entrar en la subrutina de vigilancia, se pierde la oportunidad de actualizar los eventos de la ventana.

Ahora mismo no lo sé, pero eso quizás se resolvería llamando a un método del mainwindow que permitiera procesar los eventos del usuario. Algo así se usaba hace veinte años con los primeros sistemas operativos orientados a gráficos: en las rutinas que ocupaban mucha CPU, se incorporaban una llamada al sistema que permitía al resto de la aplicación responder a los eventos del usuario. Así, el usuario no sentía que la aplicación había quedado bloqueada cuando entraba en ese cálculo.

Hoy en día, en Perl, se suele usar Tk con la ayuda de POE, permitiendo una pseudo-multitarea, simplificando bastante ese proceso. Viene un ejemplo de lector de RSS.

Foro - Perl en Español

Ayuda con Tk

Ayuda con Tk

Publicidad

Re: Ayuda con Tk

Re: Ayuda con Tk

Re: Ayuda con Tk

Re: Ayuda con Tk

Re: Ayuda con Tk

¿Quién está conectado?