GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-22 11:59:43 +01:00
Code Issues Projects Releases Wiki Activity

Fix trailing whitespace throughout

Browse Source
This commit is contained in:
Pragmatic Software 2019-06-26 09:34:19 -07:00
parent 8b5de0beee
commit 5e2cb09744
88 changed files with 1326 additions and 1338 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
PBot/AntiFlood.pm
View File

@ -45,8 +45,8 @@ sub initialize {
$self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__); $self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
# flags for 'validated' field # flags for 'validated' field
$self->{NICKSERV_VALIDATED} = (1<<0); $self->{NICKSERV_VALIDATED} = (1<<0);
$self->{NEEDS_CHECKBAN} = (1<<1); $self->{NEEDS_CHECKBAN} = (1<<1);
$self->{channels} = {}; # per-channel statistics, e.g. for optimized tracking of last spoken nick for enter-abuse detection, etc $self->{channels} = {}; # per-channel statistics, e.g. for optimized tracking of last spoken nick for enter-abuse detection, etc
$self->{nickflood} = {}; # statistics to track nickchange flooding $self->{nickflood} = {}; # statistics to track nickchange flooding
@ -270,7 +270,7 @@ sub update_join_watch {
# check QUIT message for netsplits, and decrement joinwatch to allow a free rejoin # check QUIT message for netsplits, and decrement joinwatch to allow a free rejoin
if ($text =~ /^QUIT .*\.net .*\.split/) { if ($text =~ /^QUIT .*\.net .*\.split/) {
if ($channel_data->{join_watch} > 0) { if ($channel_data->{join_watch} > 0) {
$channel_data->{join_watch}--; $channel_data->{join_watch}--;
$self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $channel, $channel_data); $self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $channel, $channel_data);
} }
} }
@ -513,9 +513,9 @@ sub check_flood {
$self->{pbot}->{logger}->log("[anti-flood] I am not an op for ${channel}-floodbans, disregarding join-flood.\n"); $self->{pbot}->{logger}->log("[anti-flood] I am not an op for ${channel}-floodbans, disregarding join-flood.\n");
} }
} }
$channel_data->{join_watch} = $max_messages - 2; # give them a chance to rejoin $channel_data->{join_watch} = $max_messages - 2; # give them a chance to rejoin
$self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $channel, $channel_data); $self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $channel, $channel_data);
} }
} elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_CHAT}) { } elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_CHAT}) {
if ($channel =~ /^#/) { #channel flood (opposed to private message or otherwise) if ($channel =~ /^#/) { #channel flood (opposed to private message or otherwise)
# don't increment offenses again if already banned # don't increment offenses again if already banned
@ -915,7 +915,7 @@ sub check_bans {
if ($self->whitelisted($baninfo->{channel}, $baninfo->{banmask}, 'ban') || $self->whitelisted($baninfo->{channel}, $mask, 'user')) { if ($self->whitelisted($baninfo->{channel}, $baninfo->{banmask}, 'ban') || $self->whitelisted($baninfo->{channel}, $mask, 'user')) {
#$self->{pbot}->{logger}->log("anti-flood: [check-bans] $mask [$alias] evaded $baninfo->{banmask} in $baninfo->{channel}, but allowed through whitelist\n"); #$self->{pbot}->{logger}->log("anti-flood: [check-bans] $mask [$alias] evaded $baninfo->{banmask} in $baninfo->{channel}, but allowed through whitelist\n");
next; next;
} }
# special case for twkm clone bans # special case for twkm clone bans
if ($baninfo->{banmask} =~ m/\?\*!\*@\*$/) { if ($baninfo->{banmask} =~ m/\?\*!\*@\*$/) {

2
PBot/AntiSpam.pm
View File

@ -31,7 +31,7 @@ sub new {
sub initialize { sub initialize {
my ($self, %conf) = @_; my ($self, %conf) = @_;
$self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__); $self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
my $filename = delete $conf{spamkeywords_file} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spam_keywords'; my $filename = delete $conf{spamkeywords_file} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spam_keywords';

8
PBot/BlackList.pm
View File

@ -57,7 +57,7 @@ sub remove {
$channel = lc $channel; $channel = lc $channel;
$hostmask = lc $hostmask; $hostmask = lc $hostmask;
if (exists $self->{blacklist}->{$channel}) { if (exists $self->{blacklist}->{$channel}) {
delete $self->{blacklist}->{$channel}->{$hostmask}; delete $self->{blacklist}->{$channel}->{$hostmask};
if (keys %{ $self->{blacklist}->{$channel} } == 0) { if (keys %{ $self->{blacklist}->{$channel} } == 0) {
@ -85,7 +85,7 @@ sub load_blacklist {
} }
$self->{pbot}->{logger}->log("Loading blacklist from $filename ...\n"); $self->{pbot}->{logger}->log("Loading blacklist from $filename ...\n");
open(FILE, "< $filename") or Carp::croak "Couldn't open $filename: $!\n"; open(FILE, "< $filename") or Carp::croak "Couldn't open $filename: $!\n";
my @contents = <FILE>; my @contents = <FILE>;
close(FILE); close(FILE);
@ -97,11 +97,11 @@ sub load_blacklist {
$i++; $i++;
my ($channel, $hostmask) = split(/\s+/, $line); my ($channel, $hostmask) = split(/\s+/, $line);
if (not defined $hostmask || not defined $channel) { if (not defined $hostmask || not defined $channel) {
Carp::croak "Syntax error around line $i of $filename\n"; Carp::croak "Syntax error around line $i of $filename\n";
} }
if (exists $self->{blacklist}->{$channel}->{$hostmask}) { if (exists $self->{blacklist}->{$channel}->{$hostmask}) {
Carp::croak "Duplicate blacklist entry [$hostmask][$channel] found in $filename around line $i\n"; Carp::croak "Duplicate blacklist entry [$hostmask][$channel] found in $filename around line $i\n";
} }

4
PBot/BotAdminCommands.pm
View File

@ -38,7 +38,7 @@ sub initialize {
} }
$self->{pbot} = $pbot; $self->{pbot} = $pbot;
$pbot->{commands}->register(sub { return $self->login(@_) }, "login", 0); $pbot->{commands}->register(sub { return $self->login(@_) }, "login", 0);
$pbot->{commands}->register(sub { return $self->logout(@_) }, "logout", 0); $pbot->{commands}->register(sub { return $self->logout(@_) }, "logout", 0);
$pbot->{commands}->register(sub { return $self->in_channel(@_) }, "in", 0); $pbot->{commands}->register(sub { return $self->in_channel(@_) }, "in", 0);
@ -295,7 +295,7 @@ sub export {
} }
if ($arguments =~ /^factoids$/i) { if ($arguments =~ /^factoids$/i) {
return $self->{pbot}->{factoids}->export_factoids; return $self->{pbot}->{factoids}->export_factoids;
} }
if ($arguments =~ /^admins$/i) { if ($arguments =~ /^admins$/i) {

4
PBot/BotAdmins.pm
View File

@ -105,7 +105,7 @@ sub load_admins {
$self->{pbot}->{logger}->log("Loading admins from $filename ...\n"); $self->{pbot}->{logger}->log("Loading admins from $filename ...\n");
$self->{admins}->load; $self->{admins}->load;
my $i = 0; my $i = 0;
foreach my $channel (keys %{ $self->{admins}->hash } ) { foreach my $channel (keys %{ $self->{admins}->hash } ) {
@ -130,7 +130,7 @@ sub load_admins {
sub save_admins { sub save_admins {
my $self = shift; my $self = shift;
$self->{admins}->save; $self->{admins}->save;
$self->export_admins; $self->export_admins;
} }

4
PBot/DualIndexHashObject.pm
View File

@ -1,7 +1,7 @@
# File: DualIndexHashObject.pm # File: DualIndexHashObject.pm
# Author: pragma_ # Author: pragma_
# #
# Purpose: Provides a hash-table object with an abstracted API that includes # Purpose: Provides a hash-table object with an abstracted API that includes
# setting and deleting values, saving to and loading from files, etc. # setting and deleting values, saving to and loading from files, etc.
# This Source Code Form is subject to the terms of the Mozilla Public # This Source Code Form is subject to the terms of the Mozilla Public
@ -182,7 +182,7 @@ sub levenshtein_matches {
$distance = 0.60 if not defined $distance; $distance = 0.60 if not defined $distance;
$primary_index_key = '.*' if not defined $primary_index_key; $primary_index_key = '.*' if not defined $primary_index_key;
if (not $secondary_index_key) { if (not $secondary_index_key) {
foreach my $index (sort keys %{ $self->hash }) { foreach my $index (sort keys %{ $self->hash }) {
my $distance_result = fastdistance($primary_index_key, $index); my $distance_result = fastdistance($primary_index_key, $index);

30
PBot/FactoidCommands.pm
View File

@ -66,7 +66,7 @@ sub initialize {
$self->{pbot} = $pbot; $self->{pbot} = $pbot;
$pbot->{registry}->add_default('text', 'general', 'module_repo', $conf{module_repo} // 'https://github.com/pragma-/pbot/blob/master/modules/'); $pbot->{registry}->add_default('text', 'general', 'module_repo', $conf{module_repo} // 'https://github.com/pragma-/pbot/blob/master/modules/');
$pbot->{commands}->register(sub { return $self->factadd(@_) }, "learn", 0); $pbot->{commands}->register(sub { return $self->factadd(@_) }, "learn", 0);
$pbot->{commands}->register(sub { return $self->factadd(@_) }, "factadd", 0); $pbot->{commands}->register(sub { return $self->factadd(@_) }, "factadd", 0);
$pbot->{commands}->register(sub { return $self->factrem(@_) }, "forget", 0); $pbot->{commands}->register(sub { return $self->factrem(@_) }, "forget", 0);
@ -169,7 +169,7 @@ sub log_factoid {
sub find_factoid_with_optional_channel { sub find_factoid_with_optional_channel {
my ($self, $from, $arguments, $command, %opts) = @_; my ($self, $from, $arguments, $command, %opts) = @_;
my %default_opts = ( my %default_opts = (
usage => undef, usage => undef,
explicit => 0, explicit => 0,
@ -695,7 +695,7 @@ sub list {
my $self = shift; my $self = shift;
my ($from, $nick, $user, $host, $arguments) = @_; my ($from, $nick, $user, $host, $arguments) = @_;
my $text; my $text;
if (not defined $arguments) { if (not defined $arguments) {
return "Usage: list <modules|factoids|commands|admins>"; return "Usage: list <modules|factoids|commands|admins>";
} }
@ -829,7 +829,7 @@ sub factmove {
if ($src_channel eq $target_channel) { if ($src_channel eq $target_channel) {
$self->log_factoid($target_channel, $target, "$nick!$user\@$host", "renamed from $found_source to $target"); $self->log_factoid($target_channel, $target, "$nick!$user\@$host", "renamed from $found_source to $target");
return "[$found_src_channel] $found_source renamed to $target"; return "[$found_src_channel] $found_source renamed to $target";
} else { } else {
$self->log_factoid($found_src_channel, $found_source, "$nick!$user\@$host", "moved from $found_src_channel/$found_source to $target_channel/$target"); $self->log_factoid($found_src_channel, $found_source, "$nick!$user\@$host", "moved from $found_src_channel/$found_source to $target_channel/$target");
$self->log_factoid($target_channel, $target, "$nick!$user\@$host", "moved from $found_src_channel/$found_source to $target_channel/$target"); $self->log_factoid($target_channel, $target, "$nick!$user\@$host", "moved from $found_src_channel/$found_source to $target_channel/$target");
@ -870,7 +870,7 @@ sub factalias {
} }
my ($channel, $alias_trigger) = $self->{pbot}->{factoids}->find_factoid($chan, $alias, exact_channel => 1, exact_trigger => 1); my ($channel, $alias_trigger) = $self->{pbot}->{factoids}->find_factoid($chan, $alias, exact_channel => 1, exact_trigger => 1);
if (defined $alias_trigger) { if (defined $alias_trigger) {
$self->{pbot}->{logger}->log("attempt to overwrite existing command\n"); $self->{pbot}->{logger}->log("attempt to overwrite existing command\n");
return "'$alias_trigger' already exists for channel $channel"; return "'$alias_trigger' already exists for channel $channel";
@ -890,7 +890,7 @@ sub factalias {
$self->{pbot}->{logger}->log("$nick!$user\@$host [$chan] aliased $alias => $command\n"); $self->{pbot}->{logger}->log("$nick!$user\@$host [$chan] aliased $alias => $command\n");
$self->{pbot}->{factoids}->save_factoids(); $self->{pbot}->{factoids}->save_factoids();
return "'$alias' aliases '$command' for " . ($chan eq '.*' ? 'the global channel' : $chan); return "'$alias' aliases '$command' for " . ($chan eq '.*' ? 'the global channel' : $chan);
} }
sub add_regex { sub add_regex {
@ -1018,7 +1018,7 @@ sub factadd {
} }
$self->{pbot}->{factoids}->add_factoid('text', $from_chan, "$nick!$user\@$host", $keyword, $text); $self->{pbot}->{factoids}->add_factoid('text', $from_chan, "$nick!$user\@$host", $keyword, $text);
$self->{pbot}->{logger}->log("$nick!$user\@$host added [$from_chan] $keyword_text => $text\n"); $self->{pbot}->{logger}->log("$nick!$user\@$host added [$from_chan] $keyword_text => $text\n");
return "/say $keyword_text added to " . ($from_chan eq '.*' ? 'global channel' : $from_chan) . "."; return "/say $keyword_text added to " . ($from_chan eq '.*' ? 'global channel' : $from_chan) . ".";
} }
@ -1091,7 +1091,7 @@ sub histogram {
foreach my $owner (sort {$hash{$b} <=> $hash{$a}} keys %hash) { foreach my $owner (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
my $percent = int($hash{$owner} / $factoid_count * 100); my $percent = int($hash{$owner} / $factoid_count * 100);
$text .= "$owner: $hash{$owner} ($percent". "%)\n"; $text .= "$owner: $hash{$owner} ($percent". "%)\n";
$i++; $i++;
last if $i >= 10; last if $i >= 10;
} }
@ -1226,19 +1226,19 @@ sub factinfo {
# factoid # factoid
if ($factoids->{$channel}->{$trigger}->{type} eq 'text') { if ($factoids->{$channel}->{$trigger}->{type} eq 'text') {
return "/say $trigger: Factoid submitted by " . $factoids->{$channel}->{$trigger}->{owner} . " for $chan on " . localtime($factoids->{$channel}->{$trigger}->{created_on}) . " [$created_ago], " . (defined $factoids->{$channel}->{$trigger}->{edited_by} ? "last edited by $factoids->{$channel}->{$trigger}->{edited_by} on " . localtime($factoids->{$channel}->{$trigger}->{edited_on}) . " [" . ago(gettimeofday - $factoids->{$channel}->{$trigger}->{edited_on}) . "], " : "") . "referenced " . $factoids->{$channel}->{$trigger}->{ref_count} . " times (last by " . $factoids->{$channel}->{$trigger}->{ref_user} . (exists $factoids->{$channel}->{$trigger}->{last_referenced_on} ? " on " . localtime($factoids->{$channel}->{$trigger}->{last_referenced_on}) . " [$ref_ago]" : "") . ")"; return "/say $trigger: Factoid submitted by " . $factoids->{$channel}->{$trigger}->{owner} . " for $chan on " . localtime($factoids->{$channel}->{$trigger}->{created_on}) . " [$created_ago], " . (defined $factoids->{$channel}->{$trigger}->{edited_by} ? "last edited by $factoids->{$channel}->{$trigger}->{edited_by} on " . localtime($factoids->{$channel}->{$trigger}->{edited_on}) . " [" . ago(gettimeofday - $factoids->{$channel}->{$trigger}->{edited_on}) . "], " : "") . "referenced " . $factoids->{$channel}->{$trigger}->{ref_count} . " times (last by " . $factoids->{$channel}->{$trigger}->{ref_user} . (exists $factoids->{$channel}->{$trigger}->{last_referenced_on} ? " on " . localtime($factoids->{$channel}->{$trigger}->{last_referenced_on}) . " [$ref_ago]" : "") . ")";
} }
# module # module
if ($factoids->{$channel}->{$trigger}->{type} eq 'module') { if ($factoids->{$channel}->{$trigger}->{type} eq 'module') {
my $module_repo = $self->{pbot}->{registry}->get_value('general', 'module_repo'); my $module_repo = $self->{pbot}->{registry}->get_value('general', 'module_repo');
$module_repo .= "$factoids->{$channel}->{$trigger}->{workdir}/" if exists $factoids->{$channel}->{$trigger}->{workdir}; $module_repo .= "$factoids->{$channel}->{$trigger}->{workdir}/" if exists $factoids->{$channel}->{$trigger}->{workdir};
return "/say $trigger: Module loaded by " . $factoids->{$channel}->{$trigger}->{owner} . " for $chan on " . localtime($factoids->{$channel}->{$trigger}->{created_on}) . " [$created_ago] -> $module_repo" . $factoids->{$channel}->{$trigger}->{action} . ", used " . $factoids->{$channel}->{$trigger}->{ref_count} . " times (last by " . $factoids->{$channel}->{$trigger}->{ref_user} . (exists $factoids->{$channel}->{$trigger}->{last_referenced_on} ? " on " . localtime($factoids->{$channel}->{$trigger}->{last_referenced_on}) . " [$ref_ago]" : "") . ")"; return "/say $trigger: Module loaded by " . $factoids->{$channel}->{$trigger}->{owner} . " for $chan on " . localtime($factoids->{$channel}->{$trigger}->{created_on}) . " [$created_ago] -> $module_repo" . $factoids->{$channel}->{$trigger}->{action} . ", used " . $factoids->{$channel}->{$trigger}->{ref_count} . " times (last by " . $factoids->{$channel}->{$trigger}->{ref_user} . (exists $factoids->{$channel}->{$trigger}->{last_referenced_on} ? " on " . localtime($factoids->{$channel}->{$trigger}->{last_referenced_on}) . " [$ref_ago]" : "") . ")";
} }
# regex # regex
if ($factoids->{$channel}->{$trigger}->{type} eq 'regex') { if ($factoids->{$channel}->{$trigger}->{type} eq 'regex') {
return "/say $trigger: Regex created by " . $factoids->{$channel}->{$trigger}->{owner} . " for $chan on " . localtime($factoids->{$channel}->{$trigger}->{created_on}) . " [$created_ago], " . (defined $factoids->{$channel}->{$trigger}->{edited_by} ? "last edited by $factoids->{$channel}->{$trigger}->{edited_by} on " . localtime($factoids->{$channel}->{$trigger}->{edited_on}) . " [" . ago(gettimeofday - $factoids->{$channel}->{$trigger}->{edited_on}) . "], " : "") . " used " . $factoids->{$channel}->{$trigger}->{ref_count} . " times (last by " . $factoids->{$channel}->{$trigger}->{ref_user} . (exists $factoids->{$channel}->{$trigger}->{last_referenced_on} ? " on " . localtime($factoids->{$channel}->{$trigger}->{last_referenced_on}) . " [$ref_ago]" : "") . ")"; return "/say $trigger: Regex created by " . $factoids->{$channel}->{$trigger}->{owner} . " for $chan on " . localtime($factoids->{$channel}->{$trigger}->{created_on}) . " [$created_ago], " . (defined $factoids->{$channel}->{$trigger}->{edited_by} ? "last edited by $factoids->{$channel}->{$trigger}->{edited_by} on " . localtime($factoids->{$channel}->{$trigger}->{edited_on}) . " [" . ago(gettimeofday - $factoids->{$channel}->{$trigger}->{edited_on}) . "], " : "") . " used " . $factoids->{$channel}->{$trigger}->{ref_count} . " times (last by " . $factoids->{$channel}->{$trigger}->{ref_user} . (exists $factoids->{$channel}->{$trigger}->{last_referenced_on} ? " on " . localtime($factoids->{$channel}->{$trigger}->{last_referenced_on}) . " [$ref_ago]" : "") . ")";
} }
return "/say $arguments is not a factoid or a module"; return "/say $arguments is not a factoid or a module";
@ -1327,7 +1327,7 @@ sub count {
foreach my $channel (keys %{ $factoids }) { foreach my $channel (keys %{ $factoids }) {
foreach my $command (keys %{ $factoids->{$channel} }) { foreach my $command (keys %{ $factoids->{$channel} }) {
next if $factoids->{$channel}->{$command}->{type} ne 'text'; next if $factoids->{$channel}->{$command}->{type} ne 'text';
$total++; $total++;
if ($factoids->{$channel}->{$command}->{owner} =~ /^\Q$arguments\E$/i) { if ($factoids->{$channel}->{$command}->{owner} =~ /^\Q$arguments\E$/i) {
$i++; $i++;
} }
@ -1437,7 +1437,7 @@ sub factfind {
next if ($arguments ne "" && $factoids->{$chan}->{$trigger}->{action} !~ /$regex/i && $trigger !~ /$regex/i); next if ($arguments ne "" && $factoids->{$chan}->{$trigger}->{action} !~ /$regex/i && $trigger !~ /$regex/i);
$i++; $i++;
if ($chan ne $last_chan) { if ($chan ne $last_chan) {
$text .= $chan eq '.*' ? "[global channel] " : "[$chan] "; $text .= $chan eq '.*' ? "[global channel] " : "[$chan] ";
$last_chan = $chan; $last_chan = $chan;
@ -1500,7 +1500,7 @@ sub factchange {
$delim = quotemeta $delim; $delim = quotemeta $delim;
if ($sub =~ /^s$delim(.*?)$delim(.*)$delim(.*)$/) { if ($sub =~ /^s$delim(.*?)$delim(.*)$delim(.*)$/) {
$tochange = $1; $tochange = $1;
$changeto = $2; $changeto = $2;
$modifier = $3; $modifier = $3;
} elsif ($sub =~ /^s$delim(.*?)$delim(.*)$/) { } elsif ($sub =~ /^s$delim(.*?)$delim(.*)$/) {
@ -1668,7 +1668,7 @@ sub unload_module {
$self->{pbot}->{factoids}->save_factoids(); $self->{pbot}->{factoids}->save_factoids();
$self->{pbot}->{logger}->log("$nick!$user\@$host unloaded module $arguments\n"); $self->{pbot}->{logger}->log("$nick!$user\@$host unloaded module $arguments\n");
return "/say $arguments unloaded."; return "/say $arguments unloaded.";
} }
} }
1; 1;

6
PBot/FactoidModuleLauncher.pm
View File

@ -88,14 +88,14 @@ sub execute_module {
close $writer; close $writer;
$stuff->{checkflood} = 1; $stuff->{checkflood} = 1;
$self->{pbot}->{interpreter}->handle_result($stuff, "/me groans loudly.\n"); $self->{pbot}->{interpreter}->handle_result($stuff, "/me groans loudly.\n");
return; return;
} }
# FIXME -- add check to ensure $module exists # FIXME -- add check to ensure $module exists
if ($pid == 0) { # start child block if ($pid == 0) { # start child block
close $reader; close $reader;
# don't quit the IRC client when the child dies # don't quit the IRC client when the child dies
no warnings; no warnings;
*PBot::IRC::Connection::DESTROY = sub { return; }; *PBot::IRC::Connection::DESTROY = sub { return; };
@ -161,7 +161,7 @@ sub module_pipe_reader {
$stuff->{no_nickoverride} = 0; $stuff->{no_nickoverride} = 0;
$stuff->{force_nickoverride} = 1; $stuff->{force_nickoverride} = 1;
} else { } else {
# extract nick-like thing from module result # extract nick-like thing from module result
if ($stuff->{result} =~ s/^(\S+): //) { if ($stuff->{result} =~ s/^(\S+): //) {
my $nick = $1; my $nick = $1;
if (lc $nick eq "usage") { if (lc $nick eq "usage") {

20
PBot/Factoids.pm
View File

@ -164,7 +164,7 @@ sub export_factoids {
print FILE '<script type="text/javascript" src="js/picnet.table.filter.min.js"></script>' . "\n"; print FILE '<script type="text/javascript" src="js/picnet.table.filter.min.js"></script>' . "\n";
print FILE "</head>\n<body><i>Last updated at $time</i>\n"; print FILE "</head>\n<body><i>Last updated at $time</i>\n";
print FILE "<hr><h2>Candide's factoids</h2>\n"; print FILE "<hr><h2>Candide's factoids</h2>\n";
my $i = 0; my $i = 0;
my $table_id = 1; my $table_id = 1;
@ -201,7 +201,7 @@ sub export_factoids {
} else { } else {
print FILE "<tr>\n"; print FILE "<tr>\n";
} }
print FILE "<td>" . encode_entities($self->{factoids}->hash->{$channel}->{$trigger}->{owner}) . "</td>\n"; print FILE "<td>" . encode_entities($self->{factoids}->hash->{$channel}->{$trigger}->{owner}) . "</td>\n";
print FILE "<td>" . encode_entities(strftime "%Y/%m/%d %H:%M:%S", localtime $self->{factoids}->hash->{$channel}->{$trigger}->{created_on}) . "</td>\n"; print FILE "<td>" . encode_entities(strftime "%Y/%m/%d %H:%M:%S", localtime $self->{factoids}->hash->{$channel}->{$trigger}->{created_on}) . "</td>\n";
@ -225,7 +225,7 @@ sub export_factoids {
print FILE "<td width=100%><b>" . encode_entities($trigger) . "</b> is $action</td>\n"; print FILE "<td width=100%><b>" . encode_entities($trigger) . "</b> is $action</td>\n";
} }
if (exists $self->{factoids}->hash->{$channel}->{$trigger}->{edited_by}) { if (exists $self->{factoids}->hash->{$channel}->{$trigger}->{edited_by}) {
print FILE "<td>" . $self->{factoids}->hash->{$channel}->{$trigger}->{edited_by} . "</td>\n"; print FILE "<td>" . $self->{factoids}->hash->{$channel}->{$trigger}->{edited_by} . "</td>\n";
print FILE "<td>" . encode_entities(strftime "%Y/%m/%d %H:%M:%S", localtime $self->{factoids}->hash->{$channel}->{$trigger}->{edited_on}) . "</td>\n"; print FILE "<td>" . encode_entities(strftime "%Y/%m/%d %H:%M:%S", localtime $self->{factoids}->hash->{$channel}->{$trigger}->{edited_on}) . "</td>\n";
} else { } else {
@ -240,7 +240,7 @@ sub export_factoids {
} else { } else {
print FILE "<td></td>\n"; print FILE "<td></td>\n";
} }
print FILE "</tr>\n"; print FILE "</tr>\n";
} }
} }
@ -261,9 +261,9 @@ sub export_factoids {
print FILE "});\n"; print FILE "});\n";
print FILE "</script>\n"; print FILE "</script>\n";
print FILE "</body>\n</html>\n"; print FILE "</body>\n</html>\n";
close(FILE); close(FILE);
#$self->{pbot}->{logger}->log("$i factoids exported to path: " . $self->export_path . ", site: " . $self->export_site . "\n"); #$self->{pbot}->{logger}->log("$i factoids exported to path: " . $self->export_path . ", site: " . $self->export_site . "\n");
return "/say $i factoids exported to " . $self->export_site; return "/say $i factoids exported to " . $self->export_site;
} }
@ -804,7 +804,7 @@ sub interpreter {
if ($found > 1) { if ($found > 1) {
return undef if $stuff->{referenced}; return undef if $stuff->{referenced};
return $ref_from . "Ambiguous keyword '$original_keyword' exists in multiple channels (use 'fact <channel> <keyword>' to choose one): $chans"; return $ref_from . "Ambiguous keyword '$original_keyword' exists in multiple channels (use 'fact <channel> <keyword>' to choose one): $chans";
} }
# if there's just one other channel that has this keyword, trigger that instance # if there's just one other channel that has this keyword, trigger that instance
elsif ($found == 1) { elsif ($found == 1) {
$pbot->{logger}->log("Found '$original_keyword' as '$fwd_trig' in [$fwd_chan]\n"); $pbot->{logger}->log("Found '$original_keyword' as '$fwd_trig' in [$fwd_chan]\n");
@ -812,12 +812,12 @@ sub interpreter {
$stuff->{interpret_depth}++; $stuff->{interpret_depth}++;
$stuff->{ref_from} = $fwd_chan; $stuff->{ref_from} = $fwd_chan;
return $pbot->{factoids}->interpreter($stuff); return $pbot->{factoids}->interpreter($stuff);
} }
# otherwise keyword hasn't been found, display similiar matches for all channels # otherwise keyword hasn't been found, display similiar matches for all channels
else { else {
# if a non-nick argument was supplied, e.g., a sentence using the bot's nick, don't say anything # if a non-nick argument was supplied, e.g., a sentence using the bot's nick, don't say anything
return undef if length $stuff->{arguments} and not $self->{pbot}->{nicklist}->is_present($stuff->{from}, $stuff->{arguments}); return undef if length $stuff->{arguments} and not $self->{pbot}->{nicklist}->is_present($stuff->{from}, $stuff->{arguments});
my $namespace = $strictnamespace ? $stuff->{from} : '.*'; my $namespace = $strictnamespace ? $stuff->{from} : '.*';
$namespace = '.*' if $namespace !~ /^#/; $namespace = '.*' if $namespace !~ /^#/;
@ -1137,7 +1137,7 @@ sub handle_action {
return ""; return "";
} }
} else { } else {
$self->{pbot}->{logger}->log("($stuff->{from}): $stuff->{nick}!$stuff->{user}\@$stuff->{host}): Unknown command type for '$keyword_text'\n"); $self->{pbot}->{logger}->log("($stuff->{from}): $stuff->{nick}!$stuff->{user}\@$stuff->{host}): Unknown command type for '$keyword_text'\n");
return "/me blinks." . " $ref_from"; return "/me blinks." . " $ref_from";
} }
} }

6
PBot/HashObject.pm
View File

@ -1,7 +1,7 @@
# File: HashObject.pm # File: HashObject.pm
# Author: pragma_ # Author: pragma_
# #
# Purpose: Provides a hash-table object with an abstracted API that includes # Purpose: Provides a hash-table object with an abstracted API that includes
# setting and deleting values, saving to and loading from files, etc. # setting and deleting values, saving to and loading from files, etc.
# This Source Code Form is subject to the terms of the Mozilla Public # This Source Code Form is subject to the terms of the Mozilla Public
@ -172,12 +172,12 @@ sub levenshtein_matches {
my ($self, $keyword) = @_; my ($self, $keyword) = @_;
my $comma = ''; my $comma = '';
my $result = ""; my $result = "";
foreach my $index (sort keys %{ $self->hash }) { foreach my $index (sort keys %{ $self->hash }) {
my $distance = fastdistance($keyword, $index); my $distance = fastdistance($keyword, $index);
# print "Distance $distance for $keyword (" , (length $keyword) , ") vs $index (" , length $index , ")\n"; # print "Distance $distance for $keyword (" , (length $keyword) , ") vs $index (" , length $index , ")\n";
my $length = (length($keyword) > length($index)) ? length $keyword : length $index; my $length = (length($keyword) > length($index)) ? length $keyword : length $index;
# print "Percentage: ", $distance / $length, "\n"; # print "Percentage: ", $distance / $length, "\n";

38
PBot/IRC.pm
View File

@ -16,7 +16,7 @@
package PBot::IRC; # pragma_ 2011/01/21 package PBot::IRC; # pragma_ 2011/01/21
BEGIN { require 5.004; } # needs IO::* and $coderef->(@args) syntax BEGIN { require 5.004; } # needs IO::* and $coderef->(@args) syntax
use PBot::IRC::Connection; # pragma_ 2011/01/21 use PBot::IRC::Connection; # pragma_ 2011/01/21
use PBot::IRC::EventQueue; # pragma_ 2011/01/21 use PBot::IRC::EventQueue; # pragma_ 2011/01/21
@ -37,7 +37,7 @@ $VERSION = "0.79";
sub new { sub new {
my $proto = shift; my $proto = shift;
my $self = { my $self = {
'_conn' => [], '_conn' => [],
'_connhash' => {}, '_connhash' => {},
@ -49,9 +49,9 @@ sub new {
'_timeout' => 1, '_timeout' => 1,
'_write' => IO::Select->new(), '_write' => IO::Select->new(),
}; };
bless $self, $proto; bless $self, $proto;
return $self; return $self;
} }
@ -70,7 +70,7 @@ sub schedulequeue {
# (optional) a flag string to pass to addfh() (see below) # (optional) a flag string to pass to addfh() (see below)
sub addconn { sub addconn {
my ($self, $conn) = @_; my ($self, $conn) = @_;
$self->addfh( $conn->socket, $conn->can('parse'), ($_[2] || 'r'), $conn); $self->addfh( $conn->socket, $conn->can('parse'), ($_[2] || 'r'), $conn);
} }
@ -84,9 +84,9 @@ sub addconn {
sub addfh { sub addfh {
my ($self, $fh, $code, $flag, $obj) = @_; my ($self, $fh, $code, $flag, $obj) = @_;
my ($letter); my ($letter);
die "Not enough arguments to IRC->addfh()" unless defined $code; die "Not enough arguments to IRC->addfh()" unless defined $code;
if ($flag) { if ($flag) {
foreach $letter (split(//, lc $flag)) { foreach $letter (split(//, lc $flag)) {
if ($letter eq 'r') { if ($letter eq 'r') {
@ -100,7 +100,7 @@ sub addfh {
} else { } else {
$self->{_read}->add( $fh ); $self->{_read}->add( $fh );
} }
$self->{_connhash}->{$fh} = [ $code, $obj ]; $self->{_connhash}->{$fh} = [ $code, $obj ];
} }
@ -108,7 +108,7 @@ sub addfh {
# Takes 1 optional arg: a new boolean value for the flag. # Takes 1 optional arg: a new boolean value for the flag.
sub debug { sub debug {
my $self = shift; my $self = shift;
if (@_) { if (@_) {
$self->{_debug} = $_[0]; $self->{_debug} = $_[0];
} }
@ -156,7 +156,7 @@ sub do_one_loop {
# Block until input arrives, then hand the filehandle over to the # Block until input arrives, then hand the filehandle over to the
# user-supplied coderef. Look! It's a freezer full of government cheese! # user-supplied coderef. Look! It's a freezer full of government cheese!
if ($nexttimer) { if ($nexttimer) {
$timeout = $nexttimer - $time < $self->{_timeout} $timeout = $nexttimer - $time < $self->{_timeout}
? $nexttimer - $time : $self->{_timeout}; ? $nexttimer - $time : $self->{_timeout};
@ -170,11 +170,11 @@ sub do_one_loop {
foreach $sock (@{$ev}) { foreach $sock (@{$ev}) {
my $conn = $self->{_connhash}->{$sock}; my $conn = $self->{_connhash}->{$sock};
$conn or next; $conn or next;
# $conn->[0] is a code reference to a handler sub. # $conn->[0] is a code reference to a handler sub.
# $conn->[1] is optionally an object which the # $conn->[1] is optionally an object which the
# handler sub may be a method of. # handler sub may be a method of.
$conn->[0]->($conn->[1] ? ($conn->[1], $sock) : $sock); $conn->[0]->($conn->[1] ? ($conn->[1], $sock) : $sock);
} }
} }
@ -193,7 +193,7 @@ sub flush_output_queue {
sub newconn { sub newconn {
my $self = shift; my $self = shift;
my $conn = PBot::IRC::Connection->new($self, @_); # pragma_ 2011/01/21 my $conn = PBot::IRC::Connection->new($self, @_); # pragma_ 2011/01/21
return if $conn->error; return if $conn->error;
return $conn; return $conn;
} }
@ -236,14 +236,14 @@ sub dequeue_output_event {
# Takes 1 arg: a Connection (or DCC or whatever) to remove. # Takes 1 arg: a Connection (or DCC or whatever) to remove.
sub removeconn { sub removeconn {
my ($self, $conn) = @_; my ($self, $conn) = @_;
$self->removefh( $conn->socket ); $self->removefh( $conn->socket );
} }
# Given a filehandle, removes it from all select lists. You get the picture. # Given a filehandle, removes it from all select lists. You get the picture.
sub removefh { sub removefh {
my ($self, $fh) = @_; my ($self, $fh) = @_;
$self->{_read}->remove( $fh ); $self->{_read}->remove( $fh );
$self->{_write}->remove( $fh ); $self->{_write}->remove( $fh );
$self->{_error}->remove( $fh ); $self->{_error}->remove( $fh );
@ -254,7 +254,7 @@ sub removefh {
# first... (takes no args, of course) # first... (takes no args, of course)
sub start { sub start {
my $self = shift; my $self = shift;
while (1) { while (1) {
$self->do_one_loop(); $self->do_one_loop();
} }
@ -265,7 +265,7 @@ sub start {
# Fractional timeout values are just fine, as per the core select(). # Fractional timeout values are just fine, as per the core select().
sub timeout { sub timeout {
my $self = shift; my $self = shift;
if (@_) { $self->{_timeout} = $_[0] } if (@_) { $self->{_timeout} = $_[0] }
return $self->{_timeout}; return $self->{_timeout};
} }
@ -476,7 +476,7 @@ SSL
If you wish to connect to an irc server which is using SSL, set this to a If you wish to connect to an irc server which is using SSL, set this to a
true value. Ie: "C<SSL => 1>". true value. Ie: "C<SSL => 1>".
=back =back
=head2 Handlers =head2 Handlers
@ -756,4 +756,4 @@ http://www.irchelp.org/, home of fine IRC resources.
=cut =cut

380
PBot/IRC/Connection.pm
View File

File diff suppressed because it is too large Load Diff

80
PBot/IRC/DCC.pm
View File

@ -90,13 +90,13 @@ sub _getline {
if (defined $sock->recv($input, 10240)) { if (defined $sock->recv($input, 10240)) {
$frag .= $input; $frag .= $input;
if (length($frag) > 0) { if (length($frag) > 0) {
warn "Got ". length($frag) ." bytes from $sock\n" warn "Got ". length($frag) ." bytes from $sock\n"
if $self->{_debug}; if $self->{_debug};
if ($block) { # Block mode (GET) if ($block) { # Block mode (GET)
return $input; return $input;
} else { # Line mode (CHAT) } else { # Line mode (CHAT)
# We're returning \n's 'cause DCC's need 'em # We're returning \n's 'cause DCC's need 'em
my @lines = split /\012/, $frag, -1; my @lines = split /\012/, $frag, -1;
@ -109,10 +109,10 @@ sub _getline {
# um, if we can read, i say we should read more than 0 # um, if we can read, i say we should read more than 0
# besides, recv isn't returning undef on closed # besides, recv isn't returning undef on closed
# sockets. getting rid of this connection... # sockets. getting rid of this connection...
warn "recv() received 0 bytes in _getline, closing connection.\n" warn "recv() received 0 bytes in _getline, closing connection.\n"
if $self->{_debug}; if $self->{_debug};
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01 $self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_nick}, $self->{_nick},
$self->{_socket}, $self->{_socket},
@ -124,10 +124,10 @@ sub _getline {
} }
} else { } else {
# Error, lets scrap this connection # Error, lets scrap this connection
warn "recv() returned undef, socket error in _getline()\n" warn "recv() returned undef, socket error in _getline()\n"
if $self->{_debug}; if $self->{_debug};
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01 $self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_nick}, $self->{_nick},
$self->{_socket}, $self->{_socket},
@ -141,10 +141,10 @@ sub _getline {
sub DESTROY { sub DESTROY {
my $self = shift; my $self = shift;
# Only do the Disconnection Dance of Death if the socket is still # Only do the Disconnection Dance of Death if the socket is still
# live. Duplicate dcc_close events would be a Bad Thing. # live. Duplicate dcc_close events would be a Bad Thing.
if ($self->{_socket}->opened) { if ($self->{_socket}->opened) {
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01 $self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
$self->{_nick}, $self->{_nick},
@ -154,7 +154,7 @@ sub DESTROY {
close $self->{_fh} if $self->{_fh}; close $self->{_fh} if $self->{_fh};
$self->{_parent}->{_parent}->parent->removeconn($self); $self->{_parent}->{_parent}->parent->removeconn($self);
} }
} }
sub peer { sub peer {
@ -200,7 +200,7 @@ sub new {
binmode $fh; # I love this next line. :-) binmode $fh; # I love this next line. :-)
ref $fh eq 'GLOB' ? select((select($fh), $|++)[0]) : $fh->autoflush(1); ref $fh eq 'GLOB' ? select((select($fh), $|++)[0]) : $fh->autoflush(1);
$sock = new IO::Socket::INET( Proto => "tcp", $sock = new IO::Socket::INET( Proto => "tcp",
PeerAddr => "$address:$port" ); PeerAddr => "$address:$port" );
@ -210,13 +210,13 @@ sub new {
$sock, $sock,
'get', 'get',
'get', $sock)); 'get', $sock));
} else { } else {
carp "Can't connect to $address: $!"; carp "Can't connect to $address: $!";
close $fh; close $fh;
return; return;
} }
$sock->autoflush(1); $sock->autoflush(1);
my $self = { my $self = {
@ -231,7 +231,7 @@ sub new {
_parent => $container, _parent => $container,
_size => $size, # Expected size of file _size => $size, # Expected size of file
_socket => $sock, # Socket we're reading from _socket => $sock, # Socket we're reading from
_time => time, _time => time,
_type => 'GET', _type => 'GET',
}; };
@ -265,10 +265,10 @@ sub parse {
$self->{_socket}->close; $self->{_socket}->close;
return; return;
} }
$self->{_bin} += length($line); $self->{_bin} += length($line);
# confirm the packet we've just recieved # confirm the packet we've just recieved
unless ( $self->{_socket}->send( pack("N", $self->{_bin}) ) ) { unless ( $self->{_socket}->send( pack("N", $self->{_bin}) ) ) {
carp "Error writing to DCC GET socket: $!"; carp "Error writing to DCC GET socket: $!";
@ -281,7 +281,7 @@ sub parse {
$self->{_socket}->close; $self->{_socket}->close;
return; return;
} }
$self->{_bout} += 4; $self->{_bout} += 4;
# The file is done. # The file is done.
@ -297,7 +297,7 @@ sub parse {
$self->{_socket}->close; $self->{_socket}->close;
return; return;
} }
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_update', # pragma_ 2011/21/01 $self->{_parent}->handler(PBot::IRC::Event->new('dcc_update', # pragma_ 2011/21/01
$self->{_nick}, $self->{_nick},
$self, $self,
@ -374,9 +374,9 @@ sub new {
carp "Couldn't open DCC SEND socket: $!"; carp "Couldn't open DCC SEND socket: $!";
$fh->close; $fh->close;
return; return;
} }
$container->ctcp('DCC SEND', $nick, $filename, $container->ctcp('DCC SEND', $nick, $filename,
unpack("N",inet_aton($container->hostname())), unpack("N",inet_aton($container->hostname())),
$sock->sockport(), $size); $sock->sockport(), $size);
@ -384,7 +384,7 @@ sub new {
my $self = { my $self = {
_bin => 0, # Bytes we've recieved thus far _bin => 0, # Bytes we've recieved thus far
_blocksize => $blocksize, _blocksize => $blocksize,
_bout => 0, # Bytes we've sent _bout => 0, # Bytes we've sent
_debug => $container->debug, _debug => $container->debug,
_fh => $fh, # FileHandle we will be reading from. _fh => $fh, # FileHandle we will be reading from.
@ -394,12 +394,12 @@ sub new {
_parent => $container, _parent => $container,
_size => $size, # Size of file _size => $size, # Size of file
_socket => $sock, # Socket we're writing to _socket => $sock, # Socket we're writing to
_time => 0, # This gets set by Accept->parse() _time => 0, # This gets set by Accept->parse()
_type => 'SEND', _type => 'SEND',
}; };
bless $self, $class; bless $self, $class;
$sock = PBot::IRC::DCC::Accept->new($sock, $self); # pragma_ 2011/21/01 $sock = PBot::IRC::DCC::Accept->new($sock, $self); # pragma_ 2011/21/01
unless (defined $sock) { unless (defined $sock) {
@ -443,9 +443,9 @@ sub parse {
$self->{_socket}->close; $self->{_socket}->close;
return; return;
} }
$size = unpack("N", $size); $size = unpack("N", $size);
if ($size >= $self->{_size}) { if ($size >= $self->{_size}) {
if ($self->{_debug}) { if ($self->{_debug}) {
@ -461,9 +461,9 @@ sub parse {
$self->{_type})); $self->{_type}));
$self->{_socket}->close; $self->{_socket}->close;
return; return;
} }
# we're still waiting for acknowledgement, # we're still waiting for acknowledgement,
# better not send any more # better not send any more
return if $size < $self->{_bout}; return if $size < $self->{_bout};
@ -504,7 +504,7 @@ sub parse {
$self, $self,
$self->{_type}, $self->{_type},
$self )); $self ));
return 1; return 1;
} }
@ -536,7 +536,7 @@ sub new {
$sock = new IO::Socket::INET( Proto => "tcp", $sock = new IO::Socket::INET( Proto => "tcp",
Listen => 1); Listen => 1);
unless (defined $sock) { unless (defined $sock) {
carp "Couldn't open DCC CHAT socket: $!"; carp "Couldn't open DCC CHAT socket: $!";
return; return;
@ -559,9 +559,9 @@ sub new {
_time => 0, # This gets set by Accept->parse() _time => 0, # This gets set by Accept->parse()
_type => 'CHAT', _type => 'CHAT',
}; };
bless $self, $class; bless $self, $class;
$sock = PBot::IRC::DCC::Accept->new($sock, $self); # pragma_ 2011/21/01 $sock = PBot::IRC::DCC::Accept->new($sock, $self); # pragma_ 2011/21/01
unless (defined $sock) { unless (defined $sock) {
@ -600,9 +600,9 @@ sub new {
_time => time, _time => time,
_type => 'CHAT', _type => 'CHAT',
}; };
bless $self, $class; bless $self, $class;
$self->{_parent}->parent->addfh($self->socket, $self->{_parent}->parent->addfh($self->socket,
$self->can('parse'), 'r', $self); $self->can('parse'), 'r', $self);
} }
@ -624,9 +624,9 @@ sub parse {
foreach my $line ($self->_getline($sock)) { foreach my $line ($self->_getline($sock)) {
return unless defined $line; return unless defined $line;
$self->{_bin} += length($line); $self->{_bin} += length($line);
return undef if $line eq "\012"; return undef if $line eq "\012";
$self->{_bout} += length($line); $self->{_bout} += length($line);
@ -635,7 +635,7 @@ sub parse {
$self->{_socket}, $self->{_socket},
'chat', 'chat',
$line)); $line));
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_update', # pragma_ 2011/21/01 $self->{_parent}->handler(PBot::IRC::Event->new('dcc_update', # pragma_ 2011/21/01
$self->{_nick}, $self->{_nick},
$self, $self,
@ -653,7 +653,7 @@ sub privmsg {
unless (@_) { unless (@_) {
croak 'Not enough arguments to privmsg()'; croak 'Not enough arguments to privmsg()';
} }
# Don't send a CR over DCC CHAT -- it's not wanted. # Don't send a CR over DCC CHAT -- it's not wanted.
$self->socket->send(join('', @_) . "\012"); $self->socket->send(join('', @_) . "\012");
} }
@ -688,7 +688,7 @@ sub new {
_parent => $parent, _parent => $parent,
_type => 'accept', _type => 'accept',
}; };
bless $self, $class; bless $self, $class;
# Tkil's gonna love this one. :-) But what the hell... it's safe to # Tkil's gonna love this one. :-) But what the hell... it's safe to
@ -726,7 +726,7 @@ sub parse {
return; return;
} }
} }
$self->{_parent}->{_parent}->parent->addconn($self->{_parent}); $self->{_parent}->{_parent}->parent->addconn($self->{_parent});
$self->{_parent}->{_parent}->parent->removeconn($self); $self->{_parent}->{_parent}->parent->removeconn($self);

32
PBot/IRC/Event.pm
View File

@ -40,7 +40,7 @@ sub new {
my $to = shift; my $to = shift;
my $format = shift; my $format = shift;
my $args = \@_; my $args = \@_;
my $self = { my $self = {
'type' => $type, 'type' => $type,
'from' => undef, 'from' => undef,
@ -48,18 +48,18 @@ sub new {
'format' => $format, 'format' => $format,
'args' => [], 'args' => [],
}; };
bless $self, $class; bless $self, $class;
if ($self->type !~ /\D/) { if ($self->type !~ /\D/) {
$self->type($self->trans($self->type)); $self->type($self->trans($self->type));
} else { } else {
$self->type(lc($self->type)); $self->type(lc($self->type));
} }
$self->from($from); # sets nick, user, and host $self->from($from); # sets nick, user, and host
$self->args($args); # strips colons from args $self->args($args); # strips colons from args
return $self; return $self;
} }
@ -69,7 +69,7 @@ sub args {
my $self = shift; my $self = shift;
my $args = shift; my $args = shift;
if ($args) { if ($args) {
my (@q, $i, $ct) = @{$args}; # This line is solemnly dedicated to \mjd. my (@q, $i, $ct) = @{$args}; # This line is solemnly dedicated to \mjd.
$self->{'args'} = [ ]; $self->{'args'} = [ ];
@ -123,7 +123,7 @@ sub from {
{ local $^W; { local $^W;
@part = split /[\@!]/, $_[0], 3; @part = split /[\@!]/, $_[0], 3;
} }
$self->nick(defined $part[0] ? $part[0] : ''); $self->nick(defined $part[0] ? $part[0] : '');
$self->user(defined $part[1] ? $part[1] : ''); $self->user(defined $part[1] ? $part[1] : '');
$self->host(defined $part[2] ? $part[2] : ''); $self->host(defined $part[2] ? $part[2] : '');
@ -132,7 +132,7 @@ sub from {
$self->userhost($self->host); $self->userhost($self->host);
$self->{'from'} = $_[0]; $self->{'from'} = $_[0];
} }
return $self->{'from'}; return $self->{'from'};
} }
@ -158,7 +158,7 @@ sub nick {
# Takes any number of args: this event's list of recipients. # Takes any number of args: this event's list of recipients.
sub to { sub to {
my $self = shift; my $self = shift;
$self->{'to'} = [ @_ ] if @_; $self->{'to'} = [ @_ ] if @_;
return wantarray ? @{$self->{'to'}} : $self->{'to'}; return wantarray ? @{$self->{'to'}} : $self->{'to'};
} }
@ -167,7 +167,7 @@ sub to {
# Takes 1 optional arg: the new value for this event's "type" field. # Takes 1 optional arg: the new value for this event's "type" field.
sub type { sub type {
my $self = shift; my $self = shift;
$self->{'type'} = $_[0] if @_; $self->{'type'} = $_[0] if @_;
return $self->{'type'}; return $self->{'type'};
} }
@ -184,7 +184,7 @@ sub user {
# Just $self->user plus '@' plus $self->host, for convenience. # Just $self->user plus '@' plus $self->host, for convenience.
sub userhost { sub userhost {
my $self = shift; my $self = shift;
$self->{'userhost'} = $_[0] if @_; $self->{'userhost'} = $_[0] if @_;
return $self->{'userhost'}; return $self->{'userhost'};
} }
@ -194,7 +194,7 @@ sub userhost {
sub trans { sub trans {
shift if (ref($_[0]) || $_[0]) =~ /^PBot::IRC/; # pragma_ 2011/21/01 shift if (ref($_[0]) || $_[0]) =~ /^PBot::IRC/; # pragma_ 2011/21/01
my $ev = shift; my $ev = shift;
return (exists $_names{$ev} ? $_names{$ev} : undef); return (exists $_names{$ev} ? $_names{$ev} : undef);
} }
@ -207,10 +207,10 @@ sub trans {
'004' => "myinfo", '004' => "myinfo",
'005' => "map", # Undernet Extension, Kajetan@Hinner.com, 17/11/98 '005' => "map", # Undernet Extension, Kajetan@Hinner.com, 17/11/98
'006' => "mapmore", # Undernet Extension, Kajetan@Hinner.com, 17/11/98 '006' => "mapmore", # Undernet Extension, Kajetan@Hinner.com, 17/11/98
'007' => "mapend", # Undernet Extension, Kajetan@Hinner.com, 17/11/98 '007' => "mapend", # Undernet Extension, Kajetan@Hinner.com, 17/11/98
'008' => "snomask", # Undernet Extension, Kajetan@Hinner.com, 17/11/98 '008' => "snomask", # Undernet Extension, Kajetan@Hinner.com, 17/11/98
'009' => "statmemtot", # Undernet Extension, Kajetan@Hinner.com, 17/11/98 '009' => "statmemtot", # Undernet Extension, Kajetan@Hinner.com, 17/11/98
'010' => "statmem", # Undernet Extension, Kajetan@Hinner.com, 17/11/98 '010' => "statmem", # Undernet Extension, Kajetan@Hinner.com, 17/11/98
200 => "tracelink", 200 => "tracelink",
201 => "traceconnecting", 201 => "traceconnecting",

4
PBot/IRC/EventQueue.pm
View File

@ -6,7 +6,7 @@ use strict;
sub new { sub new {
my $class = shift; my $class = shift;
my $self = { my $self = {
'queue' => {}, 'queue' => {},
}; };
@ -56,7 +56,7 @@ sub head {
my $self = shift; my $self = shift;
return undef if $self->is_empty; return undef if $self->is_empty;
no warnings; # because we want to numerically sort strings... no warnings; # because we want to numerically sort strings...
my $headkey = (sort {$a <=> $b} (keys(%{$self->queue})))[0]; my $headkey = (sort {$a <=> $b} (keys(%{$self->queue})))[0];
use warnings; use warnings;

18
PBot/IRC/EventQueue/Entry.pm
View File

@ -1,40 +1,40 @@
package PBot::IRC::EventQueue::Entry; # pragma_ 2011/21/01 package PBot::IRC::EventQueue::Entry; # pragma_ 2011/21/01
use strict; use strict;
my $id = 0; my $id = 0;
sub new { sub new {
my $class = shift; my $class = shift;
my $time = shift; my $time = shift;
my $content = shift; my $content = shift;
my $self = { my $self = {
'time' => $time, 'time' => $time,
'content' => $content, 'content' => $content,
'id' => "$time:" . $id++, 'id' => "$time:" . $id++,
}; };
bless $self, $class; bless $self, $class;
return $self; return $self;
} }
sub id { sub id {
my $self = shift; my $self = shift;
return $self->{'id'}; return $self->{'id'};
} }
sub time { sub time {
my $self = shift; my $self = shift;
$self->{'time'} = $_[0] if @_; $self->{'time'} = $_[0] if @_;
return $self->{'time'}; return $self->{'time'};
} }
sub content { sub content {
my $self = shift; my $self = shift;
$self->{'content'} = $_[0] if @_; $self->{'content'} = $_[0] if @_;
return $self->{'content'}; return $self->{'content'};
} }
1; 1;

28
PBot/IRCHandlers.pm
View File

@ -31,7 +31,7 @@ sub new {
sub initialize { sub initialize {
my ($self, %conf) = @_; my ($self, %conf) = @_;
$self->{pbot} = delete $conf{pbot}; $self->{pbot} = delete $conf{pbot};
Carp::croak("Missing pbot parameter to " . __FILE__) if not defined $self->{pbot}; Carp::croak("Missing pbot parameter to " . __FILE__) if not defined $self->{pbot};
@ -115,7 +115,7 @@ sub on_motd {
sub on_self_join { sub on_self_join {
my ($self, $event_type, $event) = @_; my ($self, $event_type, $event) = @_;
$self->send_who($event->{channel}); #$self->send_who($event->{channel});
return 0; return 0;
} }
@ -126,7 +126,7 @@ sub on_self_part {
sub on_public { sub on_public {
my ($self, $event_type, $event) = @_; my ($self, $event_type, $event) = @_;
my $from = $event->{event}->{to}[0]; my $from = $event->{event}->{to}[0];
my $nick = $event->{event}->nick; my $nick = $event->{event}->nick;
my $user = $event->{event}->user; my $user = $event->{event}->user;
@ -162,7 +162,7 @@ sub on_notice {
$self->{pbot}->{logger}->log("Received NOTICE from $nick!$user\@$host to $event->{event}->{to}[0] '$text'\n"); $self->{pbot}->{logger}->log("Received NOTICE from $nick!$user\@$host to $event->{event}->{to}[0] '$text'\n");
return 0 if not length $host; return 0 if not length $host;
if ($nick eq 'NickServ') { if ($nick eq 'NickServ') {
if ($text =~ m/This nickname is registered/) { if ($text =~ m/This nickname is registered/) {
$self->{pbot}->{logger}->log("Identifying with NickServ . . .\n"); $self->{pbot}->{logger}->log("Identifying with NickServ . . .\n");
@ -185,7 +185,7 @@ sub on_action {
my ($self, $event_type, $event) = @_; my ($self, $event_type, $event) = @_;
$event->{event}->{args}[0] = "/me " . $event->{event}->{args}[0]; $event->{event}->{args}[0] = "/me " . $event->{event}->{args}[0];
$self->on_public($event_type, $event); $self->on_public($event_type, $event);
return 0; return 0;
} }
@ -249,7 +249,7 @@ sub on_mode {
$self->{pbot}->{chanops}->{is_opped}->{$channel}{timeout} = gettimeofday + $timeout; $self->{pbot}->{chanops}->{is_opped}->{$channel}{timeout} = gettimeofday + $timeout;
delete $self->{pbot}->{chanops}->{op_requested}->{$channel}; delete $self->{pbot}->{chanops}->{op_requested}->{$channel};
$self->{pbot}->{chanops}->perform_op_commands($channel); $self->{pbot}->{chanops}->perform_op_commands($channel);
} }
elsif ($mode eq "-o") { elsif ($mode eq "-o") {
$self->{pbot}->{logger}->log("$nick removed my ops in $channel\n"); $self->{pbot}->{logger}->log("$nick removed my ops in $channel\n");
delete $self->{pbot}->{chanops}->{is_opped}->{$channel}; delete $self->{pbot}->{chanops}->{is_opped}->{$channel};
@ -257,8 +257,8 @@ sub on_mode {
elsif ($mode eq "+b") { elsif ($mode eq "+b") {
$self->{pbot}->{logger}->log("Got banned in $channel, attempting unban."); $self->{pbot}->{logger}->log("Got banned in $channel, attempting unban.");
$event->{conn}->privmsg("chanserv", "unban $channel"); $event->{conn}->privmsg("chanserv", "unban $channel");
} }
} }
else { # bot not targeted else { # bot not targeted
if ($mode eq "+b") { if ($mode eq "+b") {
if ($nick eq "ChanServ" or $target =~ m/##fix_your_connection$/i) { if ($nick eq "ChanServ" or $target =~ m/##fix_your_connection$/i) {
@ -281,7 +281,7 @@ sub on_mode {
} }
} }
} }
} }
elsif ($mode eq "+q") { elsif ($mode eq "+q") {
if ($nick ne $event->{conn}->nick) { # bot muted if ($nick ne $event->{conn}->nick) { # bot muted
if ($self->{pbot}->{chanops}->can_gain_ops($channel)) { if ($self->{pbot}->{chanops}->can_gain_ops($channel)) {
@ -325,8 +325,8 @@ sub on_join {
$self->{pbot}->{antiflood}->check_bans($message_account, $event->{event}->from, $channel); $self->{pbot}->{antiflood}->check_bans($message_account, $event->{event}->from, $channel);
} }
$self->{pbot}->{antiflood}->check_flood($channel, $nick, $user, $host, $msg, $self->{pbot}->{antiflood}->check_flood($channel, $nick, $user, $host, $msg,
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'), $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'),
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'), $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'),
$self->{pbot}->{messagehistory}->{MSG_JOIN}); $self->{pbot}->{messagehistory}->{MSG_JOIN});
return 0; return 0;
@ -370,14 +370,14 @@ sub on_kick {
my $text = "KICKED by $nick!$user\@$host ($reason)"; my $text = "KICKED by $nick!$user\@$host ($reason)";
$self->{pbot}->{messagehistory}->add_message($message_account, $hostmask, $channel, $text, $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}); $self->{pbot}->{messagehistory}->add_message($message_account, $hostmask, $channel, $text, $self->{pbot}->{messagehistory}->{MSG_DEPARTURE});
$self->{pbot}->{antiflood}->check_flood($channel, $target_nick, $target_user, $target_host, $text, $self->{pbot}->{antiflood}->check_flood($channel, $target_nick, $target_user, $target_host, $text,
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'), $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'),
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'), $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'),
$self->{pbot}->{messagehistory}->{MSG_DEPARTURE}); $self->{pbot}->{messagehistory}->{MSG_DEPARTURE});
} }
$message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account_id("$nick!$user\@$host"); $message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account_id("$nick!$user\@$host");
if (defined $message_account) { if (defined $message_account) {
my $text = "KICKED " . (defined $hostmask ? $hostmask : $target) . " from $channel ($reason)"; my $text = "KICKED " . (defined $hostmask ? $hostmask : $target) . " from $channel ($reason)";
$self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, $text, $self->{pbot}->{messagehistory}->{MSG_CHAT}); $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, $text, $self->{pbot}->{messagehistory}->{MSG_CHAT});
@ -408,7 +408,7 @@ sub on_departure {
$self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, $text, $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}); $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, $text, $self->{pbot}->{messagehistory}->{MSG_DEPARTURE});
} }
$self->{pbot}->{antiflood}->check_flood($channel, $nick, $user, $host, $text, $self->{pbot}->{antiflood}->check_flood($channel, $nick, $user, $host, $text,
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'), $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'),
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'), $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'),
$self->{pbot}->{messagehistory}->{MSG_DEPARTURE}); $self->{pbot}->{messagehistory}->{MSG_DEPARTURE});

12
PBot/IgnoreList.pm
View File

@ -87,7 +87,7 @@ sub load_ignores {
} }
$self->{pbot}->{logger}->log("Loading ignorelist from $filename ...\n"); $self->{pbot}->{logger}->log("Loading ignorelist from $filename ...\n");
open(FILE, "< $filename") or Carp::croak "Couldn't open $filename: $!\n"; open(FILE, "< $filename") or Carp::croak "Couldn't open $filename: $!\n";
my @contents = <FILE>; my @contents = <FILE>;
close(FILE); close(FILE);
@ -99,11 +99,11 @@ sub load_ignores {
$i++; $i++;
my ($hostmask, $channel, $length) = split(/\s+/, $line); my ($hostmask, $channel, $length) = split(/\s+/, $line);
if (not defined $hostmask || not defined $channel || not defined $length) { if (not defined $hostmask || not defined $channel || not defined $length) {
Carp::croak "Syntax error around line $i of $filename\n"; Carp::croak "Syntax error around line $i of $filename\n";
} }
if (exists ${ $self->{ignore_list} }{$hostmask}{$channel}) { if (exists ${ $self->{ignore_list} }{$hostmask}{$channel}) {
Carp::croak "Duplicate ignore [$hostmask][$channel] found in $filename around line $i\n"; Carp::croak "Duplicate ignore [$hostmask][$channel] found in $filename around line $i\n";
} }
@ -144,7 +144,7 @@ sub check_ignore {
my $pbot = $self->{pbot}; my $pbot = $self->{pbot};
$channel = lc $channel; $channel = lc $channel;
my $hostmask = "$nick!$user\@$host"; my $hostmask = "$nick!$user\@$host";
my $now = gettimeofday; my $now = gettimeofday;
@ -168,9 +168,9 @@ sub check_ignore {
$self->{ignore_flood_counter}->{$channel} = 0; $self->{ignore_flood_counter}->{$channel} = 0;
if ($channel =~ /^#/) { if ($channel =~ /^#/) {
$pbot->{conn}->me($channel, "has been overwhelmed."); $pbot->{conn}->me($channel, "has been overwhelmed.");
$pbot->{conn}->me($channel, "lies down and falls asleep."); $pbot->{conn}->me($channel, "lies down and falls asleep.");
return 1; return 1;
} }
} }
=cut =cut
} }

6
PBot/IgnoreListCommands.pm
View File

@ -70,7 +70,7 @@ sub ignore_user {
if (not defined $channel) { if (not defined $channel) {
$channel = ".*"; # all channels $channel = ".*"; # all channels
} }
if (not defined $length) { if (not defined $length) {
$length = -1; # permanently $length = -1; # permanently
} else { } else {
@ -103,12 +103,12 @@ sub unignore_user {
if (not defined $channel) { if (not defined $channel) {
$channel = ".*"; $channel = ".*";
} }
if (exists $self->{pbot}->{ignorelist}->{ignore_list}->{$target} and not exists $self->{pbot}->{ignorelist}->{ignore_list}->{$target}->{$channel}) { if (exists $self->{pbot}->{ignorelist}->{ignore_list}->{$target} and not exists $self->{pbot}->{ignorelist}->{ignore_list}->{$target}->{$channel}) {
$self->{pbot}->{logger}->log("$nick attempt to remove nonexistent [$target][$channel] from ignore list\n"); $self->{pbot}->{logger}->log("$nick attempt to remove nonexistent [$target][$channel] from ignore list\n");
return "/msg $nick [$target][$channel] not found in ignore list (use `ignore list` to list ignores)"; return "/msg $nick [$target][$channel] not found in ignore list (use `ignore list` to list ignores)";
} }
$self->{pbot}->{ignorelist}->remove($target, $channel); $self->{pbot}->{ignorelist}->remove($target, $channel);
$self->{pbot}->{logger}->log("$nick removed [$target][$channel] from ignore list\n"); $self->{pbot}->{logger}->log("$nick removed [$target][$channel] from ignore list\n");
return "/msg $nick [$target][$channel] unignored"; return "/msg $nick [$target][$channel] unignored";

2
PBot/Interpreter.pm
View File

@ -1,7 +1,7 @@
# File: Interpreter.pm # File: Interpreter.pm
# Author: pragma_ # Author: pragma_
# #
# Purpose: # Purpose:
# This Source Code Form is subject to the terms of the Mozilla Public # 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 # License, v. 2.0. If a copy of the MPL was not distributed with this

2
PBot/LagChecker.pm
View File

@ -44,7 +44,7 @@ sub initialize {
$self->{ping_send_time} = undef; # when last ping was sent $self->{ping_send_time} = undef; # when last ping was sent
# maximum number of lag history entries to retain # maximum number of lag history entries to retain
$pbot->{registry}->add_default('text', 'lagchecker', 'lag_history_max', $conf{lag_history_max} // 3); $pbot->{registry}->add_default('text', 'lagchecker', 'lag_history_max', $conf{lag_history_max} // 3);
# lagging is true if lag_average reaches or exceeds this threshold, in seconds # lagging is true if lag_average reaches or exceeds this threshold, in seconds
$pbot->{registry}->add_default('text', 'lagchecker', 'lag_threshold', $conf{lag_threadhold} // 2); $pbot->{registry}->add_default('text', 'lagchecker', 'lag_threshold', $conf{lag_threadhold} // 2);
# how often to send PING, in seconds # how often to send PING, in seconds

2
PBot/Logger.pm
View File

@ -40,7 +40,7 @@ sub log {
if (defined $self->{log_file}) { if (defined $self->{log_file}) {
print PLOG_FILE "$time :: $text"; print PLOG_FILE "$time :: $text";
} }
print "$time :: $text"; print "$time :: $text";
} }

4
PBot/MessageHistory.pm
View File

@ -2,7 +2,7 @@
# Author: pragma_ # Author: pragma_
# #
# Purpose: Keeps track of who has said what and when, as well as their # Purpose: Keeps track of who has said what and when, as well as their
# nickserv accounts and alter-hostmasks. # nickserv accounts and alter-hostmasks.
# #
# Used in conjunction with AntiFlood and Quotegrabs for kick/ban on # Used in conjunction with AntiFlood and Quotegrabs for kick/ban on
# flood/ban-evasion and grabbing quotes, respectively. # flood/ban-evasion and grabbing quotes, respectively.
@ -222,7 +222,7 @@ sub recall_message {
my $usage = 'Usage: recall [nick [history [channel]]] [-c,channel <channel>] [-t,text,h,history <history>] [-b,before <context before>] [-a,after <context after>] [-x,context <nick>] [-n,count <count>] [+ ...]'; my $usage = 'Usage: recall [nick [history [channel]]] [-c,channel <channel>] [-t,text,h,history <history>] [-b,before <context before>] [-a,after <context after>] [-x,context <nick>] [-n,count <count>] [+ ...]';
if (not defined $arguments or not length $arguments) { if (not defined $arguments or not length $arguments) {
return $usage; return $usage;
} }
$arguments = lc $arguments; $arguments = lc $arguments;

20
PBot/MessageHistory_SQLite.pm
View File

@ -64,7 +64,7 @@ sub sqlite_commit_interval_trigger {
sub sqlite_debug_trigger { sub sqlite_debug_trigger {
my ($self, $section, $item, $newvalue) = @_; my ($self, $section, $item, $newvalue) = @_;
$self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue")) if defined $self->{dbh}; $self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue")) if defined $self->{dbh};
} }
sub begin { sub begin {
@ -72,7 +72,7 @@ sub begin {
$self->{pbot}->{logger}->log("Opening message history SQLite database: $self->{filename}\n"); $self->{pbot}->{logger}->log("Opening message history SQLite database: $self->{filename}\n");
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1 }) or die $DBI::errstr; $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1 }) or die $DBI::errstr;
$self->{dbh}->sqlite_enable_load_extension(my $_enabled = 1); $self->{dbh}->sqlite_enable_load_extension(my $_enabled = 1);
$self->{dbh}->prepare("SELECT load_extension('/usr/lib/sqlite3/pcre.so')"); $self->{dbh}->prepare("SELECT load_extension('/usr/lib/sqlite3/pcre.so')");
@ -106,7 +106,7 @@ SQL
$self->{dbh}->do(<<SQL); $self->{dbh}->do(<<SQL);
CREATE TABLE IF NOT EXISTS Nickserv ( CREATE TABLE IF NOT EXISTS Nickserv (
id INTEGER, id INTEGER,
nickserv TEXT COLLATE NOCASE, nickserv TEXT COLLATE NOCASE,
timestamp NUMERIC, timestamp NUMERIC,
UNIQUE (id, nickserv) UNIQUE (id, nickserv)
@ -248,7 +248,7 @@ sub create_nickserv {
sub update_nickserv_account { sub update_nickserv_account {
my ($self, $id, $nickserv, $timestamp) = @_; my ($self, $id, $nickserv, $timestamp) = @_;
#$self->{pbot}->{logger}->log("Updating nickserv account for id $id to $nickserv with timestamp [$timestamp]\n"); #$self->{pbot}->{logger}->log("Updating nickserv account for id $id to $nickserv with timestamp [$timestamp]\n");
$self->create_nickserv($id, $nickserv); $self->create_nickserv($id, $nickserv);
@ -330,7 +330,7 @@ sub find_message_account_by_nick {
my $row = $sth->fetchrow_hashref(); my $row = $sth->fetchrow_hashref();
return ($row->{id}, $row->{hostmask}); return ($row->{id}, $row->{hostmask});
}; };
$self->{pbot}->{logger}->log($@) if $@; $self->{pbot}->{logger}->log($@) if $@;
return ($id, $hostmask); return ($id, $hostmask);
} }
@ -551,7 +551,7 @@ sub get_message_account {
return ($rows, $self->{alias_type}->{STRONG}); return ($rows, $self->{alias_type}->{STRONG});
} }
} }
# cloaked hostmask # cloaked hostmask
if ($host =~ m{/}) { if ($host =~ m{/}) {
$sth = $self->{dbh}->prepare('SELECT id, hostmask, last_seen FROM Hostmasks WHERE host = ? ORDER BY last_seen DESC'); $sth = $self->{dbh}->prepare('SELECT id, hostmask, last_seen FROM Hostmasks WHERE host = ? ORDER BY last_seen DESC');
@ -647,7 +647,7 @@ sub get_message_account {
} }
if ($match) { if ($match) {
$rows->[0] = { id => $self->get_ancestor_id($akas{$aka}->{id}), hostmask => $aka }; $rows->[0] = { id => $self->get_ancestor_id($akas{$aka}->{id}), hostmask => $aka };
return ($rows, $self->{alias_type}->{STRONG}); return ($rows, $self->{alias_type}->{STRONG});
} }
} }
@ -703,7 +703,7 @@ sub get_message_account {
my @nickserv_accounts = $self->get_nickserv_accounts($rows->[0]->{id}); my @nickserv_accounts = $self->get_nickserv_accounts($rows->[0]->{id});
foreach my $nickserv_account (@nickserv_accounts) { foreach my $nickserv_account (@nickserv_accounts) {
$self->{pbot}->{logger}->log("$nick!$user\@$host [$rows->[0]->{id}] seen with nickserv account [$nickserv_account]\n"); $self->{pbot}->{logger}->log("$nick!$user\@$host [$rows->[0]->{id}] seen with nickserv account [$nickserv_account]\n");
$self->{pbot}->{antiflood}->check_nickserv_accounts($nick, $nickserv_account, "$nick!$user\@$host"); $self->{pbot}->{antiflood}->check_nickserv_accounts($nick, $nickserv_account, "$nick!$user\@$host");
} }
return $rows->[0]->{id}; return $rows->[0]->{id};
} }
@ -786,7 +786,7 @@ sub get_hostmasks_for_channel {
$sth->execute($channel); $sth->execute($channel);
return $sth->fetchall_arrayref({}); return $sth->fetchall_arrayref({});
}; };
$self->{pbot}->{logger}->log($@) if $@; $self->{pbot}->{logger}->log($@) if $@;
return $hostmasks; return $hostmasks;
} }
@ -1055,7 +1055,7 @@ sub recall_message_by_count {
sub recall_message_by_text { sub recall_message_by_text {
my ($self, $id, $channel, $text, $ignore_command) = @_; my ($self, $id, $channel, $text, $ignore_command) = @_;
my $regex = '(?i)'; my $regex = '(?i)';
$regex .= ($text =~ m/^\w/) ? '\b' : '\B'; $regex .= ($text =~ m/^\w/) ? '\b' : '\B';
$regex .= quotemeta $text; $regex .= quotemeta $text;

8
PBot/NickList.pm
View File

@ -2,7 +2,7 @@
# Author: pragma_ # Author: pragma_
# #
# Purpose: Maintains lists of nicks currently present in channels. # Purpose: Maintains lists of nicks currently present in channels.
# Used to retrieve list of channels a nick is present in or to # Used to retrieve list of channels a nick is present in or to
# determine if a nick is present in a channel. # determine if a nick is present in a channel.
# This Source Code Form is subject to the terms of the Mozilla Public # This Source Code Form is subject to the terms of the Mozilla Public
@ -46,7 +46,7 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.nick', sub { $self->on_nickchange(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.nick', sub { $self->on_nickchange(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_activity(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_activity(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_activity(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_activity(@_) });
# handlers for the bot itself joining/leaving channels # handlers for the bot itself joining/leaving channels
$self->{pbot}->{event_dispatcher}->register_handler('pbot.join', sub { $self->on_join_channel(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('pbot.join', sub { $self->on_join_channel(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_part_channel(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_part_channel(@_) });
@ -113,7 +113,7 @@ sub get_channels {
push @channels, $channel; push @channels, $channel;
} }
} }
return \@channels; return \@channels;
} }
@ -236,7 +236,7 @@ sub random_nick {
if (exists $self->{nicklist}->{$channel}) { if (exists $self->{nicklist}->{$channel}) {
my $now = gettimeofday; my $now = gettimeofday;
my @nicks = grep { $now - $self->{nicklist}->{$channel}->{$_}->{timestamp} < 3600 * 2 } keys %{ $self->{nicklist}->{$channel} }; my @nicks = grep { $now - $self->{nicklist}->{$channel}->{$_}->{timestamp} < 3600 * 2 } keys %{ $self->{nicklist}->{$channel} };
my $nick = $nicks[rand @nicks]; my $nick = $nicks[rand @nicks];
return $self->{nicklist}->{$channel}->{$nick}->{nick}; return $self->{nicklist}->{$channel}->{$nick}->{nick};
} else { } else {

16
PBot/PBot.pm
View File

@ -36,7 +36,7 @@ use PBot::AntiSpam;
use PBot::Interpreter; use PBot::Interpreter;
use PBot::Commands; use PBot::Commands;
use PBot::ChanOps; use PBot::ChanOps;
use PBot::Factoids; use PBot::Factoids;
use PBot::BotAdmins; use PBot::BotAdmins;
use PBot::IgnoreList; use PBot::IgnoreList;
use PBot::BlackList; use PBot::BlackList;
@ -96,14 +96,14 @@ sub initialize {
$self->{registry}->add_default('text', 'irc', 'ircname', $conf{ircname} // "http://code.google.com/p/pbot2-pl/"); $self->{registry}->add_default('text', 'irc', 'ircname', $conf{ircname} // "http://code.google.com/p/pbot2-pl/");
$self->{registry}->add_default('text', 'irc', 'identify_password', $conf{identify_password} // 'none'); $self->{registry}->add_default('text', 'irc', 'identify_password', $conf{identify_password} // 'none');
$self->{registry}->add_default('text', 'irc', 'log_default_handler', 1); $self->{registry}->add_default('text', 'irc', 'log_default_handler', 1);
$self->{registry}->set_default('irc', 'SSL_ca_file', 'private', 1); $self->{registry}->set_default('irc', 'SSL_ca_file', 'private', 1);
$self->{registry}->set_default('irc', 'SSL_ca_path', 'private', 1); $self->{registry}->set_default('irc', 'SSL_ca_path', 'private', 1);
$self->{registry}->set_default('irc', 'identify_password', 'private', 1); $self->{registry}->set_default('irc', 'identify_password', 'private', 1);
$self->{registry}->add_trigger('irc', 'botnick', sub { $self->change_botnick_trigger(@_) }); $self->{registry}->add_trigger('irc', 'botnick', sub { $self->change_botnick_trigger(@_) });
$self->{registry}->add_trigger('irc', 'debug', sub { $self->irc_debug_trigger(@_) }); $self->{registry}->add_trigger('irc', 'debug', sub { $self->irc_debug_trigger(@_) });
$self->{event_dispatcher} = PBot::EventDispatcher->new(pbot => $self, %conf); $self->{event_dispatcher} = PBot::EventDispatcher->new(pbot => $self, %conf);
$self->{irchandlers} = PBot::IRCHandlers->new(pbot => $self, %conf); $self->{irchandlers} = PBot::IRCHandlers->new(pbot => $self, %conf);
$self->{select_handler} = PBot::SelectHandler->new(pbot => $self, %conf); $self->{select_handler} = PBot::SelectHandler->new(pbot => $self, %conf);
@ -176,7 +176,7 @@ sub connect {
$self->{logger}->log("Connecting to $server ...\n"); $self->{logger}->log("Connecting to $server ...\n");
while (not $self->{conn} = $self->{irc}->newconn( while (not $self->{conn} = $self->{irc}->newconn(
Nick => random_nick, Nick => random_nick,
Username => $self->{registry}->get_value('irc', 'username'), Username => $self->{registry}->get_value('irc', 'username'),
Ircname => $self->{registry}->get_value('irc', 'ircname'), Ircname => $self->{registry}->get_value('irc', 'ircname'),
@ -197,8 +197,8 @@ sub connect {
$self->{conn}->add_handler([ 251,252,253,254,255,302 ], sub { $self->{irchandlers}->on_init(@_) }); $self->{conn}->add_handler([ 251,252,253,254,255,302 ], sub { $self->{irchandlers}->on_init(@_) });
# ignore these events # ignore these events
$self->{conn}->add_handler(['whoisserver', $self->{conn}->add_handler(['whoisserver',
'whoiscountry', 'whoiscountry',
'whoischannels', 'whoischannels',
'whoisidle', 'whoisidle',
'motdstart', 'motdstart',
@ -216,9 +216,9 @@ sub do_one_loop {
sub start { sub start {
my $self = shift; my $self = shift;
while (1) { while (1) {
$self->connect() if not $self->{connected}; $self->connect() if not $self->{connected};
$self->do_one_loop() if $self->{connected}; $self->do_one_loop() if $self->{connected};
} }
} }

2
PBot/Plugins.pm
View File

@ -70,7 +70,7 @@ sub load {
$self->{pbot}->{refresher}->{refresher}->refresh_module("PBot/Plugins/$plugin.pm"); $self->{pbot}->{refresher}->{refresher}->refresh_module("PBot/Plugins/$plugin.pm");
my $ret = eval { my $ret = eval {
eval "require $class"; eval "require $class";
if ($@) { if ($@) {

6
PBot/Plugins/ActionTrigger.pm
View File

@ -358,12 +358,12 @@ sub check_trigger {
my $action = $trigger->{action}; my $action = $trigger->{action};
my @stuff = ($1, $2, $3, $4, $5, $6, $7, $8, $9); my @stuff = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
my $i; my $i;
map { ++$i; $action =~ s/\$$i/$_/g; } @stuff; map { ++$i; $action =~ s/\$$i/$_/g; } @stuff;
my $delay = 0; my $delay = 0;
my ($n, $u, $h) = $trigger->{owner} =~ /^([^!]+)!([^@]+)\@(.*)$/; my ($n, $u, $h) = $trigger->{owner} =~ /^([^!]+)!([^@]+)\@(.*)$/;
my $command = { my $command = {
nick => $n, nick => $n,
user => $u, user => $u,
host => $h, host => $h,

2
PBot/Plugins/AntiRepeat.pm
View File

@ -63,7 +63,7 @@ sub on_public {
my $antirepeat = $self->{pbot}->{registry}->get_value($channel, 'antirepeat'); my $antirepeat = $self->{pbot}->{registry}->get_value($channel, 'antirepeat');
return 0 if defined $antirepeat and not $antirepeat; return 0 if defined $antirepeat and not $antirepeat;
return 0 if $channel !~ m/^#/; return 0 if $channel !~ m/^#/;
return 0 if $event->{interpreted}; return 0 if $event->{interpreted};
return 0 if $self->{pbot}->{antiflood}->whitelisted($channel, "$nick!$user\@$host", 'antiflood'); return 0 if $self->{pbot}->{antiflood}->whitelisted($channel, "$nick!$user\@$host", 'antiflood');

2
PBot/Plugins/AntiTwitter.pm
View File

@ -49,7 +49,7 @@ sub on_public {
if ($self->{pbot}->{nicklist}->is_present_similar($channel, $n, 0.05)) { if ($self->{pbot}->{nicklist}->is_present_similar($channel, $n, 0.05)) {
$self->{offenses}->{$channel}->{$nick}->{offenses}++; $self->{offenses}->{$channel}->{$nick}->{offenses}++;
$self->{offenses}->{$channel}->{$nick}->{time} = gettimeofday; $self->{offenses}->{$channel}->{$nick}->{time} = gettimeofday;
$self->{pbot}->{logger}->log("$nick!$user\@$host is a twit. ($self->{offenses}->{$channel}->{$nick}->{offenses} offenses) $channel: $msg\n"); $self->{pbot}->{logger}->log("$nick!$user\@$host is a twit. ($self->{offenses}->{$channel}->{$nick}->{offenses} offenses) $channel: $msg\n");
given ($self->{offenses}->{$channel}->{$nick}->{offenses}) { given ($self->{offenses}->{$channel}->{$nick}->{offenses}) {

12
PBot/Plugins/Battleship.pm
View File

@ -366,7 +366,7 @@ sub battleship_cmd {
if (not $self->{pbot}->{admins}->loggedin($self->{channel}, "$nick!$user\@$host")) { if (not $self->{pbot}->{admins}->loggedin($self->{channel}, "$nick!$user\@$host")) {
return "$nick: Sorry, only admins may see the full board."; return "$nick: Sorry, only admins may see the full board.";
} }
if ($self->{current_state} eq 'nogame' or $self->{current_state} eq 'accept' if ($self->{current_state} eq 'nogame' or $self->{current_state} eq 'accept'
or $self->{current_state} eq 'genboard' or $self->{current_state} eq 'gameover') { or $self->{current_state} eq 'genboard' or $self->{current_state} eq 'gameover') {
return "$nick: There is no board to show right now."; return "$nick: There is no board to show right now.";
@ -383,7 +383,7 @@ sub battleship_cmd {
} }
$self->show_battlefield(4, $nick); $self->show_battlefield(4, $nick);
} }
default { default {
return $usage; return $usage;
} }
@ -675,7 +675,7 @@ sub generate_ship {
} }
$self->{ship_length}->[$ship] = $l; $self->{ship_length}->[$ship] = $l;
return 1; return 1;
} }
if (++$fail >= 5000) { if (++$fail >= 5000) {
@ -899,7 +899,7 @@ sub show_battlefield {
$self->{pbot}->{logger}->log("showing battlefield for player $player\n"); $self->{pbot}->{logger}->log("showing battlefield for player $player\n");
$buf = "$color{cyan} "; $buf = "$color{cyan} ";
for($x = 1; $x < $self->{N_X} + 1; $x++) { for($x = 1; $x < $self->{N_X} + 1; $x++) {
if ($x % 10 == 0) { if ($x % 10 == 0) {
$buf .= $color{yellow} if $self->{N_X} > 10; $buf .= $color{yellow} if $self->{N_X} > 10;
@ -952,7 +952,7 @@ sub show_battlefield {
$buf .= "$self->{board}->[$y][$x] "; $buf .= "$self->{board}->[$y][$x] ";
} }
} elsif ($player == 2) { } elsif ($player == 2) {
if ($self->{board}->[$y][$x] eq '|' || $self->{board}->[$y][$x] eq '―' if ($self->{board}->[$y][$x] eq '|' || $self->{board}->[$y][$x] eq '―'
|| $self->{board}->[$y][$x] eq 'I' || $self->{board}->[$y][$x] eq '=') { || $self->{board}->[$y][$x] eq 'I' || $self->{board}->[$y][$x] eq '=') {
$buf .= "$color{blue}~ "; $buf .= "$color{blue}~ ";
next; next;
@ -989,7 +989,7 @@ sub show_battlefield {
# bottom border # bottom border
$buf .= "$color{cyan} "; $buf .= "$color{cyan} ";
for($x = 1; $x < $self->{N_X} + 1; $x++) { for($x = 1; $x < $self->{N_X} + 1; $x++) {
if ($x % 10 == 0) { if ($x % 10 == 0) {
$buf .= $color{yellow} if $self->{N_X} > 10; $buf .= $color{yellow} if $self->{N_X} > 10;

4
PBot/Plugins/Counter.pm
View File

@ -44,7 +44,7 @@ sub initialize {
sub unload { sub unload {
my $self = shift; my $self = shift;
$self->{pbot}->{commands}->unregister('counteradd'); $self->{pbot}->{commands}->unregister('counteradd');
$self->{pbot}->{commands}->unregister('counterdel'); $self->{pbot}->{commands}->unregister('counterdel');
$self->{pbot}->{commands}->unregister('counterreset'); $self->{pbot}->{commands}->unregister('counterreset');
@ -297,7 +297,7 @@ sub get_trigger {
sub counteradd { sub counteradd {
my ($self, $from, $nick, $user, $host, $arguments) = @_; my ($self, $from, $nick, $user, $host, $arguments) = @_;
if (not $self->dbi_begin) { if (not $self->dbi_begin) {
return "Internal error."; return "Internal error.";
} }

18
PBot/Plugins/Quotegrabs.pm
View File

@ -57,7 +57,7 @@ sub initialize {
sub uniq { my %seen; grep !$seen{$_}++, @_ } sub uniq { my %seen; grep !$seen{$_}++, @_ }
sub export_quotegrabs { sub export_quotegrabs {
my $self = shift; my $self = shift;
return "Quotegrabs exporting not enabled." if not defined $self->{export_path}; return "Quotegrabs exporting not enabled." if not defined $self->{export_path};
@ -125,9 +125,9 @@ sub export_quotegrabs {
$nick = "<$nicks[0]>"; $nick = "<$nicks[0]>";
} }
$text = "<td><b>". encode_entities($nick) . "</b> " . encode_entities($text) . "</td>\n"; $text = "<td><b>". encode_entities($nick) . "</b> " . encode_entities($text) . "</td>\n";
print FILE $text; print FILE $text;
print FILE "<td>" . encode_entities(strftime "%Y/%m/%d %a %H:%M:%S", localtime $quotegrab->{timestamp}) . "</td>\n"; print FILE "<td>" . encode_entities(strftime "%Y/%m/%d %a %H:%M:%S", localtime $quotegrab->{timestamp}) . "</td>\n";
print FILE "<td>" . encode_entities($quotegrab->{grabbed_by}) . "</td>\n"; print FILE "<td>" . encode_entities($quotegrab->{grabbed_by}) . "</td>\n";
@ -237,7 +237,7 @@ sub grab_quotegrab {
$quotegrab->{grabbed_by} = "$nick!$user\@$host"; $quotegrab->{grabbed_by} = "$nick!$user\@$host";
$quotegrab->{text} = validate_string($grab_text); $quotegrab->{text} = validate_string($grab_text);
$quotegrab->{id} = undef; $quotegrab->{id} = undef;
$quotegrab->{id} = $self->{database}->add_quotegrab($quotegrab); $quotegrab->{id} = $self->{database}->add_quotegrab($quotegrab);
if (not defined $quotegrab->{id}) { if (not defined $quotegrab->{id}) {
@ -245,7 +245,7 @@ sub grab_quotegrab {
} }
$self->export_quotegrabs(); $self->export_quotegrabs();
my $text = $quotegrab->{text}; my $text = $quotegrab->{text};
($grab_nick) = split /\+/, $grab_nicks, 2; ($grab_nick) = split /\+/, $grab_nicks, 2;
@ -330,8 +330,8 @@ sub show_random_quotegrab {
}; };
$arguments =~ s/(?<!\\)'/\\'/g; $arguments =~ s/(?<!\\)'/\\'/g;
my ($ret, $args) = GetOptionsFromString($arguments, my ($ret, $args) = GetOptionsFromString($arguments,
'channel|c=s' => \$channel_search, 'channel|c=s' => \$channel_search,
'text|t=s' => \$text_search); 'text|t=s' => \$text_search);
return "$getopt_error -- $usage" if defined $getopt_error; return "$getopt_error -- $usage" if defined $getopt_error;
@ -354,7 +354,7 @@ sub show_random_quotegrab {
$channel_search = undef if defined $channel_search and $channel_search !~ /^#/; $channel_search = undef if defined $channel_search and $channel_search !~ /^#/;
my $quotegrab = $self->{database}->get_random_quotegrab($nick_search, $channel_search, $text_search); my $quotegrab = $self->{database}->get_random_quotegrab($nick_search, $channel_search, $text_search);
if (not defined $quotegrab) { if (not defined $quotegrab) {
my $result = "No quotes grabbed "; my $result = "No quotes grabbed ";
@ -365,7 +365,7 @@ sub show_random_quotegrab {
if (defined $channel_search) { if (defined $channel_search) {
$result .= "in channel $channel_search "; $result .= "in channel $channel_search ";
} }
if (defined $text_search) { if (defined $text_search) {
$result .= "matching text '$text_search' "; $result .= "matching text '$text_search' ";
} }

6
PBot/Plugins/Quotegrabs/Quotegrabs_Hashtable.pm
View File

@ -55,7 +55,7 @@ sub load_quotegrabs {
return if not defined $filename; return if not defined $filename;
$self->{pbot}->{logger}->log("Loading quotegrabs from $filename ...\n"); $self->{pbot}->{logger}->log("Loading quotegrabs from $filename ...\n");
open(FILE, "< $filename") or die "Couldn't open $filename: $!\n"; open(FILE, "< $filename") or die "Couldn't open $filename: $!\n";
my @contents = <FILE>; my @contents = <FILE>;
close(FILE); close(FILE);
@ -143,7 +143,7 @@ sub get_random_quotegrab {
$text = '.*' if not defined $text; $text = '.*' if not defined $text;
my @quotes; my @quotes;
eval { eval {
for(my $i = 0; $i <= $#{ $self->{quotegrabs} }; $i++) { for(my $i = 0; $i <= $#{ $self->{quotegrabs} }; $i++) {
my $hash = $self->{quotegrabs}[$i]; my $hash = $self->{quotegrabs}[$i];
@ -158,7 +158,7 @@ sub get_random_quotegrab {
$self->{pbot}->{logger}->log("Error in show_random_quotegrab parameters: $@\n"); $self->{pbot}->{logger}->log("Error in show_random_quotegrab parameters: $@\n");
return undef; return undef;
} }
if ($#quotes < 0) { if ($#quotes < 0) {
return undef; return undef;
} }

2
PBot/Plugins/Quotegrabs/Quotegrabs_SQLite.pm
View File

@ -124,7 +124,7 @@ sub get_random_quotegrab {
push @params, "$nick"; push @params, "$nick";
$where = ''; $where = '';
$and = 'AND '; $and = 'AND ';
} }
if (defined $channel) { if (defined $channel) {
$sql .= $where . $and . 'channel LIKE ? '; $sql .= $where . $and . 'channel LIKE ? ';

4
PBot/Plugins/RemindMe.pm
View File

@ -43,7 +43,7 @@ sub initialize {
sub unload { sub unload {
my $self = shift; my $self = shift;
$self->dbi_end; $self->dbi_end;
$self->{pbot}->{commands}->unregister('remindme'); $self->{pbot}->{commands}->unregister('remindme');
@ -191,7 +191,7 @@ sub delete_reminder {
sub remindme { sub remindme {
my ($self, $from, $nick, $user, $host, $arguments) = @_; my ($self, $from, $nick, $user, $host, $arguments) = @_;
if (not $self->{dbh}) { if (not $self->{dbh}) {
return "Internal error."; return "Internal error.";
} }

4
PBot/Plugins/Spinach.pm
View File

@ -1930,7 +1930,7 @@ sub getlies {
if ($needed <= 0) { if ($needed <= 0) {
$state->{reroll_question} = 1; $state->{reroll_question} = 1;
$self->send_message($self->{channel}, "The answer was: " . uc ($state->{current_question}->{answer}) . $reveallies); $self->send_message($self->{channel}, "The answer was: " . uc ($state->{current_question}->{answer}) . $reveallies);
return 'reroll'; return 'reroll';
} }
} }
@ -2326,7 +2326,7 @@ sub showfinalscore {
} }
if ($i >= 4) { if ($i >= 4) {
$mentions = "$player->{name}: " . $self->commify($player->{score}) . "$comma$mentions"; $mentions = "$player->{name}: " . $self->commify($player->{score}) . "$comma$mentions";
$comma = "; "; $comma = "; ";
if ($i == 4) { if ($i == 4) {
$mentions = "Honorable mentions: $mentions"; $mentions = "Honorable mentions: $mentions";

10
PBot/Plugins/Spinach/Rank.pm
View File

@ -73,10 +73,10 @@ sub print_bad_lies {
sub sort_mentions { sub sort_mentions {
my ($self) = @_; my ($self) = @_;
if ($self->{rank_direction} eq '+') { if ($self->{rank_direction} eq '+') {
return $b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third} <=> return $b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third} <=>
$a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third}; $a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third};
} else { } else {
return $a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third} <=> return $a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third} <=>
$b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third}; $b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third};
} }
} }
@ -84,7 +84,7 @@ sub sort_mentions {
sub print_mentions { sub print_mentions {
my ($self, $player) = @_; my ($self, $player) = @_;
return undef if $player->{games_played} == 0; return undef if $player->{games_played} == 0;
my $result = $player->{games_played} - $player->{times_first} - $player->{times_second} - $player->{times_third}; my $result = $player->{games_played} - $player->{times_first} - $player->{times_second} - $player->{times_third};
return "$player->{nick}: $result"; return "$player->{nick}: $result";
} }
@ -181,11 +181,11 @@ sub rank {
lowscore => { sort => sub { $self->sort_generic('low_score', @_) }, print => sub { $self->print_generic('low_score', @_) }, title => 'low score' }, lowscore => { sort => sub { $self->sort_generic('low_score', @_) }, print => sub { $self->print_generic('low_score', @_) }, title => 'low score' },
avgscore => { sort => sub { $self->sort_generic('avg_score', @_) }, print => sub { $self->print_avg_score(@_) }, title => 'average score' }, avgscore => { sort => sub { $self->sort_generic('avg_score', @_) }, print => sub { $self->print_avg_score(@_) }, title => 'average score' },
goodlies => { sort => sub { $self->sort_generic('good_lies', @_) }, print => sub { $self->print_generic('good_lies', @_) }, title => 'good lies' }, goodlies => { sort => sub { $self->sort_generic('good_lies', @_) }, print => sub { $self->print_generic('good_lies', @_) }, title => 'good lies' },
badlies => { sort => sub { $self->sort_bad_lies(@_) }, print => sub { $self->print_bad_lies(@_) }, title => 'bad lies' }, badlies => { sort => sub { $self->sort_bad_lies(@_) }, print => sub { $self->print_bad_lies(@_) }, title => 'bad lies' },
first => { sort => sub { $self->sort_generic('times_first', @_) }, print => sub { $self->print_generic('times_first', @_) }, title => 'first place' }, first => { sort => sub { $self->sort_generic('times_first', @_) }, print => sub { $self->print_generic('times_first', @_) }, title => 'first place' },
second => { sort => sub { $self->sort_generic('times_second', @_) }, print => sub { $self->print_generic('times_second', @_) }, title => 'second place' }, second => { sort => sub { $self->sort_generic('times_second', @_) }, print => sub { $self->print_generic('times_second', @_) }, title => 'second place' },
third => { sort => sub { $self->sort_generic('times_third', @_) }, print => sub { $self->print_generic('times_third', @_) }, title => 'third place' }, third => { sort => sub { $self->sort_generic('times_third', @_) }, print => sub { $self->print_generic('times_third', @_) }, title => 'third place' },
mentions => { sort => sub { $self->sort_mentions(@_) }, print => sub { $self->print_mentions(@_) }, title => 'mentions' }, mentions => { sort => sub { $self->sort_mentions(@_) }, print => sub { $self->print_mentions(@_) }, title => 'mentions' },
games => { sort => sub { $self->sort_generic('games_played', @_) }, print => sub { $self->print_generic('games_played', @_) }, title => 'games played' }, games => { sort => sub { $self->sort_generic('games_played', @_) }, print => sub { $self->print_generic('games_played', @_) }, title => 'games played' },
questions => { sort => sub { $self->sort_generic('questions_played', @_) }, print => sub { $self->print_generic('questions_played', @_) }, title => 'questions played' }, questions => { sort => sub { $self->sort_generic('questions_played', @_) }, print => sub { $self->print_generic('questions_played', @_) }, title => 'questions played' },
goodguesses => { sort => sub { $self->sort_generic('good_guesses', @_) }, print => sub { $self->print_generic('good_guesses', @_) }, title => 'good guesses' }, goodguesses => { sort => sub { $self->sort_generic('good_guesses', @_) }, print => sub { $self->print_generic('good_guesses', @_) }, title => 'good guesses' },

2
PBot/Plugins/_Example.pm
View File

@ -36,7 +36,7 @@ sub unload {
sub on_public { sub on_public {
my ($self, $event_type, $event) = @_; my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $msg) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->args); my ($nick, $user, $host, $msg) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->args);
if ($event->{interpreted}) { if ($event->{interpreted}) {
$self->{pbot}->{logger}->log("Message was already handled by the interpreter.\n"); $self->{pbot}->{logger}->log("Message was already handled by the interpreter.\n");
return 0; return 0;

2
PBot/Registry.pm
View File

@ -96,7 +96,7 @@ sub remove {
$section = lc $section; $section = lc $section;
delete $self->{registry}->hash->{$section}->{$item}; delete $self->{registry}->hash->{$section}->{$item};
if (not scalar keys %{ $self->{registry}->hash->{$section} }) { if (not scalar keys %{ $self->{registry}->hash->{$section} }) {
delete $self->{registry}->hash->{$section}; delete $self->{registry}->hash->{$section};
} }

8
PBot/RegistryCommands.pm
View File

@ -30,7 +30,7 @@ sub initialize {
my $pbot = delete $conf{pbot} // Carp::croak("Missing pbot reference to FactoidCommands"); my $pbot = delete $conf{pbot} // Carp::croak("Missing pbot reference to FactoidCommands");
$self->{pbot} = $pbot; $self->{pbot} = $pbot;
$pbot->{commands}->register(sub { return $self->regadd(@_) }, "regadd", 60); $pbot->{commands}->register(sub { return $self->regadd(@_) }, "regadd", 60);
$pbot->{commands}->register(sub { return $self->regrem(@_) }, "regrem", 60); $pbot->{commands}->register(sub { return $self->regrem(@_) }, "regrem", 60);
$pbot->{commands}->register(sub { return $self->regshow(@_) }, "regshow", 0); $pbot->{commands}->register(sub { return $self->regshow(@_) }, "regshow", 0);
@ -220,12 +220,12 @@ sub regchange {
if (defined $arguments) { if (defined $arguments) {
if ($arguments =~ /^([^\s]+) ([^\s]+)\s+s(.)/) { if ($arguments =~ /^([^\s]+) ([^\s]+)\s+s(.)/) {
$section = $1; $section = $1;
$item = $2; $item = $2;
$delim = $3; $delim = $3;
} }
if ($arguments =~ /$delim(.*?)$delim(.*)$delim(.*)?$/) { if ($arguments =~ /$delim(.*?)$delim(.*)$delim(.*)?$/) {
$tochange = $1; $tochange = $1;
$changeto = $2; $changeto = $2;
$modifier = $3; $modifier = $3;
} }

14
PBot/Timer.pm
View File

@ -21,17 +21,17 @@ our $max_seconds = 1000000;
our $seconds = 0; our $seconds = 0;
our @timer_funcs; our @timer_funcs;
$SIG{ALRM} = sub { $SIG{ALRM} = sub {
$seconds += $min_timeout; $seconds += $min_timeout;
alarm $min_timeout; alarm $min_timeout;
# print "ALARM! $seconds $min_timeout\n";
# print "ALARM! $seconds $min_timeout\n";
# call timer func subroutines # call timer func subroutines
foreach my $func (@timer_funcs) { &$func; } foreach my $func (@timer_funcs) { &$func; }
# prevent $seconds over-flow # prevent $seconds over-flow
$seconds -= $max_seconds if $seconds > $max_seconds; $seconds -= $max_seconds if $seconds > $max_seconds;
}; };
sub new { sub new {

2
PBot/Utils/ValidateString.pm
View File

@ -15,7 +15,7 @@ sub validate_string {
return $string if not defined $string or not length $string; return $string if not defined $string or not length $string;
$max_length = 1024 * 8 if not defined $max_length; $max_length = 1024 * 8 if not defined $max_length;
eval { eval {
my $h = decode_json($string); my $h = decode_json($string);
foreach my $k (keys %$h) { foreach my $k (keys %$h) {
$h->{$k} = substr $h->{$k}, 0, $max_length unless $max_length <= 0; $h->{$k} = substr $h->{$k}, 0, $max_length unless $max_length <= 0;

20
misc/spinach/cat.pl
View File

@ -205,8 +205,8 @@ my @rename_rules = (
{ old => qr/^BABY NAMES BEG/, new => "BABY NAMES" }, { old => qr/^BABY NAMES BEG/, new => "BABY NAMES" },
{ old => qr/^CURRENCY & FLAGS$/, new => "CURRENCIES & FLAGS" }, { old => qr/^CURRENCY & FLAGS$/, new => "CURRENCIES & FLAGS" },
{ old => qr/^CURRENCIES$/, new => "CURRENCIES & FLAGS" }, { old => qr/^CURRENCIES$/, new => "CURRENCIES & FLAGS" },
{ old => qr/^FUN$/, new => "FUN & GAMES" }, { old => qr/^FUN$/, new => "FUN & GAMES" },
{ old => qr/^GAMES$/, new => "FUN & GAMES" }, { old => qr/^GAMES$/, new => "FUN & GAMES" },
{ old => qr/^HOBBIES & LEISURE$/, new => "FUN & GAMES" }, { old => qr/^HOBBIES & LEISURE$/, new => "FUN & GAMES" },
{ old => qr/^MISC GAMES$/, new => "FUN & GAMES" }, { old => qr/^MISC GAMES$/, new => "FUN & GAMES" },
{ old => qr/^SIMPSONS$/, new => "THE SIMPSONS" }, { old => qr/^SIMPSONS$/, new => "THE SIMPSONS" },
@ -235,8 +235,8 @@ my @rename_rules = (
{ old => qr/^EPL$/, new => "SOCCER" }, { old => qr/^EPL$/, new => "SOCCER" },
{ old => qr/^NZ$/, new => "NEW ZEALAND" }, { old => qr/^NZ$/, new => "NEW ZEALAND" },
{ old => qr/^NZ /, new => "NEW ZEALAND" }, { old => qr/^NZ /, new => "NEW ZEALAND" },
{ old => qr/[NB]URSERY RHYME/, new => "FAIRYTALES & NURSERY RHYMES" }, { old => qr/[NB]URSERY RHYME/, new => "FAIRYTALES & NURSERY RHYMES" },
{ old => qr/NURESRY RHYME/, new => "FAIRYTALES & NURSERY RHYMES" }, { old => qr/NURESRY RHYME/, new => "FAIRYTALES & NURSERY RHYMES" },
{ old => qr/^GEOGRAPH/, new => "GEOGRAPHY" }, { old => qr/^GEOGRAPH/, new => "GEOGRAPHY" },
{ old => qr/TREKKIE/, new => "STAR TREK" }, { old => qr/TREKKIE/, new => "STAR TREK" },
{ old => qr/^STAR TREK/, new => "STAR TREK" }, { old => qr/^STAR TREK/, new => "STAR TREK" },
@ -313,8 +313,8 @@ my %refilter_rules = (
], ],
"MUSIC" => [ "MUSIC" => [
{ regex => qr/theme song/i, category => "THEME SONGS" }, { regex => qr/theme song/i, category => "THEME SONGS" },
{ regex => qr/80's tune performed by/i, category => "80'S TUNE PERFORMED BY" }, { regex => qr/80's tune performed by/i, category => "80'S TUNE PERFORMED BY" },
{ regex => qr/90's tune performed by/i, category => "90'S TUNE PERFORMED BY" }, { regex => qr/90's tune performed by/i, category => "90'S TUNE PERFORMED BY" },
{ regex => qr/50's chart toppers/i, category => "1950'S CHART TOPPERS" }, { regex => qr/50's chart toppers/i, category => "1950'S CHART TOPPERS" },
{ regex => qr/60's chart toppers/i, category => "1960'S CHART TOPPERS" }, { regex => qr/60's chart toppers/i, category => "1960'S CHART TOPPERS" },
{ regex => qr/70's chart toppers/i, category => "1970'S CHART TOPPERS" }, { regex => qr/70's chart toppers/i, category => "1970'S CHART TOPPERS" },
@ -694,7 +694,7 @@ for my $i (0 .. $#lines) {
if (not $l[0] =~ m/ /) { if (not $l[0] =~ m/ /) {
print STDERR "Skipping doc $i (no spaces): $l[0] ($l[1])\n"; print STDERR "Skipping doc $i (no spaces): $l[0] ($l[1])\n";
next; next;
} }
# skip questions that we don't want # skip questions that we don't want
@ -800,7 +800,7 @@ foreach my $cat (sort { @{$docs{$b}} <=> @{$docs{$a}} } keys %docs) {
print STDERR " $cat: ", scalar @{$docs{$cat}}, "\n"; print STDERR " $cat: ", scalar @{$docs{$cat}}, "\n";
if (@{$docs{$cat}} < $minimum_category_size) { if (@{$docs{$cat}} < $minimum_category_size) {
$small++ $small++
} else { } else {
$total += @{$docs{$cat}}; $total += @{$docs{$cat}};
$approved{$cat} = 1; $approved{$cat} = 1;
@ -837,7 +837,7 @@ $total = @uncat;
foreach my $doc (sort { $lines[$a] cmp $lines[$b] } @uncat) { foreach my $doc (sort { $lines[$a] cmp $lines[$b] } @uncat) {
if ($i % 1000 == 0) { if ($i % 1000 == 0) {
print STDERR "-" x 80, "\n"; print STDERR "-" x 80, "\n";
print STDERR "$i / $total\n"; print STDERR "$i / $total\n";
print STDERR "-" x 80, "\n"; print STDERR "-" x 80, "\n";
} }
$i++; $i++;
@ -899,7 +899,7 @@ foreach my $doc (@remaining_uncat) {
push @{$docs{$cat}}, $doc; push @{$docs{$cat}}, $doc;
if (@{$docs{$cat}} == $minimum_category_size) { if (@{$docs{$cat}} == $minimum_category_size) {
$approved{$cat} = 1; $approved{$cat} = 1;
} }
print STDERR "Using uncat rules $cat for doc $i: $l[0] ($l[1])\n"; print STDERR "Using uncat rules $cat for doc $i: $l[0] ($l[1])\n";
} else { } else {
$new_uncat{$doc} = 1; $new_uncat{$doc} = 1;

2
modules/c11std.pl
View File

@ -173,7 +173,7 @@ while ($text =~ m/^\s{0,4}([0-9A-Z]+\.[0-9\.]*)/msg) {
} }
last if $found && $paragraph_specified == $USER_SPECIFIED; last if $found && $paragraph_specified == $USER_SPECIFIED;
if ($paragraph_specified == $USER_SPECIFIED) { if ($paragraph_specified == $USER_SPECIFIED) {
if (length $search) { if (length $search) {
print "No such text '$search' in paragraph $paragraph of section $section of n1570.\n"; print "No such text '$search' in paragraph $paragraph of section $section of n1570.\n";

2
modules/c2english.pl
View File

@ -169,7 +169,7 @@ $white_code =~ s/(?:\'((?:\\\'|(?!\').)*)\')/"'" . ('-' x length $1) . "'"/ge;
my $precode; my $precode;
if ($white_code =~ m/#include/) { if ($white_code =~ m/#include/) {
$precode = $code; $precode = $code;
} else { } else {
$precode = $prelude . $code; $precode = $prelude . $code;
} }

2
modules/c99std.pl
View File

@ -172,7 +172,7 @@ while ($text =~ m/^\s{0,4}([0-9A-Z]+\.[0-9\.]*)/msg) {
} }
last if $found && $paragraph_specified == $USER_SPECIFIED; last if $found && $paragraph_specified == $USER_SPECIFIED;
if ($paragraph_specified == $USER_SPECIFIED) { if ($paragraph_specified == $USER_SPECIFIED) {
if (length $search) { if (length $search) {
print "No such text '$search' found within paragraph $paragraph of section $section of n1256.\n"; print "No such text '$search' found within paragraph $paragraph of section $section of n1256.\n";

2
modules/cjeopardy/cjeopardy.pl
View File

@ -43,7 +43,7 @@ if (defined $ret) {
my $last_question = <$fh>; my $last_question = <$fh>;
my $last_answer = <$fh>; my $last_answer = <$fh>;
my $last_timestamp = <$fh>; my $last_timestamp = <$fh>;
if (scalar gettimeofday - $last_timestamp <= $TIMELIMIT) { if (scalar gettimeofday - $last_timestamp <= $TIMELIMIT) {
my $duration = duration($TIMELIMIT - scalar gettimeofday - $last_timestamp); my $duration = duration($TIMELIMIT - scalar gettimeofday - $last_timestamp);
print "$color{magneta}The current question is$color{reset}: $last_question"; print "$color{magneta}The current question is$color{reset}: $last_question";

4
modules/cjeopardy/cjeopardy_answer.pl
View File

@ -170,7 +170,7 @@ foreach my $answer (@valid_answers) {
my $percentage = $distance / $length * 100; my $percentage = $distance / $length * 100;
if ($percentage < $incorrect_percentage) { if ($percentage < $incorrect_percentage) {
$incorrect_percentage = $percentage; $incorrect_percentage = $percentage;
} }
if ($percentage < 15) { if ($percentage < 15) {
@ -319,7 +319,7 @@ foreach my $answer (@valid_answers) {
if ($channel eq '#cjeopardy') { if ($channel eq '#cjeopardy') {
my $question = `./cjeopardy.pl $channel`; my $question = `./cjeopardy.pl $channel`;
if ($hint_only_mode) { if ($hint_only_mode) {
my $hint = `./cjeopardy_hint.pl candide $channel`; my $hint = `./cjeopardy_hint.pl candide $channel`;
$hint =~ s/^Hint: //; $hint =~ s/^Hint: //;

2
modules/cjeopardy/cjeopardy_hint.pl
View File

@ -102,7 +102,7 @@ while (@indices <= $hidden_character_count - $spaces - $dashes - $underscores -
next if $char eq '_'; next if $char eq '_';
next if $char eq '"'; next if $char eq '"';
next if grep { $index eq $_ } @indices; next if grep { $index eq $_ } @indices;
push @indices, $index; push @indices, $index;
} }
foreach my $index (@indices) { foreach my $index (@indices) {

2
modules/cjeopardy/cjeopardy_scores.pl
View File

@ -315,7 +315,7 @@ if (lc $command eq 'score') {
$score .= "highest correct streak: $player_data->{highest_correct_streak}" . ($player_data->{lifetime_highest_correct_streak} > $player_data->{highest_correct_streak} ? " [$player_data->{lifetime_highest_correct_streak}]" : "") . ", "; $score .= "highest correct streak: $player_data->{highest_correct_streak}" . ($player_data->{lifetime_highest_correct_streak} > $player_data->{highest_correct_streak} ? " [$player_data->{lifetime_highest_correct_streak}]" : "") . ", ";
$score .= "quickest correct streak: "; $score .= "quickest correct streak: ";
$score .= ($player_data->{highest_quick_correct_streak} > 0 ? "$player_data->{highest_quick_correct_streak} in " . (concise duration $player_data->{quickest_correct_streak}) : "N/A") . ($player_data->{lifetime_highest_quick_correct_streak} > $player_data->{highest_quick_correct_streak} ? " [$player_data->{lifetime_highest_quick_correct_streak} in " . (concise duration $player_data->{lifetime_quickest_correct_streak}) . "]" : "") . ", "; $score .= ($player_data->{highest_quick_correct_streak} > 0 ? "$player_data->{highest_quick_correct_streak} in " . (concise duration $player_data->{quickest_correct_streak}) : "N/A") . ($player_data->{lifetime_highest_quick_correct_streak} > $player_data->{highest_quick_correct_streak} ? " [$player_data->{lifetime_highest_quick_correct_streak} in " . (concise duration $player_data->{lifetime_quickest_correct_streak}) . "]" : "") . ", ";
$score .= "quickest answer: "; $score .= "quickest answer: ";
if ($player_data->{quickest_correct} == 0) { if ($player_data->{quickest_correct} == 0) {

4
modules/codepad.pl
View File

@ -68,13 +68,13 @@ $code = '';
if ($lang eq "C" or $lang eq "C++") { if ($lang eq "C" or $lang eq "C++") {
my $has_main = 0; my $has_main = 0;
my $prelude = ''; my $prelude = '';
$prelude = "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//s; $prelude = "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//s;
while ($precode =~ s/([ a-zA-Z0-9_*\[\]]+)\s+([a-zA-Z0-9_*]+)\s*\((.*?)\)\s*({.*)//) { while ($precode =~ s/([ a-zA-Z0-9_*\[\]]+)\s+([a-zA-Z0-9_*]+)\s*\((.*?)\)\s*({.*)//) {
my ($ret, $ident, $params, $potential_body) = ($1, $2, $3, $4); my ($ret, $ident, $params, $potential_body) = ($1, $2, $3, $4);
my @extract = extract_codeblock($potential_body, '{}'); my @extract = extract_codeblock($potential_body, '{}');
my $body; my $body;
if (not defined $extract[0]) { if (not defined $extract[0]) {

4
modules/compiler_block.pl
View File

@ -16,8 +16,8 @@ use IO::Socket::INET;
use JSON; use JSON;
my $sock = IO::Socket::INET->new( my $sock = IO::Socket::INET->new(
PeerAddr => '192.168.0.42', PeerAddr => '192.168.0.42',
PeerPort => 9000, PeerPort => 9000,
Proto => 'tcp'); Proto => 'tcp');
if (not defined $sock) { if (not defined $sock) {

19
modules/compiler_client.pl
View File

@ -12,24 +12,21 @@
use warnings; use warnings;
use strict; use strict;
use IO::Socket::INET; use IO::Socket;
use JSON; use JSON;
my $sock = IO::Socket::INET->new( my $sock = IO::Socket::INET->new(
PeerAddr => '127.0.0.1', PeerAddr => '127.0.0.1',
PeerPort => 9000, PeerPort => 9000,
Proto => 'tcp'); Proto => 'tcp');
if (not defined $sock) { if(not defined $sock) {
print "Fatal error compiling: $!; try again later\n"; print "Fatal error compiling: $!; try again later\n";
die $!; die $!;
} }
my $json = join ' ', @ARGV; my $json = join ' ', @ARGV;
my $length = length $json; print STDERR "join = $json?\n";
print STDERR "got $length bytes of argv json: [$json]\n";
my $h = decode_json $json; my $h = decode_json $json;
my $lang = $h->{lang} // "c11"; my $lang = $h->{lang} // "c11";
@ -40,13 +37,9 @@ if ($h->{code} =~ s/-lang=([^ ]+)//) {
$h->{lang} = $lang; $h->{lang} = $lang;
$json = encode_json $h; $json = encode_json $h;
$length = length $json; print $sock "$json\n";
print STDERR "got $length bytes of json: [$json]\n"; while(my $line = <$sock>) {
syswrite($sock, "$json\n");
while (my $line = <$sock>) {
print "$line"; print "$line";
} }

2
modules/compiler_vm/compiler_client.pl
View File

@ -17,7 +17,7 @@ use JSON;
my $sock = IO::Socket::INET->new( my $sock = IO::Socket::INET->new(
PeerAddr => '127.0.0.1', PeerAddr => '127.0.0.1',
PeerPort => 9000, PeerPort => 9000,
Proto => 'tcp'); Proto => 'tcp');
if(not defined $sock) { if(not defined $sock) {

8
modules/compiler_vm/compiler_server.pl
View File

@ -23,7 +23,7 @@ my $NOGRAPHIC = 1;
sub server_listen { sub server_listen {
my $port = shift @_; my $port = shift @_;
my $server = IO::Socket::INET->new( my $server = IO::Socket::INET->new(
Proto => 'tcp', Proto => 'tcp',
LocalPort => $port, LocalPort => $port,
Listen => SOMAXCONN, Listen => SOMAXCONN,
@ -54,7 +54,7 @@ sub vm_start {
if($pid == 0) { if($pid == 0) {
my $command = "qemu-system-x86_64 -M pc -net none -hda compiler-snap.qcow2 -m 512 -monitor tcp:127.0.0.1:$MONITOR_PORT,server,nowait -serial tcp:127.0.0.1:$SERIAL_PORT,server,nowait -serial tcp:127.0.0.1:$HEARTBEAT_PORT,server -boot c -enable-kvm -loadvm 1" . ($NOGRAPHIC ? " -nographic" : ""); my $command = "qemu-system-x86_64 -M pc -net none -hda compiler-snap.qcow2 -m 512 -monitor tcp:127.0.0.1:$MONITOR_PORT,server,nowait -serial tcp:127.0.0.1:$SERIAL_PORT,server,nowait -serial tcp:127.0.0.1:$HEARTBEAT_PORT,server -boot c -enable-kvm -loadvm 1" . ($NOGRAPHIC ? " -nographic" : "");
my @command_list = split / /, $command; my @command_list = split / /, $command;
exec(@command_list); exec(@command_list);
} else { } else {
return $pid; return $pid;
} }
@ -92,7 +92,7 @@ sub execute {
local $SIG{ALRM} = sub { print "Time out\n"; kill 9, $pid; print "sent KILL to $pid\n"; die "Timed-out: $result\n"; }; local $SIG{ALRM} = sub { print "Time out\n"; kill 9, $pid; print "sent KILL to $pid\n"; die "Timed-out: $result\n"; };
alarm($COMPILE_TIMEOUT); alarm($COMPILE_TIMEOUT);
while(my $line = <$fh>) { while(my $line = <$fh>) {
$result .= $line; $result .= $line;
} }
@ -294,7 +294,7 @@ sub compiler_server {
vm_stop $vm_pid; vm_stop $vm_pid;
$running = 0; $running = 0;
last; last;
} }
print "Compiler server no longer running, restarting...\n"; print "Compiler server no longer running, restarting...\n";
} }
waitpid($heartbeat_pid, 0); waitpid($heartbeat_pid, 0);

4
modules/compiler_vm/compiler_server_vbox_win32.pl
View File

@ -29,7 +29,7 @@ $SIG{INT} = sub { vm_stop(); exit 1; };
sub server_listen { sub server_listen {
my $port = shift @_; my $port = shift @_;
my $server = IO::Socket::INET->new( my $server = IO::Socket::INET->new(
Proto => 'tcp', Proto => 'tcp',
LocalPort => $port, LocalPort => $port,
Listen => SOMAXCONN, Listen => SOMAXCONN,
@ -262,7 +262,7 @@ sub compiler_server {
$ns->setvar('running', 0); $ns->setvar('running', 0);
vm_stop; vm_stop;
last; last;
} }
print "Compiler server no longer running, restarting...\n"; print "Compiler server no longer running, restarting...\n";
} }
print "Waiting for heartbeat $heartbeat_pid to die\n"; print "Waiting for heartbeat $heartbeat_pid to die\n";

14
modules/compiler_vm/compiler_server_virsh.pl
View File

@ -18,7 +18,7 @@ my $COMPILE_TIMEOUT = 10;
sub server_listen { sub server_listen {
my $port = shift @_; my $port = shift @_;
my $server = IO::Socket::INET->new( my $server = IO::Socket::INET->new(
Proto => 'tcp', Proto => 'tcp',
LocalPort => $port, LocalPort => $port,
Listen => SOMAXCONN, Listen => SOMAXCONN,
@ -41,9 +41,9 @@ sub vm_start {
sub vm_reset { sub vm_reset {
return if $ENV{NORESET}; return if $ENV{NORESET};
system("virsh detach-disk $DOMAIN_NAME vdb"); #system("virsh detach-disk $DOMAIN_NAME vdb");
system("virsh snapshot-revert $DOMAIN_NAME 1"); system("virsh snapshot-revert $DOMAIN_NAME 1");
system("virsh attach-disk $DOMAIN_NAME --source /var/lib/libvirt/images/factdata.qcow2 --target vdb"); #system("virsh attach-disk $DOMAIN_NAME --source /var/lib/libvirt/images/factdata.qcow2 --target vdb");
print "Reset vm\n"; print "Reset vm\n";
} }
@ -85,7 +85,7 @@ sub execute {
my $ret = $? >> 8; my $ret = $? >> 8;
alarm 0; alarm 0;
print "[$ret, $result]\n"; print "[$ret, $result]\n";
return ($ret, $result); return ($ret, $result);
}; };
@ -174,7 +174,7 @@ sub compiler_server {
if ($heartbeat == -1) { if ($heartbeat == -1) {
print "fucking dead, restarting\n"; print "fucking dead, restarting\n";
waitpid $heartbeat_pid, 0; waitpid $heartbeat_pid, 0;
# vm_stop; #vm_stop;
next; next;
} }
@ -259,10 +259,10 @@ sub compiler_server {
next; next;
print "stopping vm\n"; print "stopping vm\n";
vm_stop; #vm_stop;
$running = 0; $running = 0;
last; last;
} }
print "Compiler server no longer running, restarting...\n"; print "Compiler server no longer running, restarting...\n";
} }
print "waiting on heartbeat pid?\n"; print "waiting on heartbeat pid?\n";

2
modules/compiler_vm/compiler_server_watchdog.pl
View File

@ -39,7 +39,7 @@ while (1) {
foreach $p (@{$t->table}) { foreach $p (@{$t->table}) {
$pids->{$p->pid} = { fname => $p->fname, ppid => $p->ppid }; $pids->{$p->pid} = { fname => $p->fname, ppid => $p->ppid };
} }
foreach $p (keys %$pids) { foreach $p (keys %$pids) {
if ($pids->{$p}->{fname} eq $QEMU) { if ($pids->{$p}->{fname} eq $QEMU) {

2
modules/compiler_vm/compiler_vm_server.pl
View File

@ -12,7 +12,7 @@ use File::Basename;
use JSON; use JSON;
my $USERNAME = 'compiler'; my $USERNAME = 'compiler';
my $USE_LOCAL = defined $ENV{'CC_LOCAL'}; my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
use constant MOD_DIR => '/usr/local/share/compiler_vm/languages'; use constant MOD_DIR => '/usr/local/share/compiler_vm/languages';

2
modules/compiler_vm/languages/_c_base.pm
View File

@ -180,7 +180,7 @@ sub preprocess_code {
my $precode; my $precode;
if($white_code =~ m/#include/) { if($white_code =~ m/#include/) {
$precode = $self->{code}; $precode = $self->{code};
} else { } else {
$precode = $default_prelude . $self->{code}; $precode = $default_prelude . $self->{code};
} }

6
modules/compiler_vm/languages/_default.pm
View File

@ -383,7 +383,7 @@ sub execute {
#print FILE "Sending $length bytes [$compile_json] to vm_server\n"; #print FILE "Sending $length bytes [$compile_json] to vm_server\n";
$chunk_size -= 1; # account for newline in syswrite $chunk_size -= 1; # account for newline in syswrite
while ($chunks_sent < $length) { while ($chunks_sent < $length) {
my $chunk = substr $compile_json, $chunks_sent, $chunk_size; my $chunk = substr $compile_json, $chunks_sent, $chunk_size;
#print FILE "Sending chunk [$chunk]\n"; #print FILE "Sending chunk [$chunk]\n";
@ -617,7 +617,7 @@ sub process_interactive_edit {
print "No recent code to $self->{got_run}.\n"; print "No recent code to $self->{got_run}.\n";
exit 0; exit 0;
} }
} }
if($subcode =~ m/^\s*(and)?\s*remove \s*([^']+)?\s*'/) { if($subcode =~ m/^\s*(and)?\s*remove \s*([^']+)?\s*'/) {
$last_keyword = 'remove'; $last_keyword = 'remove';
@ -824,7 +824,7 @@ sub process_interactive_edit {
$before = $`; $before = $`;
$after = $'; $after = $';
} elsif($suffix =~ /^i$/) { } elsif($suffix =~ /^i$/) {
$ret = $code =~ s|$regex|$to|i; $ret = $code =~ s|$regex|$to|i;
($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9); ($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
$before = $`; $before = $`;
$after = $'; $after = $';

2
modules/compiler_vm/languages/server/_c_base.pm
View File

@ -3,7 +3,7 @@
use warnings; use warnings;
use strict; use strict;
package _c_base; package _c_base;
use parent '_default'; use parent '_default';
sub preprocess { sub preprocess {

4
modules/compiler_vm/languages/server/java.pm
View File

@ -3,7 +3,7 @@
use warnings; use warnings;
use strict; use strict;
package java; package java;
use parent '_default'; use parent '_default';
sub preprocess { sub preprocess {
@ -28,7 +28,7 @@ sub postprocess {
print "Executing java\n"; print "Executing java\n";
my $input_quoted = quotemeta $self->{input}; my $input_quoted = quotemeta $self->{input};
$input_quoted =~ s/\\"/"'\\"'"/g; $input_quoted =~ s/\\"/"'\\"'"/g;
my ($retval, $result) = $self->execute(60, "date -s \@$self->{date}; ulimit -t 5; echo $input_quoted | java prog $self->{arguments} > .output"); my ($retval, $result) = $self->execute(60, "bash -c \"date -s \@$self->{date}; ulimit -t 5; echo $input_quoted | java prog $self->{arguments} > .output\"");
$result = ""; $result = "";
open(FILE, '.output'); open(FILE, '.output');

2
modules/compiler_vm/languages/server/tendra.pm
View File

@ -17,7 +17,7 @@ sub postprocess {
$self->{output} = "[$self->{output}]\n"; $self->{output} = "[$self->{output}]\n";
} }
my ($retval, $result) = $self->execute(60, "date -s \@$self->{date}; ulimit -t 5; cat .input | /home/compiler/prog > .output"); my ($retval, $result) = $self->execute(60, "bash -c \"date -s \@$self->{date}; ulimit -t 5; cat .input | /home/compiler/prog > .output\"");
$self->{error} = $retval; $self->{error} = $retval;

2
modules/compiler_vm/languages/tcl.pm
View File

@ -3,7 +3,7 @@
use warnings; use warnings;
use strict; use strict;
package tcl; package tcl;
use parent '_default'; use parent '_default';
sub initialize { sub initialize {

2
modules/cstd.pl
View File

@ -166,7 +166,7 @@ while ($text =~ m/^\s{4,6}(\d+\.[0-9\.]*)/msg) {
} }
last if $found && $paragraph_specified == $USER_SPECIFIED; last if $found && $paragraph_specified == $USER_SPECIFIED;
if ($paragraph_specified == $USER_SPECIFIED) { if ($paragraph_specified == $USER_SPECIFIED) {
print "No such paragraph '$paragraph' in section '$section' of n1256.\n"; print "No such paragraph '$paragraph' in section '$section' of n1256.\n";
exit 0; exit 0;

4
modules/define.pl
View File

@ -34,7 +34,7 @@ if ($text =~ m/no dictionary results/i)
{ {
print "No entry found for '$phrase'. "; print "No entry found for '$phrase'. ";
if ($text =~ m/Did you mean <a class.*?>(.*?)<\/a>/g) if ($text =~ m/Did you mean <a class.*?>(.*?)<\/a>/g)
{ {
print "Did you mean '$1'? Alternate suggestions: "; print "Did you mean '$1'? Alternate suggestions: ";
@ -54,7 +54,7 @@ if ($text =~ m/no dictionary results/i)
# print "Suggestions: "; # print "Suggestions: ";
# #
# $i = 30; # $i = 30;
# while ($text =~ m/<a href=".*?\/search\?r=13&amp;q=.*?>(.*?)<\/a>/g # while ($text =~ m/<a href=".*?\/search\?r=13&amp;q=.*?>(.*?)<\/a>/g
# && $i > 0) # && $i > 0)
# { # {
# print "$1, "; # print "$1, ";

2
modules/expand_macros.pl
View File

@ -15,7 +15,7 @@ use LWP::UserAgent;
my $debug = 0; my $debug = 0;
my $USE_LOCAL = defined $ENV{'CC_LOCAL'}; my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
my $output = ""; my $output = "";
my $nooutput = 'No output.'; my $nooutput = 'No output.';

24
modules/gdefine.pl
View File

@ -3,12 +3,12 @@
# This Source Code Form is subject to the terms of the Mozilla Public # 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 # 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/. # file, You can obtain one at http://mozilla.org/MPL/2.0/.
# quick and dirty by :pragma # quick and dirty by :pragma
use strict; use strict;
use LWP::UserAgent; use LWP::UserAgent;
my ($defint, $phrase, $text, $entry, $entries, $i); my ($defint, $phrase, $text, $entry, $entries, $i);
my @defs; my @defs;
@ -17,26 +17,26 @@ if ($#ARGV < 0)
print "What phrase would you like to define?\n"; print "What phrase would you like to define?\n";
die; die;
} }
$phrase = join("+", @ARGV); $phrase = join("+", @ARGV);
$entry = 1; $entry = 1;
if ($phrase =~ m/([0-9]+)\+(.*)/) if ($phrase =~ m/([0-9]+)\+(.*)/)
{ {
$entry = $1; $entry = $1;
$phrase = $2; $phrase = $2;
} }
my $ua = LWP::UserAgent->new; my $ua = LWP::UserAgent->new;
$ua->agent("howdy"); $ua->agent("howdy");
my $response = $ua->get("http://www.google.com/search?q=define:$phrase"); my $response = $ua->get("http://www.google.com/search?q=define:$phrase");
$phrase =~ s/\+/ /g; $phrase =~ s/\+/ /g;
if (not $response->is_success) { if (not $response->is_success) {
exit(1); exit(1);
} }
$text = $response->content; $text = $response->content;
if ($text =~ m/No definitions were found/i) if ($text =~ m/No definitions were found/i)
{ {
@ -44,11 +44,11 @@ if ($text =~ m/No definitions were found/i)
print "\n"; print "\n";
exit 1; exit 1;
} }
print "$phrase: "; print "$phrase: ";
$i = $entry; $i = $entry;
while ($i <= $entry + 5) while ($i <= $entry + 5)
{ {
if ($text =~ m/<li>(.*?)<br>/gs) if ($text =~ m/<li>(.*?)<br>/gs)

8
modules/gencstd.pl
View File

@ -4,7 +4,7 @@
# License, v. 2.0. If a copy of the MPL was not distributed with this # 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/. # file, You can obtain one at http://mozilla.org/MPL/2.0/.
# ugly and hacked together # ugly and hacked together
use warnings; use warnings;
use strict; use strict;
@ -12,7 +12,7 @@ use strict;
use HTML::Entities; use HTML::Entities;
use Data::Dumper; use Data::Dumper;
my $debug = 1000; my $debug = 1000;
sub gen_data; sub gen_data;
sub gen_txt; sub gen_txt;
@ -58,7 +58,7 @@ sub gen_data {
my $diff = $section_number - $last_section_number; my $diff = $section_number - $last_section_number;
print STDERR "Diff: $diff\n" if $debug >= 2; print STDERR "Diff: $diff\n" if $debug >= 2;
if ($section_number > 0 and $diff < 0 or $diff > 1) { if ($section_number > 0 and $diff < 0 or $diff > 1) {
print STDERR "Diff out of bounds: $diff\n"; print STDERR "Diff out of bounds: $diff\n";
last; last;
} }
@ -176,7 +176,7 @@ sub gen_data {
sub bysection { sub bysection {
my $inverse = 1; my $inverse = 1;
print STDERR "section cmp $a <=> $b\n" if $debug > 10; print STDERR "section cmp $a <=> $b\n" if $debug > 10;
my ($a1, $p1) = split /p/, $a; my ($a1, $p1) = split /p/, $a;
my ($b1, $p2) = split /p/, $b; my ($b1, $p2) = split /p/, $b;

2
modules/google.pl
View File

@ -70,7 +70,7 @@ if ($text =~ m/Showing web page information/g)
$header = $1; $header = $1;
$header =~ s/<.*?>//g; $header =~ s/<.*?>//g;
print "$header"; print "$header";
if ($text =~ m/Description:(.*?)<br>/) if ($text =~ m/Description:(.*?)<br>/)
{ {
$header = $1; $header = $1;

2
modules/gtop15.pl
View File

@ -103,7 +103,7 @@ while ($html =~ m/<a href=".*?"\s*class="zeit_link">\s*(.*?)\s*<\/a>(.*?)<\/li>/
# } # }
# next if (ord($1) < 97 && ord($1) > 122 && ord($1) < 65 && ord($1) > 90 # next if (ord($1) < 97 && ord($1) > 122 && ord($1) < 65 && ord($1) > 90
# && ord($1) < 48 && ord($1) > 57); # && ord($1) < 48 && ord($1) > 57);
# $result .= $1; # $result .= $1;
# } # }
} }

12
modules/headlines.pl
View File

@ -13,10 +13,10 @@ use LWP::Simple;
my %news_sites = ( my %news_sites = (
"jbad" => [ "http://jalalabad.us/backend/geeklog.rdf", "jbad" => [ "http://jalalabad.us/backend/geeklog.rdf",
"Jalalabad.us" "Jalalabad.us"
], ],
"bbc" => [ "http://news.bbc.co.uk/rss/newsonline_uk_edition/world/rss091.xml", "bbc" => [ "http://news.bbc.co.uk/rss/newsonline_uk_edition/world/rss091.xml",
"news.bbc.co.uk" "news.bbc.co.uk"
], ],
"cnn" => [ "http://www.cnn.com/cnn.rss", "cnn" => [ "http://www.cnn.com/cnn.rss",
"CNN News" "CNN News"
@ -86,19 +86,19 @@ sub check_news {
$rss->parse($content); $rss->parse($content);
}; };
if (my $error = $@) { if (my $error = $@) {
$error =~ s/\n//g; $error =~ s/\n//g;
print "Got error: $error\n"; print "Got error: $error\n";
return 0; return 0;
} }
foreach my $item (@{$rss->{'items'}}) { foreach my $item (@{$rss->{'items'}}) {
next unless defined($item->{'title'}) && defined($item->{'link'}); next unless defined($item->{'title'}) && defined($item->{'link'});
if ($links == 1) if ($links == 1)
{ {
$text = " $item->{'title'} : ( $item->{'link'} )"; $text = " $item->{'title'} : ( $item->{'link'} )";
$text =~ s/\n//g; $text =~ s/\n//g;
$text =~ s/\t//g; $text =~ s/\t//g;
$text =~ s/\r//g; $text =~ s/\r//g;
print "$text\n"; print "$text\n";

14
modules/ideone.pl
View File

@ -91,7 +91,7 @@ my %languages = (
# C99 34 # C99 34
# C++ 1 # C++ 1
my %preludes = ( my %preludes = (
'34' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n", '34' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n",
'11' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n", '11' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n",
'1' => "#include <iostream>\n#include <cstdio>\n", '1' => "#include <iostream>\n#include <cstdio>\n",
@ -133,7 +133,7 @@ if ($code =~ m/^\s*run\s*$/i) {
print "$nick: No recent code to run.\n"; print "$nick: No recent code to run.\n";
exit 0; exit 0;
} }
} else { } else {
my $subcode = $code; my $subcode = $code;
my $got_undo = 0; my $got_undo = 0;
my $got_sub = 0; my $got_sub = 0;
@ -344,7 +344,7 @@ if ($code =~ m/^\s*run\s*$/i) {
$before = $`; $before = $`;
$after = $'; $after = $';
} elsif ($suffix =~ /^i$/) { } elsif ($suffix =~ /^i$/) {
$ret = $code =~ s|$regex|$to|i; $ret = $code =~ s|$regex|$to|i;
$a = $1; $a = $1;
$b = $2; $b = $2;
$c = $3; $c = $3;
@ -564,10 +564,10 @@ $code = '';
if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{$lang}{'id'} == 34) { if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{$lang}{'id'} == 34) {
my $has_main = 0; my $has_main = 0;
my $prelude = ''; my $prelude = '';
$prelude = "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//s; $prelude = "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//s;
while ($precode =~ s/([ a-zA-Z0-9_*\[\]]+)\s+([a-zA-Z0-9_*]+)\s*\((.*?)\)\s*({.*)//) { while ($precode =~ s/([ a-zA-Z0-9_*\[\]]+)\s+([a-zA-Z0-9_*]+)\s*\((.*?)\)\s*({.*)//) {
my ($ret, $ident, $params, $potential_body) = ($1, $2, $3, $4); my ($ret, $ident, $params, $potential_body) = ($1, $2, $3, $4);
@ -600,7 +600,7 @@ if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{
if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{$lang}{'id'} == 35 if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{$lang}{'id'} == 35
or $languages{$lang}{'id'} == 27 or $languages{$lang}{'id'} == 10 or $languages{$lang}{'id'} == 34) { or $languages{$lang}{'id'} == 27 or $languages{$lang}{'id'} == 10 or $languages{$lang}{'id'} == 34) {
$code = pretty($code) $code = pretty($code)
} }
$code =~ s/\\n/\n/g if $languages{$lang}{'id'} == 13 or $languages{$lang}{'id'} == 101 or $languages{$lang}{'id'} == 45; $code =~ s/\\n/\n/g if $languages{$lang}{'id'} == 13 or $languages{$lang}{'id'} == 101 or $languages{$lang}{'id'} == 45;
@ -735,7 +735,7 @@ if ($result->{result} == $INTERNAL_ERROR) {
} }
$output .= "\n" . $result->{stderr}; $output .= "\n" . $result->{stderr};
$output .= "\n" . $result->{output}; $output .= "\n" . $result->{output};
$output = decode_entities($output); $output = decode_entities($output);

2
modules/insult.pl
View File

@ -6,7 +6,7 @@
use strict; use strict;
use LWP::Simple; use LWP::Simple;
$_ = get("http://www.randominsults.net/"); $_ = get("http://www.randominsults.net/");
if (/<strong><i>(.*?)\s*<\/i><\/strong>/) { if (/<strong><i>(.*?)\s*<\/i><\/strong>/) {
print @ARGV,': ' if @ARGV; print @ARGV,': ' if @ARGV;

1538
modules/lookupbot.pl
View File

File diff suppressed because it is too large Load Diff

6
modules/love_quote.pl
View File

@ -31,7 +31,7 @@ my @quotes;
while (1) { while (1) {
my $arguments = "love you"; my $arguments = "love you";
my $author = ""; my $author = "";
$arguments =~ s/\$nick/me/gi; $arguments =~ s/\$nick/me/gi;
$arguments =~ s/\s/+/g; $arguments =~ s/\s/+/g;
@ -71,7 +71,7 @@ while (1) {
push @quotes, $t; push @quotes, $t;
print "Added '$t'\n" if $debug; print "Added '$t'\n" if $debug;
print "$#quotes\n" if $debug; print "$#quotes\n" if $debug;
} }
if ($text =~ m/Page \d+ of (\d+)/) { if ($text =~ m/Page \d+ of (\d+)/) {
$pages = $1; $pages = $1;
@ -81,7 +81,7 @@ while (1) {
} else { } else {
last; last;
} }
if ($#quotes < 0) { if ($#quotes < 0) {
print "No results found.\n"; print "No results found.\n";
die; die;

4
modules/man.pl
View File

@ -30,13 +30,13 @@ $manpage =~ s/\+.*$//;
my $get_text; my $get_text;
do { do {
# $text = get("http://www.freebsd.org/cgi/man.cgi?query=$manpage&sektion=$section&apropos=0&manpath=FreeBSD+6.2-RELEASE&format=ascii"); # $text = get("http://www.freebsd.org/cgi/man.cgi?query=$manpage&sektion=$section&apropos=0&manpath=FreeBSD+6.2-RELEASE&format=ascii");
$get_text = get("http://www.freebsd.org/cgi/man.cgi?query=$manpage&sektion=$section&apropos=0&manpath=SuSE+Linux%2Fi386+11.3&format=ascii"); $get_text = get("http://www.freebsd.org/cgi/man.cgi?query=$manpage&sektion=$section&apropos=0&manpath=SuSE+Linux%2Fi386+11.3&format=ascii");
$text = substr($get_text, 0, 5000); $text = substr($get_text, 0, 5000);
# print '['.length($text).']'."\n"; # print '['.length($text).']'."\n";
if ($text =~ m/Sorry, no data found/) if ($text =~ m/Sorry, no data found/)
{ {
$section--; $section--;

6
modules/map.pl
View File

@ -13,7 +13,7 @@ if ($#ARGV < 0)
print "Try again. Please specify the location you would like to search for nearby cities around.\n"; print "Try again. Please specify the location you would like to search for nearby cities around.\n";
die; die;
} }
$location = join("+", @ARGV); $location = join("+", @ARGV);
$location =~ s/,/%2C/; $location =~ s/,/%2C/;
@ -31,7 +31,7 @@ $location =~ s/%2C/,/g;
if ($text =~ m/No match found/) if ($text =~ m/No match found/)
{ {
print "$location is not a valid location for this service.\n"; print "$location is not a valid location for this service.\n";
die; die;
} }
@ -52,7 +52,7 @@ if ($text =~ m/location matches\:/g)
$buffer =~ s/<\/b>//g; $buffer =~ s/<\/b>//g;
$buffer =~ s/^\s+//; $buffer =~ s/^\s+//;
$buf = $buf . "$buffer - "; $buf = $buf . "$buffer - ";
if ($location =~ m/$buffer/i) if ($location =~ m/$buffer/i)
{ {

2
modules/math.pl
View File

@ -11,7 +11,7 @@ use Math::Units qw(convert);
my ($arguments, $response, $invalid, @conversion); my ($arguments, $response, $invalid, @conversion);
my @valid_keywords = ( my @valid_keywords = (
'sin', 'cos', 'tan', 'atan', 'exp', 'int', 'hex', 'oct', 'log', 'sqrt', 'sin', 'cos', 'tan', 'atan', 'exp', 'int', 'hex', 'oct', 'log', 'sqrt',
'floor', 'ceil', 'asin', 'acos', 'log10', 'sinh', 'cosh', 'tanh', 'abs', 'floor', 'ceil', 'asin', 'acos', 'log10', 'sinh', 'cosh', 'tanh', 'abs',
'pi', 'deg2rad', 'rad2deg', 'atan2', 'cbrt' 'pi', 'deg2rad', 'rad2deg', 'atan2', 'cbrt'
); );

24
modules/nickometer.pl
View File

@ -65,24 +65,24 @@ sub nickometer ($) {
if ($_ =~ m/^.$/) { if ($_ =~ m/^.$/) {
&punish(1000, "single letter nick"); &punish(1000, "single letter nick");
} }
while (m/[A-Z]([^A-Z]+)\b/g) { while (m/[A-Z]([^A-Z]+)\b/g) {
&punish(250, "length 1 between capitals") if length $1 == 1; &punish(250, "length 1 between capitals") if length $1 == 1;
} }
# Allow Perl referencing # Allow Perl referencing
s/^\\([A-Za-z])/$1/; s/^\\([A-Za-z])/$1/;
# Keep me safe from Pudge ;-) # Keep me safe from Pudge ;-)
s/\^(pudge)/$1/i; s/\^(pudge)/$1/i;
# C-- ain't so bad either # C-- ain't so bad either
s/^C--$/C/; s/^C--$/C/;
# Punish consecutive non-alphas # Punish consecutive non-alphas
s/([^A-Za-z0-9]{2,}) s/([^A-Za-z0-9]{2,})
/my $consecutive = length($1); /my $consecutive = length($1);
&punish(&slow_pow(10, $consecutive), &punish(&slow_pow(10, $consecutive),
"$consecutive total consecutive non-alphas") "$consecutive total consecutive non-alphas")
if $consecutive; if $consecutive;
$1 $1
@ -91,12 +91,12 @@ sub nickometer ($) {
# Remove balanced brackets and punish for unmatched # Remove balanced brackets and punish for unmatched
while (s/^([^()]*) (\() (.*) (\)) ([^()]*) $/$1$3$5/x || while (s/^([^()]*) (\() (.*) (\)) ([^()]*) $/$1$3$5/x ||
s/^([^{}]*) (\{) (.*) (\}) ([^{}]*) $/$1$3$5/x || s/^([^{}]*) (\{) (.*) (\}) ([^{}]*) $/$1$3$5/x ||
s/^([^\[\]]*) (\[) (.*) (\]) ([^\[\]]*) $/$1$3$5/x) s/^([^\[\]]*) (\[) (.*) (\]) ([^\[\]]*) $/$1$3$5/x)
{ {
print "Removed $2$4 outside parentheses; nick now $_\n" if $verbose; print "Removed $2$4 outside parentheses; nick now $_\n" if $verbose;
} }
my $parentheses = tr/(){}[]/(){}[]/; my $parentheses = tr/(){}[]/(){}[]/;
&punish(&slow_pow(10, $parentheses), &punish(&slow_pow(10, $parentheses),
"$parentheses unmatched " . "$parentheses unmatched " .
($parentheses == 1 ? 'parenthesis' : 'parentheses')) ($parentheses == 1 ? 'parenthesis' : 'parentheses'))
if $parentheses; if $parentheses;
@ -116,11 +116,11 @@ sub nickometer ($) {
# alpha is caps. # alpha is caps.
my $orig_case = $_; my $orig_case = $_;
s/^([^A-Za-z]*[A-Z].*[a-z].*?)[_-]?([A-Z])/$1\l$2/; s/^([^A-Za-z]*[A-Z].*[a-z].*?)[_-]?([A-Z])/$1\l$2/;
# A caps first alpha is sometimes not lame # A caps first alpha is sometimes not lame
s/^([^A-Za-z]*)([A-Z])([a-z])/$1\l$2$3/; s/^([^A-Za-z]*)([A-Z])([a-z])/$1\l$2$3/;
# Punish uppercase to lowercase shifts and vice-versa, modulo # Punish uppercase to lowercase shifts and vice-versa, modulo
# exceptions above # exceptions above
my $case_shifts = &case_shifts($orig_case); my $case_shifts = &case_shifts($orig_case);
&punish(&slow_pow(5, $case_shifts), &punish(&slow_pow(5, $case_shifts),
@ -133,7 +133,7 @@ sub nickometer ($) {
# Punish letter to numeric shifts and vice-versa # Punish letter to numeric shifts and vice-versa
my $number_shifts = &number_shifts($_); my $number_shifts = &number_shifts($_);
&punish(&slow_pow(9, $number_shifts), &punish(&slow_pow(9, $number_shifts),
$number_shifts . ' letter/number ' . $number_shifts . ' letter/number ' .
(($number_shifts == 1) ? 'shift' : 'shifts')) (($number_shifts == 1) ? 'shift' : 'shifts'))
if $number_shifts > 1; if $number_shifts > 1;
@ -155,8 +155,8 @@ sub nickometer ($) {
print "\nRaw lameness score is $score\n" if $verbose; print "\nRaw lameness score is $score\n" if $verbose;
# Use an appropriate function to map [0, +inf) to [0, 100) # Use an appropriate function to map [0, +inf) to [0, 100)
my $percentage = 100 * my $percentage = 100 *
(1 + tanh(($score-400)/400)) * (1 + tanh(($score-400)/400)) *
(1 - 1/(1+$score/5)) / 2; (1 - 1/(1+$score/5)) / 2;
my $digits = 2 * (2 - &round_up(log(100 - $percentage) / log(10))); my $digits = 2 * (2 - &round_up(log(100 - $percentage) / log(10)));

6
modules/random_quote.pl
View File

@ -33,7 +33,7 @@ while (1) {
} else { } else {
my $arguments = join('+', @ARGV); my $arguments = join('+', @ARGV);
my $author = ""; my $author = "";
$arguments =~ s/\$nick/me/gi; $arguments =~ s/\$nick/me/gi;
$arguments =~ s/\s/+/g; $arguments =~ s/\s/+/g;
@ -74,7 +74,7 @@ while (1) {
#print "Added '$t'\n"; #print "Added '$t'\n";
#print "$#quotes\n"; #print "$#quotes\n";
last if ($#ARGV < 0); last if ($#ARGV < 0);
} }
if ($text =~ m/Page \d+ of (\d+)/) { if ($text =~ m/Page \d+ of (\d+)/) {
$pages = $1; $pages = $1;
@ -84,7 +84,7 @@ while (1) {
} else { } else {
last; last;
} }
if ($#quotes < 0) { if ($#quotes < 0) {
print "No results found.\n"; print "No results found.\n";
exit; exit;

2
modules/seen.pl
View File

@ -37,7 +37,7 @@ while (seek(FILE, $pos--, 0))
if ($line =~ m/^(\d\d:\d\d) -!- $nick (.*?)$/i) if ($line =~ m/^(\d\d:\d\d) -!- $nick (.*?)$/i)
{ {
$result = "date at $1: $nick $2\n"; $result = "date at $1: $nick $2\n";
} }
elsif ($line =~ m/^(\d\d:\d\d) <\s*$nick> (.*?)$/i) elsif ($line =~ m/^(\d\d:\d\d) <\s*$nick> (.*?)$/i)
{ {

5
modules/urban
View File

@ -51,11 +51,6 @@ if (@$args == 0) {
close $fh; close $fh;
} }
if ($args =~ m/afroman/) {
print "Oh fuck off.\n";
exit;
}
my $ud = WebService::UrbanDictionary->new; my $ud = WebService::UrbanDictionary->new;
my $results = $ud->request($args); my $results = $ud->request($args);

22
modules/weather.pl
View File

@ -1,4 +1,4 @@
#!/usr/bin/perl -I /home/msmud/lib/lib/perl5/site_perl/5.10.0/ #!/usr/bin/perl -I /home/msmud/lib/lib/perl5/site_perl/5.10.0/
# This Source Code Form is subject to the terms of the Mozilla Public # 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 # License, v. 2.0. If a copy of the MPL was not distributed with this
@ -13,7 +13,7 @@ if ($#ARGV < 0)
print "Try again. Please specify the location you would like weather for.\n"; print "Try again. Please specify the location you would like weather for.\n";
die; die;
} }
$location = join("+", @ARGV); $location = join("+", @ARGV);
$location =~ s/,/%2C/; $location =~ s/,/%2C/;
@ -33,7 +33,7 @@ $location =~ s/%2C/,/g;
if ($text =~ m/No match found/) if ($text =~ m/No match found/)
{ {
print "$location is not a valid location for this service.\n"; print "$location is not a valid location for this service.\n";
die; die;
} }
@ -54,7 +54,7 @@ if ($text =~ m/location matches\:/g)
$weather =~ s/<\/b>//g; $weather =~ s/<\/b>//g;
$weather =~ s/^\s+//; $weather =~ s/^\s+//;
$buf = $buf . "$weather - "; $buf = $buf . "$weather - ";
if ($location =~ m/$weather/i) if ($location =~ m/$weather/i)
{ {
@ -70,8 +70,8 @@ if ($text =~ m/location matches\:/g)
} }
} }
my ($update, $temp, $high, $low, $tempc, $highc, $lowc, $cond, my ($update, $temp, $high, $low, $tempc, $highc, $lowc, $cond,
$today, $tonight, $country, $state, $city, $humid, $wind, $today, $tonight, $country, $state, $city, $humid, $wind,
$sunup, $sundown, $feels, $feelsc); $sunup, $sundown, $feels, $feelsc);
$text =~ m/<a href="\/">Weather<\/a>\s>/g; $text =~ m/<a href="\/">Weather<\/a>\s>/g;
@ -84,7 +84,7 @@ if ($text =~ m/location matches\:/g)
$country = $1; $country = $1;
} }
if ($country ne "Canada") if ($country ne "Canada")
{ {
$text =~ m/<a href=.*?>(.*?)<\/a>\s>/g; $text =~ m/<a href=.*?>(.*?)<\/a>\s>/g;
$state = $1; $state = $1;
@ -97,7 +97,7 @@ if ($text =~ m/location matches\:/g)
if $text =~ m/at:\s(.*?)<\/font><\/td>/gi; if $text =~ m/at:\s(.*?)<\/font><\/td>/gi;
while ($text =~ while ($text =~
m/<td\swidth\=\".*?align\=center\scolspan\=.*?\sface\=.*?\s.*?<b>(.*?)<\/b>/g) m/<td\swidth\=\".*?align\=center\scolspan\=.*?\sface\=.*?\s.*?<b>(.*?)<\/b>/g)
{ {
push(@days, $1); push(@days, $1);
@ -110,7 +110,7 @@ m/<td\swidth\=\".*?align\=center\scolspan\=.*?\sface\=.*?\s.*?<b>(.*?)<\/b>/g)
$date = $i; $date = $i;
last; last;
} }
$i = $i + 1; $i = $i + 1;
} }
if ($i > 4 && $date ne "") if ($i > 4 && $date ne "")
@ -149,14 +149,14 @@ m/<td\swidth\=\".*?align\=center\scolspan\=.*?\sface\=.*?\s.*?<b>(.*?)<\/b>/g)
for($i = 0; $i <= $date; $i++) for($i = 0; $i <= $date; $i++)
{ {
$text =~ $text =~
m/<td\salign=right\scolspan=1.*?face=Arial>High\:.*?size=3\sface=Arial>\n\s\s(.*?)\&/sgi; m/<td\salign=right\scolspan=1.*?face=Arial>High\:.*?size=3\sface=Arial>\n\s\s(.*?)\&/sgi;
$high = $1; $high = $1;
} }
for($i = 0; $i <= $date; $i++) for($i = 0; $i <= $date; $i++)
{ {
$text =~ $text =~
m/<td\salign=right\scolspan=1.*?face=Arial>Low\:.*?size=3\sface=Arial>\n\s(.*?)\&/sgi; m/<td\salign=right\scolspan=1.*?face=Arial>Low\:.*?size=3\sface=Arial>\n\s(.*?)\&/sgi;
$low = $1; $low = $1;
} }

10
modules/wikipedia.pl
View File

@ -21,8 +21,8 @@ my $entry = $wiki->search($term);
if ($entry) { if ($entry) {
my $text = $entry->text(); my $text = $entry->text();
if ($text) { if ($text) {
$text =~ s/{{.*?}}//msg; $text =~ s/{{.*?}}//msg;
$text =~ s/\[\[//g; $text =~ s/\[\[//g;
$text =~ s/\]\]//g; $text =~ s/\]\]//g;
@ -30,13 +30,13 @@ if ($entry) {
$text =~ s/__[A-Z]+__//g; $text =~ s/__[A-Z]+__//g;
$text =~ s/\s+\(\)//msg; $text =~ s/\s+\(\)//msg;
$text = HTML::FormatText->new->format(parse_html($text)); $text = HTML::FormatText->new->format(parse_html($text));
print $text; print $text;
} else { } else {
print "Specific entry not found, see also: "; print "Specific entry not found, see also: ";
my $semi = ""; my $semi = "";
foreach ($entry->related()) { print "$semi$_"; $semi = "; "; } foreach ($entry->related()) { print "$semi$_"; $semi = "; "; }
} }
} else { } else {
print qq("$term" not found in Wikipedia\n) print qq("$term" not found in Wikipedia\n)
} }

6
pbot.pl
View File

@ -1,4 +1,4 @@
#!/usr/bin/env perl #!/usr/bin/env perl
# #
# File: pbot.pl # File: pbot.pl
# Author: pragma_ # Author: pragma_
@ -29,11 +29,11 @@ use PBot::PBot;
# #
# !! NOTICE !! # !! NOTICE !!
# Be sure to set $bothome to the location PBot was extracted (default assumes ~/pbot). # Be sure to set $bothome to the location PBot was extracted (default assumes ~/pbot).
# This location must contain the PBot directory, among others configured below. # This location must contain the PBot directory, among others configured below.
my $bothome = "$ENV{HOME}/pbot"; my $bothome = "$ENV{HOME}/pbot";
my %config = ( my %config = (
# ----------------------------------------------------- # -----------------------------------------------------
# Be sure to set your IRC information to a registered NickServ account # Be sure to set your IRC information to a registered NickServ account
# if you want channel auto-join to work. # if you want channel auto-join to work.