#!/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="<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,$webPart[1]);
$webContent[0]=~ s/<([^>])*>//g;
$webContent[0]=~ s/\(definición\)//g;
decode_entities($webContent[0]);
$kernel->post($identifier,'privmsg',$who,':: -----------------------------------------');
my $lineaOut="";
my @sinLinea=split("\n",$webContent[0]);
if (substr($sinLinea[1],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: ".$webContent[0];
}
elsif ($donde==2) {
my $parteWeb="Los antónimos de ";
my @webPart= split($parteWeb,$final);
my $nparteWeb="</UL>";
my @webContent=split($nparteWeb,$webPart[1]);
$webContent[0]=~ s/<([^>])*>//g;
$webContent[0]=~ s/\(definición\)//g;
decode_entities($webContent[0]);
$kernel->post($identifier,'privmsg',$who,':: -----------------------------------------');
my $lineaOut="";
my @sinLinea=split("\n",$webContent[0]);
if (substr($sinLinea[1],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: ".$webContent[0];
}
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();
