From cd1fc57841deab0e9b8bcfad49d527c6b263534c Mon Sep 17 00:00:00 2001 From: David Phillips Date: Tue, 10 Apr 2018 15:20:24 +1200 Subject: Correct capitalisation on module names --- Plugin/Antiflood.pm | 42 +++++++++++++++++++++++++++++++++ Plugin/Map.pm | 34 +++++++++++++++++++++++++++ Plugin/Timezone.pm | 40 ++++++++++++++++++++++++++++++++ Plugin/Tittilate.pm | 37 +++++++++++++++++++++++++++++ Plugin/URL_Title.pm | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++++ idalius.pl | 15 ++++++------ plugin/antiflood.pm | 42 --------------------------------- plugin/map.pm | 34 --------------------------- plugin/timezone.pm | 40 -------------------------------- plugin/tittilate.pm | 37 ----------------------------- plugin/url_title.pm | 67 ----------------------------------------------------- 11 files changed, 227 insertions(+), 228 deletions(-) create mode 100644 Plugin/Antiflood.pm create mode 100644 Plugin/Map.pm create mode 100644 Plugin/Timezone.pm create mode 100644 Plugin/Tittilate.pm create mode 100644 Plugin/URL_Title.pm delete mode 100644 plugin/antiflood.pm delete mode 100644 plugin/map.pm delete mode 100644 plugin/timezone.pm delete mode 100644 plugin/tittilate.pm delete mode 100644 plugin/url_title.pm diff --git a/Plugin/Antiflood.pm b/Plugin/Antiflood.pm new file mode 100644 index 0000000..4db7ace --- /dev/null +++ b/Plugin/Antiflood.pm @@ -0,0 +1,42 @@ +#!/usr/bin/env perl + +package Plugin::Antiflood; + +use strict; +use warnings; + +my $message_count = 5; +my $message_period = 11; + + +my %config; +my %lastmsg = (); + +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 $channel = $where->[0]; + my $nick = (split /!/, $who)[0]; + + return if ($config{antiflood_on} == 0); + + my $now = time(); + push @{$lastmsg{$nick}}, $now; + + if (@{$lastmsg{$nick}} >= $message_count) { + @{$lastmsg{$nick}} = splice @{$lastmsg{$nick}}, 1, $message_count - 1; + my $first = @{$lastmsg{$nick}}[0]; + if ($now - $first <= $message_period) { + $irc->yield(kick => $channel => $nick => "Flood"); + } + } + return; +} +1; diff --git a/Plugin/Map.pm b/Plugin/Map.pm new file mode 100644 index 0000000..9ca8cef --- /dev/null +++ b/Plugin/Map.pm @@ -0,0 +1,34 @@ +#!/usr/bin/env perl + +package Plugin::Map; + +use strict; +use warnings; + +my %config; +my $run_command; + + +sub configure { + my $self = shift; + my $cmdref = shift; + my $cref = shift; + %config = %$cref; + $run_command = shift; + + $cmdref->("map", sub { $self->map(@_); } ); + + return $self; +} + +sub map { + my ($self, $logger, $who, $where, $rest, @arguments) = @_; + my ($command, $subjects) = ($rest =~ /^(.+?)\s+(.*)$/); + + return "[]" unless $subjects; + + my @array = map { $run_command->("$command $_", $who, $where) } (split /,/, $subjects); + + return "[" . (join ", ", @array). "]"; +} +1; diff --git a/Plugin/Timezone.pm b/Plugin/Timezone.pm new file mode 100644 index 0000000..eaea907 --- /dev/null +++ b/Plugin/Timezone.pm @@ -0,0 +1,40 @@ +#!/usr/bin/env perl + +package Plugin::Timezone; + +use strict; +use warnings; + +use DateTime; + +my %config; + +sub configure { + my $self = $_[0]; + my $cmdref = $_[1]; + my $cref = $_[2]; + %config = %$cref; + + $cmdref->("time", sub { $self->time(@_); } ); + + return $self; +} + +sub time { + my ($self, $logger, $who, $where, $rest, @arguments) = @_; + + my $requester = ( split /!/, $who)[0]; + my @known_zones = (keys %{$config{timezone}}); + + return "Syntax: time [nick]" unless @arguments == 1; + + my $nick = $arguments[0]; + if (grep {$_ eq $nick} @known_zones) { + my $d = DateTime->now(); + $d->set_time_zone($config{timezone}->{$nick}); + return "$requester: $nick\'s clock reads $d"; + } else { + return "$requester: I don't know what timezone $nick is in"; + } +} +1; diff --git a/Plugin/Tittilate.pm b/Plugin/Tittilate.pm new file mode 100644 index 0000000..b2c2286 --- /dev/null +++ b/Plugin/Tittilate.pm @@ -0,0 +1,37 @@ +#!/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; diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm new file mode 100644 index 0000000..495df8e --- /dev/null +++ b/Plugin/URL_Title.pm @@ -0,0 +1,67 @@ +#!/usr/bin/env perl + +package Plugin::URL_Title; + +use strict; +use warnings; +use HTTP::Tiny; +use HTML::HeadParser; +use utf8; + +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 $url; + + return if ($config{url_on} == 0); + + if ($what =~ /(https?:\/\/[^ ]+)/i) { + $url = $1; + } + return unless $url; + + my $http = HTTP::Tiny->new((default_headers => {'Range' => "bytes=0-65536", 'Accept' => 'text/html'}, timeout => 3)); + + my $response = $http->get($url); + + if (!$response->{success}) { + $logger->("Something broke: $response->{reason}"); + return; + } + + if (!($response->{headers}->{"content-type"} =~ m,text/html ?,)) { + $logger->("Not html, giving up now"); + return; + } + + my $html = $response->{content}; + + my $parser = HTML::HeadParser->new; + $parser->parse($html); + + # get title and unpack from utf8 (assumption) + my $title = $parser->header("title"); + utf8::upgrade($title); + 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; + + my $composed_title = "$title ($shorturl)"; + return $composed_title; +} +1; diff --git a/idalius.pl b/idalius.pl index 0e01e32..89b74ca 100755 --- a/idalius.pl +++ b/idalius.pl @@ -9,7 +9,7 @@ use POE::Component::IRC; use POE::Component::IRC::Plugin::NickServID; use config_file; use IRC::Utils qw(strip_color strip_formatting); -use Module::Pluggable search_path => "plugin", instantiate => 'configure'; +use Module::Pluggable search_path => "Plugin", instantiate => 'configure'; my $config_file = "bot.conf"; my %config = config_file::parse_config($config_file); @@ -69,11 +69,16 @@ drop_priv(); $poe_kernel->run(); +sub log_info { + # FIXME direct to a log file instead of stdout + my $stamp = strftime("%Y-%m-%d %H:%M:%S %z", localtime); + print "$stamp | @_\n"; +} # Register a command name to a certain sub sub register_command { my ($command, $action) = @_; - print ("registering $command to $action\n"); + log_info "Registering command: $command"; $commands{$command} = $action; } @@ -100,12 +105,6 @@ sub drop_priv { setuid($config{uid}) or die "Failed to setuid: $!\n"; } -sub log_info { - # FIXME direct to a log file instead of stdout - my $stamp = strftime("%Y-%m-%d %H:%M:%S %z", localtime); - print "$stamp | @_\n"; -} - # Add a strike against a nick for module flood protection # This differs from antiflood.pm in that it is used only for when users have # triggered a response from the bot. diff --git a/plugin/antiflood.pm b/plugin/antiflood.pm deleted file mode 100644 index a44c07c..0000000 --- a/plugin/antiflood.pm +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/env perl - -package plugin::antiflood; - -use strict; -use warnings; - -my $message_count = 5; -my $message_period = 11; - - -my %config; -my %lastmsg = (); - -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 $channel = $where->[0]; - my $nick = (split /!/, $who)[0]; - - return if ($config{antiflood_on} == 0); - - my $now = time(); - push @{$lastmsg{$nick}}, $now; - - if (@{$lastmsg{$nick}} >= $message_count) { - @{$lastmsg{$nick}} = splice @{$lastmsg{$nick}}, 1, $message_count - 1; - my $first = @{$lastmsg{$nick}}[0]; - if ($now - $first <= $message_period) { - $irc->yield(kick => $channel => $nick => "Flood"); - } - } - return; -} -1; diff --git a/plugin/map.pm b/plugin/map.pm deleted file mode 100644 index f8cb256..0000000 --- a/plugin/map.pm +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/env perl - -package plugin::map; - -use strict; -use warnings; - -my %config; -my $run_command; - - -sub configure { - my $self = shift; - my $cmdref = shift; - my $cref = shift; - %config = %$cref; - $run_command = shift; - - $cmdref->("map", sub { $self->map(@_); } ); - - return $self; -} - -sub map { - my ($self, $logger, $who, $where, $rest, @arguments) = @_; - my ($command, $subjects) = ($rest =~ /^(.+?)\s+(.*)$/); - - return "[]" unless $subjects; - - my @array = map { $run_command->("$command $_", $who, $where) } (split /,/, $subjects); - - return "[" . (join ", ", @array). "]"; -} -1; diff --git a/plugin/timezone.pm b/plugin/timezone.pm deleted file mode 100644 index 8807d54..0000000 --- a/plugin/timezone.pm +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/env perl - -package plugin::timezone; - -use strict; -use warnings; - -use DateTime; - -my %config; - -sub configure { - my $self = $_[0]; - my $cmdref = $_[1]; - my $cref = $_[2]; - %config = %$cref; - - $cmdref->("time", sub { $self->time(@_); } ); - - return $self; -} - -sub time { - my ($self, $logger, $who, $where, $rest, @arguments) = @_; - - my $requester = ( split /!/, $who)[0]; - my @known_zones = (keys %{$config{timezone}}); - - return "Syntax: time [nick]" unless @arguments == 1; - - my $nick = $arguments[0]; - if (grep {$_ eq $nick} @known_zones) { - my $d = DateTime->now(); - $d->set_time_zone($config{timezone}->{$nick}); - return "$requester: $nick\'s clock reads $d"; - } else { - return "$requester: I don't know what timezone $nick is in"; - } -} -1; diff --git a/plugin/tittilate.pm b/plugin/tittilate.pm deleted file mode 100644 index 4df6b07..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; diff --git a/plugin/url_title.pm b/plugin/url_title.pm deleted file mode 100644 index 32995fd..0000000 --- a/plugin/url_title.pm +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/env perl - -package plugin::url_title; - -use strict; -use warnings; -use HTTP::Tiny; -use HTML::HeadParser; -use utf8; - -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 $url; - - return if ($config{url_on} == 0); - - if ($what =~ /(https?:\/\/[^ ]+)/i) { - $url = $1; - } - return unless $url; - - my $http = HTTP::Tiny->new((default_headers => {'Range' => "bytes=0-65536", 'Accept' => 'text/html'}, timeout => 3)); - - my $response = $http->get($url); - - if (!$response->{success}) { - $logger->("Something broke: $response->{reason}"); - return; - } - - if (!($response->{headers}->{"content-type"} =~ m,text/html ?,)) { - $logger->("Not html, giving up now"); - return; - } - - my $html = $response->{content}; - - my $parser = HTML::HeadParser->new; - $parser->parse($html); - - # get title and unpack from utf8 (assumption) - my $title = $parser->header("title"); - utf8::upgrade($title); - 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; - - my $composed_title = "$title ($shorturl)"; - return $composed_title; -} -1; -- cgit v1.1