Me he encontrado con el siguiente problema, comparando un programa para IRC (bot) escrito en C tiene mayor eficiencia que el mismo que yo hago pero en Perl (bot).
Si escribo help en el privado del botijo (sería un comando) en repetidas ocasiones éste se cuelga y da las respuestas con dos segundos de atraso, pero si lo hago al programa de IRC (bot) escrito en C, va perfectamente, inmediato.
Un trozo de código y me dicen si es fallo mio, si necesito hacer 'nonblocking', si el socket está mal implementado, o definitivamente, me resigno.
Using perl Syntax Highlighting
- while (1) #bucle para mantener la conexión
- {
- $socket = IO::Socket::INET->new(
- PeerAddr => $configuration->{'servidor'},
- PeerPort => $configuration->{'puerto'},
- Proto => 'tcp'
- ) or die "Connection failed (Revise el estado del servidor remoto o el archivo services.conf)";
- if ($starting eq "FALSE")
- {
- &connect;
- $starting = "TRUE";
- }
- while (<$socket>) #bucle para leer los datos recibidos por el socket
- {
- print $_;
- my $bytes = $_;
- @lectura = split(" ",$bytes);
- if (($lectura[1] eq "PING") or ($lectura[1] eq "G"))
- {
- reply_ping($lectura[2]);
- }
- if (($lectura[1] eq "P") or ($lectura[1] eq "PRIVMSG"))
- {
- if ($nchan->{'numeric'} eq $lectura[2])
- {
- sendMsg($configuration->{'copers'},"Estoy leyendo el sistema de privados");
- }
- elsif ($nadmin->{'numeric'} eq $lectura[2])
- {
- my $tmpCommand = lc($lectura[3]);
- $tmpCommand =~ s/^\W//;
- if ($acommands{$tmpCommand})
- {
- my $executeCommand = $acommands{$tmpCommand};
- $SIG{'KILL'} = sub { threads->exit(); };
- my $processCommand = threads->new(\&$executeCommand,$tmpCommand,"Valor2");
- $processCommand->join();
- $processCommand->kill('KILL');
- sendMsg($configuration->{'copers'},"probando");
- } else {
- sendMsg($configuration->{'copers'},"comando desconocido $lectura[3]");
- }
- }
- }
- }
- sub reply_ping
- {
- my($send) = (shift);
- print $socket qq(:$configuration->{'numeric'} Z $send\n);
- $send = "";
- }
- sub connect_pseudoClient
- {
- my $pseudoclient = shift;
- my $id = shift;
- my $hs = shift;
- my $modes = shift;
- my $more = shift;
- my $nm = shift;
- my $desc = shift;
- my $timer = time;
- print $socket qq($configuration->{'numeric'} N $pseudoclient 1 $timer $id $hs $modes $more $nm :$desc\n);
- print $socket qq($nm J $configuration->{'copers'}\n);
- print $socket qq($nchan->{'numeric'} M $configuration->{'copers'} +o $nm\n);
- }
- sub login
- {
- $timer = time;
- print $socket qq(PASS $configuration->{'password'}\n);
- print $socket qq(SERVER $configuration->{'hostbots'} 1 $timer $timer P10 $configuration->{'numeric'}Q] +hs :$configuration->{'nombrered'}\n);
- }
- sub stats
- {
- my $time_out = time - $time;
- my $pid = $$ + 1;
- print "PID: $pid\n";
- print "OS: $^O\n";
- print "Kernel: $^V\n";
- }
- sub connect
- {
- login();
- connect_pseudoClient($chanserv->{'nickname'},$chanserv->{'identd'},$chanserv->{'host'},$chanserv->{'modos'},$chanserv->{'nickname'},$nchan->{'numeric'},$chanserv->{'descripcion'});
- connect_pseudoClient($adminserv->{'nickname'},$adminserv->{'identd'},$adminserv->{'host'},$adminserv->{'modos'},$adminserv->{'nickname'},$nadmin->{'numeric'},$adminserv->{'descripcion'});
- }
- sub sendMsg
- {
- my($channel,$plaintext) = (shift,shift);
- print $socket qq($configuration->{'numeric'} P $channel :$plaintext\n);
- }
Coloreado en 0.005 segundos, usando GeSHi 1.0.8.4
PD: No quiero usar los módulos de Perl para IRC, quiero código nativo.