From 00f7c03c9ad2e9dddf92f679b0f59c8d6b47a37a Mon Sep 17 00:00:00 2001 From: David Phillips Date: Mon, 7 May 2018 18:06:17 +1200 Subject: Replace HTML::HeadParser with HTML::Parser Weird bugs with HeadParser, cannot debug and patch for upstream as yet --- Plugin/URL_Title.pm | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm index 8248560..5774528 100644 --- a/Plugin/URL_Title.pm +++ b/Plugin/URL_Title.pm @@ -5,7 +5,7 @@ package Plugin::URL_Title; use strict; use warnings; use HTTP::Tiny; -use HTML::HeadParser; +use HTML::Parser; use utf8; my %config; @@ -18,6 +18,17 @@ sub configure { return $self; } +my $title; + +sub start_handler +{ + return if shift ne "title"; + my $self = shift; + $self->handler(text => sub { $title = shift; }, "dtext"); + $self->handler(end => sub { shift->eof if shift eq "title"; }, + "tagname,self"); +} + sub message { my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; @@ -47,11 +58,12 @@ sub message my $html = $response->{content}; utf8::decode($html); - my $parser = HTML::HeadParser->new; - $parser->parse($html); + $title = ""; + my $p = HTML::Parser->new(api_version => 3); + $p->handler( start => \&start_handler, "tagname,self"); + $p->parse($html); + die "Error: $!\n" if $!; - # get title and unpack from utf8 (assumption) - my $title = $parser->header("title"); utf8::upgrade($title); return unless $title; -- cgit v1.1 From 817ebdeb8eeaa344fd77a2c84d4e90d4cdf5f66a Mon Sep 17 00:00:00 2001 From: David Phillips Date: Mon, 7 May 2018 20:57:27 +1200 Subject: Fold URL title whitespace into same line --- Plugin/URL_Title.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm index 5774528..1d0056e 100644 --- a/Plugin/URL_Title.pm +++ b/Plugin/URL_Title.pm @@ -64,6 +64,9 @@ sub message $p->parse($html); die "Error: $!\n" if $!; + $title =~ s/\s+/ /g; + $title =~ s/(^\s+|\s+$)//g; + utf8::upgrade($title); return unless $title; -- cgit v1.1 From eb2ff6434ee9ffe9354539186bbb7b8726788e0f Mon Sep 17 00:00:00 2001 From: David Phillips Date: Mon, 7 May 2018 21:17:47 +1200 Subject: Truncate URLs based on shorturl length, not full URL --- Plugin/URL_Title.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm index 1d0056e..3297bed 100644 --- a/Plugin/URL_Title.pm +++ b/Plugin/URL_Title.pm @@ -71,12 +71,13 @@ sub message return unless $title; my $shorturl = $url; - $shorturl = (substr $url, 0, $config{url_len}) . "…" if length ($url) > $config{url_len}; - # remove http(s):// to avoid triggering other poorly configured bots $shorturl =~ s,^https?://,,g; $shorturl =~ s,/$,,g; + # truncate URL without http(s):// to configured length if needed + $shorturl = (substr $shorturl, 0, $config{url_len}) . "…" if length ($shorturl) > $config{url_len}; + my $composed_title = "$title ($shorturl)"; return $composed_title; } -- cgit v1.1 From 56cf40827f8c54926936ecfbb256651493c70750 Mon Sep 17 00:00:00 2001 From: David Phillips Date: Wed, 16 May 2018 14:02:49 +1200 Subject: Add command to inspect ignores --- idalius.pl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/idalius.pl b/idalius.pl index c88ed8e..fd44242 100755 --- a/idalius.pl +++ b/idalius.pl @@ -294,6 +294,10 @@ sub irc_msg { $irc->yield(privmsg => $nick => "Syntax: topic "); } } + if ($what =~ /^who are you ignoring/) { + my $ignores = join ", ", @{$config{ignore}}; + $irc->yield(privmsg => $nick => "I am ignoring: $ignores"); + } if ($what =~ /^mode\s/) { my ($rest) = $what =~ /^mode\s+(.*)?$/; if ($rest) { -- cgit v1.1 From 7ef75e83372ff08223ff1ad31891cb0586abdff3 Mon Sep 17 00:00:00 2001 From: David Phillips Date: Thu, 17 May 2018 21:32:55 +1200 Subject: Lower spam limit, tell person we ignore --- idalius.pl | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/idalius.pl b/idalius.pl index fd44242..4c9c8f3 100755 --- a/idalius.pl +++ b/idalius.pl @@ -109,10 +109,10 @@ sub drop_priv { # This differs from antiflood.pm in that it is used only for when users have # triggered a response from the bot. sub strike_add { - my $strike_count = 15; - my $strike_period = 30; + my $strike_count = 14; + my $strike_period = 45; - my ($nick) = @_; + my ($nick, $channel) = @_; my $now = time(); push @{$laststrike{$nick}}, $now; if (@{$laststrike{$nick}} >= $strike_count) { @@ -120,6 +120,7 @@ sub strike_add { my $first = @{$laststrike{$nick}}[0]; if ($now - $first <= $strike_period) { log_info "Ignoring $nick because of command flood"; + $irc->yield(privmsg => $channel => "$nick: I'm ignoring you now, you've caused me to talk too much"); push @{$config{ignore}}, $nick; } } @@ -181,7 +182,7 @@ sub irc_public { if ($stripped_what =~ s/^$config{prefix}//) { $output = run_command($stripped_what, $who, $where); $irc->yield(privmsg => $where => $output) if $output; - strike_add $nick if $output; + strike_add($nick, $channel) if $output; } for my $module (@plugin_list) { @@ -189,7 +190,7 @@ sub irc_public { if ($module->can("message")) { $output = $module->message(\&log_info, $irc->nick_name, $who, $where, $what, $stripped_what, $irc); } - strike_add $nick if $output; + strike_add($nick, $channel) if $output; $irc->yield(privmsg => $where => $output) if $output; } -- cgit v1.1 From b1f4150fc408b00e20117be28ff111a3d3c27fa8 Mon Sep 17 00:00:00 2001 From: David Phillips Date: Fri, 18 May 2018 14:11:54 +1200 Subject: Correct order of ignore message --- idalius.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/idalius.pl b/idalius.pl index 4c9c8f3..89c89e5 100755 --- a/idalius.pl +++ b/idalius.pl @@ -190,8 +190,8 @@ sub irc_public { if ($module->can("message")) { $output = $module->message(\&log_info, $irc->nick_name, $who, $where, $what, $stripped_what, $irc); } - strike_add($nick, $channel) if $output; $irc->yield(privmsg => $where => $output) if $output; + strike_add($nick, $channel) if $output; } return; -- cgit v1.1 From 53718f690df53285362145ee474f40a2f5cc63e7 Mon Sep 17 00:00:00 2001 From: David Phillips Date: Tue, 19 Jun 2018 00:12:14 +1200 Subject: URL_Title: Allow SVG titling --- Plugin/URL_Title.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm index 3297bed..6d46e43 100644 --- a/Plugin/URL_Title.pm +++ b/Plugin/URL_Title.pm @@ -41,7 +41,9 @@ sub message } return unless $url; - my $http = HTTP::Tiny->new((default_headers => {'Range' => "bytes=0-65536", 'Accept' => 'text/html'}, timeout => 3)); + # FIXME add more XML-based formats that we can theoretically extract titles from + # FIXME factor out accepted formats and response match into accepted formats array + my $http = HTTP::Tiny->new((default_headers => {'Range' => "bytes=0-65536", 'Accept' => 'text/html, image/svg+xml'}, timeout => 3)); my $response = $http->get($url); @@ -50,8 +52,8 @@ sub message return; } - if (!($response->{headers}->{"content-type"} =~ m,text/html ?,)) { - $logger->("Not html, giving up now"); + if (!($response->{headers}->{"content-type"} =~ m,(text/html|image/svg\+xml),)) { + $logger->("I don't think I can parse titles from $response->{headers}->{'content-type'} - stopping here"); return; } -- cgit v1.1 From 792eade6c29beb6cf9b1e31ddffdc6476ff21b01 Mon Sep 17 00:00:00 2001 From: David Phillips Date: Wed, 20 Jun 2018 17:41:52 +1200 Subject: Change URL parsing from space to RFC 3982 --- Plugin/URL_Title.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm index 6d46e43..a2c8930 100644 --- a/Plugin/URL_Title.pm +++ b/Plugin/URL_Title.pm @@ -36,7 +36,8 @@ sub message return if ($config{url_on} == 0); - if ($what =~ /(https?:\/\/[^ ]+)/i) { + # Drawn from RFC 3986§2 + if ($what =~ /(https?:\/\/[A-z0-9\-\._~:\/\?#\[\]@\!\$&'()\*\+,;=]+)/i) { $url = $1; } return unless $url; -- cgit v1.1 From 549ac4f97e0a70238006cc7b4d4ff752f281b930 Mon Sep 17 00:00:00 2001 From: David Phillips Date: Wed, 20 Jun 2018 17:49:19 +1200 Subject: No need for [A-z] when case-insensitive flag used --- Plugin/URL_Title.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm index a2c8930..73fa498 100644 --- a/Plugin/URL_Title.pm +++ b/Plugin/URL_Title.pm @@ -37,7 +37,7 @@ sub message return if ($config{url_on} == 0); # Drawn from RFC 3986§2 - if ($what =~ /(https?:\/\/[A-z0-9\-\._~:\/\?#\[\]@\!\$&'()\*\+,;=]+)/i) { + if ($what =~ /(https?:\/\/[a-z0-9\-\._~:\/\?#\[\]@\!\$&'()\*\+,;=]+)/i) { $url = $1; } return unless $url; -- cgit v1.1 From ca1ba1ad6825e93bf6be91317ffdf57d076ad798 Mon Sep 17 00:00:00 2001 From: David Phillips Date: Tue, 26 Jun 2018 21:39:33 +1200 Subject: Use tidier format for time --- Plugin/Timezone.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Plugin/Timezone.pm b/Plugin/Timezone.pm index eaea907..60a0f34 100644 --- a/Plugin/Timezone.pm +++ b/Plugin/Timezone.pm @@ -30,9 +30,10 @@ sub time { my $nick = $arguments[0]; if (grep {$_ eq $nick} @known_zones) { - my $d = DateTime->now(); + my $d = DateTime->now(); $d->set_time_zone($config{timezone}->{$nick}); - return "$requester: $nick\'s clock reads $d"; + my $timestr = $d->strftime("%Y-%m-%d %H:%M %Z"); + return "$requester: $nick\'s clock reads $timestr"; } else { return "$requester: I don't know what timezone $nick is in"; } -- cgit v1.1 From e56d58c07ccfe7d3e5ab9439d688259b70d60d95 Mon Sep 17 00:00:00 2001 From: David Phillips Date: Sat, 14 Jul 2018 19:34:37 +1200 Subject: Fix typo in module name --- Plugin/Titillate.pm | 37 +++++++++++++++++++++++++++++++++++++ Plugin/Tittilate.pm | 37 ------------------------------------- 2 files changed, 37 insertions(+), 37 deletions(-) create mode 100644 Plugin/Titillate.pm delete mode 100644 Plugin/Tittilate.pm diff --git a/Plugin/Titillate.pm b/Plugin/Titillate.pm new file mode 100644 index 0000000..f969df7 --- /dev/null +++ b/Plugin/Titillate.pm @@ -0,0 +1,37 @@ +#!/usr/bin/env perl + +package Plugin::Titillate; + +use strict; +use warnings; + +my %config; + +sub configure { + my $self = $_[0]; + my $cmdref = $_[1]; + my $cref = $_[2]; + %config = %$cref; + return $self; +} + +sub message { + my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; + my $gathered = ""; + my @expressions = (keys %{$config{triggers}}); + my $expression = join '|', @expressions; + while ($what =~ /($expression)/gi) { + my $matched = $1; + my $key; + # figure out which key matched + foreach (@expressions) { + if ($matched =~ /$_/i) { + $key = $_; + last; + } + } + $gathered .= $config{triggers}->{$key}; + } + return $gathered; +} +1; diff --git a/Plugin/Tittilate.pm b/Plugin/Tittilate.pm deleted file mode 100644 index b2c2286..0000000 --- a/Plugin/Tittilate.pm +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/env perl - -package Plugin::Tittilate; - -use strict; -use warnings; - -my %config; - -sub configure { - my $self = $_[0]; - my $cmdref = $_[1]; - my $cref = $_[2]; - %config = %$cref; - return $self; -} - -sub message { - my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_; - my $gathered = ""; - my @expressions = (keys %{$config{triggers}}); - my $expression = join '|', @expressions; - while ($what =~ /($expression)/gi) { - my $matched = $1; - my $key; - # figure out which key matched - foreach (@expressions) { - if ($matched =~ /$_/i) { - $key = $_; - last; - } - } - $gathered .= $config{triggers}->{$key}; - } - return $gathered; -} -1; -- cgit v1.1