diff --git a/PBot/AntiFlood.pm b/PBot/AntiFlood.pm index 2c2ed8c3..c03ed612 100644 --- a/PBot/AntiFlood.pm +++ b/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"; diff --git a/PBot/AntiSpam.pm b/PBot/AntiSpam.pm index 3769f8e4..4027c802 100644 --- a/PBot/AntiSpam.pm +++ b/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"; diff --git a/PBot/BanList.pm b/PBot/BanList.pm index f407d41c..2b2b4c81 100644 --- a/PBot/BanList.pm +++ b/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; diff --git a/PBot/BlackList.pm b/PBot/BlackList.pm index 64b36e26..52ec67f2 100644 --- a/PBot/BlackList.pm +++ b/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"; diff --git a/PBot/Capabilities.pm b/PBot/Capabilities.pm index b2083ee1..dbfdd785 100644 --- a/PBot/Capabilities.pm +++ b/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"; diff --git a/PBot/ChanOpCommands.pm b/PBot/ChanOpCommands.pm index 73f57838..7d19bbb2 100644 --- a/PBot/ChanOpCommands.pm +++ b/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/; diff --git a/PBot/ChanOps.pm b/PBot/ChanOps.pm index 4c809493..5e221aa3 100644 --- a/PBot/ChanOps.pm +++ b/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); diff --git a/PBot/Channels.pm b/PBot/Channels.pm index a9739b8b..98c5b6f9 100644 --- a/PBot/Channels.pm +++ b/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) = @_; diff --git a/PBot/Commands.pm b/PBot/Commands.pm index 7e8863a9..42798b4f 100644 --- a/PBot/Commands.pm +++ b/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/; diff --git a/PBot/DualIndexHashObject.pm b/PBot/DualIndexHashObject.pm index 7bcb2540..763c018d 100644 --- a/PBot/DualIndexHashObject.pm +++ b/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; diff --git a/PBot/DualIndexSQLiteObject.pm b/PBot/DualIndexSQLiteObject.pm index bd167e60..dc566191 100644 --- a/PBot/DualIndexSQLiteObject.pm +++ b/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); diff --git a/PBot/EventDispatcher.pm b/PBot/EventDispatcher.pm index 7698ef2e..57f3920e 100644 --- a/PBot/EventDispatcher.pm +++ b/PBot/EventDispatcher.pm @@ -7,6 +7,7 @@ use parent 'PBot::Class'; use warnings; use strict; use feature 'unicode_strings'; +use utf8; use IO::Select; diff --git a/PBot/FactoidCommands.pm b/PBot/FactoidCommands.pm index 0e6fa06c..1945c3c6 100644 --- a/PBot/FactoidCommands.pm +++ b/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); diff --git a/PBot/Factoids.pm b/PBot/Factoids.pm index ca4505aa..f4f67efa 100644 --- a/PBot/Factoids.pm +++ b/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"; diff --git a/PBot/Functions.pm b/PBot/Functions.pm index 4581611a..87a51368 100644 --- a/PBot/Functions.pm +++ b/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) = @_; diff --git a/PBot/HashObject.pm b/PBot/HashObject.pm index 5ce7741b..624cf019 100644 --- a/PBot/HashObject.pm +++ b/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; diff --git a/PBot/IRC.pm b/PBot/IRC.pm index e9686e83..0894850d 100644 --- a/PBot/IRC.pm +++ b/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"; } diff --git a/PBot/IRC/Connection.pm b/PBot/IRC/Connection.pm index d2a80fc2..afbb9b7e 100644 --- a/PBot/IRC/Connection.pm +++ b/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'}; - $password = $arg{'Password'} if exists $arg{'Password'}; + $self->hostname($arg{'LocalAddr'}) if exists $arg{'LocalAddr'}; + $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'}; diff --git a/PBot/IRC/DCC.pm b/PBot/IRC/DCC.pm index 0364ce9d..0a8b5985 100644 --- a/PBot/IRC/DCC.pm +++ b/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! --- # diff --git a/PBot/IRC/Event.pm b/PBot/IRC/Event.pm index 729f49ed..a1e6f35b 100644 --- a/PBot/IRC/Event.pm +++ b/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; diff --git a/PBot/IRC/EventQueue.pm b/PBot/IRC/EventQueue.pm index e3bf1a96..63b8d17a 100644 --- a/PBot/IRC/EventQueue.pm +++ b/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 diff --git a/PBot/IRC/EventQueue/Entry.pm b/PBot/IRC/EventQueue/Entry.pm index 10381fcf..0e055cc2 100644 --- a/PBot/IRC/EventQueue/Entry.pm +++ b/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; diff --git a/PBot/IRCHandlers.pm b/PBot/IRCHandlers.pm index 8dc6ba76..e2b3cec9 100644 --- a/PBot/IRCHandlers.pm +++ b/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; diff --git a/PBot/IgnoreList.pm b/PBot/IgnoreList.pm index e980f5eb..218e4d7c 100644 --- a/PBot/IgnoreList.pm +++ b/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/; diff --git a/PBot/Interpreter.pm b/PBot/Interpreter.pm index a09a5ba2..3f4b168e 100644 --- a/PBot/Interpreter.pm +++ b/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 ($from, $nick, $user, $host, $text) = @_; + my ($self, $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 $original_result; + utf8::encode $paste_text; + 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"); - } else { - $link = 'undef'; + + # truncate paste to max paste length + # FIXME: this potentially chops unicode characters in wrong places + $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; "; - if ($link =~ m/^http/) { $trunc .= "see $link for full text.]"; } - else { $trunc .= "$link]"; } + my $trunc = "... [truncated"; - $self->{pbot}->{logger}->log("Message truncated -- pasted to $link\n") if $paste; - my $trunc_len = length $result < $max_msg_len ? length $result : $max_msg_len; - $result = substr($result, 0, $trunc_len); - substr($result, $trunc_len - length $trunc) = $trunc; + if (not defined $paste_result) { + # no paste + $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; - return $result; + utf8::decode $text; + 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 = 0 if not defined $use_output_queue; + $use_output_queue = $self->{pbot}->{factoids}->{factoids}->get_data($chan, $trigger, 'use_output_queue') // 0; } } } 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'); - $max_lines = 4 if not defined $max_lines; + my $max_lines = $self->{pbot}->{registry}->get_value($context->{from}, 'max_newlines') // 4; my $lines = 0; my $stripped_line; foreach my $line (split /[\n\r]+/, $result) { $stripped_line = $line; - $stripped_line =~ s/^\s+//; - $stripped_line =~ s/\s+$//; + $stripped_line =~ s/^\s+|\s+$//g; 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); } - else { $line = $self->truncate_result($context->{from}, $context->{nick}, $context->{text}, $original_result, $line, 1); } + if ($preserve_newlines) { + $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; diff --git a/PBot/LagChecker.pm b/PBot/LagChecker.pm index 50cb9f18..1ed70b76 100644 --- a/PBot/LagChecker.pm +++ b/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; diff --git a/PBot/Logger.pm b/PBot/Logger.pm index d32af353..b1c72cd7 100644 --- a/PBot/Logger.pm +++ b/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; diff --git a/PBot/MessageHistory.pm b/PBot/MessageHistory.pm index 939edf78..7fabee96 100644 --- a/PBot/MessageHistory.pm +++ b/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); diff --git a/PBot/MessageHistory_SQLite.pm b/PBot/MessageHistory_SQLite.pm index 68eb01eb..9f105cda 100644 --- a/PBot/MessageHistory_SQLite.pm +++ b/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); diff --git a/PBot/MiscCommands.pm b/PBot/MiscCommands.pm index 15c0ea82..9fedbb87 100644 --- a/PBot/MiscCommands.pm +++ b/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/; diff --git a/PBot/Modules.pm b/PBot/Modules.pm index 4f750d21..b2be0249 100644 --- a/PBot/Modules.pm +++ b/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 -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 " 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 " 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 " 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)") - . "): $context->{nick}!$context->{user}\@$context->{host}: Executing module [$context->{command}] $module $context->{arguments}\n" + '(' . (defined $context->{from} ? $context->{from} : "(undef)") . '): ' + . "$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"); } } diff --git a/PBot/NickList.pm b/PBot/NickList.pm index 861ca3b1..03940472 100644 --- a/PBot/NickList.pm +++ b/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; diff --git a/PBot/PBot.pm b/PBot/PBot.pm index 6b62992d..cf05c438 100644 --- a/PBot/PBot.pm +++ b/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; diff --git a/PBot/Plugins.pm b/PBot/Plugins.pm index fa270de9..c10342e3 100644 --- a/PBot/Plugins.pm +++ b/PBot/Plugins.pm @@ -12,6 +12,7 @@ use parent 'PBot::Class'; use warnings; use strict; use feature 'unicode_strings'; +use utf8; use File::Basename; diff --git a/PBot/ProcessManager.pm b/PBot/ProcessManager.pm index 1263cff7..630ea982 100644 --- a/PBot/ProcessManager.pm +++ b/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; - if (@processes == 1) { $result = 'One process: '; } else { $result = @processes . ' processes: '; } + foreach my $pid (sort keys %{$self->{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; - $result .= "$process->{pid}: $process->{commands}->[0]"; + my $entry = "$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 ] [-s ] [pids...]; -a kill all processes; -t kill processes running longer than ; -s send 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, - 'time|t=i' => \$kill_time, + 'all|a' => \$kill_all, + '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; } - - if (exists $context->{special} and $context->{special} eq 'code-factoid') { - $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}); + # don't output unnecessary result if command was referenced within a message + if ($context->{referenced}) { + return if $context->{result} =~ m/(?:no results)/i; } - $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}); } - else { - # don't override nick if already set - if ( exists $context->{special} - and $context->{special} ne 'code-factoid' + if (not length $context->{result}) { + $self->{pbot}->{logger}->log("No text result from code-factoid.\n"); + return; + } + + $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} - ->truncate_result($context->{channel}, $self->{pbot}->{registry}->get_value('irc', 'botnick'), 'undef', $context->{result}, $context->{result}, 0); - $self->{pbot}->{antiflood} - ->check_flood($context->{from}, $self->{pbot}->{registry}->get_value('irc', 'botnick'), $self->{pbot}->{registry}->get_value('irc', 'username'), 'pbot', $text, 0, 0, 0); + # send the result off to the bot to be handled + $context->{checkflood} = 1; + $self->{pbot}->{interpreter}->handle_result($context, $context->{result}); } 1; diff --git a/PBot/Refresher.pm b/PBot/Refresher.pm index 29b0f267..2dfdd379 100644 --- a/PBot/Refresher.pm +++ b/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; diff --git a/PBot/Registerable.pm b/PBot/Registerable.pm index d67d1d38..258ed6d6 100644 --- a/PBot/Registerable.pm +++ b/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) = @_; diff --git a/PBot/Registry.pm b/PBot/Registry.pm index 769ab52a..c74e6782 100644 --- a/PBot/Registry.pm +++ b/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; diff --git a/PBot/RegistryCommands.pm b/PBot/RegistryCommands.pm index 173dc63e..71594f19 100644 --- a/PBot/RegistryCommands.pm +++ b/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) = @_; diff --git a/PBot/SQLiteLogger.pm b/PBot/SQLiteLogger.pm index a2e744db..67aa0140 100644 --- a/PBot/SQLiteLogger.pm +++ b/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); diff --git a/PBot/SQLiteLoggerLayer.pm b/PBot/SQLiteLoggerLayer.pm index 73222d56..1cad17bc 100644 --- a/PBot/SQLiteLoggerLayer.pm +++ b/PBot/SQLiteLoggerLayer.pm @@ -13,6 +13,7 @@ use strict; use warnings; use feature 'unicode_strings'; +use utf8; sub PUSHED { my ($class, $mode, $fh) = @_; diff --git a/PBot/SelectHandler.pm b/PBot/SelectHandler.pm index 3100e521..63dedd74 100644 --- a/PBot/SelectHandler.pm +++ b/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->{buffers}->{$handle} = ""; + $self->{readers}->{$handle} = $subref; + $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"); } - else { - if ($ret < $length) { - $self->{readers}->{$fh}->($self->{buffers}->{$fh}); - $self->{buffers}->{$fh} = ""; - } + # if we read less than max length bytes then this is probably + # a complete message so send it to reader now, otherwise we'll + # continue to accumulate input into reader's buffer and then send + # the buffer when reader closes. + + if ($ret < $length) { + # send reader's buffer to reader subref + $self->{readers}->{$fh}->($self->{buffers}->{$fh}); + + # clear out reader's buffer + $self->{buffers}->{$fh} = ''; } } } diff --git a/PBot/StdinReader.pm b/PBot/StdinReader.pm index 1d0c9e35..cc2a7f10 100644 --- a/PBot/StdinReader.pm +++ b/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, "{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; diff --git a/PBot/Timer.pm b/PBot/Timer.pm index e2e64d1b..a7c3779b 100644 --- a/PBot/Timer.pm +++ b/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/; diff --git a/PBot/Updater.pm b/PBot/Updater.pm index 94fe1867..2e4d16a9 100644 --- a/PBot/Updater.pm +++ b/PBot/Updater.pm @@ -14,6 +14,7 @@ use parent 'PBot::Class'; use warnings; use strict; use feature 'unicode_strings'; +use utf8; use File::Basename; diff --git a/PBot/Users.pm b/PBot/Users.pm index 8f14224b..11080505 100644 --- a/PBot/Users.pm +++ b/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) = @_; diff --git a/PBot/VERSION.pm b/PBot/VERSION.pm index a2cd9fc1..c1312604 100644 --- a/PBot/VERSION.pm +++ b/PBot/VERSION.pm @@ -13,6 +13,7 @@ use parent 'PBot::Class'; use strict; use warnings; use feature 'unicode_strings'; +use utf8; use LWP::UserAgent; diff --git a/PBot/WebPaste.pm b/PBot/WebPaste.pm index 55db78f6..4e48edf3 100644 --- a/PBot/WebPaste.pm +++ b/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;