This is a Wikipedia
user page. This is not an encyclopedia article or the talk page for an encyclopedia article. If you find this page on any site other than Wikipedia, you are viewing a mirror site. Be aware that the page may be outdated and that the user whom this page is about may have no personal affiliation with any site other than Wikipedia. The original page is located at https://en.wikipedia.org/wiki/User:OPeixe. |
---
Wikipedia:Babel | ||||
---|---|---|---|---|
| ||||
Search user languages |
|
( OPeixe). WikiProject Galicia
ELingua BOT. An IRC BOT written on 2004 to be able to make queries on the RAE
Real_Academia_Española 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(" ",$ircInput1]) unless !defined($ircInput1]);
my ($palabra,$command,$param)="";
$palabra=$ircCommand0 unless !defined($ircCommand0]);
$palabra=~s/ //g;
$command=$ircCommand1 unless !defined($ircCommand1]);
$param= $ircCommand2 unless !defined($ircCommand2]);
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 ($valRespuesta0==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 ($valRespuesta0==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 '.$valRespuesta1.' ('.$valRespuesta2.'). Última petición '.$valRespuesta3.' ('.$valRespuesta4.'). Peticiones: '.$valRespuesta5];
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.' '.$valRespuesta1.' Acepciones, '.$valRespuesta2.' Usos, '.$valRespuesta3];
$msgStats.=' Sinónimos, '. $valRespuesta4.' Antónimos, '.$valRespuesta5.' Peticiones.';
$msgFechas='En BBDD desde '.$valRespuesta6.' ('.$valRespuesta8.'). Última petición '.$valRespuesta7.' ('.$valRespuesta9.')';
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=$fecha2."-".$fecha1."-".$fecha0];
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="<html";
if (index($response_string,"<HTML")>0) {
$initS="<HTML";
}
$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);
#}
# else
# {
# $mkernel->post($identifier,'notice', $who, 'El servidor de '.$valBusca[$donde].' no responde. Inténtalo más tarde.');
# &gLog("ERROR WEB: ".$response_string);
# }
},
},
);
}
}
sub leeRaeWEB {
my ($kernel,$lema,$donde,$content,$who,$mostrauso,$mostraacp,$command,$param) = @_;
my $final=$content;
my $errorLema=0;
if ($donde == 0) {
# $final=~ s/<\/tr>/\n/g;
# my $idARt$final=~ s/<ARTICULO IDRES="(.*?)">
# </ARTICULO>
# <ESTADO_BIEN/>
$final=~ s/<span class=\"eLema\">/\n[LEMA]/g;
$final=~ s/<span class=\"eEtimo\">/\n[ETIMO]/g;
$final=~ s/<span class=\"eOrdenAcepLema\">/\n[ORDEN]/g;
$final=~ s/<span class=\"eAbrv\">//g;
$final=~ s/<a class=\"eAbrv\" title=\"(.*?)\">/\n[ABREV \"$1\"]/g;
$final=~ s/<span class=\"eAbrvNoEdit\">//g;
$final=~ s/<a class=\"eAbrvNoEdit\" title=\"(.*?)\">/\n[ABREV \"$1\"]/g;
$final=~ s/<span class=\"eAcep\">/\n[ACEP]/g;
$final=~ s/<span class=\"eFCompleja\">/\n[FORCOM]/g;
$final=~ s/<span class=\"eOrdenAcepFC\">/\n[ORDENFC]/g;
$final=~ s/<ESTADO_BIEN\/>/\nOK/g;
$final=~ s/<SUP>/ /g;
my $debug=utf8($final);
$final= $debug->latin1;
my $Titulo=$final=~ /<TITLE>(.*?)<\/TITLE>/;
$Titulo=$1;
$final=~ s/<a title=\"Véase\">/\n/g;
$final=~ s/<([^>])*>//g;
$final=~ s/ \[/\[/g;
$final=~ s/Real Academia Española © Todos los derechos reservados/\n/g;
my @lineas=split("\n",$final);
my $fin=0;
my $ttUso=-1;
my $ttAcp=0;
my ( $lemaTemp, @miQuery, $idTemp, $etimoTemp, $ordenTemp, $numAbrev, @abreTemp, @abreTitulo, $acepTemp, $nLema, $idFormCom, $formCom, $ordenForm);
$nLema=0;
if ($Titulo ne "RAE. DRAE. Aviso de error.") {
for (my $t=0;$t<@lineas;$t++) {
my $lineaOut;
if ($lineas$t =~/^\[/i) {
my $raeOb = $lineas$t =~ /\[(.*?)\]/;
$lineaOut=substr( $lineas$t], index($lineas$t],"]")+1, length($lineas$t])-index($lineas$t],"]") );
decode_entities($lineaOut);
$raeOb=$1;
$lineaOut=~s/'/\\'/gi;
if ($raeOb eq "LEMA") {
if ( (index($lineaOut,".")<0) && (index($lineaOut," ")!=0) ) {
# Grabar LEMA EN BD.
if (index($lineaOut,",")>-1) {
$lemaTemp=substr($lineaOut,0,index($lineaOut,","));
} else {$lemaTemp=$lineaOut;}
$etimoTemp="";
$nLema=1;
}
}
elsif ($raeOb eq "ETIMO") {
# my $idLema=&BDdimeID($lemaTemp);
$etimoTemp.=$lineaOut;
}
elsif ( ($raeOb eq "ORDEN") || ($raeOb eq "ORDENFC") ) {
if (defined ($etimoTemp)) {
$etimoTemp=~s/\(//g;
$etimoTemp=~s/\)//g;
} else {$etimoTemp="-";}
if ($nLema==1) {
&QueryDO("insert into PALABRAS (ID_REC,LEMA,ETIMOLOGIA) values (0, '$lemaTemp','$etimoTemp')");
($idTemp) = &QueryArr("select MAX(ID_REC) from PALABRAS where LEMA='$lemaTemp'");
&QueryDO("insert into LEMASTATS (REF_ID,FECHA_INICIO,NICK_INICIO,FECHA_ULTIMA,NICK_FINAL,TOTAL_QUERY) values ('$idTemp',now(),'$who',now(),'$who','1')");
}
# Nueva acepción
$lineaOut=~s/\.//g;
$ordenTemp=$lineaOut;
$numAbrev=0;
}
elsif (substr($raeOb,0,length("ABREV")) eq "ABREV") {
my $titTemp = $raeOb =~ /\"(.*?)\"/;
$titTemp=$1;
#$lineaOut=substr( $lineaOut, index($lineaOut,"]")+1, length($lineaOut)-index($lineaOut,"]") );
my ( $idAbrev )=&QueryArr("select ID_REC from ABREVIATURAS where ABREVIATURA='$lineaOut'");
if (!defined($idAbrev)) {
&QueryDO("insert into ABREVIATURAS (ID_REC,ABREVIATURA,DESCRIPCION) values (0,'$lineaOut','$titTemp')");
( $idAbrev )=&QueryArr("select ID_REC from ABREVIATURAS where ABREVIATURA='$lineaOut'");
}
# if ($idAbrev<1) {
# &QueryDO("insert into ABREVIATURAS (ID_REC,ABREVIATURA,DESCRIPCION) values (0,'$lineaOut','$titTemp')");
# ( $idAbrev )=&QueryArr("select ID_REC from ABREVIATURAS where ABREVIATURA='$lineaOut'");
# }
$abreTemp$numAbrev=$idAbrev;
$numAbrev++;
}
elsif ($raeOb eq "ACEP") {
my $abrevList="";
my $s;
for ($s=0;$s<@abreTemp-1;$s++) {
$abrevList.="$abreTemp[$s],";
}
$abrevList.="$abreTemp[$s]";
$acepTemp=$lineaOut;
if ($nLema==3) {
&QueryDO("insert into USOSACEP (REF_ID,RAEORDEN,ACEPCION,ABREVIATURAS) values ('$idFormCom','$ordenTemp','$acepTemp','$abrevList')");
}
else {
&QueryDO("insert into ACEPCIONES (REF_ID,RAEORDEN,ACEPCION,ABREVIATURAS) values ('$idTemp','$ordenTemp','$acepTemp','$abrevList')");
$nLema=2;
}
}
#RAE: FORCOM : ~s en alto.
#RAE: ORDENFC : 1.
elsif ($raeOb eq "FORCOM") {
$nLema=3;
&QueryDO("insert into USOS (ID_REC,REF_ID,FRASE) values (0,'$idTemp','$lineaOut')");
( $idFormCom ) = &QueryArr("select MAX(ID_REC) from USOS where FRASE='$lineaOut'");
}
}
}
}
else {
&QueryDO("insert into NORAE values (0,'$lema',now(),'$who',now(),'$who','1')");
}
&muestraLema($kernel,$lema,$donde,$who,$mostrauso,$mostraacp,$command,$param);
}
elsif ($donde==1) {
print "UNIOVI:\n".$final."\n";
my $parteWeb="Los sinónimos de ";
my @webPart= split($parteWeb,$final);
my $nparteWeb="</UL>";
my @webContent=split($nparteWeb,$webPart1]);
$webContent0=~ s/<([^>])*>//g;
$webContent0=~ s/\(definición\)//g;
decode_entities($webContent0]);
$kernel->post($identifier,'privmsg',$who,':: -----------------------------------------');
my $lineaOut="";
my @sinLinea=split("\n",$webContent0]);
if (substr($sinLinea1],0,length("Inténtelo de nuevo")) eq "Inténtelo de nuevo") {
$kernel->post($identifier,'privmsg',$who,':: No hay resultados.');
}
else {
for (my $b=2;$b<@sinLinea-1;$b++) {
if (length($sinLinea$b])>2) {
$lineaOut.=$sinLinea$b.","
}
}
$lineaOut.=$sinLinea@sinLinea-1];
$kernel->post($identifier,'privmsg',$who,':: '.$lineaOut);
}
$kernel->post($identifier,'privmsg',$who,':: FIN ------------------------- © UNIOVI.ES ---');
print "Sinónimos: ".$webContent0];
}
elsif ($donde==2) {
my $parteWeb="Los antónimos de ";
my @webPart= split($parteWeb,$final);
my $nparteWeb="</UL>";
my @webContent=split($nparteWeb,$webPart1]);
$webContent0=~ s/<([^>])*>//g;
$webContent0=~ s/\(definición\)//g;
decode_entities($webContent0]);
$kernel->post($identifier,'privmsg',$who,':: -----------------------------------------');
my $lineaOut="";
my @sinLinea=split("\n",$webContent0]);
if (substr($sinLinea1],0,length("Inténtelo de nuevo")) eq "Inténtelo de nuevo") {
$kernel->post($identifier,'privmsg',$who,':: No hay resultados.');
}
else {
for (my $b=2;$b<@sinLinea-1;$b++) {
if (length($sinLinea$b])>2) {
$lineaOut.=$sinLinea$b.","
}
}
$lineaOut.=$sinLinea@sinLinea-1];
$kernel->post($identifier,'privmsg',$who,':: '.$lineaOut);
}
$kernel->post($identifier,'privmsg',$who,':: FIN ------------------------- © UNIOVI.ES ---');
print "Antónimos: ".$webContent0];
}
else {
}
&gLog("Procesado y grabado ".$lema." a petición de ".$who);
}
sub ordenQuit {
my ($kernel, $who, $chan, $priv) = @_;
if ($who eq $owner) {
&gLog("Propietario ordena QUIT.");
$kernel->post($identifier,'quit',$quitmsg);
&_stop();
}
else {
# Send private reply if it was in a private message,
# otherwise reply to channel.
if ($priv) {
&gLog("Privado a ".$who." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$who,'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
else {
&gLog("Público a ".$who." en ".$chan->0." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$chan->0],'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
}
}
sub ordenJoin {
my ($kernel, $who, $chan, $join, $priv) = @_;
if ($who eq $owner) {
&gLog("Propietario ordena JOIN.");
$kernel->post( $identifier, 'join', $join );
}
else {
if ($priv) {
&gLog("Privado a ".$who." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$who,'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
else {
&gLog("Público a ".$who." en ".$chan->0." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$chan->0],'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
}
}
sub ordenPart {
my ($kernel, $who, $chan, $part, $priv) = @_;
if ($who eq $owner) {
&gLog("Propietario ordena PART.");
$kernel->post( $identifier, 'part', $part );
}
else {
if ($priv) {
&gLog("Privado a ".$who." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$who,'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
else {
&gLog("Público a ".$who." en ".$chan->0." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$chan->0],'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
}
}
sub gLog {
my $logLine=$_0];
my $ahora = localtime;
if (open(elLog, ">>BELingua.log")) {
print (elLog $ahora." ELingua: ".$logLine."\n");
close(elLog);
}
if ($termOut==1) {
print $ahora." ELingua: ".$logLine."\n"
}
}
################################################################################
#ENLAZAR A LA BD
sub BDLogin
{
$Nombre_Bd = $_0];
$Servidor_Bd = $_1];
$Usuario_Bd = $_2];
$Contrasenia_Bd = $_3];
}
#End Datos_Enlace_Bd
################################################################################
#CONECTA A LA BD
sub Conectar_Bd
{
if ( $dbh != 0 )
{
$dbh->disconnect();
}
#LINEA DE CONEXION A LA BD
$dbh=DBI->connect("DBI:mysql:$Nombre_Bd:$Servidor_Bd","$Usuario_Bd","$Contrasenia_Bd");
}#End Conectar_Bd
################################################################################
#DESCONCECTA DE LA BD
sub Desconectar_Bd
{
if ( $dbh > 0 )
{
$dbh->disconnect();
}
}#End Desconectar_Bd
################################################################################
# Operaciones sin respuesta Insert,Update,Delete
# Devuelve registros añadidos,modificados,borrados
# para tener un control de si lo ha hecho o no.
sub QueryDO
{
my $Query_Temporal_Sql = "$_[0]";
my $Registros_Afectados = 0;
if ( length($Query_Temporal_Sql) > -1 )
{
&Conectar_Bd($Nombre_Bd,$Servidor_Bd,$Usuario_Bd,$Contrasenia_Bd);
$Registros_Afectados = $dbh->do($Query_Temporal_Sql);
if ($Registros_Afectados eq "0E0") { $Registros_Afectados = 0; }
&Desconectar_Bd;
}#End-If Hay Query_Temporal_Sql
return $Registros_Afectados;
}#End QueryDO
################################################################################
# Respuesta= ARRAY
sub QueryArr
{
my $Query_Temporal_Sql = "$_[0]";
my @ArrResult = (0);
my $sth = "";
if ( length($Query_Temporal_Sql) > -1 )
{
&Conectar_Bd($Nombre_Bd,$Servidor_Bd,$Usuario_Bd,$Contrasenia_Bd);
$sth=$dbh->prepare($Query_Temporal_Sql);
$sth->execute();
@ArrResult=$sth->fetchrow_array();
$sth->finish();
&Desconectar_Bd;
}#End-If Hay Query_Temporal_Sql
return (@ArrResult);
}#End QueryArr
################################################################################
# Respuesta= REFERENCIA (Array multidimensional)
sub QueryRef
{
my $Query_Temporal_Sql = "$_[0]";
my $RefResult=0;
my $sth = "";
if ( length($Query_Temporal_Sql) > -1 )
{
&Conectar_Bd($Nombre_Bd,$Servidor_Bd,$Usuario_Bd,$Contrasenia_Bd);
$sth=$dbh->prepare($Query_Temporal_Sql);
$sth->execute();
$RefResult=$sth->fetchall_arrayref();
$sth->finish();
&Desconectar_Bd;
}#End-If Hay Query_Temporal_Sql
return ($RefResult);
}#End QueryRef
sub Utf8_To_Ascii
{
my $string = shift;
my $format = $ENV{"UCFORMAT"}||('%lx');
$string =~ s/([\xC0-\xDF])([\x80-\xBF])/sprintf ("%c", hex(sprintf($format,unpack("c",$1)<<6&0x07C0|unpack("c",$2)&0x003F)))/ge;
$string =~ s/([\xE0-\xEF])([\x80-\xBF])([\x80-\xBF])/sprintf ("%c", hex(sprintf($format,unpack("c",$1)<<12&0xF000|unpack("c",$2)<<6&0x0FC0|unpack("c",$3)&0x003F)))/ge;
$string =~ s/([\xF0-\xF7])([\x80-\xBF])([\x80-\xBF])([\x80-\xBF])/sprintf ("%c", hex(sprintf($format,unpack("c",$1)<<18&0x1C0000|unpack("c",$2)<<12&0x3F000|unpack("c",$3)<<6&0x0FC0|unpack("c",$4)&0x003F)))/ge;
return $string;
}
POE::Component::IRC->new($identifier) or die "Wah: $!\n";
POE::Session->new( 'main' => qw(_start
irc_001
irc_disconnected
irc_error
irc_socketerr
_stop
irc_public
irc_ctcp_action
irc_msg) );
$poe_kernel->run();
This is a Wikipedia
user page. This is not an encyclopedia article or the talk page for an encyclopedia article. If you find this page on any site other than Wikipedia, you are viewing a mirror site. Be aware that the page may be outdated and that the user whom this page is about may have no personal affiliation with any site other than Wikipedia. The original page is located at https://en.wikipedia.org/wiki/User:OPeixe. |
---
Wikipedia:Babel | ||||
---|---|---|---|---|
| ||||
Search user languages |
|
( OPeixe). WikiProject Galicia
ELingua BOT. An IRC BOT written on 2004 to be able to make queries on the RAE
Real_Academia_Española 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(" ",$ircInput1]) unless !defined($ircInput1]);
my ($palabra,$command,$param)="";
$palabra=$ircCommand0 unless !defined($ircCommand0]);
$palabra=~s/ //g;
$command=$ircCommand1 unless !defined($ircCommand1]);
$param= $ircCommand2 unless !defined($ircCommand2]);
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 ($valRespuesta0==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 ($valRespuesta0==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 '.$valRespuesta1.' ('.$valRespuesta2.'). Última petición '.$valRespuesta3.' ('.$valRespuesta4.'). Peticiones: '.$valRespuesta5];
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.' '.$valRespuesta1.' Acepciones, '.$valRespuesta2.' Usos, '.$valRespuesta3];
$msgStats.=' Sinónimos, '. $valRespuesta4.' Antónimos, '.$valRespuesta5.' Peticiones.';
$msgFechas='En BBDD desde '.$valRespuesta6.' ('.$valRespuesta8.'). Última petición '.$valRespuesta7.' ('.$valRespuesta9.')';
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=$fecha2."-".$fecha1."-".$fecha0];
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="<html";
if (index($response_string,"<HTML")>0) {
$initS="<HTML";
}
$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);
#}
# else
# {
# $mkernel->post($identifier,'notice', $who, 'El servidor de '.$valBusca[$donde].' no responde. Inténtalo más tarde.');
# &gLog("ERROR WEB: ".$response_string);
# }
},
},
);
}
}
sub leeRaeWEB {
my ($kernel,$lema,$donde,$content,$who,$mostrauso,$mostraacp,$command,$param) = @_;
my $final=$content;
my $errorLema=0;
if ($donde == 0) {
# $final=~ s/<\/tr>/\n/g;
# my $idARt$final=~ s/<ARTICULO IDRES="(.*?)">
# </ARTICULO>
# <ESTADO_BIEN/>
$final=~ s/<span class=\"eLema\">/\n[LEMA]/g;
$final=~ s/<span class=\"eEtimo\">/\n[ETIMO]/g;
$final=~ s/<span class=\"eOrdenAcepLema\">/\n[ORDEN]/g;
$final=~ s/<span class=\"eAbrv\">//g;
$final=~ s/<a class=\"eAbrv\" title=\"(.*?)\">/\n[ABREV \"$1\"]/g;
$final=~ s/<span class=\"eAbrvNoEdit\">//g;
$final=~ s/<a class=\"eAbrvNoEdit\" title=\"(.*?)\">/\n[ABREV \"$1\"]/g;
$final=~ s/<span class=\"eAcep\">/\n[ACEP]/g;
$final=~ s/<span class=\"eFCompleja\">/\n[FORCOM]/g;
$final=~ s/<span class=\"eOrdenAcepFC\">/\n[ORDENFC]/g;
$final=~ s/<ESTADO_BIEN\/>/\nOK/g;
$final=~ s/<SUP>/ /g;
my $debug=utf8($final);
$final= $debug->latin1;
my $Titulo=$final=~ /<TITLE>(.*?)<\/TITLE>/;
$Titulo=$1;
$final=~ s/<a title=\"Véase\">/\n/g;
$final=~ s/<([^>])*>//g;
$final=~ s/ \[/\[/g;
$final=~ s/Real Academia Española © Todos los derechos reservados/\n/g;
my @lineas=split("\n",$final);
my $fin=0;
my $ttUso=-1;
my $ttAcp=0;
my ( $lemaTemp, @miQuery, $idTemp, $etimoTemp, $ordenTemp, $numAbrev, @abreTemp, @abreTitulo, $acepTemp, $nLema, $idFormCom, $formCom, $ordenForm);
$nLema=0;
if ($Titulo ne "RAE. DRAE. Aviso de error.") {
for (my $t=0;$t<@lineas;$t++) {
my $lineaOut;
if ($lineas$t =~/^\[/i) {
my $raeOb = $lineas$t =~ /\[(.*?)\]/;
$lineaOut=substr( $lineas$t], index($lineas$t],"]")+1, length($lineas$t])-index($lineas$t],"]") );
decode_entities($lineaOut);
$raeOb=$1;
$lineaOut=~s/'/\\'/gi;
if ($raeOb eq "LEMA") {
if ( (index($lineaOut,".")<0) && (index($lineaOut," ")!=0) ) {
# Grabar LEMA EN BD.
if (index($lineaOut,",")>-1) {
$lemaTemp=substr($lineaOut,0,index($lineaOut,","));
} else {$lemaTemp=$lineaOut;}
$etimoTemp="";
$nLema=1;
}
}
elsif ($raeOb eq "ETIMO") {
# my $idLema=&BDdimeID($lemaTemp);
$etimoTemp.=$lineaOut;
}
elsif ( ($raeOb eq "ORDEN") || ($raeOb eq "ORDENFC") ) {
if (defined ($etimoTemp)) {
$etimoTemp=~s/\(//g;
$etimoTemp=~s/\)//g;
} else {$etimoTemp="-";}
if ($nLema==1) {
&QueryDO("insert into PALABRAS (ID_REC,LEMA,ETIMOLOGIA) values (0, '$lemaTemp','$etimoTemp')");
($idTemp) = &QueryArr("select MAX(ID_REC) from PALABRAS where LEMA='$lemaTemp'");
&QueryDO("insert into LEMASTATS (REF_ID,FECHA_INICIO,NICK_INICIO,FECHA_ULTIMA,NICK_FINAL,TOTAL_QUERY) values ('$idTemp',now(),'$who',now(),'$who','1')");
}
# Nueva acepción
$lineaOut=~s/\.//g;
$ordenTemp=$lineaOut;
$numAbrev=0;
}
elsif (substr($raeOb,0,length("ABREV")) eq "ABREV") {
my $titTemp = $raeOb =~ /\"(.*?)\"/;
$titTemp=$1;
#$lineaOut=substr( $lineaOut, index($lineaOut,"]")+1, length($lineaOut)-index($lineaOut,"]") );
my ( $idAbrev )=&QueryArr("select ID_REC from ABREVIATURAS where ABREVIATURA='$lineaOut'");
if (!defined($idAbrev)) {
&QueryDO("insert into ABREVIATURAS (ID_REC,ABREVIATURA,DESCRIPCION) values (0,'$lineaOut','$titTemp')");
( $idAbrev )=&QueryArr("select ID_REC from ABREVIATURAS where ABREVIATURA='$lineaOut'");
}
# if ($idAbrev<1) {
# &QueryDO("insert into ABREVIATURAS (ID_REC,ABREVIATURA,DESCRIPCION) values (0,'$lineaOut','$titTemp')");
# ( $idAbrev )=&QueryArr("select ID_REC from ABREVIATURAS where ABREVIATURA='$lineaOut'");
# }
$abreTemp$numAbrev=$idAbrev;
$numAbrev++;
}
elsif ($raeOb eq "ACEP") {
my $abrevList="";
my $s;
for ($s=0;$s<@abreTemp-1;$s++) {
$abrevList.="$abreTemp[$s],";
}
$abrevList.="$abreTemp[$s]";
$acepTemp=$lineaOut;
if ($nLema==3) {
&QueryDO("insert into USOSACEP (REF_ID,RAEORDEN,ACEPCION,ABREVIATURAS) values ('$idFormCom','$ordenTemp','$acepTemp','$abrevList')");
}
else {
&QueryDO("insert into ACEPCIONES (REF_ID,RAEORDEN,ACEPCION,ABREVIATURAS) values ('$idTemp','$ordenTemp','$acepTemp','$abrevList')");
$nLema=2;
}
}
#RAE: FORCOM : ~s en alto.
#RAE: ORDENFC : 1.
elsif ($raeOb eq "FORCOM") {
$nLema=3;
&QueryDO("insert into USOS (ID_REC,REF_ID,FRASE) values (0,'$idTemp','$lineaOut')");
( $idFormCom ) = &QueryArr("select MAX(ID_REC) from USOS where FRASE='$lineaOut'");
}
}
}
}
else {
&QueryDO("insert into NORAE values (0,'$lema',now(),'$who',now(),'$who','1')");
}
&muestraLema($kernel,$lema,$donde,$who,$mostrauso,$mostraacp,$command,$param);
}
elsif ($donde==1) {
print "UNIOVI:\n".$final."\n";
my $parteWeb="Los sinónimos de ";
my @webPart= split($parteWeb,$final);
my $nparteWeb="</UL>";
my @webContent=split($nparteWeb,$webPart1]);
$webContent0=~ s/<([^>])*>//g;
$webContent0=~ s/\(definición\)//g;
decode_entities($webContent0]);
$kernel->post($identifier,'privmsg',$who,':: -----------------------------------------');
my $lineaOut="";
my @sinLinea=split("\n",$webContent0]);
if (substr($sinLinea1],0,length("Inténtelo de nuevo")) eq "Inténtelo de nuevo") {
$kernel->post($identifier,'privmsg',$who,':: No hay resultados.');
}
else {
for (my $b=2;$b<@sinLinea-1;$b++) {
if (length($sinLinea$b])>2) {
$lineaOut.=$sinLinea$b.","
}
}
$lineaOut.=$sinLinea@sinLinea-1];
$kernel->post($identifier,'privmsg',$who,':: '.$lineaOut);
}
$kernel->post($identifier,'privmsg',$who,':: FIN ------------------------- © UNIOVI.ES ---');
print "Sinónimos: ".$webContent0];
}
elsif ($donde==2) {
my $parteWeb="Los antónimos de ";
my @webPart= split($parteWeb,$final);
my $nparteWeb="</UL>";
my @webContent=split($nparteWeb,$webPart1]);
$webContent0=~ s/<([^>])*>//g;
$webContent0=~ s/\(definición\)//g;
decode_entities($webContent0]);
$kernel->post($identifier,'privmsg',$who,':: -----------------------------------------');
my $lineaOut="";
my @sinLinea=split("\n",$webContent0]);
if (substr($sinLinea1],0,length("Inténtelo de nuevo")) eq "Inténtelo de nuevo") {
$kernel->post($identifier,'privmsg',$who,':: No hay resultados.');
}
else {
for (my $b=2;$b<@sinLinea-1;$b++) {
if (length($sinLinea$b])>2) {
$lineaOut.=$sinLinea$b.","
}
}
$lineaOut.=$sinLinea@sinLinea-1];
$kernel->post($identifier,'privmsg',$who,':: '.$lineaOut);
}
$kernel->post($identifier,'privmsg',$who,':: FIN ------------------------- © UNIOVI.ES ---');
print "Antónimos: ".$webContent0];
}
else {
}
&gLog("Procesado y grabado ".$lema." a petición de ".$who);
}
sub ordenQuit {
my ($kernel, $who, $chan, $priv) = @_;
if ($who eq $owner) {
&gLog("Propietario ordena QUIT.");
$kernel->post($identifier,'quit',$quitmsg);
&_stop();
}
else {
# Send private reply if it was in a private message,
# otherwise reply to channel.
if ($priv) {
&gLog("Privado a ".$who." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$who,'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
else {
&gLog("Público a ".$who." en ".$chan->0." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$chan->0],'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
}
}
sub ordenJoin {
my ($kernel, $who, $chan, $join, $priv) = @_;
if ($who eq $owner) {
&gLog("Propietario ordena JOIN.");
$kernel->post( $identifier, 'join', $join );
}
else {
if ($priv) {
&gLog("Privado a ".$who." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$who,'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
else {
&gLog("Público a ".$who." en ".$chan->0." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$chan->0],'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
}
}
sub ordenPart {
my ($kernel, $who, $chan, $part, $priv) = @_;
if ($who eq $owner) {
&gLog("Propietario ordena PART.");
$kernel->post( $identifier, 'part', $part );
}
else {
if ($priv) {
&gLog("Privado a ".$who." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$who,'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
else {
&gLog("Público a ".$who." en ".$chan->0." Sin permisos para ejecutar comando.");
$kernel->post($identifier,'privmsg',$chan->0],'Mis tendencias anarquistas me impiden obedecer órdenes.');
}
}
}
sub gLog {
my $logLine=$_0];
my $ahora = localtime;
if (open(elLog, ">>BELingua.log")) {
print (elLog $ahora." ELingua: ".$logLine."\n");
close(elLog);
}
if ($termOut==1) {
print $ahora." ELingua: ".$logLine."\n"
}
}
################################################################################
#ENLAZAR A LA BD
sub BDLogin
{
$Nombre_Bd = $_0];
$Servidor_Bd = $_1];
$Usuario_Bd = $_2];
$Contrasenia_Bd = $_3];
}
#End Datos_Enlace_Bd
################################################################################
#CONECTA A LA BD
sub Conectar_Bd
{
if ( $dbh != 0 )
{
$dbh->disconnect();
}
#LINEA DE CONEXION A LA BD
$dbh=DBI->connect("DBI:mysql:$Nombre_Bd:$Servidor_Bd","$Usuario_Bd","$Contrasenia_Bd");
}#End Conectar_Bd
################################################################################
#DESCONCECTA DE LA BD
sub Desconectar_Bd
{
if ( $dbh > 0 )
{
$dbh->disconnect();
}
}#End Desconectar_Bd
################################################################################
# Operaciones sin respuesta Insert,Update,Delete
# Devuelve registros añadidos,modificados,borrados
# para tener un control de si lo ha hecho o no.
sub QueryDO
{
my $Query_Temporal_Sql = "$_[0]";
my $Registros_Afectados = 0;
if ( length($Query_Temporal_Sql) > -1 )
{
&Conectar_Bd($Nombre_Bd,$Servidor_Bd,$Usuario_Bd,$Contrasenia_Bd);
$Registros_Afectados = $dbh->do($Query_Temporal_Sql);
if ($Registros_Afectados eq "0E0") { $Registros_Afectados = 0; }
&Desconectar_Bd;
}#End-If Hay Query_Temporal_Sql
return $Registros_Afectados;
}#End QueryDO
################################################################################
# Respuesta= ARRAY
sub QueryArr
{
my $Query_Temporal_Sql = "$_[0]";
my @ArrResult = (0);
my $sth = "";
if ( length($Query_Temporal_Sql) > -1 )
{
&Conectar_Bd($Nombre_Bd,$Servidor_Bd,$Usuario_Bd,$Contrasenia_Bd);
$sth=$dbh->prepare($Query_Temporal_Sql);
$sth->execute();
@ArrResult=$sth->fetchrow_array();
$sth->finish();
&Desconectar_Bd;
}#End-If Hay Query_Temporal_Sql
return (@ArrResult);
}#End QueryArr
################################################################################
# Respuesta= REFERENCIA (Array multidimensional)
sub QueryRef
{
my $Query_Temporal_Sql = "$_[0]";
my $RefResult=0;
my $sth = "";
if ( length($Query_Temporal_Sql) > -1 )
{
&Conectar_Bd($Nombre_Bd,$Servidor_Bd,$Usuario_Bd,$Contrasenia_Bd);
$sth=$dbh->prepare($Query_Temporal_Sql);
$sth->execute();
$RefResult=$sth->fetchall_arrayref();
$sth->finish();
&Desconectar_Bd;
}#End-If Hay Query_Temporal_Sql
return ($RefResult);
}#End QueryRef
sub Utf8_To_Ascii
{
my $string = shift;
my $format = $ENV{"UCFORMAT"}||('%lx');
$string =~ s/([\xC0-\xDF])([\x80-\xBF])/sprintf ("%c", hex(sprintf($format,unpack("c",$1)<<6&0x07C0|unpack("c",$2)&0x003F)))/ge;
$string =~ s/([\xE0-\xEF])([\x80-\xBF])([\x80-\xBF])/sprintf ("%c", hex(sprintf($format,unpack("c",$1)<<12&0xF000|unpack("c",$2)<<6&0x0FC0|unpack("c",$3)&0x003F)))/ge;
$string =~ s/([\xF0-\xF7])([\x80-\xBF])([\x80-\xBF])([\x80-\xBF])/sprintf ("%c", hex(sprintf($format,unpack("c",$1)<<18&0x1C0000|unpack("c",$2)<<12&0x3F000|unpack("c",$3)<<6&0x0FC0|unpack("c",$4)&0x003F)))/ge;
return $string;
}
POE::Component::IRC->new($identifier) or die "Wah: $!\n";
POE::Session->new( 'main' => qw(_start
irc_001
irc_disconnected
irc_error
irc_socketerr
_stop
irc_public
irc_ctcp_action
irc_msg) );
$poe_kernel->run();