diff --git a/Modules/Debug.pm b/Modules/Debug.pm
index 5cbfe1377b9929dcdf6c2f761b706400ff5735ba..e7aed73c0a7c752369b027d1b0a19456f6152143 100644
--- a/Modules/Debug.pm
+++ b/Modules/Debug.pm
@@ -98,7 +98,7 @@ sub debug_help
{
my ($conn, $event, $reply_to, $ref_params) = @_;
- $conn->privmsg($reply_to, "`".$Config::command_sign."debug {<module>|queue [<sched_id>]}` => Print module variables or schedule queue events");
+ $conn->privmsg($reply_to, "`".$Config::command_sign."dbg {<module>|queue [<sched_id>]}` => Print module variables or schedule queue events");
return 1;
} # Fin debug_help
diff --git a/Modules/Horoscope.pm b/Modules/Horoscope.pm
index 63769f26b82c4bbe54dcc42fdce6baceb80c2752..5093e3ea32ade81e57181d1770461991ca3ee3cf 100644
--- a/Modules/Horoscope.pm
+++ b/Modules/Horoscope.pm
@@ -71,7 +71,7 @@ sub send_result
my ($conn, $status, $buffer, $params) = @_;
$::logger->debug("Horoscope result received\n");
- if($status)
+ if($status != -1)
{
$::logger->debug("Status ok\n");
my $parser = HTML::TokeParser::Simple->new("string" => $buffer);
diff --git a/Modules/HostIsDown.pm b/Modules/HostIsDown.pm
index bf1f54c25ed3dbb1e2897b8ca08ce78e50924889..27ad17d30cc1c03e8601199d1d3bda564f4e1577 100644
--- a/Modules/HostIsDown.pm
+++ b/Modules/HostIsDown.pm
@@ -46,7 +46,7 @@ sub send_result
my ($conn, $status, $buffer, $params) = @_;
$::logger->debug("HostIsDown result received\n");
- if($status)
+ if($status != -1)
{
$::logger->debug("Status ok\n");
my $parser = HTML::TokeParser::Simple->new("string" => $buffer);
diff --git a/Modules/Join.pm b/Modules/Join.pm
index 6dbbdf2b648d7bfe38d59df9f510b6d408fa6ff2..c3d251dd0ab6e4febd54c386bfdfc4155a056006 100644
--- a/Modules/Join.pm
+++ b/Modules/Join.pm
@@ -21,7 +21,7 @@ my %joining_chans = ();
sub join_main
{
my ($self, $event , $reply_to, $ref_params) = @_;
-
+
if(defined($ref_params->[0]))
{
if(substr($ref_params->[0], 0, 1) ne "#")
@@ -29,14 +29,14 @@ sub join_main
$::displayer->sendto($reply_to, "Can't join a query");
return 1;
}
-
- $joining_chans{$ref_params->[0]} = $reply_to;
-
+
+ $joining_chans{lc $ref_params->[0]} = $reply_to;
+
$self->join($ref_params->[0]);
-
+
return 1;
}
-
+
return 0;
} # Fin join_main
@@ -48,11 +48,11 @@ sub join_main
sub namreply_handle
{
my ($conn, $event) = @_;
-
+
if($event->{'format'} eq 'server')
{
- my $chan = $event->{'args'}[2];
-
+ my $chan = lc $event->{'args'}[2];
+
if(defined($joining_chans{$chan}))
{
my $reply_to = $joining_chans{$chan};
@@ -75,9 +75,9 @@ sub namreply_handle
sub toomanychannels_handle
{
my ($conn, $event) = @_;
-
- my $chan = $event->{'args'}[1];
-
+
+ my $chan = lc $event->{'args'}[1];
+
if(defined($joining_chans{$chan}))
{
my $reply_to = $joining_chans{$chan};
@@ -88,7 +88,7 @@ sub toomanychannels_handle
{
$conn->privmsg($Config::owner, "ERR_TOOMANYCHANNELS received for $chan, but wasn't joining it.");
}
-
+
return 1;
} # Fin toomanychannels_handle
@@ -99,9 +99,9 @@ sub toomanychannels_handle
sub inviteonlychan_handle
{
my ($conn, $event) = @_;
-
- my $chan = $event->{'args'}[1];
-
+
+ my $chan = lc $event->{'args'}[1];
+
if(defined($joining_chans{$chan}))
{
my $reply_to = $joining_chans{$chan};
@@ -112,7 +112,7 @@ sub inviteonlychan_handle
{
$conn->privmsg($Config::owner, "ERR_INVITEONLYCHAN received for $chan, but wasn't joining it.");
}
-
+
return 1;
} # Fin inviteonlychan_handle
@@ -123,9 +123,9 @@ sub inviteonlychan_handle
sub channelisfull_handle
{
my ($self, $event) = @_;
-
- my $chan = $event->{'args'}[1];
-
+
+ my $chan = lc $event->{'args'}[1];
+
if(defined($joining_chans{$chan}))
{
my $reply_to = $joining_chans{$chan};
@@ -136,7 +136,7 @@ sub channelisfull_handle
{
$conn->privmsg($Config::owner, "ERR_CHANNELISFULL received for $chan, but wasn't joining it.");
}
-
+
return 1;
} # Fin channelisfull_handle
@@ -147,9 +147,9 @@ sub channelisfull_handle
sub bannedfromchannel_handle
{
my ($self, $event) = @_;
-
- my $chan = $event->{'args'}[1];
-
+
+ my $chan = lc $event->{'args'}[1];
+
if(defined($joining_chans{$chan}))
{
my $reply_to = $joining_chans{$chan};
@@ -160,7 +160,7 @@ sub bannedfromchannel_handle
{
$conn->privmsg($Config::owner, "ERR_BANNEDFROMCHAN received for $chan, but wasn't joining it.");
}
-
+
return 1;
} # Fin bannedfromchannel_handle
@@ -172,8 +172,8 @@ sub bannedfromchannel_handle
sub join_save
{
my (undef, undef, $reloading) = @_;
-
-
+
+
if($reloading)
{
# On se désenregistre sinon on risque d'avoir deux fois le handler d'appelé
@@ -183,9 +183,9 @@ sub join_save
EventHandler::remove_event("channelisfull", "before", \&channelisfull_handle);
EventHandler::remove_event("bannedfromchannel", "before", \&bannedfromchannel_handle);
}
-
+
return 1;
-} # Fin join_load
+} # Fin join_save
# ###
@@ -200,8 +200,8 @@ sub join_load
EventHandler::add_event("inviteonlychan", "before", \&inviteonlychan_handle);
EventHandler::add_event("channelisfull", "before", \&channelisfull_handle);
EventHandler::add_event("bannedfromchannel", "before", \&bannedfromchannel_handle);
-
-
+
+
return 1;
} # Fin join_load
@@ -213,10 +213,10 @@ sub join_load
sub join_help
{
my ($self, $event, $reply_to, $ref_params) = @_;
-
+
$self->privmsg($reply_to, "`".$Config::command_sign."join <#channel>` => "
."let ".$Config::nick." join <#channel>");
-
+
return 1;
} # Fin join_help
diff --git a/Modules/Postit.pm b/Modules/Postit.pm
index cbc946cfa8f88db686efc5056ba37bcfbf8b6508..9a9ecc1a817b30972d165fb95845ea2114d6ac62 100644
--- a/Modules/Postit.pm
+++ b/Modules/Postit.pm
@@ -34,18 +34,18 @@ my %months = (
# ###
# postit_main
# Permet de créer des post-it virtuels
-#
+#
# Usage :
# !postit [drop] <label> [<text>]
# ###
sub postit_main
{
my ($self, $event, $reply_to, $ref_params) = @_;
-
+
if(defined($ref_params->[0]))
{
my $first_word = shift @{$ref_params};
-
+
if($first_word eq 'drop')
{
return 1 if(drop_postit($self, $event, $reply_to, $ref_params));
@@ -66,7 +66,7 @@ sub postit_main
}
}
}
-
+
$ref_params->[0] = 'postit';
Help::help_main($self, $event, $reply_to, $ref_params);
} # Fin postit_main
@@ -79,28 +79,28 @@ sub postit_main
sub drop_postit
{
my ($self, $event, $reply_to, $ref_params) = @_;
-
+
return 0 if(!defined($ref_params->[0]));
-
+
my $label = shift @{$ref_params};
my $ref_postit = \%postits;
my $event_nick = $event->{'nick'};
-
+
if(!defined($ref_postit->{$event_nick}))
{
$self->privmsg($reply_to, "No postit to drop for you");
return 1;
}
-
+
if(!defined($ref_postit->{$event_nick}->{$label}))
{
$self->privmsg($reply_to, "No postit named '$label' to drop for you");
return 1;
}
-
+
delete $ref_postit->{$event_nick}->{$label};
$self->privmsg($reply_to, "Postit named '$label' deleted");
-
+
return 1;
} # Fin drop_postit
@@ -112,25 +112,25 @@ sub drop_postit
sub see_postit
{
my ($self, $event, $reply_to, $label) = @_;
-
+
my $event_nick = $event->{'nick'};
-
+
if(!defined($postits{$event_nick}))
{
$self->privmsg($reply_to, "No postit found for you");
return 1;
}
-
+
if(!defined( $postits{$event_nick}->{$label} ))
{
$self->privmsg($reply_to, "No postit named '$label' found");
return 1;
}
-
-
+
+
# On envoie le postit
$self->privmsg($reply_to, $postits{$event_nick}->{$label});
-
+
return 1;
} # Fin see_postit
@@ -142,10 +142,10 @@ sub see_postit
sub see_labels
{
my ($self, $event, $reply_to) = @_;
-
+
my $event_nick = $event->{'nick'};
my $ref_postit = \%postits;
-
+
my @labels = ();
if(defined($ref_postit->{$event_nick}))
{
@@ -154,7 +154,7 @@ sub see_labels
push(@labels, $key);
}
}
-
+
if(defined($labels[0]))
{
if(defined($labels[1]))
@@ -170,7 +170,7 @@ sub see_labels
{
$self->privmsg($reply_to, $event_nick.": You don't have any postit");
}
-
+
return 1;
} # Fin see_labels
@@ -182,19 +182,19 @@ sub see_labels
sub write_postit
{
my ($self, $event, $reply_to, $label, $ref_params) = @_;
-
+
my $event_nick = $event->{'nick'};
my $ref_postit = \%postits;
-
+
# On récupère le moment où l'utilisateur a posé son postit
my (undef, $month, $day, $clock, $year) = split /\s+/, localtime(time);
$month = $months{$month};
-
-
+
+
# On se fait une chaine formattée avec des belles couleurs sous irssi
my $formatted_time = "\x0304[\x0303$day/$month/$year $clock\x0304]\x03 ";
my $message = $formatted_time.join(' ', @{$ref_params});
-
+
if(!defined($ref_postit->{$event_nick}))
{
$ref_postit->{ $event_nick } = {
@@ -209,13 +209,13 @@ sub write_postit
{
$self->privmsg($reply_to, $event_nick
.": your message has been concat to the previous one, all is good!");
-
+
my $old_msg = ($ref_postit->{ $event_nick }->{$label} =~ /^.*?\]. (.*)$/)[0];
-
+
$ref_params->[0] = substr($ref_params->[0], 1);
shift @{$ref_params} if($ref_params->[0] eq '');
return 0 if(!defined($ref_params->[0]));
-
+
$ref_postit->{ $event_nick }->{$label} = $formatted_time . $old_msg .' '. join(' ', @{$ref_params});
}
else
@@ -223,20 +223,20 @@ sub write_postit
$self->privmsg($reply_to, $event_nick
.": I kept the new one but there was already one named '$label': "
.$ref_postit->{$event_nick}->{$label});
-
+
$ref_postit->{ $event_nick }->{$label} = $message;
}
return 1;
}
-
+
$ref_postit->{ $event_nick }->{$label} = $message;
}
-
+
my $random_affirmation = $Config::affirmative[int(rand($#Config::affirmative + 1))];
-
+
$self->privmsg($reply_to, $random_affirmation);
-
-
+
+
return 1;
} # Fin write_postit
@@ -248,13 +248,13 @@ sub write_postit
sub change_owner
{
my (undef, $event) = @_;
-
+
my $old_nick = $event->{'nick'};
my $new_nick = $event->{'args'}[0];
-
-
+
+
my $ref_postits = \%postits;
-
+
if(defined($ref_postits->{$old_nick}))
{
# On copie les postits de $old_nick vers $new_nick
@@ -263,7 +263,7 @@ sub change_owner
if(defined($ref_postits->{$new_nick}))
{
$ref_postits->{$new_nick}->{$label} = $ref_postits->{$old_nick}->{$label};
-
+
# On supprime l'entrée dans la référence à l'ancien pseudo
delete $ref_postits->{$old_nick}->{$label};
}
@@ -272,15 +272,15 @@ sub change_owner
$ref_postits->{ $new_nick } = {
$label => $ref_postits->{$old_nick}->{$label}
};
-
+
# On supprime l'entrée dans la référence à l'ancien pseudo
delete $ref_postits->{$old_nick}->{$label};
}
}
-
+
delete $ref_postits->{$old_nick};
}
-
+
} # Fin change_owner
@@ -291,12 +291,12 @@ sub change_owner
sub postit_help
{
my ($self, $event, $reply_to, $ref_params) = @_;
-
+
$self->privmsg($reply_to, "`".$Config::command_sign."postit <label> [+][<text>]` => "
."write a post-it, concat to or see one");
$self->privmsg($reply_to, "`".$Config::command_sign."postit drop <label>` => drop a postit from its <label>");
$self->privmsg($reply_to, "`".$Config::command_sign."postit labels` => show your labels");
-
+
return 1;
} # Fin postit_help
@@ -309,29 +309,29 @@ sub postit_save
{
my (undef, $folder, $reloading) = @_;
my $file_postit = "/postits".$Config::suffixe.".sav";
-
+
open POSTITS, ">", $folder.$file_postit or die "Unable to create $folder$file_postit";
-
+
foreach my $nick (keys %postits)
{
- printf POSTITS "$nick\n";
+ print POSTITS "$nick\n";
foreach my $label (keys %{$postits{$nick}})
{
- printf POSTITS $label."\n";
- printf POSTITS $postits{$nick}{$label}."\n";
+ print POSTITS $label."\n";
+ print POSTITS $postits{$nick}{$label}."\n";
}
- printf POSTITS "$nick\n";
+ print POSTITS "$nick\n";
}
-
+
close POSTITS;
-
+
if($reloading)
{
# On veut pouvoir chopper les changements de pseudos, mais on se
# désenregistre, sinon on risque d'avoir deux fois le handler d'appelé
EventHandler::remove_event("nick", "before", \&change_owner);
}
-
+
return 1;
} # Fin postit_save
@@ -345,14 +345,14 @@ sub postit_load
shift; # Pas besoin de la connexion au serveur
my $folder = shift;
my $file_postit = "/postits".$Config::suffixe.".sav";
-
+
open POSTITS, "<", $folder.$file_postit or return 0;
-
+
my $got_nick = '';
while(my $line = <POSTITS>)
{
chomp $line;
-
+
if($got_nick eq '')
{
# Un nouveau pseudo qui avait posé un postit
@@ -369,19 +369,19 @@ sub postit_load
# On récupère le message
my $msg = <POSTITS>;
chomp $msg;
-
+
$postits{ $got_nick }{$line} = $msg;
}
-
+
}
-
+
close POSTITS;
-
+
# On veut pouvoir chopper les changements de pseudos, donc on ajoute un
# event handler sur le changement de pseudo (= l'évènement 'nick')
EventHandler::add_event("nick", "before", \&change_owner);
-
-
+
+
return 1;
} # Fin postit_load
diff --git a/Modules/Queue.pm b/Modules/Queue.pm
new file mode 100644
index 0000000000000000000000000000000000000000..65c17959895ac9b5863ed66db66a3ae84fd1fe97
--- /dev/null
+++ b/Modules/Queue.pm
@@ -0,0 +1,83 @@
+package Queue; # right = owner ; command = queue
+
+
+use strict;
+use warnings;
+
+
+# ###
+# queue_main
+#
+#
+# Usage :
+# !queue remove <sched_id>
+# ###
+sub queue_main
+{
+ my ($conn, $event, $reply_to, $ref_params) = @_;
+
+ return 0 unless(defined($ref_params->[0]));
+
+ if($ref_params->[0] eq 'remove')
+ {
+ if($conn->parent->schedulequeue->is_empty())
+ {
+ $::displayer->sendto($reply_to, "The schedule queue is empty from any event.");
+ return 1;
+ }
+
+ if(defined($ref_params->[1]))
+ {
+ return remove_queue_id($conn, $event, $reply_to, $ref_params->[1]);
+ }
+ }
+
+ $ref_params->[0] = 'queue';
+ Help::help_main($conn, $event, $reply_to, $ref_params);
+} # Fin queue_main
+
+
+# ###
+# remove_queue_id
+# Supprime un event de la queue
+# ###
+sub remove_queue_id
+{
+ my ($conn, $event, $reply_to, $sched_id) = @_;
+
+ my $schqueue = $conn->parent->schedulequeue;
+ if(exists($schqueue->queue->{$sched_id}))
+ {
+ my $entry = $schqueue->queue->{$sched_id};
+
+ $schqueue->dequeue($entry);
+ $::displayer->sendto($reply_to, "Event $sched_id removed from the schedule queue.");
+ }
+ else
+ {
+ $::displayer->sendto($reply_to, "No such event in the schedule queue.");
+ }
+
+ return 1;
+} # Fin remove_queue_id
+
+
+# ###
+# queue_help
+# Aide de queue
+# ###
+sub queue_help
+{
+ my ($conn, $event, $reply_to, $ref_params) = @_;
+
+ $conn->privmsg($reply_to, "`".$Config::command_sign."queue remove <sched_id>` => Remove the <sched_id> event from the queue");
+
+ return 1;
+} # Fin queue_help
+
+
+1;
+
+__END__
+
+
diff --git a/Modules/Rss.pm b/Modules/Rss.pm
index 7ce5b44a5be03bd1d73d72ef309f2a04297f41f5..08c37f89247612cb40262847ac2d8ef79585b72b 100644
--- a/Modules/Rss.pm
+++ b/Modules/Rss.pm
@@ -43,7 +43,7 @@ my %periods = %Common::periods;
# ###
# rss_main
# Sert à avertir lorsqu'une update d'un flux rss est présente
-#
+#
# Usage :
# !rss {run|stop|status}
# !rss {add <url> [[every] <nb> <period>]|del <url> [<#chan>|all]} [grep [on] <regex>]
@@ -53,7 +53,7 @@ my %periods = %Common::periods;
sub rss_main
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
if(
substr($reply_to, 0, 1) eq '#' &&
lc $event->{"nick"} ne lc $Config::owner &&
@@ -63,8 +63,8 @@ sub rss_main
$conn->privmsg($reply_to, $event->{"nick"}.": You're not authorized to use this module here");
return 1;
}
-
-
+
+
if(defined($ref_params->[0]))
{
if($ref_params->[0] =~ /^(?:run|start|stop|status)$/i)
@@ -92,7 +92,7 @@ sub rss_main
return 1 if(see_rss($conn, $event, $reply_to, $ref_params));
}
}
-
+
$ref_params->[0] = 'rss';
Help::help_main($conn, $event, $reply_to, $ref_params);
} # Fin rss_main
@@ -105,11 +105,11 @@ sub rss_main
sub run_rss
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
return 0 if($event->{"nick"} ne $Config::owner);
-
+
my $cmd = shift @{$ref_params};
-
+
if($cmd =~ /^(?:run|start)$/i)
{
if(defined($ref_params->[0]))
@@ -120,9 +120,9 @@ sub run_rss
$conn->privmsg($reply_to, "No such schedule '$id'");
return 1;
}
-
+
my $sched_infos = $state{"schedules"}->{$id};
-
+
if($sched_infos->{"running"})
{
$conn->privmsg($reply_to, "The scheduled RSS '$id' is already running");
@@ -146,7 +146,7 @@ sub run_rss
$conn->privmsg($reply_to, "The RSS fetcher is now running");
$::logger->info("The RSS fetcher is now running...");
$state{"running"} = 1;
-
+
run_for_real($conn);
}
}
@@ -161,14 +161,14 @@ sub run_rss
$conn->privmsg($reply_to, "No such schedule '$id'");
return 1;
}
-
+
my $sched_infos = $state{"schedules"}->{$id};
-
+
if($sched_infos->{"running"})
{
$conn->parent->schedulequeue->dequeue($sched_infos->{"sched_id"})
if(defined($sched_infos->{"sched_id"}));
-
+
$sched_infos->{"running"} = 0;
$sched_infos->{"checking"} = 0;
$::logger->info("The scheduled RSS '$id' is new stopped");
@@ -183,13 +183,13 @@ sub run_rss
$conn->privmsg($reply_to, "The RSS fetcher is now stopped");
$::logger->info("The RSS fetcher is now stopped") if($state{"running"});
$state{"running"} = 0;
-
+
# On enlève chaque rss qui est dans la schedulequeue
foreach my $id (keys %{$state{"schedules"}})
{
$conn->parent->schedulequeue->dequeue($state{"schedules"}->{$id}->{"sched_id"})
if(defined($state{"schedules"}->{$id}->{"sched_id"}));
-
+
$state{"schedules"}->{$id}->{"running"} = 0;
$state{"schedules"}->{$id}->{"checking"} = 0;
}
@@ -205,11 +205,11 @@ sub run_rss
$conn->privmsg($reply_to, "No such schedule '$id'");
return 1;
}
-
+
my $sched_infos = $state{"schedules"}->{$id};
-
+
my $msg = "The schedule '$id' is in stage checking: ";
-
+
if($sched_infos->{"checking"})
{
$msg .= "YES, ";
@@ -218,9 +218,9 @@ sub run_rss
{
$msg .= "NO, ";
}
-
+
$msg .= "running: ";
-
+
if($sched_infos->{"running"})
{
$msg .= "YES";
@@ -229,7 +229,7 @@ sub run_rss
{
$msg .= "NO";
}
-
+
$conn->privmsg($reply_to, $msg);
}
else
@@ -244,7 +244,7 @@ sub run_rss
}
}
}
-
+
return 1;
} # Fin run_rss
@@ -256,16 +256,16 @@ sub run_rss
sub reloadfail_rss
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
return 0 if($event->{"nick"} ne $Config::owner);
-
+
# On enlève le "reloadfail"
shift @{$ref_params};
-
+
# S'il n'y a pas d'URL, wtf quoi
return 0 unless(defined($ref_params->[0]));
-
-
+
+
my $tmp = shift @{$ref_params};
my $url = undef;
if(!eval{ $url = qr/$tmp/i })
@@ -273,7 +273,7 @@ sub reloadfail_rss
$conn->privmsg($reply_to, "'$tmp' doesn't seem to be a correct regex for a URL");
return 1;
}
-
+
my @urls = ();
foreach my $id (keys %{$state{"schedules"}})
{
@@ -283,9 +283,9 @@ sub reloadfail_rss
push @urls, $state{"schedules"}->{$id}->{"url"};
}
}
-
+
$conn->privmsg($reply_to, "These urls have there 'fails' to 0: ".join(", ", @urls));
-
+
return 1;
} # Fin reloadfail_rss
@@ -297,7 +297,7 @@ sub reloadfail_rss
sub run_for_real
{
my ($conn, $schedule, $id) = @_;
-
+
if(defined($schedule) && defined($id))
{
if($schedule->{"running"})
@@ -308,17 +308,17 @@ sub run_for_real
}
if($schedule->{"checking"})
{
- $::displayer->sendto($schedule->{"reply_to"}->[0],
+ $::displayer->sendto($schedule->{"reply_to"}->[0],
$schedule->{"url"}.": Checking stage, wait for it please");
return 1;
}
if(!$state{"running"})
{
- $::displayer->sendto($schedule->{"reply_to"}->[0],
+ $::displayer->sendto($schedule->{"reply_to"}->[0],
$schedule->{"url"}.": The RSS module is not currently running");
return 1;
}
-
+
$schedule->{"checking"} = 1;
$::logger->debug("Checking '".$schedule->{"url"}."' for RSS feed compatibility");
check_stream($conn, $schedule, $id);
@@ -329,7 +329,7 @@ sub run_for_real
foreach $id (keys %{$state{"schedules"}})
{
$schedule = $state{"schedules"}->{$id};
-
+
# Si le schedule n'est pas lancé pour celui-là
if(!$schedule->{"running"} && !$schedule->{"checking"})
{
@@ -338,7 +338,7 @@ sub run_for_real
}
}
}
-
+
return 1;
} # Fin run_for_real
@@ -350,15 +350,15 @@ sub run_for_real
sub add_rss
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
# On enlève le 'add'
shift @{$ref_params};
-
+
return 0 if(!defined($ref_params->[0]));
-
+
$reply_to = lc $reply_to;
-
-
+
+
# add <url> [[every] <nb> <period>]
my %sched_infos = (
"sched_id" => undef,
@@ -372,28 +372,28 @@ sub add_rss
"last_titles" => [],
"fails" => 0
);
-
+
my $url = lc shift @{$ref_params};
-
-
+
+
# [[every] <nb> <period>] [grep <regex>]
if($url =~ m#^https?://#i)
{
$sched_infos{"url"} = $url;
-
+
if(&already_registered($url, $reply_to))
{
$conn->privmsg($reply_to, "'$url' is already registered for this channel");
return 1;
}
-
+
my $reply = "";
-
+
# Si on a plus que seulement l'url
if(defined($ref_params->[0]))
{
my $re = join(' ', @{$ref_params});
-
+
if($re =~ /^(?:(?:every )?(\d+)?\s*(\w+))?\s*(?:grep(?: on)? (.+))?$/i)
{
my $every_min = $1;
@@ -401,11 +401,11 @@ sub add_rss
{
my $period = $2;
$period =~ s/s$//;
-
+
if(defined($periods{$period}))
{
$sched_infos{"period"} = $periods{$period};
-
+
$sched_infos{"period"} *= int($every_min) if(defined($every_min) && $every_min ne '');
}
else
@@ -414,7 +414,7 @@ sub add_rss
.($Config::rss_default_period / 60)."mins). ";
}
}
-
+
if(defined($3) && $3 ne '')
{
my $prere = $3;
@@ -430,27 +430,27 @@ sub add_rss
}
}
}
-
-
+
+
$reply .= "'$url' added, entering checking mode";
$conn->privmsg($reply_to, $reply);
-
+
$reply = "Added URL for RSS stream: $url on $reply_to every "
.$sched_infos{"period"}."s (checking stage begin...)";
$reply .= " grep on '".$sched_infos{"grep"}."'" if(defined($sched_infos{"grep"}));
-
+
$::logger->debug($reply);
-
+
my $id = get_next_id(lc $reply_to);
$state{"schedules"}->{$id} = \%sched_infos;
-
+
run_for_real($conn, \%sched_infos, $id);
}
else
{
$conn->privmsg($reply_to, "This URL ($url) doesn't seem valid");
}
-
+
return 1;
} # Fin add_rss
@@ -462,7 +462,7 @@ sub add_rss
sub already_registered
{
my ($url, $chan) = @_;
-
+
foreach my $id (keys %{$state{"schedules"}})
{
return 1 if(
@@ -470,7 +470,7 @@ sub already_registered
Common::is_in_list($state{"schedules"}->{$id}->{"reply_to"}, $chan)
);
}
-
+
return 0;
} # Fin already_registered
@@ -482,15 +482,15 @@ sub already_registered
sub del_rss
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
# On enlève le 'del'
shift @{$ref_params};
-
+
return 0 if(!defined($ref_params->[0]));
-
+
$reply_to = lc $reply_to;
-
-
+
+
# del <url>
my $tmp = shift @{$ref_params};
my $url = undef;
@@ -499,37 +499,37 @@ sub del_rss
$conn->privmsg($reply_to, "'$tmp' doesn't seem to be a correct regex for a URL");
return 1;
}
-
-
+
+
my %deleted = ();
foreach my $id (keys %{$state{"schedules"}})
{
my ($chan) = split / /, $id;
-
+
# Next si la cible n'est pas sur le même chan/query
next unless lc $reply_to eq lc $chan;
-
+
if(substr($chan, 0, 1) eq '#')
{
# Next si on n'est pas op sur le chan
next unless Chans::is_op($chan, $event->{"nick"}) or $event->{"nick"} eq $Config::owner;
}
-
-
+
+
# On regarde si ça correspond
if($state{"schedules"}->{$id}->{"url"} =~ $url || $state{"schedules"}->{$id}->{"master_title"} =~ $url)
{
$deleted{$state{"schedules"}->{$id}->{"url"}} = "";
-
+
$conn->parent->schedulequeue->dequeue($state{"schedules"}->{$id}->{"sched_id"})
if(defined($state{"schedules"}->{$id}->{"sched_id"}));
-
+
$state{"schedules"}->{$id}->{"sched_id"} = undef;
delete $state{"schedules"}->{$id};
}
}
-
-
+
+
# Résultat...
$::logger->debug("Deletion: '".join("', '", keys %deleted)."'");
if(%deleted && defined((keys %deleted)[1]))
@@ -544,7 +544,7 @@ sub del_rss
{
$conn->privmsg($reply_to, "No URL found to delete");
}
-
+
return 1;
} # Fin del_rss
@@ -556,31 +556,31 @@ sub del_rss
sub change_rss
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
# On enlève le 'change'
shift @{$ref_params};
-
+
return 0 if(!defined($ref_params->[0]));
-
+
my $url = lc shift @{$ref_params};
-
+
if($url =~ m#^https?://#i)
{
shift @{$ref_params} if(defined($ref_params->[0]) && $ref_params->[0] =~ /^to$/i);
shift @{$ref_params} if(defined($ref_params->[0]) && $ref_params->[0] =~ /^every$/i);
-
+
if(defined($ref_params->[0]) && defined($ref_params->[1]))
{
if($ref_params->[0] =~ /^\d+$/ && defined($periods{$ref_params->[1]}))
{
my $new_period = $ref_params->[0] * $periods{$ref_params->[1]};
-
+
my $schedule = undef;
-
+
foreach my $id (keys %{$state{"schedules"}})
{
my ($chan_added) = split / /, $id;
-
+
if(
$state{"schedules"}->{$id}->{"url"} eq $url
&& $chan_added eq lc $reply_to
@@ -590,15 +590,15 @@ sub change_rss
last;
}
}
-
+
if(!defined($schedule))
{
$conn->privmsg($reply_to, "'$url' doesn't seem to be registered");
return 1;
}
-
+
$schedule->{"period"} = $new_period;
-
+
$conn->privmsg($reply_to, "'$url' will be scheduled every ${new_period}s");
}
else
@@ -615,7 +615,7 @@ sub change_rss
{
$conn->privmsg($reply_to, "This URL ($url) doesn't seem valid");
}
-
+
return 1;
} # Fin change_rss
@@ -627,21 +627,21 @@ sub change_rss
sub see_rss
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
# On enlève le 'see'
shift @{$ref_params};
-
+
# see [#chan] [<url>]
my $url = undef;
my $chan_see = undef;
-
+
if(defined($ref_params->[0]) && substr($ref_params->[0], 0, 1) eq "#")
{
$chan_see = lc shift @{$ref_params};
}
-
+
$chan_see = $reply_to unless defined $chan_see;
-
+
if(defined($ref_params->[0]))
{
my $tmp = $ref_params->[0];
@@ -651,15 +651,15 @@ sub see_rss
return 1;
}
}
-
-
+
+
my @to_see = ();
-
+
foreach my $id (keys %{$state{"schedules"}})
{
my ($chan) = split / /, $id;
-
-
+
+
if(substr($chan, 0, 1) eq '#')
{
next unless Chans::is_op($chan, $event->{"nick"}) or $event->{"nick"} eq $Config::owner;
@@ -668,8 +668,8 @@ sub see_rss
{
next unless lc $reply_to eq lc $chan;
}
-
-
+
+
# On regarde si ça correspond
if(
(!defined($url) || $state{"schedules"}->{$id}->{"url"} =~ $url
@@ -681,9 +681,9 @@ sub see_rss
push @to_see, $id;
}
}
-
-
-
+
+
+
# Résultat...
if(@to_see && defined($to_see[1]))
{
@@ -693,13 +693,13 @@ sub see_rss
elsif(@to_see)
{
my $msg = "Only one found:";
-
+
$msg .= " \x02".$state{"schedules"}->{$to_see[0]}->{"master_title"}."\x02"
if(defined($state{"schedules"}->{$to_see[0]}->{"master_title"}));
-
+
$msg .= " '".$state{"schedules"}->{$to_see[0]}->{"url"}."' every "
.$state{"schedules"}->{$to_see[0]}->{"period"}."s";
-
+
if(
defined($state{"schedules"}->{$to_see[0]}->{"grep"})
&& $state{"schedules"}->{$to_see[0]}->{"grep"} ne ""
@@ -707,55 +707,55 @@ sub see_rss
{
$msg .= ", grep on '".$state{"schedules"}->{$to_see[0]}->{"grep"}."'";
}
-
+
$msg .= ", displays on ".join(', ', @{$state{"schedules"}->{$to_see[0]}->{"reply_to"}});
-
+
my $next_update = $state{"schedules"}->{$to_see[0]}->{"last_update"}
+ $state{"schedules"}->{$to_see[0]}->{"period"};
$msg .= ". Next update: ".localtime($next_update);
-
-
+
+
$conn->privmsg($reply_to, $msg);
}
else
{
$conn->privmsg($reply_to, "No URL found");
}
-
+
return 1;
} # Fin see_rss
# ###
# rss_on_kick
-#
+#
# ###
sub rss_on_kick
{
my ($conn, $event) = @_;
-
+
# On regarde si c'est nous qui avons été kické
if($event->{'to'}[0] eq $Config::nick)
{
my $kicked_chan = $event->{'args'}[0];
my @deleted = ();
-
+
foreach my $id (keys %{$state{"schedules"}})
{
my ($chan) = split / /, $id;
-
+
if(lc $kicked_chan eq lc $chan)
{
push @deleted, $state{"schedules"}->{$id}->{"url"};
-
+
$conn->parent->schedulequeue->dequeue($state{"schedules"}->{$id}->{"sched_id"})
if(defined($state{"schedules"}->{$id}->{"sched_id"}));
-
+
$state{"schedules"}->{$id}->{"sched_id"} = undef;
delete $state{"schedules"}->{$id};
}
}
-
+
if(@deleted)
{
$::logger->info("Kick event removed these URLs: '".join("', '", @deleted)."'");
@@ -771,24 +771,24 @@ sub rss_on_kick
sub check_stream
{
my ($conn, $schedule, $id) = @_;
-
+
# On créé la requête
my $htmlreq = new HTMLRequests($conn);
-
+
my $url = $schedule->{"url"};
my $method = "GET";
my $raw_result = 0;
my $callback = \&check_stream_cb;
-
+
my %params = (
"schedule" => $schedule,
"id" => $id
);
-
+
# Et on lance la requête
$::logger->info("Running RSS check for url '$url'");
- $htmlreq->wget($url, $method, undef, $raw_result, $callback, \%params);
-
+ $htmlreq->wget($url, $method, undef, $raw_result, $callback, \%params);
+
return 1;
} # Fin check_stream
@@ -802,28 +802,28 @@ sub check_stream_cb
my ($conn, $status, $buffer, $params) = @_;
my $url = $params->{"schedule"}->{"url"};
$::logger->debug("RSS result received for URL '$url' (id ".$params->{"id"}.")\n");
-
+
my $reply_to = $params->{"schedule"}->{"reply_to"};
-
+
# On vérifie le statut récupéré de l'url
- if($status)
+ if($status != -1)
{
my $parser = HTML::TokeParser::Simple->new("string" => $buffer);
-
+
# On récupère le titre principal du flux RSS
$parser->get_tag("title");
$params->{"schedule"}->{"master_title"} = $parser->get_text();
-
-
+
+
if(!$parser->get_tag("item"))
{
send_chans($conn, "Can't find usable content in '$url', deleting this URL", $reply_to);
$::logger->debug("Can't find item tag in '$url' source code, deleting");
-
+
delete $state{"schedules"}->{$params->{"id"}};
return 1;
}
-
+
# On récupère seulement un titre pour le check
$parser->get_tag("title");
my $title = $parser->get_text();
@@ -833,18 +833,18 @@ sub check_stream_cb
$title =~ s/\s+/ /g;
$title =~ s/\n/ /g;
$title =~ s/^\s*(.*?)\s*$/$1/;
-
+
$parser->get_tag("link");
my $link = $parser->get_text();
-
+
$::logger->debug("Found title '$title' and link '$link', the RSS feed '$url'");
-
+
$params->{"schedule"}->{"last_titles"} = [$title];
-
+
# On donne le dernier titre en disant que c'est oki, que le flux sera suivi
send_chans($conn, "\x0304[\x0303$url\x0304]\x03 Last title is \x02$title\x02 \x0302$link\x03 scheduled every ".
$params->{"schedule"}->{"period"}."s", $reply_to);
-
+
# Enfin, on lance le schedule
$params->{"schedule"}->{"running"} = 1;
$params->{"schedule"}->{"checking"} = 0;
@@ -862,10 +862,10 @@ sub check_stream_cb
# On prévient que l'url est injoignable
send_chans($conn, "'$url' isn't reachable, aborting", $reply_to);
$::logger->debug("'$url' isn't reachable, aborting");
-
+
delete $state{"schedules"}->{$params->{"id"}};
}
-
+
return 1;
} # Fin check_stream_cb
@@ -877,23 +877,23 @@ sub check_stream_cb
sub get_stream
{
my ($conn, $schedule, $id) = @_;
-
+
# On créé la requête
my $htmlreq = new HTMLRequests($conn);
-
+
my $url = $schedule->{"url"};
my $method = "GET";
my $raw_result = 0;
my $callback = \&get_stream_cb;
-
+
my %params = (
"schedule" => $schedule,
"id" => $id
);
-
+
# Et on lance la requête
- $htmlreq->wget($url, $method, undef, $raw_result, $callback, \%params);
-
+ $htmlreq->wget($url, $method, undef, $raw_result, $callback, \%params);
+
return 1;
} # Fin get_stream
@@ -907,38 +907,38 @@ sub get_stream_cb
my ($conn, $status, $buffer, $params) = @_;
my $url = $params->{"schedule"}->{"url"};
$::logger->debug("RSS result received for URL '$url'\n");
-
+
my $reply_to = $params->{"schedule"}->{"reply_to"};
my $grep = $params->{"schedule"}->{"grep"};
-
+
# On undef le sched_id car le schedule n'est plus dans la queue
$params->{"schedule"}->{"sched_id"} = undef;
-
+
# On vérifie le statut récupéré de l'url
- if($status)
+ if($status != -1)
{
# On récupère le dernier titre
my $parser = HTML::TokeParser::Simple->new("string" => $buffer);
my $tag = undef;
-
+
my @titles = ();
my @urls = ();
my $too_much = 0;
my $found_at_least_one_tag = 0;
-
+
while(1)
{
$tag = $parser->get_tag("item");
if(!$tag)
{
last if(@titles || $found_at_least_one_tag);
-
+
$params->{"schedule"}->{"fails"} += 1;
-
+
my $msg = "Can't find usable content in '$url', "
."the URL may have changed or something else went wrong";
my $logfile = debug_big_buffer($buffer);
-
+
if($params->{"schedule"}->{"fails"} >= $max_fails)
{
# Au bout d'un certain nombre de fails, on arrête
@@ -950,11 +950,15 @@ sub get_stream_cb
else
{
# On n'a pas encore atteint le quota de fails, on continue
- $msg .= " (fails: ".$params->{"schedule"}->{"fails"}."/$max_fails)";
- send_chans($conn, $msg, $reply_to);
-
+ if($params->{"schedule"}->{"fails"} >= $max_fails * 7/10)
+ {
+ # But send a warning to the user only at 70% of the max_fails
+ $msg .= " (fails: ".$params->{"schedule"}->{"fails"}."/$max_fails)";
+ send_chans($conn, $msg, $reply_to);
+ }
+
$::logger->debug("Can't find item tag in '$url' source code, see $logfile");
-
+
$params->{"schedule"}->{"sched_id"} = $conn->{"cmdtool"}->schedule(
$params->{"schedule"}->{"period"},
\&get_stream,
@@ -963,13 +967,13 @@ sub get_stream_cb
);
$::logger->debug("Rescheduled '$url' in ".$params->{"schedule"}->{"period"}."s");
}
-
+
return 1;
}
-
+
next if($tag->is_end_tag);
$found_at_least_one_tag = 1;
-
+
# On récupère un titre
$parser->get_tag("title");
my $title = $parser->get_text();
@@ -979,8 +983,8 @@ sub get_stream_cb
$title =~ s/\s+/ /g;
$title =~ s/\n/ /g;
$title =~ s/^\s*(.*?)\s*$/$1/;
-
-
+
+
# On arrête de parser lorsqu'on a fini de récupérer tous les nouveaux titres
last if(Common::is_in_list($params->{"schedule"}->{"last_titles"}, $title));
# Ou lorsqu'on atteint les 5 URLs (on sait jamais)
@@ -989,29 +993,29 @@ sub get_stream_cb
$too_much = 1;
last;
}
-
+
# On passe à l'url suivante si grep a été défini et qu'on matche pas
next if(defined($grep) && $title !~ $grep);
-
+
$::logger->debug("'$title' matches $grep") if(defined($grep));
-
-
+
+
$parser->get_tag("link");
my $link = $parser->get_text();
-
+
push @titles, $title;
push @urls, $link;
-
+
$::logger->debug("Found title '$title' and link '$link' the RSS feed '$url'");
}
-
-
+
+
# On donne les derniers titres en disant que c'est oki, que le flux sera suivi
if(@titles)
{
my $title = $url;
$title = $params->{"schedule"}->{"master_title"} if(defined($params->{"schedule"}->{"master_title"}));
-
+
if(defined $titles[1])
{
my $msg = "\x0304[\x0303$title\x0304]\x03 New entries are ";
@@ -1023,9 +1027,9 @@ sub get_stream_cb
$msg .= "\x0307|\x03 ";
}
$msg .= "\x02".$titles[$max]."\x02 \x0302".$urls[$max]."\x03";
-
+
$msg .= ". There may be more new URLs, checkout by yourself!" if($too_much);
-
+
send_chans($conn, $msg, $reply_to);
}
else
@@ -1033,17 +1037,17 @@ sub get_stream_cb
send_chans($conn, "\x0304[\x0303$title\x0304]\x03 New entry found: \x02"
.$titles[0]."\x02 \x0302".$urls[0]."\x03", $reply_to);
}
-
-
+
+
my @merge = (@titles, @{$params->{"schedule"}->{"last_titles"}});
pop @merge while($#merge > $nb_last_titles);
-
+
$params->{"schedule"}->{"last_titles"} = \@merge;
}
-
+
# Enfin, on relance le schedule si c'est toujours oki
return if(!$state{"running"} && $params->{"schedule"}->{"running"});
-
+
$params->{"schedule"}->{"sched_id"} = $conn->{"cmdtool"}->schedule(
$params->{"schedule"}->{"period"},
\&get_stream,
@@ -1053,7 +1057,7 @@ sub get_stream_cb
$params->{"schedule"}->{"fails"} = 0;
$params->{"schedule"}->{"last_update"} = time;
$::logger->debug("Rescheduled '$url' in ".$params->{"schedule"}->{"period"}."s (".$params->{"id"}.")");
-
+
# Sometimes bug just happen
if(!defined($state{"schedules"}->{$params->{"id"}}))
{
@@ -1064,15 +1068,15 @@ sub get_stream_cb
{
# On prévient que l'url est injoignable
$params->{"schedule"}->{"fails"} += 1;
-
+
my $msg = "'$url' isn't reachable anymore";
-
+
if($params->{"schedule"}->{"fails"} >= $max_fails)
{
# Au bout d'un certain nombre de fails, on arrête
$msg .= ". Deleting this URL.";
delete $state{"schedules"}->{$params->{"id"}};
-
+
send_chans($conn, $msg, $reply_to);
$::logger->debug("Can't find item tag in '$url' source code");
}
@@ -1082,7 +1086,7 @@ sub get_stream_cb
$msg .= " (fails: ".$params->{"schedule"}->{"fails"}."/$max_fails)";
send_chans($conn, $msg, $reply_to);
$::logger->debug("Can't find item tag in '$url' source code");
-
+
$params->{"schedule"}->{"sched_id"} = $conn->{"cmdtool"}->schedule(
$params->{"schedule"}->{"period"},
\&get_stream,
@@ -1102,10 +1106,10 @@ sub get_stream_cb
sub get_next_id
{
my $from = shift;
-
+
my $cpt = 0;
$cpt++ while(defined($state{"schedules"}->{$from." ".$cpt}));
-
+
return $from." ".$cpt;
} # Fin get_next_id
@@ -1117,7 +1121,7 @@ sub get_next_id
sub send_chans
{
my ($conn, $msg, $to) = @_;
-
+
foreach my $chan_q (@{$to})
{
$::displayer->sendto($chan_q, $msg);
@@ -1133,26 +1137,26 @@ sub send_chans
sub debug_big_buffer
{
my $buffer = shift;
-
+
# Sauvegarde de l'ancien fichier de log
my $last_logfile = $::logger->file;
-
+
# Création du nom du fichier
my $logdir = $Config::logs_dir;
$logdir =~ s#/+$##;
-
+
my $time = scalar localtime(time);
$time =~ s/\s+/-/g;
my $new_logfile = $Config::logs_dir."/rss-$time.log";
-
+
# Changement du fichier de log
$::logger->file($new_logfile);
# Écriture du buffer
$::logger->debug($buffer);
-
+
# Restauration de l'ancien fichier de log
$::logger->file($last_logfile);
-
+
return $new_logfile;
}
@@ -1163,9 +1167,9 @@ sub debug_big_buffer
sub rss_help
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
shift @{$ref_params};
-
+
if($event->{"nick"} eq $Config::owner)
{
$conn->privmsg($reply_to, "`".$Config::command_sign."rss {run|stop|status} [<id>]`"
@@ -1173,15 +1177,15 @@ sub rss_help
$conn->privmsg($reply_to, "`".$Config::command_sign."rss reloadfail <URL>`"
." => change fail value to 0 for <URL>");
}
-
-
+
+
$conn->privmsg($reply_to, "`".$Config::command_sign."rss {add <URL> [every <nb> <period>] [grep <regex>]|del {<URL>|<Feed title>}}`"
." => Add/remove a <URL> to fetch (check every hour by default), grep <regex> on news title");
$conn->privmsg($reply_to, "`".$Config::command_sign."rss change <URL> to every <nb> <period>`"
." => Change fetch period of a <URL>");
$conn->privmsg($reply_to, "`".$Config::command_sign."rss see [<#chan>] [<URL>|<Feed title>]`"
." => See what you have asked to monitor");
-
+
return 1;
} # Fin rss_help
@@ -1191,13 +1195,13 @@ sub rss_help
sub rss_save
{
my ($conn, $folder, $reloading) = @_;
-
+
my $file_rss = $folder."/rss".$Config::suffixe.".sav";
-
+
store \%state, $file_rss;
-
+
EventHandler::remove_event("kick", "after", \&rss_on_kick) if $reloading;
-
+
return 1;
} # Fin rss_save
@@ -1205,19 +1209,21 @@ sub rss_save
sub rss_load
{
my ($conn, $folder, $reloading) = @_;
-
+
my $file_rss = $folder."/rss".$Config::suffixe.".sav";
-
+
my $stateref = retrieve $file_rss;
-
+
+ my $currtime = time;
+
%state = %{$stateref};
-
+
foreach my $id (keys %{$state{"schedules"}})
{
my $schedule = $state{"schedules"}->{$id};
-
- $schedule->{"last_update"} = 0;
-
+
+ $schedule->{"last_update"} = $currtime;
+
if($state{"running"} && !defined($reloading) && $schedule->{"running"})
{
$schedule->{"running"} = 0;
@@ -1225,12 +1231,12 @@ sub rss_load
run_for_real($conn, $schedule, $id);
}
}
-
-
+
+
# Ajout d'un handler pour supprimer les rss du chan d'où on se fait kick
EventHandler::add_event("kick", "after", \&rss_on_kick);
-
-
+
+
return 1;
} # Fin rss_load
diff --git a/Modules/Television.pm b/Modules/Television.pm
index 54550ec812d984f6477ef63c4aa686c932342746..15da4f208f2999a4d447ca2627de0d22957895b3 100644
--- a/Modules/Television.pm
+++ b/Modules/Television.pm
@@ -12,7 +12,7 @@ my $url = 'http://www.programme-television.org/programme-television-maintenant?b
# Table des chaines servant à construire la regexp pour la commande !tv <chaine>
-my %table_chaines = (
+my %table_chaines = (
"TF1" => 0,
"France2" => 1,
"France3" => 2,
@@ -110,7 +110,7 @@ sub send_result
my ($conn, $status, $buffer, $params) = @_;
$::logger->debug("Television result received\n");
- if($status)
+ if($status != -1)
{
$::logger->debug("Status ok\n");
diff --git a/Modules/Translation.pm b/Modules/Translation.pm
index f3626f38cd014743f12ff65df6390937ce1c743e..52b3d5526f46023070a5dd7275ed4d4ac5745e14 100644
--- a/Modules/Translation.pm
+++ b/Modules/Translation.pm
@@ -1,7 +1,6 @@
package Translation; # command = trad,translation
-# use HTML::TokeParser::Simple;
-use JSON qw( decode_json );
+use JSON;
use URI::Escape;
use Common;
@@ -68,17 +67,17 @@ my %table_traduction = (
# ###
# translation_main
-# Traduit
-#
+# Traduit
+#
# Usage :
# !trad <init_lang> <end_lang> <text>
# ###
sub trad_main
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
return 0 unless(defined($ref_params->[2]));
-
+
my $prec = '';
if($ref_params->[0] =~ /^-(.*)$/)
{
@@ -86,38 +85,33 @@ sub trad_main
shift @{$ref_params};
return 0 unless(defined($ref_params->[2]));
}
-
+
my $init_lang = shift @{$ref_params};
my $end_lang = shift @{$ref_params};
- my $to_translate = join('+', @{$ref_params});
-
+ my $to_translate = join(' ', @{$ref_params});
+
$init_lang = &get_two_char_lang($init_lang);
$end_lang = &get_two_char_lang($end_lang);
-
+
if($init_lang eq $end_lang)
{
$conn->privmsg($reply_to, join(' ', @{$ref_params}));
return 1;
}
-
+
return 0 unless(defined($init_lang) && defined($end_lang));
-
+
my $htmlreq = new HTMLRequests($conn);
-
+
# Échappement des caractères spéciaux
- my $to_translate = uri_escape($to_translate);
-
- my $url = "http://translate.google.fr/translate_a/t?client=t&text=$to_translate&sl=$init_lang&tl=$end_lang&ie=UTF-8&oe=UTF-8&multires=1&ssel=0&tsel=0&sc=1";
-# my $url = "http://translate.google.fr/translate_t?hl=fr&ie=UTF-8&text=$to_translate&sl=$init_lang&tl=$end_lang";
- my $method = "POST";
- my %req_params = (
- "text" => join(' ', @{$ref_params}),
- "sl" => $init_lang,
- "tl" => $end_lang
- );
+ $to_translate = uri_escape($to_translate);
+
+ my $url = "https://translate.google.fr/translate_a/single?client=t&sl=$init_lang&tl=$end_lang&dt=bd&dt=ex&dt=ld&dt=md&dt=qca&dt=rw&dt=rm&dt=ss&dt=t&dt=at&ie=UTF-8&oe=UTF-8&ssel=3&tsel=3&kc=0&q=$to_translate";
+ my $method = "GET";
+ my %req_params = ();
my $raw_result = 0;
my $callback = \&send_result;
-
+
my %params = (
"event" => $event,
"reply_to" => $reply_to,
@@ -126,9 +120,9 @@ sub trad_main
"init" => $init_lang,
"end" => $end_lang
);
-
+
$htmlreq->wget($url, $method, \%req_params, $raw_result, $callback, \%params);
-
+
return 1;
} # Fin trad_main
@@ -137,21 +131,32 @@ sub send_result
{
my ($conn, $status, $buffer, $params) = @_;
$::logger->debug("Translation result received\n");
-
- if($status)
+
+ if($status != -1)
{
$::logger->debug("Status ok\n");
-
- my $trad = [];
- # FIXME Quand la lib JSON (ou JSON::XS, je sais pas trop) arrivera à
- # parser du JSON, on pourra corriger ça...
- # (notez que c'est pas bien de faire un eval de trucs reçus d'internet !)
- eval "\$trad = $buffer;";
-
- my $main_trad = $trad->[0]->[0]->[0];
-
+ if($buffer =~ /<!DOCTYPE/)
+ {
+ $::displayer->sendto($params->{"reply_to"}, "I'm being banned from Google at the moment, please try again later.");
+ $::logger->info("Being banned from google right now\n");
+ # TODO voir pour rajouter un timer histoire de pas refaire de requêtes à google...
+ return;
+ }
+
+ # Google ne semble pas respecter la norme JSON, decode_json n'aime pas
+ # ça, donc on remet le buffer en normé
+ $buffer =~ s/,(?=,)/,null/g;
+ $buffer =~ s/\[,+/[null,/g;
+ my $trad = decode_json($buffer);
+
+ my @main_trad = ();
+ foreach my $t (@{$trad->[0]})
+ {
+ push(@main_trad, $t->[0]) if($#{$t} > 0);
+ }
+
my %precise = ();
-
+
if($#{$params->{'text'}} == 0 && defined($trad->[1]))
{
foreach my $more (@{$trad->[1]})
@@ -171,9 +176,13 @@ sub send_result
}
}
}
-
- my $trads = $main_trad;
-
+
+ my $trads = join('', @main_trad);
+ if($params->{'init'} eq 'auto')
+ {
+ $trads .= " \x0303(".$trad->[2].")\x03";
+ }
+
if(keys %precise)
{
if($params->{'prec'} && defined($precise{'--'.$params->{'prec'}.'-plus--'}))
@@ -194,7 +203,7 @@ sub send_result
}
}
}
-
+
if($trads)
{
$::displayer->sendto($params->{"reply_to"}, $trads);
@@ -205,10 +214,10 @@ sub send_result
$::displayer->sendto($params->{"reply_to"}, "No translation found (empty result)");
$::logger->debug("Empty translation result for '" . join(' ', @{$params->{'text'}}) . "'\n");
}
-
+
return;
}
-
+
$::logger->debug("Status not ok\n'''");
$::logger->debug($buffer);
$::logger->debug("'''\n");
@@ -222,12 +231,12 @@ sub get_two_char_lang
$lang = lc $lang if($lang ne "zh-CN");
return $lang if(length $lang == 2 || $lang eq "zh-CN");
-
+
if(defined($table_traduction{$lang}))
{
return $table_traduction{$lang};
}
-
+
return;
}
@@ -235,7 +244,7 @@ sub get_two_char_lang
sub trad_help
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
$conn->privmsg($reply_to, "`".$Config::command_sign.$ref_params->[0]." [-<prec>] <init_lang> <end_lang> <text>` => will translate <text>, <prec> is used to be more accurate following what's returned (e.g.: name, nom, verb, ...)");
$conn->privmsg($reply_to, "There are these languages: français (fr), albanais (sq), allemand (de), anglais (en), arabe (ar), bulgare (bg), catalan (ca), Chinois (zh-CN), coréen (ko), croate (hr), danois (da), espagnol (es), estonien (et), finnois (fi), galicien (gl), grec (el), hébreu (iw), hindi (hi), hongrois (hu), indonésien (id), italien (it), japonais (ja), letton (lv), lituanien (lt), maltais (mt), néerlandais (nl), norvégien (no), polonais (pl), portugais (pt), roumain (ro), russe (ru), serbe (sr), slovaque (sk), slovène (sl), suédois (sv), tagalog (tl), tchèque (cs), thaï (th), turc (tr), ukrainien (uk), vietnamien (vi)");
} # Fin trad_help
diff --git a/Modules/UrbanDictionary.pm b/Modules/UrbanDictionary.pm
index 62c35588cef162bccf52df681903f4714461388f..0104e9aa590f3501235df8d03edf073efae1bae8 100644
--- a/Modules/UrbanDictionary.pm
+++ b/Modules/UrbanDictionary.pm
@@ -46,12 +46,12 @@ sub ud_main
sub send_result
-{
- my ($conn, $status, $buffer, $params) = @_;
- $::logger->debug("UrbanDictionary result received\n");
+{
+ my ($conn, $status, $buffer, $params) = @_;
+ $::logger->debug("UrbanDictionary result received\n");
- if($status)
- {
+ if($status != -1)
+ {
$::logger->debug("Status ok\n");
my $msg = $params->{"url"};
diff --git a/Modules/Vote.pm b/Modules/Vote.pm
index 801e2278b7897d6483e79de14f2a69876103ef5f..ed1b937fbb2cd663ea14f225e777c11620fe7c8f 100644
--- a/Modules/Vote.pm
+++ b/Modules/Vote.pm
@@ -31,7 +31,7 @@ our %last_added = ();
# ###
# vote_main
# Permet de gérer des votes
-#
+#
# Usage :
# !vote new <question>
# !vote del <id>
@@ -42,14 +42,14 @@ our %last_added = ();
sub vote_main
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
# Don't use in query, only on chans
unless(substr($reply_to, 0, 1) eq '#')
{
$::displayer->sendto($reply_to, "Can't operate in query, sorry.");
return 1;
}
-
+
if(defined($ref_params->[0]) && $ref_params->[0])
{
if($ref_params->[0] eq 'new')
@@ -73,7 +73,7 @@ sub vote_main
return 1 if(vote($conn, $event, $reply_to, $ref_params));
}
}
-
+
$ref_params->[0] = 'vote';
Help::help_main($conn, $event, $reply_to, $ref_params);
} # Fin vote_main
@@ -86,22 +86,22 @@ sub vote_main
sub new_vote
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
# On enlève le 'new'
shift @{$ref_params};
-
+
unless(defined($ref_params->[0]) && $ref_params->[0])
{
$::displayer->sendto($reply_to, "Didn't find your question.");
return 0;
}
-
+
my $lc_reply_to = lc $reply_to;
my $id = get_next_id($lc_reply_to);
my (undef, $vote_id) = split / +/, $id;
my $question = join(' ', @{$ref_params});
my $full_user = (lc $event->{'nick'}).'!'.(lc $event->{'userhost'});
-
+
my %new_vote = (
'chan' => $lc_reply_to,
'id' => $vote_id,
@@ -114,14 +114,14 @@ sub new_vote
},
'author' => $full_user
);
-
+
$votes{$id} = \%new_vote;
$last_added{$lc_reply_to} = $vote_id;
-
+
my $add_date = localtime($votes{$id}->{'added date'});
$::displayer->sendto($reply_to, "Vote \x0304[\x0303id #$vote_id\x0304]\x03 added on $add_date");
$::logger->info("New vote: '$question', id='$id', added by $full_user");
-
+
return 1;
} # Fin new_vote
@@ -133,16 +133,16 @@ sub new_vote
sub del_vote
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
# On enlève le 'del' ou autre
shift @{$ref_params};
-
+
unless(defined($ref_params->[0]))
{
$::displayer->sendto($reply_to, "Didn't find the id.");
return 0;
}
-
+
my $lc_reply_to = lc $reply_to;
my $vote_id = $ref_params->[0];
if($ref_params->[0] =~ /^#?(\d+)$/)
@@ -151,13 +151,13 @@ sub del_vote
}
my $id = $lc_reply_to.' '.$vote_id;
my $full_user = (lc $event->{'nick'}).'!'.(lc $event->{'userhost'});
-
+
# On vérifie que c'est bien l'auteur qui demande la suppression du vote
if(defined($votes{$id}) && $votes{$id}->{'author'} eq $full_user)
{
return real_del_vote($id, $lc_reply_to);
}
-
+
$::displayer->sendto($reply_to, "Can't find this vote on this chan or you're not authorized.");
return 1;
} # Fin del_vote
@@ -170,16 +170,16 @@ sub del_vote
sub real_del_vote
{
my ($id, $reply_to) = @_;
-
+
my $question = $votes{$id}->{'question'};
my $yes = $votes{$id}->{'results'}->{'yes'};
my $no = $votes{$id}->{'results'}->{'no'};
-
+
delete $votes{$id};
$::displayer->sendto($reply_to, "Vote for '$question' deleted");
$::displayer->sendto($reply_to, "Final results: yes = \x0303$yes\x03 - no = \x0304$no\x03");
$::logger->info("Vote removed: '$question', id='$id'. Results: yes=$yes, no=$no");
-
+
return 1;
} # Fin real_del_vote
@@ -191,15 +191,15 @@ sub real_del_vote
sub list_votes
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
shift @{$ref_params};
-
+
my $to_check_chan = lc $reply_to;
if(defined($ref_params->[0]) && substr($ref_params->[0], 0, 1) eq '#')
{
$to_check_chan = lc $ref_params->[0];
}
-
+
my %current_votes = ();
foreach my $id (sort keys %votes)
{
@@ -208,17 +208,17 @@ sub list_votes
$current_votes{$id} = $votes{$id};
}
}
-
+
my @curr_votes = sort keys %current_votes;
my $msg = "";
-
+
if(@curr_votes)
{
foreach my $id (@curr_votes)
{
$msg .= "\x0307{#" . $votes{$id}->{'id'} . "\x03";
$msg .= " Added by \x0304" . $votes{$id}->{'author'};
- $msg .= "on \x0302" . localtime($votes{$id}->{'added date'});
+ $msg .= "\x0302 on " . localtime($votes{$id}->{'added date'});
$msg .= "\x0307}\x03 ";
}
}
@@ -227,7 +227,7 @@ sub list_votes
$msg = "There's currently no vote on $to_check_chan";
}
$::displayer->sendto($reply_to, $msg);
-
+
return 1;
} # Fin list_votes
@@ -239,36 +239,36 @@ sub list_votes
sub see_vote
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
# On enlève le 'see'
shift @{$ref_params};
-
+
unless(defined($ref_params->[0]))
{
$::displayer->sendto($reply_to, "Didn't find the id.");
return 0;
}
-
+
my $lc_reply_to = lc $reply_to;
my $vote_id = $ref_params->[0];
my $id = $lc_reply_to." ".$vote_id;
-
+
# On vérifie que le vote existe
if(defined($votes{$id}))
{
my $msg = "Vote \x0304[\x0303id #$vote_id\x0304]\x03: ";
$msg .= $votes{$id}->{'question'};
$msg .= " -- \x0302Added on " . localtime($votes{$id}->{'added date'});
-
+
$::displayer->sendto($reply_to, $msg);
-
+
# Public/private?
# if(lc $event->{'nick'} eq $votes{$id}->{'author'})
{
my $yes = $votes{$id}->{'results'}->{'yes'};
my $no = $votes{$id}->{'results'}->{'no'};
$msg = "Current results: yes = \x0303$yes\x03 - no = \x0304$no\x03";
-
+
$::displayer->sendto($reply_to, $msg);
}
}
@@ -276,7 +276,7 @@ sub see_vote
{
$::displayer->sendto($reply_to, "Can't find this vote. It has either expired or been deleted.");
}
-
+
return 1;
} # Fin see_vote
@@ -288,13 +288,13 @@ sub see_vote
sub vote
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
my $lc_reply_to = lc $reply_to;
my $vote_id = $last_added{$lc_reply_to};
my $voter = $event->{'userhost'};
-
+
my $code = real_vote(join(' ', @{$ref_params}), $lc_reply_to, $vote_id, $voter);
-
+
if($code == 0)
{
$::displayer->sendto($reply_to, "You've already answered to this vote \x0304[\x0303id #$vote_id\x0304]\x03");
@@ -307,7 +307,7 @@ sub vote
{
$::displayer->sendto($reply_to, "Can't find your answer.");
}
-
+
return 1;
} # Fin vote
@@ -319,10 +319,10 @@ sub vote
sub real_vote
{
my ($params, $chan, $vote_id, $voter) = @_;
-
+
my $id = $chan." ".$vote_id;
print Data::Dumper->Dump([$votes{$id}, $params], [qw(vote_struct params)]);
-
+
if($params =~ /^(?:y(?:es)?|oui)$/i)
{
if(can_vote($id, $voter))
@@ -331,7 +331,7 @@ sub real_vote
push @{$votes{$id}->{'voters'}}, $voter;
return 1;
}
-
+
return 0;
}
elsif($params =~ /^n(?:o(?:n)?)?$/i)
@@ -342,7 +342,7 @@ sub real_vote
push @{$votes{$id}->{'voters'}}, $voter;
return 1;
}
-
+
return 0;
}
elsif($params =~ /^#?(\d+)\s+(.+)$/i)
@@ -350,13 +350,13 @@ sub real_vote
$vote_id = $1;
my $answer = $2;
$id = $chan." ".$vote_id;
-
+
if(can_vote($id, $voter))
{
return real_vote($answer, $chan, $vote_id, $voter);
}
}
-
+
return -1;
} # Fin real_vote
@@ -368,14 +368,14 @@ sub real_vote
sub can_vote
{
my ($id, $user) = @_;
-
+
my $lc_user = lc $user;
-
+
if(grep { $_ eq $lc_user } @{$votes{$id}->{'voters'}})
{
return 0;
}
-
+
$::logger->info("$user can vote for $id");
return 1;
}
@@ -388,10 +388,10 @@ sub can_vote
sub get_next_id
{
my $base = shift;
-
+
my $cpt = 0;
$cpt++ while(defined($votes{$base." ".$cpt}));
-
+
return $base." ".$cpt;
} # Fin get_next_id
@@ -403,16 +403,16 @@ sub get_next_id
sub vote_help
{
my ($conn, $event, $reply_to, $ref_params) = @_;
-
+
$conn->privmsg($reply_to, "`".$Config::command_sign."vote new <question>` => "
- ."suggest a new vote");
+ ."suggest a new yes/no vote");
$conn->privmsg($reply_to, "`".$Config::command_sign."vote {del|see} <id>` => "
."remove or see the vote with id <id>");
$conn->privmsg($reply_to, "`".$Config::command_sign."vote list [<#chan>]` => "
."list votes on <#chan> or the current one by default");
$conn->privmsg($reply_to, "`".$Config::command_sign."vote [<id>] {yes|no}` => "
."vote for the last created vote or the one specified by its <id>");
-
+
return 1;
} # Fin vote_help
@@ -425,9 +425,9 @@ sub vote_save
{
my (undef, $folder, $reloading) = @_;
my $file_votes = $folder."/vote".$Config::suffixe.".sav";
-
+
store [\%votes, \%last_added], $file_votes;
-
+
return 1;
} # Fin vote_save
@@ -441,13 +441,13 @@ sub vote_load
shift; # Pas besoin de la connexion au serveur
my $folder = shift;
my $file_votes = $folder."/vote".$Config::suffixe.".sav";
-
+
my $file_content = retrieve $file_votes;
my ($ref_votes, $ref_last_added) = @{$file_content};
-
+
%votes = %{$ref_votes};
%last_added = %{$ref_last_added};
-
+
return 1;
} # Fin vote_load
diff --git a/Net/IRC/EventQueue/Entry.pm b/Net/IRC/EventQueue/Entry.pm
index 94a38025c9e195efc3061053b5a44b6e75c52833..161ec23b870a16be9c05dd0558215a6a40a3fe45 100755
--- a/Net/IRC/EventQueue/Entry.pm
+++ b/Net/IRC/EventQueue/Entry.pm
@@ -1,40 +1,40 @@
package Net::IRC::EventQueue::Entry;
-
+
use strict;
-
+
my $id = 0;
-
+
sub new {
my $class = shift;
my $time = shift;
my $content = shift;
-
+
my $self = {
'time' => $time,
'content' => $content,
'id' => "$time:" . $id++,
};
-
+
bless $self, $class;
return $self;
}
-
+
sub id {
my $self = shift;
return $self->{'id'};
}
-
+
sub time {
my $self = shift;
$self->{'time'} = $_[0] if @_;
return $self->{'time'};
}
-
+
sub content {
my $self = shift;
$self->{'content'} = $_[0] if @_;
return $self->{'content'};
}
-
+
1;