User:OPeixe
{{userpage}}
---
{{Babel|es|gl|en-5|ca-2}}
{{Userboxtop}}
{{Template:user programming-N}}
{{:User:Quasar Jarosz/Userboxes/Perl}}
{{Template:user sql-N}}
{{Template:user xml-4}}
{{Userboxbottom}}
(OPeixe).
----
ELingua BOT. An IRC BOT written on 2004 to be able to make queries on the RAE Real_Academia_Espa%C3%B1ola web site and store results on a MySQL table. This version also queries for Synonyms and Antonyms from Oviedo University web site.
----
- !/usr/bin/perl
use warnings;
use strict;
use POE qw(Component::Client::HTTP Component::IRC);
use HTTP::Request::Common qw(GET POST);
use HTML::Entities;
use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
use Time::Format qw(%time %strftime %manip);
use Unicode::String qw(utf8 latin1 utf16);
use DBI; #usar dbi para perl-mysql
my $dbh=0;
my ($Nombre_Bd,$Servidor_Bd,$Usuario_Bd,$Contrasenia_Bd) = ("","","","");
my $BD ="ELingua";
my $ServerBD ="localhost";
my $UserBD ="root";
my $PassBD ="";
&BDLogin($BD,$ServerBD,$UserBD,$PassBD);
$|=1;
my $identifier = "rae" . time();
my $owner = 'OPeixe';
my $servers = 'aire.irc-hispano.org neptuno.irc-hispano.org irc.irc-hispano.org dune.irc-hispano.org andromeda.irc-hispano.org atreides.irc-hispano.org coruscant.irc-hispano.org fuego.irc-hispano.org luna.irc-hispano.org';
my $ports = '6666 6667 6668';
my $nick = 'ELingua';
my $ircname = 'Lengua Libre';
my $username = 'LENGUA';
my $quitmsg = 'Abandonando...';
my $channels = '#ELingua';
my $ignorelist = '';
my $majorver='1';
my $minorver='2';
my $build="beta";
my $released='(1/3/04)';
my $version =$majorver.'.'.$minorver.'.'.$build.' '.$released;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year += 1900;
$mon +=1;
my $hInit="$mday-$mon-$year $hour:$min:$sec";
my $tInit;
my $termOut=1; # 0 = Consola Silenciosa
my @valBusca=("RAE Usual","Sinónimos UniOvi","Antónimos UniOvi");
my %ignore = map { $_ => 1 } split(" ", $ignorelist);
my %tojoin = map { $_ => 1} split(" ", $channels);
my ($title, $join, $leave, $priv, $KERNEL, $CHAN);
&gLog("Iniciando BOT.");
POE::Component::IRC->new($identifier) or die "Error: $!";
POE::Component::Client::HTTP->spawn (
Agent => 'ELingua ('.$version.')',
Alias => 'ELingua',
Timeout => 120,
);
sub _start {
my $server = 'andromeda.irc-hispano.org';
my $port = '6667';
my ($kernel) = $_[KERNEL];
$kernel->post($identifier, 'register', 'all');
$kernel->post($identifier, 'connect',
{
Debug => 0,
Nick => $nick,
Server => $server,
Port => $port,
Username => $username,
Ircname => $ircname,
}
);
&gLog("IRC BOT Iniciado.");
}
sub irc_001 {
my ($kernel) = $_[KERNEL];
$kernel->post( $identifier, 'mode', $nick, '+i' );
&gLog("IRC_001");
foreach my $canal (keys %tojoin) {
$kernel->post( $identifier, 'join', $canal );
&gLog("Entrando a : ".$canal);
$kernel->post($identifier,'notice',$canal,$version);
}
$tInit= [gettimeofday];
}
sub irc_disconnected {
my ($server) = $_[ARG0];
&gLog ("Desconectado de ".$server);
$_[KERNEL]->post( "rae", "unregister", "all" );
}
sub irc_error {
my $err = $_[ARG0];
&gLog("Error en servidor: ".$err);
$poe_kernel->run();
}
sub irc_socketerr {
my $err = $_[ARG0];
&gLog ("No se ha podido conectar al servidor: ".$err);
$poe_kernel->run();
}
sub _stop {
my ($kernel) = $_[KERNEL];
&gLog ("Sesión finalizada.");
exit 0;
}
sub irc_ctcp_action {
my ($kernel, $who, $chan, $msg) = @_[KERNEL, ARG0 .. ARG2];
$who =~ s/(.*)!(.*)/$1/;
- $kernel->post($identifier,'notice', $who, 'CTCP Desactivado.');
&gLog("Sesión CTCP de : ".$who.":".$msg);
}
sub irc_msg {
my ($kernel, $who, $chan, $msg) = @_[KERNEL, ARG0 .. ARG2];
$who =~ s/(.*)!(.*)/$1/;
&gLog("IRC PRIVMSG: ".$who." : ".$msg);
if ($msg eq "quit") {
$priv = 1;
&ordenQuit($kernel,$who,$chan);
}
elsif (($msg =~ /^join (\S+)/i) || ($msg =~ /^join (\S+)/i)) {
$join = $1;
&ordenJoin($kernel, $who, $chan, $join);
}
elsif (($msg =~ /^leave (\S+)/i) || ($msg =~ /^leave (\S+)/i)) {
$leave = $1;
&ordenPart($kernel, $who, $chan, $leave);
}
}
sub irc_public {
my ($kernel, $who, $chan, $msg) = @_[KERNEL, ARG0 .. ARG2];
$who =~ s/(.*)!(.*)/$1/;
if (($msg =~/^::/i)) {
my @ircInput=split("::",$msg);
my @ircCommand=split(" ",$ircInput[1]) unless !defined($ircInput[1]);
my ($palabra,$command,$param)="";
$palabra=$ircCommand[0] unless !defined($ircCommand[0]);
$palabra=~s/ //g;
$command=$ircCommand[1] unless !defined($ircCommand[1]);
$param= $ircCommand[2] unless !defined($ircCommand[2]);
my $dBusca=0;
my ($mostrauso, $mostraacp);
if (!defined $palabra || $palabra eq "") {
return;
}
if (defined $command) {
if ($command eq "acep") {
$mostrauso=0;
if (defined $param) {
$mostraacp=$param+1;
}
else {
$mostraacp=100;
}
}
elsif ($command eq "usos") {
$mostraacp=1;
if (defined $param) {
$mostrauso=$param;
}
else {
$mostrauso=100;
}
}
elsif ($command eq "sino") {
$dBusca=1;
}
elsif ($command eq "anto") {
$dBusca=2;
}
}
else {
$command="null";
$param="null";
$mostrauso=5;
$mostraacp=6;
}
if (lc($palabra) eq lc($nick)) {
if (lc($command) eq "quit") {
&ordenQuit($kernel,$who,$chan);
}
elsif (lc($command) eq "join") {
if ($param ne "") {
&ordenJoin($kernel, $who, $chan, $param);
}
}
elsif (lc($command) eq "part") {
if ($param ne "") {
&ordenPart($kernel, $who, $chan, $param);
}
}
else {
&gLog("Enviando ayuda a ".$who." en ".$chan->[0]);
$kernel->post($identifier,'notice',$chan->[0], ':: '.$version);
$kernel->post($identifier,'notice',$chan->[0], ':: Para localizar una palabra ::palabra');
$kernel->post($identifier,'notice',$chan->[0], ':: se muestran las primeras 5 acepciones y 5 usos frecuentes.');
$kernel->post($identifier,'notice',$chan->[0], ':: Para obtener n acpeciones ::palabra acep n (pe. ::casa acep 10)');
$kernel->post($identifier,'notice',$chan->[0], ':: si no se especifica número se muestran todas.');
$kernel->post($identifier,'notice',$chan->[0], ':: Para obtener n usos ::palabra usos n');
$kernel->post($identifier,'notice',$chan->[0], ':: si no se especifica número se muestran todas.');
$kernel->post($identifier,'notice',$chan->[0], ':: Ver 1.1.5 ::palabra sino localiza sinónimos de palabra.');
$kernel->post($identifier,'notice',$chan->[0], ':: Ver 1.1.5 ::palabra anto localiza antónimos de palabra.');
$kernel->post($identifier,'notice',$chan->[0], ':: Fin ayuda.');
}
return;
}
&gLog("Solicitud de : ".$palabra." (".$command.":".$param.") en ".$valBusca[$dBusca]." por ".$who." en ".$chan->[0]);
$kernel->post($identifier,'notice',$chan->[0],':: Localizando "'.$palabra.'" en '.$valBusca[$dBusca].' para '.$who);
my @valRespuesta=split(":",&checkDB($palabra,$who,$command,$param));
my ($resultadoHTTP,$msgStats, $msgFechas);
#valRespuesta { Está en la BD : Total ACEP : Total USOS : Total SINONIMOS : Total ANTONIMOS : Total QUERYS : Fecha REG : Fecha LAST )
if ($valRespuesta[0]==0) {
# No está en la BD ...
&getCONTENT($kernel,$palabra,$dBusca,$who,$mostrauso,$mostraacp,$command,$param);
$msgStats='*** "'.$palabra.'" no está en la BBDD local. Actualizando datos.';
$msgFechas='';
$kernel->post($identifier,'notice',$chan->[0],':: '.$msgStats);
# $msgFechas=&fechaEsp(&miQuery("select now()"));
}
elsif ($valRespuesta[0]==99) {
# Está en la tabla de ERRORES (NORAE).
$msgStats='** '.$palabra.' NO EXISTE. Esta palabra no está en el diccionario de la RAE.';
$msgFechas='En BBDD desde '.$valRespuesta[1].' ('.$valRespuesta[2].'). Última petición '.$valRespuesta[3].' ('.$valRespuesta[4].'). Peticiones: '.$valRespuesta[5];
my $tiempoON= tv_interval ( $tInit , [gettimeofday] );
my $tiempoElapsed=$time{'hh:mm:ss', $tiempoON-3600};
$kernel->post($identifier,'notice',$chan->[0],':: '.$msgStats);
$kernel->post($identifier,'notice',$chan->[0],':: '.$msgFechas);
}
else {
# Está en RAE
$msgStats='** '.$palabra.' '.$valRespuesta[1].' Acepciones, '.$valRespuesta[2].' Usos, '.$valRespuesta[3];
$msgStats.=' Sinónimos, '. $valRespuesta[4].' Antónimos, '.$valRespuesta[5].' Peticiones.';
$msgFechas='En BBDD desde '.$valRespuesta[6].' ('.$valRespuesta[8].'). Última petición '.$valRespuesta[7].' ('.$valRespuesta[9].')';
my $tiempoON= tv_interval ( $tInit , [gettimeofday] );
my $tiempoElapsed=$time{'hh:mm:ss', $tiempoON-3600};
$kernel->post($identifier,'notice',$chan->[0],':: '.$msgStats);
$kernel->post($identifier,'notice',$chan->[0],':: '.$msgFechas);
&muestraLema($kernel,$palabra,$dBusca,$who,$mostrauso,$mostraacp,$command,$param);
}
}
elsif (index(lc($msg),lc($nick))>-1) {
my $tiempoON= tv_interval ( $tInit , [gettimeofday] );
my $tiempoElapsed=$time{'hh:mm:ss', $tiempoON-3600};
$kernel->post($identifier,'notice', $chan->[0], $version .' En línea '.$tiempoElapsed.' desde '.$hInit);
$kernel->post($identifier,'notice', $who, 'Para ayuda ::ELingua');
}
}
sub muestraLema {
my ($kernel,$lema,$donde,$who,$mostrauso,$mostraacp,$command,$param) = @_;
# si estamos aquí ... es que la palabra está en la BD
my @abrevs;
my $abrevList;
my ($elLema,$laAcep);
my ($t,$p,$n);
if ($command eq "sino") {
}
$elLema=&QueryRef("select ID_REC,LEMA,ETIMOLOGIA from PALABRAS where LEMA='$lema'");
if ($#{$elLema}>-1) {
for ($t=0;$t<$#{$elLema}+1;$t++) {
$kernel->post($identifier,'privmsg', $who, ':: ---------------------------------------');
$kernel->post($identifier,'privmsg', $who, ':: **'.$elLema->[$t][1].' ( '.$elLema->[$t][2].' )');
$kernel->post($identifier,'privmsg', $who, ':: **');
$laAcep=&QueryRef("select RAEORDEN,ACEPCION,ABREVIATURAS from ACEPCIONES where REF_ID='$elLema->[$t][0]' order by RAEORDEN");
for ($p=0;$p<$#{$laAcep}+1;$p++) {
$abrevList="";
my @abrevID=split(",",$laAcep->[$p][2]);
for ($n=0;$n<@abrevID;$n++) {
($abrevs[$n])=&QueryArr("select ABREVIATURA from ABREVIATURAS where ID_REC='$abrevID[$n]'");
$abrevList.=" ".$abrevs[$n];
}
$kernel->post($identifier,'privmsg', $who, ':: * '.$laAcep->[$p][0].' '.$abrevList.' '.$laAcep->[$p][1]);
}
}
$kernel->post($identifier,'privmsg', $who, ':: **');
$kernel->post($identifier,'privmsg', $who, ':: FIN. © RAE.ES');
$kernel->post($identifier,'privmsg', $who, ':: ---------------------------------------');
&gLog("Mostrado a $who $lema");
}
else {
$kernel->post($identifier,'privmsg', $who, ':: ---------------------------------------');
$kernel->post($identifier,'privmsg', $who, ':: '.$lema.' NO ESTÁ en la RAE.');
$kernel->post($identifier,'privmsg', $who, ':: ---------------------------------------');
}
}
sub checkDB {
my ( $lema, $who, $command, $param) = @_;
my ( $idNRAE, $totalAcep,$totalUsos,$totalSino,$totalAnto,$totalPeticiones,$fechaInicio,$fechaFinal ) = 0;
my ( $nickInicio,$nickFinal ) = "*";
my $idLemas = &QueryRef("select ID_REC from PALABRAS where LEMA='$lema'");
if ($#{$idLemas}>-1) {
($fechaInicio,$nickInicio,$totalPeticiones)=&QueryArr("select FECHA_INICIO,NICK_INICIO,TOTAL_QUERY from LEMASTATS where REF_ID='$idLemas->[0][0]'");
$totalPeticiones++;
&QueryDO("update LEMASTATS set FECHA_ULTIMA=curdate(),NICK_FINAL='$who',TOTAL_QUERY='$totalPeticiones' where REF_ID='$idLemas->[0][0]'");
($fechaFinal)=&QueryArr("select curdate()");
$fechaInicio=&fechaEsp($fechaInicio);
$fechaFinal=&fechaEsp($fechaFinal);
$nickFinal=$who;
for (my $t=0;$t<$#{$idLemas}+1;$t++) {
my ($tAcep)=&QueryArr("select count(*) from ACEPCIONES where REF_ID='$idLemas->[$t][0]'");
my ($tUsos)=&QueryArr("select count(*) from USOS where REF_ID='$idLemas->[$t][0]'");
my ($tAnto)=&QueryArr("select count(*) from ANTONIMOS where REF_ID='$idLemas->[$t][0]'");
my ($tSino)=&QueryArr("select count(*) from SINONIMOS where REF_ID='$idLemas->[$t][0]'");
$totalAcep+=$tAcep;
$totalUsos+=$tUsos;
$totalSino+=$tSino;
$totalAnto+=$tAnto;
}
return '1:'.$totalAcep.':'.$totalUsos.':'.$totalSino.':'.$totalAnto.':'.$totalPeticiones.':'.$fechaInicio.':'.$fechaFinal.':'.$nickInicio.':'.$nickFinal;
}
else {
my ($idNRAE,$fechaInicio,$nickInicio,$totalPeticiones)=&QueryArr("select ID_REC,FECHA_INICIO,NICK_INICIO,TOTAL_QUERY from NORAE where PALABRA='$lema'");
if (defined($idNRAE)) {
if ($idNRAE>0) {
$totalPeticiones++;
&QueryDO("update NORAE set FECHA_ULTIMA=now(),NICK_ULTIMO='$who',TOTAL_QUERY='$totalPeticiones' where ID_REC='$idNRAE'");
($fechaFinal)=&QueryArr("select curdate()");
$fechaInicio=&fechaEsp($fechaInicio);
$fechaFinal=&fechaEsp($fechaFinal);
$nickFinal=$who;
return '99:'.$fechaInicio.':'.$nickInicio.':'.$fechaFinal.':'.$nickFinal.':'.$totalPeticiones;
}
else {
return 0;
}
}
else {
return 0;
}
}
}
sub fechaEsp {
my $tfecha=$_[0];
my @fecha=split("-",$tfecha);
$tfecha=$fecha[2]."-".$fecha[1]."-".$fecha[0];
return $tfecha;
}
sub getCONTENT {
my ($mkernel,$lema,$donde,$who,$mostrauso,$mostraacp,$command,$param)=@_;
my ($url,$content);
if ($donde==0) {
#RAE
&gLog("Buscando en RAE ... Abriendo HTTP.");
my $TIPO_HTML='2';
my $LEMA=.$lema.;
my $FORMATO='DRAE';
$url='http://buscon.rae.es/draeI/SrvltGUIBusUsual?TIPO_HTML='.$TIPO_HTML.'&LEMA='.$LEMA.'&FORMATO='.$FORMATO;
}
elsif ($donde==1) {
$url='http://tradu.scig.uniovi.es/sinon.cgi?np=30&pb='.$lema;
}
elsif ($donde==2) {
$url='http://tradu.scig.uniovi.es/sinon.cgi?np=30&pb='.$lema;
}
if (defined($url)) {
POE::Session->create
( inline_states =>
{ _start => sub {
my ( $wkernel, $heap ) = @_[ KERNEL, HEAP ];
$wkernel->post( ELingua => request => got_response => GET $url );
},
got_response => sub {
my ( $heap, $request_packet, $response_packet ) = @_[ HEAP, ARG0, ARG1 ];
my $http_request = $request_packet->[0];
my $http_response = $response_packet->[0];
my $response_string = $http_response->as_string();
#if ($http_response->is_success) {
my $initS=" if (index($response_string," $initS=" } $content=substr($response_string,index($response_string,$initS),length($response_string)-index($response_string,$initS)); &leeRaeWEB($mkernel,$lema,$donde,$content,$who,$mostrauso,$mostraacp,$command,$param); #} }, }, ); } } sub leeRaeWEB { my ($kernel,$lema,$donde,$content,$who,$mostrauso,$mostraacp,$command,$param) = @_; my $final=$content; my $errorLema=0; if ($donde == 0) { $final=~ s//\n[LEMA]/g; $final=~ s//\n[ETIMO]/g; $final=~ s//\n[ORDEN]/g; $final=~ s///g; $final=~ s//\n[ABREV \"$1\"]/g; $final=~ s///g; $final=~ s//\n[ABREV \"$1\"]/g; $final=~ s//\n[ACEP]/g; $final=~ s//\n[FORCOM]/g; $final=~ s//\n[ORDENFC]/g; $final=~ s/ $final=~ s// /g; my $debug=utf8($final); $final= $debug->latin1; my $Titulo=$final=~ /