Progress on refactoring and polishing everything

More to come!

PBot/AntiFlood.pm

@@ -16,6 +16,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use feature 'switch';
 no if $] >= 5.018, warnings => "experimental::smartmatch";

PBot/AntiSpam.pm

@@ -12,6 +12,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use feature 'switch';
 no if $] >= 5.018, warnings => "experimental::smartmatch";

PBot/BanList.pm

@@ -15,6 +15,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::HiRes qw/gettimeofday/;
 use Time::Duration;

PBot/BlackList.pm

@@ -12,6 +12,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use feature 'switch';
 no if $] >= 5.018, warnings => "experimental::smartmatch";

PBot/Capabilities.pm

@@ -11,6 +11,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use feature 'switch';
 no if $] >= 5.018, warnings => "experimental::smartmatch";

PBot/ChanOpCommands.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::Duration;
 use Time::HiRes qw/gettimeofday/;

PBot/ChanOps.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use PBot::ChanOpCommands;
 use Time::HiRes qw(gettimeofday);

PBot/Channels.pm

@@ -12,6 +12,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 sub initialize {
     my ($self, %conf) = @_;

PBot/Commands.pm

@@ -14,6 +14,7 @@ use parent 'PBot::Class', 'PBot::Registerable';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::Duration qw/duration/;
 

PBot/DualIndexHashObject.pm

@@ -18,6 +18,7 @@ package PBot::DualIndexHashObject;
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Text::Levenshtein qw(fastdistance);
 use JSON;

PBot/DualIndexSQLiteObject.pm

@@ -13,6 +13,7 @@ package PBot::DualIndexSQLiteObject;
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use DBI;
 use Text::Levenshtein qw(fastdistance);

PBot/EventDispatcher.pm

@@ -7,6 +7,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use IO::Select;
 

PBot/FactoidCommands.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::Duration;
 use Time::HiRes qw(gettimeofday);

PBot/Factoids.pm

@@ -12,6 +12,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use feature 'switch';
 no if $] >= 5.018, warnings => "experimental::smartmatch";

PBot/Functions.pm

@@ -24,6 +24,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 sub initialize {
     my ($self, %conf) = @_;

PBot/HashObject.pm

@@ -14,6 +14,7 @@ package PBot::HashObject;
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Text::Levenshtein qw(fastdistance);
 use JSON;

PBot/IRC.pm

@@ -23,6 +23,7 @@ use IO::Select;
 use Carp;
 
 use feature 'unicode_strings';
+use utf8;
 
 # grab the drop-in replacement for time() from Time::HiRes, if it's available
 BEGIN { Time::HiRes->import('time') if eval "require Time::HiRes"; }

PBot/IRC/Connection.pm

@@ -16,6 +16,7 @@
 package PBot::IRC::Connection;    # pragma_ 2011/21/01
 
 use feature 'unicode_strings';
+use utf8;
 
 use PBot::IRC::Event;             # pragma_ 2011/21/01
 use PBot::IRC::DCC;               # pragma_ 2011/21/01
@@ -221,8 +222,8 @@ sub connect {
     if (@_) {
         my (%arg) = @_;
 
-        $self->hostname($arg{'LocalAddr'}) if exists $arg{'LocalAddr'};
+        $self->hostname($arg{'LocalAddr'})      if exists $arg{'LocalAddr'};
-        $password = $arg{'Password'} if exists $arg{'Password'};
+        $password = $arg{'Password'}            if exists $arg{'Password'};
         $self->nick($arg{'Nick'})               if exists $arg{'Nick'};
         $self->port($arg{'Port'})               if exists $arg{'Port'};
         $self->server($arg{'Server'})           if exists $arg{'Server'};

PBot/IRC/DCC.pm

@@ -18,6 +18,7 @@ package PBot::IRC::DCC;    # pragma_ 2011/21/01
 use strict;
 
 use feature 'unicode_strings';
+use utf8;
 
 # --- #perl was here! ---
 #

PBot/IRC/Event.pm

@@ -25,6 +25,7 @@
 package PBot::IRC::Event;    # pragma_ 2011/21/01
 
 use feature 'unicode_strings';
+use utf8;
 
 use strict;
 our %_names;

PBot/IRC/EventQueue.pm

@@ -1,6 +1,7 @@
 package PBot::IRC::EventQueue;    # pragma_ 2011/21/01
 
 use feature 'unicode_strings';
+use utf8;
 
 use PBot::IRC::EventQueue::Entry;    # pragma_ 2011/21/01
 

PBot/IRC/EventQueue/Entry.pm

@@ -3,6 +3,7 @@ package PBot::IRC::EventQueue::Entry;    # pragma_ 2011/21/01
 use strict;
 
 use feature 'unicode_strings';
+use utf8;
 
 my $id = 0;
 

PBot/IRCHandlers.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::HiRes qw(gettimeofday);
 use Data::Dumper;

PBot/IgnoreList.pm

@@ -12,6 +12,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::Duration qw/concise duration/;
 

PBot/Interpreter.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class', 'PBot::Registerable';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::HiRes qw/gettimeofday/;
 use Time::Duration;
@@ -30,8 +31,8 @@ sub initialize {
 }
 
 sub process_line {
-    my $self = shift;
+    my ($self, $from, $nick, $user, $host, $text) = @_;
-    my ($from, $nick, $user, $host, $text) = @_;
+
     $from = lc $from if defined $from;
 
     my $context = {from => $from, nick => $nick, user => $user, host => $host, hostmask => "$nick!$user\@$host", text => $text};
@@ -737,37 +738,58 @@ sub lc_args {
 }
 
 sub truncate_result {
-    my ($self, $from, $nick, $text, $original_result, $result, $paste) = @_;
+    my ($self, $from, $nick, $command, $paste_text, $text, $paste) = @_;
+
     my $max_msg_len = $self->{pbot}->{registry}->get_value('irc', 'max_msg_len');
+
     $max_msg_len -= length "PRIVMSG $from :" if defined $from;
 
-    utf8::encode $result;
+    utf8::encode $paste_text;
-    utf8::encode $original_result;
+    utf8::encode $text;
 
-    use bytes;
+    if (length $text > $max_msg_len) {
+        my $paste_result;
 
-    if (length $result > $max_msg_len) {
-        my $link;
         if ($paste) {
+            # limit pastes to 32k by default, overridable via paste.max_length
             my $max_paste_len = $self->{pbot}->{registry}->get_value('paste', 'max_length') // 1024 * 32;
-            $original_result = substr $original_result, 0, $max_paste_len;
+
-            $link            = $self->{pbot}->{webpaste}->paste("[" . (defined $from ? $from : "stdin") . "] <$nick> $text\n\n$original_result");
+            # truncate paste to max paste length
-        } else {
+            # FIXME: this potentially chops unicode characters in wrong places
-            $link = 'undef';
+            $paste_text = substr $paste_text, 0, $max_paste_len;
+
+            utf8::decode $paste_text;
+
+            # send text to paste site
+            $paste_result = $self->{pbot}->{webpaste}->paste("($from) $nick: $command\n\n$paste_text");
         }
 
-        my $trunc = "... [truncated; ";
+        my $trunc = "... [truncated";
-        if   ($link =~ m/^http/) { $trunc .= "see $link for full text.]"; }
-        else                     { $trunc .= "$link]"; }
 
-        $self->{pbot}->{logger}->log("Message truncated -- pasted to $link\n") if $paste;
+        if (not defined $paste_result) {
-        my $trunc_len = length $result < $max_msg_len ? length $result : $max_msg_len;
+            # no paste
-        $result = substr($result, 0, $trunc_len);
+            $trunc .= "]";
-        substr($result, $trunc_len - length $trunc) = $trunc;
+        } elsif ($paste_result =~ m/^http/) {
+            # a link
+            $trunc .= "; see $paste_result for full text.]";
+        } else {
+            # an error or something else
+            $trunc .= "$paste_result]";
+        }
+
+        if ($paste) {
+            $paste_result //= 'not pasted';
+            $self->{pbot}->{logger}->log("Message truncated -- $paste_result\n");
+        }
+
+        my $trunc_len = length $text < $max_msg_len ? length $text : $max_msg_len;
+        # FIXME: this potentially chops unicode characters in wrong places
+        $text = substr($text, 0, $trunc_len);
+        substr($text, $trunc_len - length $trunc) = $trunc;
     }
 
-    utf8::decode $result;
+    utf8::decode $text;
-    return $result;
+    return $text;
 }
 
 sub handle_result {
@@ -839,8 +861,6 @@ sub handle_result {
         $result = $context->{split_result} . $result;
     }
 
-    my $original_result = $result;
-
     my $use_output_queue = 0;
 
     if (defined $context->{command}) {
@@ -854,26 +874,25 @@ sub handle_result {
                     $context->{preserve_whitespace} = $self->{pbot}->{factoids}->{factoids}->get_data($chan, $trigger, 'preserve_whitespace') // 0;
                 }
 
-                $use_output_queue = $self->{pbot}->{factoids}->{factoids}->get_data($chan, $trigger, 'use_output_queue');
+                $use_output_queue = $self->{pbot}->{factoids}->{factoids}->get_data($chan, $trigger, 'use_output_queue') // 0;
-                $use_output_queue = 0 if not defined $use_output_queue;
             }
         }
     }
 
     my $preserve_newlines = $self->{pbot}->{registry}->get_value($context->{from}, 'preserve_newlines');
 
+    my $original_result = $result;
+
     $result =~ s/[\n\r]/ /g unless $preserve_newlines;
     $result =~ s/[ \t]+/ /g unless $context->{preserve_whitespace};
 
-    my $max_lines = $self->{pbot}->{registry}->get_value($context->{from}, 'max_newlines');
+    my $max_lines = $self->{pbot}->{registry}->get_value($context->{from}, 'max_newlines') // 4;
-    $max_lines = 4 if not defined $max_lines;
     my $lines = 0;
 
     my $stripped_line;
     foreach my $line (split /[\n\r]+/, $result) {
         $stripped_line = $line;
-        $stripped_line =~ s/^\s+//;
+        $stripped_line =~ s/^\s+|\s+$//g;
-        $stripped_line =~ s/\s+$//;
         next if not length $stripped_line;
 
         if (++$lines >= $max_lines) {
@@ -891,8 +910,11 @@ sub handle_result {
             last;
         }
 
-        if   ($preserve_newlines) { $line = $self->truncate_result($context->{from}, $context->{nick}, $context->{text}, $line,            $line, 1); }
+        if ($preserve_newlines) {
-        else                      { $line = $self->truncate_result($context->{from}, $context->{nick}, $context->{text}, $original_result, $line, 1); }
+            $line = $self->truncate_result($context->{from}, $context->{nick}, $context->{text}, $line, $line, 1);
+        } else {
+            $line = $self->truncate_result($context->{from}, $context->{nick}, $context->{text}, $original_result, $line, 1);
+        }
 
         if ($use_output_queue) {
             my $delay   = rand(10) + 5;

PBot/LagChecker.pm

@@ -14,6 +14,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::HiRes qw(gettimeofday tv_interval);
 use Time::Duration;

PBot/Logger.pm

@@ -6,6 +6,7 @@ package PBot::Logger;
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Scalar::Util qw/openhandle/;
 use File::Basename;
@@ -24,36 +25,61 @@ sub new {
 
 sub initialize {
     my ($self, %conf) = @_;
-    $self->{logfile} = $conf{filename} // Carp::croak "Missing logfile parameter in " . __FILE__;
-    $self->{start}   = time;
 
+    # ensure logfile path was provided
+    $self->{logfile} = $conf{filename} // Carp::croak "Missing logfile parameter in " . __FILE__;
+
+
+    # record start time for later logfile rename in rotation
+    $self->{start} = time;
+
+    # get directories leading to logfile
     my $path = dirname $self->{logfile};
+
+    # create log file path
     if (not -d $path) {
         print "Creating new logfile path: $path\n" unless $self->{pbot}->{overrides}->{'general.daemon'};
         mkdir $path or Carp::croak "Couldn't create logfile path: $!\n";
     }
 
-    open LOGFILE, ">>$self->{logfile}" or Carp::croak "Couldn't open logfile $self->{logfile}: $!\n";
+    # open log file with utf8 encoding
+    open LOGFILE, ">> :encoding(UTF-8)", $self->{logfile} or Carp::croak "Couldn't open logfile $self->{logfile}: $!\n";
     LOGFILE->autoflush(1);
 
+    # rename logfile to start-time at exit
     $self->{pbot}->{atexit}->register(sub { $self->rotate_log; return; });
-    return $self;
 }
 
 sub log {
     my ($self, $text) = @_;
+
+    # get current time
     my $time = localtime;
+
+    # replace potentially log-corrupting characters (colors, gibberish, etc)
     $text =~ s/(\P{PosixGraph})/my $ch = $1; if ($ch =~ m{[\s]}) { $ch } else { sprintf "\\x%02X", ord $ch }/ge;
+
+    # log to file
     print LOGFILE "$time :: $text" if openhandle * LOGFILE;
-    print "$time :: $text" unless $self->{pbot}->{overrides}->{'general.daemon'};
+
+    # and print to stdout unless daemonized
+    print STDOUT "$time :: $text" unless $self->{pbot}->{overrides}->{'general.daemon'};
 }
 
 sub rotate_log {
     my ($self) = @_;
+
+    # get start time
     my $time = localtime $self->{start};
-    $time =~ s/\s+/_/g;
+    $time =~ s/\s+/_/g; # replace spaces with underscores
+
     $self->log("Rotating log to $self->{logfile}-$time\n");
+
+    # rename log to start time
     move($self->{logfile}, $self->{logfile} . '-' . $time);
+
+    # set new start time for next rotation
+    $self->{start} = time;
 }
 
 1;

PBot/MessageHistory.pm

@@ -17,6 +17,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Getopt::Long qw(GetOptionsFromArray);
 use Time::HiRes qw(gettimeofday tv_interval);

PBot/MessageHistory_SQLite.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use DBI;
 use Carp qw(shortmess);

PBot/MiscCommands.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::Duration qw/duration/;
 

PBot/Modules.pm

@@ -1,6 +1,12 @@
 # File: Modules.pm
 # Author: pragma_
 
+# Purpose: Modules are command-line programs and scripts that can be loaded
+# via PBot factoids. Command arguments are passed as command-line arguments.
+# The standard output from the script is returned as the bot command result.
+# The standard error output is stored in a file named <module>-stderr in the
+# modules/ directory.
+
 # This Source Code Form is subject to the terms of the Mozilla Public
 # License, v. 2.0. If a copy of the MPL was not distributed with this
 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
@@ -11,43 +17,65 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use IPC::Run qw/run timeout/;
 use Encode;
 
 sub initialize {
     my ($self, %conf) = @_;
+
+    # bot commands to load and unload modules
     $self->{pbot}->{commands}->register(sub { $self->cmd_load(@_) },   "load",   1);
     $self->{pbot}->{commands}->register(sub { $self->cmd_unload(@_) }, "unload", 1);
 }
 
 sub cmd_load {
     my ($self, $context) = @_;
-    my $factoids = $self->{pbot}->{factoids}->{factoids};
+
     my ($keyword, $module) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
+
     return "Usage: load <keyword> <module>" if not defined $module;
 
-    if ($factoids->exists('.*', $keyword)) { return 'There is already a keyword named ' . $factoids->get_data('.*', $keyword, '_name') . '.'; }
+    my $factoids = $self->{pbot}->{factoids}->{factoids};
+
+    if ($factoids->exists('.*', $keyword)) {
+        return 'There is already a keyword named ' . $factoids->get_data('.*', $keyword, '_name') . '.';
+    }
 
     $self->{pbot}->{factoids}->add_factoid('module', '.*', $context->{hostmask}, $keyword, $module, 1);
-    $factoids->set('.*', $keyword, 'add_nick', 1, 1);
+
+    $factoids->set('.*', $keyword, 'add_nick',   1, 1);
     $factoids->set('.*', $keyword, 'nooverride', 1);
+
     $self->{pbot}->{logger}->log("$context->{hostmask} loaded module $keyword => $module\n");
+
     return "Loaded module $keyword => $module";
 }
 
 sub cmd_unload {
     my ($self, $context) = @_;
-    my $module = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
-    return "Usage: unload <keyword>" if not defined $module;
-    my $factoids = $self->{pbot}->{factoids}->{factoids};
-    return "/say $module not found." if not $factoids->exists('.*', $module);
 
-    if ($factoids->get_data('.*', $module, 'type') ne 'module') { return "/say " . $factoids->get_data('.*', $module, '_name') . ' is not a module.'; }
+    my $module = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
+
+    return "Usage: unload <keyword>" if not defined $module;
+
+    my $factoids = $self->{pbot}->{factoids}->{factoids};
+
+    if (not $factoids->exists('.*', $module)) {
+        return "/say $module not found.";
+    }
+
+    if ($factoids->get_data('.*', $module, 'type') ne 'module') {
+        return "/say " . $factoids->get_data('.*', $module, '_name') . ' is not a module.';
+    }
 
     my $name = $factoids->get_data('.*', $module, '_name');
+
     $factoids->remove('.*', $module);
+
     $self->{pbot}->{logger}->log("$context->{hostmask} unloaded module $module\n");
+
     return "/say $name unloaded.";
 }
 
@@ -67,8 +95,11 @@ sub execute_module {
 
 sub launch_module {
     my ($self, $context) = @_;
-    $context->{arguments} = "" if not defined $context->{arguments};
+
+    $context->{arguments} //= '';
+
     my @factoids = $self->{pbot}->{factoids}->find_factoid($context->{from}, $context->{keyword}, exact_channel => 2, exact_trigger => 2);
+
     if (not @factoids or not $factoids[0]) {
         $context->{checkflood} = 1;
         $self->{pbot}->{interpreter}->handle_result($context, "/msg $context->{nick} Failed to find module for '$context->{keyword}' in channel $context->{from}\n");
@@ -76,19 +107,22 @@ sub launch_module {
     }
 
     my ($channel, $trigger) = ($factoids[0]->[0], $factoids[0]->[1]);
+
     $context->{channel} = $channel;
     $context->{keyword} = $trigger;
     $context->{trigger} = $trigger;
 
     my $module = $self->{pbot}->{factoids}->{factoids}->get_data($channel, $trigger, 'action');
+
     $self->{pbot}->{logger}->log(
-        "(" . (defined $context->{from} ? $context->{from} : "(undef)")
+        '(' . (defined $context->{from} ? $context->{from} : "(undef)") . '): '
-        . "): $context->{nick}!$context->{user}\@$context->{host}: Executing module [$context->{command}] $module $context->{arguments}\n"
+        . "$context->{hostmask}: Executing module [$context->{command}] $module $context->{arguments}\n"
     );
 
     $context->{arguments} = $self->{pbot}->{factoids}->expand_factoid_vars($context, $context->{arguments});
 
     my $module_dir = $self->{pbot}->{registry}->get_value('general', 'module_dir');
+
     if (not chdir $module_dir) {
         $self->{pbot}->{logger}->log("Could not chdir to '$module_dir': $!\n");
         Carp::croak("Could not chdir to '$module_dir': $!");
@@ -99,16 +133,29 @@ sub launch_module {
     }
 
     # FIXME -- add check to ensure $module exists
+
     my ($exitval, $stdout, $stderr) = eval {
         my $args = $context->{arguments};
-        if (not $context->{args_utf8}) { $args = encode('UTF-8', $args); }
+
+        if (not $context->{args_utf8}) {
+            $args = encode('UTF-8', $args);
+        }
+
         my @cmdline = ("./$module", $self->{pbot}->{interpreter}->split_line($args));
+
         my $timeout = $self->{pbot}->{registry}->get_value('general', 'module_timeout') // 30;
+
         my ($stdin, $stdout, $stderr);
+
         run \@cmdline, \$stdin, \$stdout, \$stderr, timeout($timeout);
+
         my $exitval = $? >> 8;
-        utf8::decode($stdout);
+
-        utf8::decode($stderr);
+        $self->{pbot}->{logger}->log("stdout before: $stdout\n");
+
+        utf8::decode $stdout;
+        utf8::decode $stderr;
+
         return ($exitval, $stdout, $stderr);
     };
 
@@ -118,6 +165,7 @@ sub launch_module {
             ($exitval, $stdout, $stderr) = (-1, "$context->{trigger}: timed-out", '');
         } else {
             ($exitval, $stdout, $stderr) = (-1, '', $error);
+            $self->{pbot}->{logger}->log("$context->{trigger}: error executing module: $error\n");
         }
     }
 

PBot/NickList.pm

@@ -15,6 +15,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Text::Levenshtein qw/fastdistance/;
 use Data::Dumper;

PBot/PBot.pm

@@ -13,9 +13,6 @@ use strict; use warnings;
 use feature 'unicode_strings';
 use utf8;
 
-# unbuffer stdout
-STDOUT->autoflush(1);
-
 use Carp ();
 use PBot::Logger;
 use PBot::VERSION;
@@ -54,6 +51,17 @@ use PBot::Users;
 use PBot::Utils::ParseDate;
 use PBot::WebPaste;
 
+# unbuffer stdout stream
+STDOUT->autoflush(1);
+
+# set standard output streams to encode as utf8
+binmode(STDOUT, ":utf8");
+binmode(STDERR, ":utf8");
+
+# decode command-line arguments from utf8
+use Encode;
+@ARGV = map { decode('UTF-8', $_, 1) } @ARGV;
+
 sub new {
     my ($proto, %conf) = @_;
     my $class = ref($proto) || $proto;

PBot/Plugins.pm

@@ -12,6 +12,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use File::Basename;
 

PBot/ProcessManager.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::Duration qw/concise duration/;
 use Time::HiRes qw/gettimeofday/;
@@ -22,9 +23,15 @@ use JSON;
 
 sub initialize {
     my ($self, %conf) = @_;
+
+    # process manager bot commands
     $self->{pbot}->{commands}->register(sub { $self->cmd_ps(@_) },   'ps',   0);
     $self->{pbot}->{commands}->register(sub { $self->cmd_kill(@_) }, 'kill', 1);
+
+    # give admin capability group the can-kill capability
     $self->{pbot}->{capabilities}->add('admin', 'can-kill', 1);
+
+    # hash of currently running bot-invoked processes
     $self->{processes} = {};
 
     # automatically reap children processes in background
@@ -35,6 +42,7 @@ sub initialize {
 
 sub cmd_ps {
     my ($self, $context) = @_;
+
     my $usage = 'Usage: ps [-atu]; -a show all information; -t show running time; -u show user/channel';
 
     my $getopt_error;
@@ -46,44 +54,55 @@ sub cmd_ps {
     Getopt::Long::Configure("bundling");
 
     my ($show_all, $show_user, $show_running_time);
+
     my @opt_args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
+
     GetOptionsFromArray(
         \@opt_args,
-        'all|a' => \$show_all,
+        'all|a'  => \$show_all,
         'user|u' => \$show_user,
         'time|t' => \$show_running_time
     );
+
     return "$getopt_error; $usage" if defined $getopt_error;
 
     my @processes;
-    foreach my $pid (sort keys %{$self->{processes}}) { push @processes, $self->{processes}->{$pid}; }
-    if (not @processes) { return "No running processes."; }
 
-    my $result;
+    foreach my $pid (sort keys %{$self->{processes}}) {
-    if (@processes == 1) { $result = 'One process: '; } else { $result = @processes . ' processes: '; }
+        push @processes, $self->{processes}->{$pid};
+    }
+
+    if (not @processes) {
+        return "No running processes.";
+    }
+
+    my $result = @processes == 1 ? 'One process: ' : @processes . ' processes: ';
+
+    my @entries;
 
-    my $sep = '';
     foreach my $process (@processes) {
-        $result .= $sep;
+        my $entry = "$process->{pid}: $process->{commands}->[0]";
-        $result .= "$process->{pid}: $process->{commands}->[0]";
 
         if ($show_running_time or $show_all) {
             my $duration = concise duration (gettimeofday - $process->{process_start});
-            $result .= " [$duration]";
+            $entry .= " [$duration]";
         }
 
         if ($show_user or $show_all) {
-            $result .= " ($process->{nick} in $process->{from})";
+            $entry .= " ($process->{nick} in $process->{from})";
         }
 
-        $sep = '; ';
+        push @entries, $entry;
     }
 
+    $result .= join '; ', @entries;
+
     return $result;
 }
 
 sub cmd_kill {
     my ($self, $context) = @_;
+
     my $usage = 'Usage: kill [-a] [-t <seconds>] [-s <signal>]  [pids...]; -a kill all processes; -t <seconds> kill processes running longer than <seconds>; -s send <signal> to processes';
 
     my $getopt_error;
@@ -95,15 +114,21 @@ sub cmd_kill {
     Getopt::Long::Configure("bundling");
 
     my ($kill_all, $kill_time, $signal);
+
     my @opt_args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, preserve_escapes => 1, strip_quotes => 1);
+
     GetOptionsFromArray(
         \@opt_args,
-        'all|a' => \$kill_all,
+        'all|a'      => \$kill_all,
-        'time|t=i' => \$kill_time,
+        'time|t=i'   => \$kill_time,
         'signal|s=s' => \$signal,
     );
+
     return "$getopt_error; $usage" if defined $getopt_error;
-    return "Must specify PIDs to kill unless options -a or -t are provided." if not $kill_all and not $kill_time and not @opt_args;
+
+    if (not $kill_all and not $kill_time and not @opt_args) {
+        return "Must specify PIDs to kill unless options -a or -t are provided.";
+    }
 
     if (defined $signal) {
         $signal = uc $signal;
@@ -112,8 +137,10 @@ sub cmd_kill {
     }
 
     my @pids;
+
     if (defined $kill_all or defined $kill_time) {
         my $now = time;
+
         foreach my $pid (sort keys %{$self->{processes}}) {
             my $process = $self->{processes}->{$pid};
             next if defined $kill_time and $now - $process->{process_start} < $kill_time;
@@ -125,27 +152,41 @@ sub cmd_kill {
             push @pids, $pid;
         }
     }
+
     return "No matching process." if not @pids;
 
     my $ret = eval { kill $signal, @pids };
-    if ($@) { my $error = $@; $error =~ s/ at PBot.*//; return $error; }
+
+    if ($@) {
+        my $error = $@;
+        $error =~ s/ at PBot.*//;
+        return $error;
+    }
+
     return "[$ret] Sent signal " . $signal . ' to ' . join ', ', @pids;
 }
 
 sub add_process {
     my ($self, $pid, $context) = @_;
+
     $context->{process_start} = gettimeofday;
+
     $self->{processes}->{$pid} = $context;
+
     $self->{pbot}->{logger}->log("Starting process $pid: $context->{commands}->[0]\n");
 }
 
 sub remove_process {
     my ($self, $pid) = @_;
+
     if (exists $self->{processes}->{$pid}) {
         my $command = $self->{processes}->{$pid}->{commands}->[0];
+
         my $duration = gettimeofday - $self->{processes}->{$pid}->{process_start};
         $duration = sprintf "%0.3f", $duration;
+
         $self->{pbot}->{logger}->log("Finished process $pid ($command): duration $duration seconds\n");
+
         delete $self->{processes}->{$pid};
     } else {
         $self->{pbot}->{logger}->log("Finished process $pid\n");
@@ -154,32 +195,46 @@ sub remove_process {
 
 sub execute_process {
     my ($self, $context, $subref, $timeout) = @_;
-    $timeout //= 30;
 
-    if (not exists $context->{commands}) { $context->{commands} = [$context->{command}]; }
+    $timeout //= 30; # default timeout 30 seconds
+
+    if (not exists $context->{commands}) {
+        $context->{commands} = [$context->{command}];
+    }
 
     # don't fork again if we're already a forked process
-    if (exists $context->{pid}) {
+    if (defined $context->{pid} and $context->{pid} == 0) {
         $subref->($context);
         return $context->{result};
     }
 
     pipe(my $reader, my $writer);
+
+    # fork new process
     $context->{pid} = fork;
 
     if (not defined $context->{pid}) {
+        # fork failed
         $self->{pbot}->{logger}->log("Could not fork process: $!\n");
+
         close $reader;
         close $writer;
+
+        delete $context->{pid};
+
+        # groan to let the users know something went wrong
         $context->{checkflood} = 1;
         $self->{pbot}->{interpreter}->handle_result($context, "/me groans loudly.\n");
+
         return;
     }
 
     if ($context->{pid} == 0) {
         # child
+
         close $reader;
 
+        # flag this instance as child
         $self->{pbot}->{child} = 1;
 
         # don't quit the IRC client when the child dies
@@ -190,23 +245,31 @@ sub execute_process {
         # remove atexit handlers
         $self->{pbot}->{atexit}->unregister_all;
 
+        # FIXME: close databases and files too? Or just set everything to check for $self->{pbot}->{child} == 1 or $context->{pid} == 0?
+
         # execute the provided subroutine, results are stored in $context
         eval {
             local $SIG{ALRM} = sub { die "Process `$context->{commands}->[0]` timed-out" };
             alarm $timeout;
             $subref->($context);
         };
-        alarm 0;
 
         # check for errors
         if ($@) {
             $context->{result} = $@;
+
             $context->{'timed-out'} = 1 if $context->{result} =~ /^Process .* timed-out at PBot\/ProcessManager/;
+
             $self->{pbot}->{logger}->log("Error executing process: $context->{result}\n");
+
+            # strip internal PBot source data for IRC output
             $context->{result} =~ s/ at PBot.*$//ms;
             $context->{result} =~ s/\s+...propagated at .*$//ms;
         }
 
+        # turn alarm back on for PBot::Timer
+        alarm 1;
+
         # print $context to pipe
         my $json = encode_json $context;
         print $writer "$json\n";
@@ -216,46 +279,62 @@ sub execute_process {
         exit 0;
     } else {
         # parent
+
+        # nothing to write to child
         close $writer;
+
+        # add process
         $self->add_process($context->{pid}, $context);
+
+        # add reader handler
         $self->{pbot}->{select_handler}->add_reader($reader, sub { $self->process_pipe_reader($context->{pid}, @_) });
+
         # return empty string since reader will handle the output when child is finished
-        return "";
+        return '';
     }
 }
 
 sub process_pipe_reader {
     my ($self, $pid, $buf) = @_;
 
+    # retrieve context object from child
     my $context = decode_json $buf or do {
         $self->{pbot}->{logger}->log("Failed to decode bad json: [$buf]\n");
         return;
     };
 
+    # context is no longer forked
     delete $context->{pid};
 
+    # check for output
     if (not defined $context->{result} or not length $context->{result}) {
         $self->{pbot}->{logger}->log("No result from process.\n");
         return if $context->{suppress_no_output};
         $context->{result} = "No output.";
     }
 
-    if ($context->{referenced}) { return if $context->{result} =~ m/(?:no results)/i; }
+    # don't output unnecessary result if command was referenced within a message
-
+    if ($context->{referenced}) {
-    if (exists $context->{special} and $context->{special} eq 'code-factoid') {
+        return if $context->{result} =~ m/(?:no results)/i;
-        $context->{result} =~ s/\s+$//g;
-        $self->{pbot}->{logger}->log("No text result from code-factoid.\n") and return if not length $context->{result};
-        $context->{original_keyword} = $context->{root_keyword};
-        $context->{result}           = $self->{pbot}->{factoids}->handle_action($context, $context->{result});
     }
 
-    $context->{checkflood} = 0;
+    # handle code factoid result
+    if (exists $context->{special} and $context->{special} eq 'code-factoid') {
+        $context->{result} =~ s/\s+$//g;
 
-    if (defined $context->{nickoverride}) { $self->{pbot}->{interpreter}->handle_result($context, $context->{result}); }
+        if (not length $context->{result}) {
-    else {
+            $self->{pbot}->{logger}->log("No text result from code-factoid.\n");
-        # don't override nick if already set
+            return;
-        if (    exists $context->{special}
+        }
-            and $context->{special} ne 'code-factoid'
+
+        $context->{original_keyword} = $context->{root_keyword};
+        $context->{result} = $self->{pbot}->{factoids}->handle_action($context, $context->{result});
+    }
+
+    # if nick isn't overridden yet, check for a potential nick prefix
+    if (not defined $context->{nickoverride}) {
+        # if add_nick is set on the factoid, set the nick override to the caller's nick
+        if (exists $context->{special} and $context->{special} ne 'code-factoid'
             and $self->{pbot}->{factoids}->{factoids}->exists($context->{channel}, $context->{trigger}, 'add_nick')
             and $self->{pbot}->{factoids}->{factoids}->get_data($context->{channel}, $context->{trigger}, 'add_nick') != 0)
         {
@@ -263,14 +342,16 @@ sub process_pipe_reader {
             $context->{no_nickoverride}    = 0;
             $context->{force_nickoverride} = 1;
         } else {
-            # extract nick-like thing from module result
+            # extract nick-like thing from process result
             if ($context->{result} =~ s/^(\S+): //) {
                 my $nick = $1;
+
                 if (lc $nick eq "usage") {
                     # put it back on result if it's a usage message
                     $context->{result} = "$nick: $context->{result}";
                 } else {
                     my $present = $self->{pbot}->{nicklist}->is_present($context->{channel}, $nick);
+
                     if ($present) {
                         # nick is present in channel
                         $context->{nickoverride} = $present;
@@ -281,13 +362,11 @@ sub process_pipe_reader {
                 }
             }
         }
-        $self->{pbot}->{interpreter}->handle_result($context, $context->{result});
     }
 
-    my $text = $self->{pbot}->{interpreter}
+    # send the result off to the bot to be handled
-      ->truncate_result($context->{channel}, $self->{pbot}->{registry}->get_value('irc', 'botnick'), 'undef', $context->{result}, $context->{result}, 0);
+    $context->{checkflood} = 1;
-    $self->{pbot}->{antiflood}
+    $self->{pbot}->{interpreter}->handle_result($context, $context->{result});
-      ->check_flood($context->{from}, $self->{pbot}->{registry}->get_value('irc', 'botnick'), $self->{pbot}->{registry}->get_value('irc', 'username'), 'pbot', $text, 0, 0, 0);
 }
 
 1;

PBot/Refresher.pm

@@ -14,6 +14,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Module::Refresh;
 use File::Basename;

PBot/Registerable.pm

@@ -11,6 +11,7 @@ package PBot::Registerable;
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 sub new {
     my ($proto, %conf) = @_;

PBot/Registry.pm

@@ -14,6 +14,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::HiRes qw(gettimeofday);
 use PBot::RegistryCommands;

PBot/RegistryCommands.pm

@@ -12,6 +12,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 sub initialize {
     my ($self, %conf) = @_;

PBot/SQLiteLogger.pm

@@ -12,6 +12,7 @@ package PBot::SQLiteLogger;
 
 use strict; use warnings;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::HiRes qw(gettimeofday);
 

PBot/SQLiteLoggerLayer.pm

@@ -13,6 +13,7 @@ use strict;
 use warnings;
 
 use feature 'unicode_strings';
+use utf8;
 
 sub PUSHED {
     my ($class, $mode, $fh) = @_;

PBot/SelectHandler.pm

@@ -7,6 +7,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use IO::Select;
 
@@ -18,10 +19,10 @@ sub initialize {
 }
 
 sub add_reader {
-    my ($self, $handle, $sub) = @_;
+    my ($self, $handle, $subref) = @_;
     $self->{select}->add($handle);
-    $self->{readers}->{$handle} = $sub;
+    $self->{readers}->{$handle} = $subref;
-    $self->{buffers}->{$handle} = "";
+    $self->{buffers}->{$handle} = '';
 }
 
 sub remove_reader {
@@ -33,32 +34,61 @@ sub remove_reader {
 
 sub do_select {
     my ($self) = @_;
+
+    # maximum read length
     my $length = 8192;
+
+    # check if any readers can read
     my @ready  = $self->{select}->can_read(.1);
 
     foreach my $fh (@ready) {
+        # read from handle
         my $ret = sysread($fh, my $buf, $length);
 
+        # error reading
         if (not defined $ret) {
-            $self->{pbot}->{logger}->log("Error with $fh: $!\n");
+            $self->{pbot}->{logger}->log("SelectHandler: Error reading $fh: $!\n");
             $self->remove_reader($fh);
             next;
         }
 
+        # reader closed
         if ($ret == 0) {
-            if (length $self->{buffers}->{$fh}) { $self->{readers}->{$fh}->($self->{buffers}->{$fh}); }
+            # is there anything in reader's buffer?
+            if (length $self->{buffers}->{$fh}) {
+                # send buffer to reader subref
+                $self->{readers}->{$fh}->($self->{buffers}->{$fh});
+            }
+
+            # remove reader
             $self->remove_reader($fh);
+
+            # skip to next reader
             next;
         }
 
+        # sanity check for missing reader
+        if (not exists $self->{readers}->{$fh}) {
+            $self->{pbot}->{logger}->log("Error: no reader for $fh\n");
+
+            # skip to next reader
+            next;
+        }
+
+        # accumulate input into reader's buffer
         $self->{buffers}->{$fh} .= $buf;
 
-        if (not exists $self->{readers}->{$fh}) { $self->{pbot}->{logger}->log("Error: no reader for $fh\n"); }
+        # if we read less than max length bytes then this is probably
-        else {
+        # a complete message so send it to reader now, otherwise we'll
-            if ($ret < $length) {
+        # continue to accumulate input into reader's buffer and then send
-                $self->{readers}->{$fh}->($self->{buffers}->{$fh});
+        # the buffer when reader closes.
-                $self->{buffers}->{$fh} = "";
+
-            }
+        if ($ret < $length) {
+            # send reader's buffer to reader subref
+            $self->{readers}->{$fh}->($self->{buffers}->{$fh});
+
+            # clear out reader's buffer
+            $self->{buffers}->{$fh} = '';
         }
     }
 }

PBot/StdinReader.pm

@@ -7,14 +7,18 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
-use POSIX qw(tcgetpgrp getpgrp);    # to check whether process is in background or foreground
+use POSIX qw(tcgetpgrp getpgrp);  # to check whether process is in background or foreground
+
+use Encode;
 
 sub initialize {
     my ($self, %conf) = @_;
 
-    # create implicit bot-admin account for bot
+    # create stdin bot-admin account for bot
     my $user = $self->{pbot}->{users}->find_user('.*', '*!stdin@pbot');
+
     if (not defined $user or not $self->{pbot}->{capabilities}->userhas($user, 'botowner')) {
         my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
         $self->{pbot}->{logger}->log("Adding stdin botowner *!stdin\@pbot...\n");
@@ -23,18 +27,25 @@ sub initialize {
         $self->{pbot}->{users}->save;
     }
 
-    # used to check whether process is in background or foreground, for stdin reading
     if (not $self->{pbot}->{registry}->get_value('general', 'daemon')) {
+        # TTY is used to check whether process is in background or foreground
         open TTY, "</dev/tty" or die $!;
         $self->{tty_fd} = fileno(TTY);
+
+        # add STDIN to select handler
         $self->{pbot}->{select_handler}->add_reader(\*STDIN, sub { $self->stdin_reader(@_) });
     } else {
         $self->{pbot}->{logger}->log("Starting in daemon mode.\n");
+        # TODO: close STDIN, etc?
     }
 }
 
 sub stdin_reader {
     my ($self, $input) = @_;
+
+    # decode STDIN input from utf8
+    $input = decode('UTF-8', $input);
+
     chomp $input;
 
     # make sure we're in the foreground first
@@ -46,14 +57,17 @@ sub stdin_reader {
 
     my ($from, $text);
 
+    my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
+
     if ($input =~ m/^~([^ ]+)\s+(.*)/) {
         $from = $1;
-        $text = $self->{pbot}->{registry}->get_value('irc', 'botnick') . " $2";
+        $text = "$botnick $2";
     } else {
         $from = 'stdin@pbot';
-        $text = $self->{pbot}->{registry}->get_value('irc', 'botnick') . " $input";
+        $text = "$botnick $input";
     }
-    return $self->{pbot}->{interpreter}->process_line($from, $self->{pbot}->{registry}->get_value('irc', 'botnick'), "stdin", "pbot", $text);
+
+    return $self->{pbot}->{interpreter}->process_line($from, $botnick, "stdin", "pbot", $text);
 }
 
 1;

PBot/Timer.pm

@@ -21,6 +21,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::Duration qw/concise duration/;
 

PBot/Updater.pm

@@ -14,6 +14,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use File::Basename;
 

PBot/Users.pm

@@ -12,6 +12,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 sub initialize {
     my ($self, %conf) = @_;

PBot/VERSION.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class';
 
 use strict; use warnings;
 use feature 'unicode_strings';
+use utf8;
 
 use LWP::UserAgent;
 

PBot/WebPaste.pm

@@ -13,6 +13,7 @@ use parent 'PBot::Class';
 
 use warnings; use strict;
 use feature 'unicode_strings';
+use utf8;
 
 use Time::HiRes qw/gettimeofday/;
 use Time::Duration;
@@ -36,8 +37,10 @@ sub initialize {
 sub get_paste_site {
     my ($self) = @_;
 
+    # get the next paste site's subroutine reference
     my $subref = $self->{paste_sites}->[$self->{current_site}];
 
+    # rotate current_site
     if (++$self->{current_site} >= @{$self->{paste_sites}}) {
         $self->{current_site} = 0;
     }
@@ -54,22 +57,31 @@ sub paste {
 
     %opts = (%default_opts, %opts);
 
+    # word-wrap text unless no_split is set
     $text =~ s/(.{120})\s/$1\n/g unless $opts{no_split};
 
+    # encode paste to utf8
+    $text = encode('UTF-8', $text);
+
     my $response;
 
     for (my $tries = 3; $tries > 0; $tries--) {
+        # get the next paste site
         my $paste_site = $self->get_paste_site;
 
+        # attempt to paste text
         $response = $paste_site->($text);
 
+        # exit loop if paste succeeded
         last if $response->is_success;
     }
 
+    # all tries failed
     if (not $response->is_success) {
         return "error pasting: " . $response->status_line;
     }
 
+    # success, return URL
     my $result = $response->decoded_content;
 
     $result =~ s/^\s+|\s+$//g;