for (;;) {
my $client;
my $rv;
my $data;
foreach $client ($select->can_read(1)) {
if ($client == $server) {
#Una nueva conexión
$client = $server->accept();
$select->add($client);
nonblock($client);
} else {
#Veamos si nos chivan algo :D
$data = '';
$rv = $client->recv($data, POSIX::BUFSIZ, 0);
unless (defined($rv) && length $data) {
#Si no hay nada, pues nada... caña XD
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};
$select->remove($client);
close $client;
next;
}
$inbuffer{$client} .= $data;
#Paso a verificar si existe alguna petición...
while ($inbuffer{$client} =~ s/(.*\n)//) {
push( @{$ready{$client}}, $1 ); #Agregamos la petición a la cola
}
}
}
foreach $client (keys %ready) {
#handle($client);
#Leemos lo que se nos envia.
}
foreach $client ($select->can_write(1)) {
$client->send("Me aseguro que puedo enviar info\n", 0);
}
}
sub handle {
my $client = shift; #Quien conecta
my $request; #Lo que nos chiva
foreach $request (@{$ready{$client}}) {
chomp $request;
cmds($client, $request); #Aqui busco los comandos.
}
delete $ready{$client};
}
sub cmds {
my ($client, $request) = @_;
print $request . "\n";
if ($ping_user{$client} < 1) {
$client->send(":irc.pruebas.org NOTICE IP_LOOKUP :*** Verificando la conexión.\n",0);
$client->send(":irc.pruebas.org NOTICE IP_LOOKUP :*** Escaneando...\n",0);
$client->send("PING :OK\n",0);
$ping_user{$client} = 1;
}
if (length($request) ne 0) {
chomp $request;
my @msg = split(" ", $request);
if($msg[0] eq 'PONG') {
msgping($client, @msg);
} elsif ($msg[0] eq 'NICK') {
register($client, @msg);
} elsif ($msg[0] eq 'USER') {
$users{$client}->{'ident'} = parse($msg[1]);
$users{$client}->{'localhost'} = parse($msg[2]);
$users{$client}->{'ip_host'} = parse($msg[3]);
$users{$client}->{'realname'} = substr($request,index($request,":")+1,length($request)-index($request,":"));
$users_record++;
}
}
}
sub msgping {
my($client,$msg) = @_;
$client->send("Vale, reconocido\n",0);
}
sub parse {
my($parsed) = shift;
$parsed =~ s/\"//g;
return $parsed;
}
#Me aseguro que lo que reciba a travez de 'NICK'
#Sea en formato 'NICK :apodo' ó 'NICK :apodo:pass' ó 'NICK :apodo!pass'
sub parse_comodin {
my($parseado) = shift;
$parseado =~ s/^://;
if ($parseado =~ /^([a-zA-Z0-9]+):([a-zA-Z0-9]+)$/) {
return 1;
} elsif ($parseado =~ /^([a-zA-Z0-9]+)!([a-zA-Z0-9]+)$/) {
return 2;
} elsif ($parseado =~ /^([a-zA-Z0-9]+)$/) {
return 0;
}
}
