mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-22 03:49:29 +01:00
Fix trailing whitespace throughout
This commit is contained in:
parent
8b5de0beee
commit
5e2cb09744
@ -45,8 +45,8 @@ sub initialize {
|
||||
$self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
|
||||
|
||||
# flags for 'validated' field
|
||||
$self->{NICKSERV_VALIDATED} = (1<<0);
|
||||
$self->{NEEDS_CHECKBAN} = (1<<1);
|
||||
$self->{NICKSERV_VALIDATED} = (1<<0);
|
||||
$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->{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
|
||||
if ($text =~ /^QUIT .*\.net .*\.split/) {
|
||||
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);
|
||||
}
|
||||
}
|
||||
@ -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");
|
||||
}
|
||||
}
|
||||
$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);
|
||||
}
|
||||
}
|
||||
} elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_CHAT}) {
|
||||
if ($channel =~ /^#/) { #channel flood (opposed to private message or otherwise)
|
||||
# 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')) {
|
||||
#$self->{pbot}->{logger}->log("anti-flood: [check-bans] $mask [$alias] evaded $baninfo->{banmask} in $baninfo->{channel}, but allowed through whitelist\n");
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
# special case for twkm clone bans
|
||||
if ($baninfo->{banmask} =~ m/\?\*!\*@\*$/) {
|
||||
|
@ -31,7 +31,7 @@ sub new {
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
|
||||
$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';
|
||||
|
@ -57,7 +57,7 @@ sub remove {
|
||||
$channel = lc $channel;
|
||||
$hostmask = lc $hostmask;
|
||||
|
||||
if (exists $self->{blacklist}->{$channel}) {
|
||||
if (exists $self->{blacklist}->{$channel}) {
|
||||
delete $self->{blacklist}->{$channel}->{$hostmask};
|
||||
|
||||
if (keys %{ $self->{blacklist}->{$channel} } == 0) {
|
||||
@ -85,7 +85,7 @@ sub load_blacklist {
|
||||
}
|
||||
|
||||
$self->{pbot}->{logger}->log("Loading blacklist from $filename ...\n");
|
||||
|
||||
|
||||
open(FILE, "< $filename") or Carp::croak "Couldn't open $filename: $!\n";
|
||||
my @contents = <FILE>;
|
||||
close(FILE);
|
||||
@ -97,11 +97,11 @@ sub load_blacklist {
|
||||
$i++;
|
||||
|
||||
my ($channel, $hostmask) = split(/\s+/, $line);
|
||||
|
||||
|
||||
if (not defined $hostmask || not defined $channel) {
|
||||
Carp::croak "Syntax error around line $i of $filename\n";
|
||||
}
|
||||
|
||||
|
||||
if (exists $self->{blacklist}->{$channel}->{$hostmask}) {
|
||||
Carp::croak "Duplicate blacklist entry [$hostmask][$channel] found in $filename around line $i\n";
|
||||
}
|
||||
|
@ -38,7 +38,7 @@ sub initialize {
|
||||
}
|
||||
|
||||
$self->{pbot} = $pbot;
|
||||
|
||||
|
||||
$pbot->{commands}->register(sub { return $self->login(@_) }, "login", 0);
|
||||
$pbot->{commands}->register(sub { return $self->logout(@_) }, "logout", 0);
|
||||
$pbot->{commands}->register(sub { return $self->in_channel(@_) }, "in", 0);
|
||||
@ -295,7 +295,7 @@ sub export {
|
||||
}
|
||||
|
||||
if ($arguments =~ /^factoids$/i) {
|
||||
return $self->{pbot}->{factoids}->export_factoids;
|
||||
return $self->{pbot}->{factoids}->export_factoids;
|
||||
}
|
||||
|
||||
if ($arguments =~ /^admins$/i) {
|
||||
|
@ -105,7 +105,7 @@ sub load_admins {
|
||||
$self->{pbot}->{logger}->log("Loading admins from $filename ...\n");
|
||||
|
||||
$self->{admins}->load;
|
||||
|
||||
|
||||
my $i = 0;
|
||||
|
||||
foreach my $channel (keys %{ $self->{admins}->hash } ) {
|
||||
@ -130,7 +130,7 @@ sub load_admins {
|
||||
|
||||
sub save_admins {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
$self->{admins}->save;
|
||||
$self->export_admins;
|
||||
}
|
||||
|
@ -1,7 +1,7 @@
|
||||
# File: DualIndexHashObject.pm
|
||||
# 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.
|
||||
|
||||
# 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;
|
||||
|
||||
$primary_index_key = '.*' if not defined $primary_index_key;
|
||||
|
||||
|
||||
if (not $secondary_index_key) {
|
||||
foreach my $index (sort keys %{ $self->hash }) {
|
||||
my $distance_result = fastdistance($primary_index_key, $index);
|
||||
|
@ -66,7 +66,7 @@ sub initialize {
|
||||
$self->{pbot} = $pbot;
|
||||
|
||||
$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(@_) }, "factadd", 0);
|
||||
$pbot->{commands}->register(sub { return $self->factrem(@_) }, "forget", 0);
|
||||
@ -169,7 +169,7 @@ sub log_factoid {
|
||||
|
||||
sub find_factoid_with_optional_channel {
|
||||
my ($self, $from, $arguments, $command, %opts) = @_;
|
||||
|
||||
|
||||
my %default_opts = (
|
||||
usage => undef,
|
||||
explicit => 0,
|
||||
@ -695,7 +695,7 @@ sub list {
|
||||
my $self = shift;
|
||||
my ($from, $nick, $user, $host, $arguments) = @_;
|
||||
my $text;
|
||||
|
||||
|
||||
if (not defined $arguments) {
|
||||
return "Usage: list <modules|factoids|commands|admins>";
|
||||
}
|
||||
@ -829,7 +829,7 @@ sub factmove {
|
||||
|
||||
if ($src_channel eq $target_channel) {
|
||||
$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 {
|
||||
$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");
|
||||
@ -870,7 +870,7 @@ sub factalias {
|
||||
}
|
||||
|
||||
my ($channel, $alias_trigger) = $self->{pbot}->{factoids}->find_factoid($chan, $alias, exact_channel => 1, exact_trigger => 1);
|
||||
|
||||
|
||||
if (defined $alias_trigger) {
|
||||
$self->{pbot}->{logger}->log("attempt to overwrite existing command\n");
|
||||
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}->{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 {
|
||||
@ -1018,7 +1018,7 @@ sub factadd {
|
||||
}
|
||||
|
||||
$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");
|
||||
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) {
|
||||
my $percent = int($hash{$owner} / $factoid_count * 100);
|
||||
$text .= "$owner: $hash{$owner} ($percent". "%)\n";
|
||||
$text .= "$owner: $hash{$owner} ($percent". "%)\n";
|
||||
$i++;
|
||||
last if $i >= 10;
|
||||
}
|
||||
@ -1226,19 +1226,19 @@ sub factinfo {
|
||||
|
||||
# factoid
|
||||
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
|
||||
if ($factoids->{$channel}->{$trigger}->{type} eq 'module') {
|
||||
my $module_repo = $self->{pbot}->{registry}->get_value('general', 'module_repo');
|
||||
$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
|
||||
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";
|
||||
@ -1327,7 +1327,7 @@ sub count {
|
||||
foreach my $channel (keys %{ $factoids }) {
|
||||
foreach my $command (keys %{ $factoids->{$channel} }) {
|
||||
next if $factoids->{$channel}->{$command}->{type} ne 'text';
|
||||
$total++;
|
||||
$total++;
|
||||
if ($factoids->{$channel}->{$command}->{owner} =~ /^\Q$arguments\E$/i) {
|
||||
$i++;
|
||||
}
|
||||
@ -1437,7 +1437,7 @@ sub factfind {
|
||||
next if ($arguments ne "" && $factoids->{$chan}->{$trigger}->{action} !~ /$regex/i && $trigger !~ /$regex/i);
|
||||
|
||||
$i++;
|
||||
|
||||
|
||||
if ($chan ne $last_chan) {
|
||||
$text .= $chan eq '.*' ? "[global channel] " : "[$chan] ";
|
||||
$last_chan = $chan;
|
||||
@ -1500,7 +1500,7 @@ sub factchange {
|
||||
$delim = quotemeta $delim;
|
||||
|
||||
if ($sub =~ /^s$delim(.*?)$delim(.*)$delim(.*)$/) {
|
||||
$tochange = $1;
|
||||
$tochange = $1;
|
||||
$changeto = $2;
|
||||
$modifier = $3;
|
||||
} elsif ($sub =~ /^s$delim(.*?)$delim(.*)$/) {
|
||||
@ -1668,7 +1668,7 @@ sub unload_module {
|
||||
$self->{pbot}->{factoids}->save_factoids();
|
||||
$self->{pbot}->{logger}->log("$nick!$user\@$host unloaded module $arguments\n");
|
||||
return "/say $arguments unloaded.";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
@ -88,14 +88,14 @@ sub execute_module {
|
||||
close $writer;
|
||||
$stuff->{checkflood} = 1;
|
||||
$self->{pbot}->{interpreter}->handle_result($stuff, "/me groans loudly.\n");
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
# FIXME -- add check to ensure $module exists
|
||||
|
||||
if ($pid == 0) { # start child block
|
||||
close $reader;
|
||||
|
||||
|
||||
# don't quit the IRC client when the child dies
|
||||
no warnings;
|
||||
*PBot::IRC::Connection::DESTROY = sub { return; };
|
||||
@ -161,7 +161,7 @@ sub module_pipe_reader {
|
||||
$stuff->{no_nickoverride} = 0;
|
||||
$stuff->{force_nickoverride} = 1;
|
||||
} else {
|
||||
# extract nick-like thing from module result
|
||||
# extract nick-like thing from module result
|
||||
if ($stuff->{result} =~ s/^(\S+): //) {
|
||||
my $nick = $1;
|
||||
if (lc $nick eq "usage") {
|
||||
|
@ -164,7 +164,7 @@ sub export_factoids {
|
||||
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 "<hr><h2>Candide's factoids</h2>\n";
|
||||
|
||||
|
||||
my $i = 0;
|
||||
my $table_id = 1;
|
||||
|
||||
@ -201,7 +201,7 @@ sub export_factoids {
|
||||
} else {
|
||||
print FILE "<tr>\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";
|
||||
|
||||
@ -225,7 +225,7 @@ sub export_factoids {
|
||||
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>" . encode_entities(strftime "%Y/%m/%d %H:%M:%S", localtime $self->{factoids}->hash->{$channel}->{$trigger}->{edited_on}) . "</td>\n";
|
||||
} else {
|
||||
@ -240,7 +240,7 @@ sub export_factoids {
|
||||
} else {
|
||||
print FILE "<td></td>\n";
|
||||
}
|
||||
|
||||
|
||||
print FILE "</tr>\n";
|
||||
}
|
||||
}
|
||||
@ -261,9 +261,9 @@ sub export_factoids {
|
||||
print FILE "});\n";
|
||||
print FILE "</script>\n";
|
||||
print FILE "</body>\n</html>\n";
|
||||
|
||||
|
||||
close(FILE);
|
||||
|
||||
|
||||
#$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;
|
||||
}
|
||||
@ -804,7 +804,7 @@ sub interpreter {
|
||||
if ($found > 1) {
|
||||
return undef if $stuff->{referenced};
|
||||
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
|
||||
elsif ($found == 1) {
|
||||
$pbot->{logger}->log("Found '$original_keyword' as '$fwd_trig' in [$fwd_chan]\n");
|
||||
@ -812,12 +812,12 @@ sub interpreter {
|
||||
$stuff->{interpret_depth}++;
|
||||
$stuff->{ref_from} = $fwd_chan;
|
||||
return $pbot->{factoids}->interpreter($stuff);
|
||||
}
|
||||
}
|
||||
# otherwise keyword hasn't been found, display similiar matches for all channels
|
||||
else {
|
||||
# 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});
|
||||
|
||||
|
||||
my $namespace = $strictnamespace ? $stuff->{from} : '.*';
|
||||
$namespace = '.*' if $namespace !~ /^#/;
|
||||
|
||||
@ -1137,7 +1137,7 @@ sub handle_action {
|
||||
return "";
|
||||
}
|
||||
} 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";
|
||||
}
|
||||
}
|
||||
|
@ -1,7 +1,7 @@
|
||||
# File: HashObject.pm
|
||||
# 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.
|
||||
|
||||
# This Source Code Form is subject to the terms of the Mozilla Public
|
||||
@ -172,12 +172,12 @@ sub levenshtein_matches {
|
||||
my ($self, $keyword) = @_;
|
||||
my $comma = '';
|
||||
my $result = "";
|
||||
|
||||
|
||||
foreach my $index (sort keys %{ $self->hash }) {
|
||||
my $distance = fastdistance($keyword, $index);
|
||||
|
||||
# print "Distance $distance for $keyword (" , (length $keyword) , ") vs $index (" , length $index , ")\n";
|
||||
|
||||
|
||||
my $length = (length($keyword) > length($index)) ? length $keyword : length $index;
|
||||
|
||||
# print "Percentage: ", $distance / $length, "\n";
|
||||
|
38
PBot/IRC.pm
38
PBot/IRC.pm
@ -16,7 +16,7 @@
|
||||
|
||||
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::EventQueue; # pragma_ 2011/01/21
|
||||
@ -37,7 +37,7 @@ $VERSION = "0.79";
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
|
||||
|
||||
my $self = {
|
||||
'_conn' => [],
|
||||
'_connhash' => {},
|
||||
@ -49,9 +49,9 @@ sub new {
|
||||
'_timeout' => 1,
|
||||
'_write' => IO::Select->new(),
|
||||
};
|
||||
|
||||
|
||||
bless $self, $proto;
|
||||
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
@ -70,7 +70,7 @@ sub schedulequeue {
|
||||
# (optional) a flag string to pass to addfh() (see below)
|
||||
sub addconn {
|
||||
my ($self, $conn) = @_;
|
||||
|
||||
|
||||
$self->addfh( $conn->socket, $conn->can('parse'), ($_[2] || 'r'), $conn);
|
||||
}
|
||||
|
||||
@ -84,9 +84,9 @@ sub addconn {
|
||||
sub addfh {
|
||||
my ($self, $fh, $code, $flag, $obj) = @_;
|
||||
my ($letter);
|
||||
|
||||
|
||||
die "Not enough arguments to IRC->addfh()" unless defined $code;
|
||||
|
||||
|
||||
if ($flag) {
|
||||
foreach $letter (split(//, lc $flag)) {
|
||||
if ($letter eq 'r') {
|
||||
@ -100,7 +100,7 @@ sub addfh {
|
||||
} else {
|
||||
$self->{_read}->add( $fh );
|
||||
}
|
||||
|
||||
|
||||
$self->{_connhash}->{$fh} = [ $code, $obj ];
|
||||
}
|
||||
|
||||
@ -108,7 +108,7 @@ sub addfh {
|
||||
# Takes 1 optional arg: a new boolean value for the flag.
|
||||
sub debug {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
if (@_) {
|
||||
$self->{_debug} = $_[0];
|
||||
}
|
||||
@ -156,7 +156,7 @@ sub do_one_loop {
|
||||
|
||||
# Block until input arrives, then hand the filehandle over to the
|
||||
# user-supplied coderef. Look! It's a freezer full of government cheese!
|
||||
|
||||
|
||||
if ($nexttimer) {
|
||||
$timeout = $nexttimer - $time < $self->{_timeout}
|
||||
? $nexttimer - $time : $self->{_timeout};
|
||||
@ -170,11 +170,11 @@ sub do_one_loop {
|
||||
foreach $sock (@{$ev}) {
|
||||
my $conn = $self->{_connhash}->{$sock};
|
||||
$conn or next;
|
||||
|
||||
|
||||
# $conn->[0] is a code reference to a handler sub.
|
||||
# $conn->[1] is optionally an object which the
|
||||
# handler sub may be a method of.
|
||||
|
||||
|
||||
$conn->[0]->($conn->[1] ? ($conn->[1], $sock) : $sock);
|
||||
}
|
||||
}
|
||||
@ -193,7 +193,7 @@ sub flush_output_queue {
|
||||
sub newconn {
|
||||
my $self = shift;
|
||||
my $conn = PBot::IRC::Connection->new($self, @_); # pragma_ 2011/01/21
|
||||
|
||||
|
||||
return if $conn->error;
|
||||
return $conn;
|
||||
}
|
||||
@ -236,14 +236,14 @@ sub dequeue_output_event {
|
||||
# Takes 1 arg: a Connection (or DCC or whatever) to remove.
|
||||
sub removeconn {
|
||||
my ($self, $conn) = @_;
|
||||
|
||||
|
||||
$self->removefh( $conn->socket );
|
||||
}
|
||||
|
||||
# Given a filehandle, removes it from all select lists. You get the picture.
|
||||
sub removefh {
|
||||
my ($self, $fh) = @_;
|
||||
|
||||
|
||||
$self->{_read}->remove( $fh );
|
||||
$self->{_write}->remove( $fh );
|
||||
$self->{_error}->remove( $fh );
|
||||
@ -254,7 +254,7 @@ sub removefh {
|
||||
# first... (takes no args, of course)
|
||||
sub start {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
while (1) {
|
||||
$self->do_one_loop();
|
||||
}
|
||||
@ -265,7 +265,7 @@ sub start {
|
||||
# Fractional timeout values are just fine, as per the core select().
|
||||
sub timeout {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
if (@_) { $self->{_timeout} = $_[0] }
|
||||
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
|
||||
true value. Ie: "C<SSL => 1>".
|
||||
|
||||
|
||||
=back
|
||||
|
||||
=head2 Handlers
|
||||
@ -756,4 +756,4 @@ http://www.irchelp.org/, home of fine IRC resources.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -90,13 +90,13 @@ sub _getline {
|
||||
if (defined $sock->recv($input, 10240)) {
|
||||
$frag .= $input;
|
||||
if (length($frag) > 0) {
|
||||
|
||||
|
||||
warn "Got ". length($frag) ." bytes from $sock\n"
|
||||
if $self->{_debug};
|
||||
|
||||
|
||||
if ($block) { # Block mode (GET)
|
||||
return $input;
|
||||
|
||||
|
||||
} else { # Line mode (CHAT)
|
||||
# We're returning \n's 'cause DCC's need 'em
|
||||
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
|
||||
# besides, recv isn't returning undef on closed
|
||||
# sockets. getting rid of this connection...
|
||||
|
||||
|
||||
warn "recv() received 0 bytes in _getline, closing connection.\n"
|
||||
if $self->{_debug};
|
||||
|
||||
|
||||
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
|
||||
$self->{_nick},
|
||||
$self->{_socket},
|
||||
@ -124,10 +124,10 @@ sub _getline {
|
||||
}
|
||||
} else {
|
||||
# Error, lets scrap this connection
|
||||
|
||||
|
||||
warn "recv() returned undef, socket error in _getline()\n"
|
||||
if $self->{_debug};
|
||||
|
||||
|
||||
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
|
||||
$self->{_nick},
|
||||
$self->{_socket},
|
||||
@ -141,10 +141,10 @@ sub _getline {
|
||||
|
||||
sub DESTROY {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
# Only do the Disconnection Dance of Death if the socket is still
|
||||
# live. Duplicate dcc_close events would be a Bad Thing.
|
||||
|
||||
|
||||
if ($self->{_socket}->opened) {
|
||||
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_close', # pragma_ 2011/21/01
|
||||
$self->{_nick},
|
||||
@ -154,7 +154,7 @@ sub DESTROY {
|
||||
close $self->{_fh} if $self->{_fh};
|
||||
$self->{_parent}->{_parent}->parent->removeconn($self);
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
sub peer {
|
||||
@ -200,7 +200,7 @@ sub new {
|
||||
|
||||
binmode $fh; # I love this next line. :-)
|
||||
ref $fh eq 'GLOB' ? select((select($fh), $|++)[0]) : $fh->autoflush(1);
|
||||
|
||||
|
||||
$sock = new IO::Socket::INET( Proto => "tcp",
|
||||
PeerAddr => "$address:$port" );
|
||||
|
||||
@ -210,13 +210,13 @@ sub new {
|
||||
$sock,
|
||||
'get',
|
||||
'get', $sock));
|
||||
|
||||
|
||||
} else {
|
||||
carp "Can't connect to $address: $!";
|
||||
close $fh;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
$sock->autoflush(1);
|
||||
|
||||
my $self = {
|
||||
@ -231,7 +231,7 @@ sub new {
|
||||
_parent => $container,
|
||||
_size => $size, # Expected size of file
|
||||
_socket => $sock, # Socket we're reading from
|
||||
_time => time,
|
||||
_time => time,
|
||||
_type => 'GET',
|
||||
};
|
||||
|
||||
@ -265,10 +265,10 @@ sub parse {
|
||||
$self->{_socket}->close;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
$self->{_bin} += length($line);
|
||||
|
||||
|
||||
|
||||
|
||||
# confirm the packet we've just recieved
|
||||
unless ( $self->{_socket}->send( pack("N", $self->{_bin}) ) ) {
|
||||
carp "Error writing to DCC GET socket: $!";
|
||||
@ -281,7 +281,7 @@ sub parse {
|
||||
$self->{_socket}->close;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
$self->{_bout} += 4;
|
||||
|
||||
# The file is done.
|
||||
@ -297,7 +297,7 @@ sub parse {
|
||||
$self->{_socket}->close;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_update', # pragma_ 2011/21/01
|
||||
$self->{_nick},
|
||||
$self,
|
||||
@ -374,9 +374,9 @@ sub new {
|
||||
carp "Couldn't open DCC SEND socket: $!";
|
||||
$fh->close;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
$container->ctcp('DCC SEND', $nick, $filename,
|
||||
$container->ctcp('DCC SEND', $nick, $filename,
|
||||
unpack("N",inet_aton($container->hostname())),
|
||||
$sock->sockport(), $size);
|
||||
|
||||
@ -384,7 +384,7 @@ sub new {
|
||||
|
||||
my $self = {
|
||||
_bin => 0, # Bytes we've recieved thus far
|
||||
_blocksize => $blocksize,
|
||||
_blocksize => $blocksize,
|
||||
_bout => 0, # Bytes we've sent
|
||||
_debug => $container->debug,
|
||||
_fh => $fh, # FileHandle we will be reading from.
|
||||
@ -394,12 +394,12 @@ sub new {
|
||||
_parent => $container,
|
||||
_size => $size, # Size of file
|
||||
_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',
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
|
||||
|
||||
$sock = PBot::IRC::DCC::Accept->new($sock, $self); # pragma_ 2011/21/01
|
||||
|
||||
unless (defined $sock) {
|
||||
@ -443,9 +443,9 @@ sub parse {
|
||||
$self->{_socket}->close;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
$size = unpack("N", $size);
|
||||
|
||||
|
||||
if ($size >= $self->{_size}) {
|
||||
|
||||
if ($self->{_debug}) {
|
||||
@ -461,9 +461,9 @@ sub parse {
|
||||
$self->{_type}));
|
||||
$self->{_socket}->close;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# we're still waiting for acknowledgement,
|
||||
# we're still waiting for acknowledgement,
|
||||
# better not send any more
|
||||
return if $size < $self->{_bout};
|
||||
|
||||
@ -504,7 +504,7 @@ sub parse {
|
||||
$self,
|
||||
$self->{_type},
|
||||
$self ));
|
||||
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
@ -536,7 +536,7 @@ sub new {
|
||||
|
||||
$sock = new IO::Socket::INET( Proto => "tcp",
|
||||
Listen => 1);
|
||||
|
||||
|
||||
unless (defined $sock) {
|
||||
carp "Couldn't open DCC CHAT socket: $!";
|
||||
return;
|
||||
@ -559,9 +559,9 @@ sub new {
|
||||
_time => 0, # This gets set by Accept->parse()
|
||||
_type => 'CHAT',
|
||||
};
|
||||
|
||||
|
||||
bless $self, $class;
|
||||
|
||||
|
||||
$sock = PBot::IRC::DCC::Accept->new($sock, $self); # pragma_ 2011/21/01
|
||||
|
||||
unless (defined $sock) {
|
||||
@ -600,9 +600,9 @@ sub new {
|
||||
_time => time,
|
||||
_type => 'CHAT',
|
||||
};
|
||||
|
||||
|
||||
bless $self, $class;
|
||||
|
||||
|
||||
$self->{_parent}->parent->addfh($self->socket,
|
||||
$self->can('parse'), 'r', $self);
|
||||
}
|
||||
@ -624,9 +624,9 @@ sub parse {
|
||||
|
||||
foreach my $line ($self->_getline($sock)) {
|
||||
return unless defined $line;
|
||||
|
||||
|
||||
$self->{_bin} += length($line);
|
||||
|
||||
|
||||
return undef if $line eq "\012";
|
||||
$self->{_bout} += length($line);
|
||||
|
||||
@ -635,7 +635,7 @@ sub parse {
|
||||
$self->{_socket},
|
||||
'chat',
|
||||
$line));
|
||||
|
||||
|
||||
$self->{_parent}->handler(PBot::IRC::Event->new('dcc_update', # pragma_ 2011/21/01
|
||||
$self->{_nick},
|
||||
$self,
|
||||
@ -653,7 +653,7 @@ sub privmsg {
|
||||
unless (@_) {
|
||||
croak 'Not enough arguments to privmsg()';
|
||||
}
|
||||
|
||||
|
||||
# Don't send a CR over DCC CHAT -- it's not wanted.
|
||||
$self->socket->send(join('', @_) . "\012");
|
||||
}
|
||||
@ -688,7 +688,7 @@ sub new {
|
||||
_parent => $parent,
|
||||
_type => 'accept',
|
||||
};
|
||||
|
||||
|
||||
bless $self, $class;
|
||||
|
||||
# Tkil's gonna love this one. :-) But what the hell... it's safe to
|
||||
@ -726,7 +726,7 @@ sub parse {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
$self->{_parent}->{_parent}->parent->addconn($self->{_parent});
|
||||
$self->{_parent}->{_parent}->parent->removeconn($self);
|
||||
|
||||
|
@ -40,7 +40,7 @@ sub new {
|
||||
my $to = shift;
|
||||
my $format = shift;
|
||||
my $args = \@_;
|
||||
|
||||
|
||||
my $self = {
|
||||
'type' => $type,
|
||||
'from' => undef,
|
||||
@ -48,18 +48,18 @@ sub new {
|
||||
'format' => $format,
|
||||
'args' => [],
|
||||
};
|
||||
|
||||
|
||||
bless $self, $class;
|
||||
|
||||
|
||||
if ($self->type !~ /\D/) {
|
||||
$self->type($self->trans($self->type));
|
||||
} else {
|
||||
$self->type(lc($self->type));
|
||||
}
|
||||
|
||||
|
||||
$self->from($from); # sets nick, user, and host
|
||||
$self->args($args); # strips colons from args
|
||||
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
@ -69,7 +69,7 @@ sub args {
|
||||
my $self = shift;
|
||||
my $args = shift;
|
||||
|
||||
if ($args) {
|
||||
if ($args) {
|
||||
my (@q, $i, $ct) = @{$args}; # This line is solemnly dedicated to \mjd.
|
||||
|
||||
$self->{'args'} = [ ];
|
||||
@ -123,7 +123,7 @@ sub from {
|
||||
{ local $^W;
|
||||
@part = split /[\@!]/, $_[0], 3;
|
||||
}
|
||||
|
||||
|
||||
$self->nick(defined $part[0] ? $part[0] : '');
|
||||
$self->user(defined $part[1] ? $part[1] : '');
|
||||
$self->host(defined $part[2] ? $part[2] : '');
|
||||
@ -132,7 +132,7 @@ sub from {
|
||||
$self->userhost($self->host);
|
||||
$self->{'from'} = $_[0];
|
||||
}
|
||||
|
||||
|
||||
return $self->{'from'};
|
||||
}
|
||||
|
||||
@ -158,7 +158,7 @@ sub nick {
|
||||
# Takes any number of args: this event's list of recipients.
|
||||
sub to {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
$self->{'to'} = [ @_ ] if @_;
|
||||
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.
|
||||
sub type {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
$self->{'type'} = $_[0] if @_;
|
||||
return $self->{'type'};
|
||||
}
|
||||
@ -184,7 +184,7 @@ sub user {
|
||||
# Just $self->user plus '@' plus $self->host, for convenience.
|
||||
sub userhost {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
$self->{'userhost'} = $_[0] if @_;
|
||||
return $self->{'userhost'};
|
||||
}
|
||||
@ -194,7 +194,7 @@ sub userhost {
|
||||
sub trans {
|
||||
shift if (ref($_[0]) || $_[0]) =~ /^PBot::IRC/; # pragma_ 2011/21/01
|
||||
my $ev = shift;
|
||||
|
||||
|
||||
return (exists $_names{$ev} ? $_names{$ev} : undef);
|
||||
}
|
||||
|
||||
@ -207,10 +207,10 @@ sub trans {
|
||||
'004' => "myinfo",
|
||||
'005' => "map", # 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
|
||||
'008' => "snomask", # 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
|
||||
'007' => "mapend", # 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
|
||||
'010' => "statmem", # Undernet Extension, Kajetan@Hinner.com, 17/11/98
|
||||
|
||||
200 => "tracelink",
|
||||
201 => "traceconnecting",
|
||||
|
@ -6,7 +6,7 @@ use strict;
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
|
||||
|
||||
my $self = {
|
||||
'queue' => {},
|
||||
};
|
||||
@ -56,7 +56,7 @@ sub head {
|
||||
my $self = shift;
|
||||
|
||||
return undef if $self->is_empty;
|
||||
|
||||
|
||||
no warnings; # because we want to numerically sort strings...
|
||||
my $headkey = (sort {$a <=> $b} (keys(%{$self->queue})))[0];
|
||||
use warnings;
|
||||
|
@ -1,40 +1,40 @@
|
||||
package PBot::IRC::EventQueue::Entry; # pragma_ 2011/21/01
|
||||
|
||||
|
||||
use strict;
|
||||
|
||||
|
||||
my $id = 0;
|
||||
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $time = shift;
|
||||
my $content = shift;
|
||||
|
||||
|
||||
my $self = {
|
||||
'time' => $time,
|
||||
'content' => $content,
|
||||
'id' => "$time:" . $id++,
|
||||
};
|
||||
|
||||
|
||||
bless $self, $class;
|
||||
return $self;
|
||||
}
|
||||
|
||||
|
||||
sub id {
|
||||
my $self = shift;
|
||||
return $self->{'id'};
|
||||
}
|
||||
|
||||
|
||||
sub time {
|
||||
my $self = shift;
|
||||
$self->{'time'} = $_[0] if @_;
|
||||
return $self->{'time'};
|
||||
}
|
||||
|
||||
|
||||
sub content {
|
||||
my $self = shift;
|
||||
$self->{'content'} = $_[0] if @_;
|
||||
return $self->{'content'};
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
@ -31,7 +31,7 @@ sub new {
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
|
||||
$self->{pbot} = delete $conf{pbot};
|
||||
Carp::croak("Missing pbot parameter to " . __FILE__) if not defined $self->{pbot};
|
||||
|
||||
@ -115,7 +115,7 @@ sub on_motd {
|
||||
|
||||
sub on_self_join {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
$self->send_who($event->{channel});
|
||||
#$self->send_who($event->{channel});
|
||||
return 0;
|
||||
}
|
||||
|
||||
@ -126,7 +126,7 @@ sub on_self_part {
|
||||
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
|
||||
my $from = $event->{event}->{to}[0];
|
||||
my $nick = $event->{event}->nick;
|
||||
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");
|
||||
|
||||
return 0 if not length $host;
|
||||
|
||||
|
||||
if ($nick eq 'NickServ') {
|
||||
if ($text =~ m/This nickname is registered/) {
|
||||
$self->{pbot}->{logger}->log("Identifying with NickServ . . .\n");
|
||||
@ -185,7 +185,7 @@ sub on_action {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
|
||||
$event->{event}->{args}[0] = "/me " . $event->{event}->{args}[0];
|
||||
|
||||
|
||||
$self->on_public($event_type, $event);
|
||||
return 0;
|
||||
}
|
||||
@ -249,7 +249,7 @@ sub on_mode {
|
||||
$self->{pbot}->{chanops}->{is_opped}->{$channel}{timeout} = gettimeofday + $timeout;
|
||||
delete $self->{pbot}->{chanops}->{op_requested}->{$channel};
|
||||
$self->{pbot}->{chanops}->perform_op_commands($channel);
|
||||
}
|
||||
}
|
||||
elsif ($mode eq "-o") {
|
||||
$self->{pbot}->{logger}->log("$nick removed my ops in $channel\n");
|
||||
delete $self->{pbot}->{chanops}->{is_opped}->{$channel};
|
||||
@ -257,8 +257,8 @@ sub on_mode {
|
||||
elsif ($mode eq "+b") {
|
||||
$self->{pbot}->{logger}->log("Got banned in $channel, attempting unban.");
|
||||
$event->{conn}->privmsg("chanserv", "unban $channel");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else { # bot not targeted
|
||||
if ($mode eq "+b") {
|
||||
if ($nick eq "ChanServ" or $target =~ m/##fix_your_connection$/i) {
|
||||
@ -281,7 +281,7 @@ sub on_mode {
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ($mode eq "+q") {
|
||||
if ($nick ne $event->{conn}->nick) { # bot muted
|
||||
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_flood($channel, $nick, $user, $host, $msg,
|
||||
$self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'),
|
||||
$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_time_threshold'),
|
||||
$self->{pbot}->{messagehistory}->{MSG_JOIN});
|
||||
return 0;
|
||||
@ -370,14 +370,14 @@ sub on_kick {
|
||||
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}->{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_time_threshold'),
|
||||
$self->{pbot}->{messagehistory}->{MSG_DEPARTURE});
|
||||
}
|
||||
|
||||
$message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account_id("$nick!$user\@$host");
|
||||
|
||||
|
||||
if (defined $message_account) {
|
||||
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});
|
||||
@ -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}->{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_time_threshold'),
|
||||
$self->{pbot}->{messagehistory}->{MSG_DEPARTURE});
|
||||
|
@ -87,7 +87,7 @@ sub load_ignores {
|
||||
}
|
||||
|
||||
$self->{pbot}->{logger}->log("Loading ignorelist from $filename ...\n");
|
||||
|
||||
|
||||
open(FILE, "< $filename") or Carp::croak "Couldn't open $filename: $!\n";
|
||||
my @contents = <FILE>;
|
||||
close(FILE);
|
||||
@ -99,11 +99,11 @@ sub load_ignores {
|
||||
$i++;
|
||||
|
||||
my ($hostmask, $channel, $length) = split(/\s+/, $line);
|
||||
|
||||
|
||||
if (not defined $hostmask || not defined $channel || not defined $length) {
|
||||
Carp::croak "Syntax error around line $i of $filename\n";
|
||||
}
|
||||
|
||||
|
||||
if (exists ${ $self->{ignore_list} }{$hostmask}{$channel}) {
|
||||
Carp::croak "Duplicate ignore [$hostmask][$channel] found in $filename around line $i\n";
|
||||
}
|
||||
@ -144,7 +144,7 @@ sub check_ignore {
|
||||
my $pbot = $self->{pbot};
|
||||
$channel = lc $channel;
|
||||
|
||||
my $hostmask = "$nick!$user\@$host";
|
||||
my $hostmask = "$nick!$user\@$host";
|
||||
|
||||
my $now = gettimeofday;
|
||||
|
||||
@ -168,9 +168,9 @@ sub check_ignore {
|
||||
$self->{ignore_flood_counter}->{$channel} = 0;
|
||||
if ($channel =~ /^#/) {
|
||||
$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;
|
||||
}
|
||||
}
|
||||
}
|
||||
=cut
|
||||
}
|
||||
|
@ -70,7 +70,7 @@ sub ignore_user {
|
||||
if (not defined $channel) {
|
||||
$channel = ".*"; # all channels
|
||||
}
|
||||
|
||||
|
||||
if (not defined $length) {
|
||||
$length = -1; # permanently
|
||||
} else {
|
||||
@ -103,12 +103,12 @@ sub unignore_user {
|
||||
if (not defined $channel) {
|
||||
$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");
|
||||
return "/msg $nick [$target][$channel] not found in ignore list (use `ignore list` to list ignores)";
|
||||
}
|
||||
|
||||
|
||||
$self->{pbot}->{ignorelist}->remove($target, $channel);
|
||||
$self->{pbot}->{logger}->log("$nick removed [$target][$channel] from ignore list\n");
|
||||
return "/msg $nick [$target][$channel] unignored";
|
||||
|
@ -1,7 +1,7 @@
|
||||
# File: Interpreter.pm
|
||||
# Author: pragma_
|
||||
#
|
||||
# Purpose:
|
||||
# Purpose:
|
||||
|
||||
# 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
|
||||
|
@ -44,7 +44,7 @@ sub initialize {
|
||||
$self->{ping_send_time} = undef; # when last ping was sent
|
||||
|
||||
# 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
|
||||
$pbot->{registry}->add_default('text', 'lagchecker', 'lag_threshold', $conf{lag_threadhold} // 2);
|
||||
# how often to send PING, in seconds
|
||||
|
@ -40,7 +40,7 @@ sub log {
|
||||
|
||||
if (defined $self->{log_file}) {
|
||||
print PLOG_FILE "$time :: $text";
|
||||
}
|
||||
}
|
||||
|
||||
print "$time :: $text";
|
||||
}
|
||||
|
@ -2,7 +2,7 @@
|
||||
# Author: pragma_
|
||||
#
|
||||
# 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
|
||||
# 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>] [+ ...]';
|
||||
|
||||
if (not defined $arguments or not length $arguments) {
|
||||
return $usage;
|
||||
return $usage;
|
||||
}
|
||||
|
||||
$arguments = lc $arguments;
|
||||
|
@ -64,7 +64,7 @@ sub sqlite_commit_interval_trigger {
|
||||
sub sqlite_debug_trigger {
|
||||
my ($self, $section, $item, $newvalue) = @_;
|
||||
$self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue")) if defined $self->{dbh};
|
||||
|
||||
|
||||
}
|
||||
|
||||
sub begin {
|
||||
@ -72,7 +72,7 @@ sub begin {
|
||||
|
||||
$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}->prepare("SELECT load_extension('/usr/lib/sqlite3/pcre.so')");
|
||||
@ -106,7 +106,7 @@ SQL
|
||||
|
||||
$self->{dbh}->do(<<SQL);
|
||||
CREATE TABLE IF NOT EXISTS Nickserv (
|
||||
id INTEGER,
|
||||
id INTEGER,
|
||||
nickserv TEXT COLLATE NOCASE,
|
||||
timestamp NUMERIC,
|
||||
UNIQUE (id, nickserv)
|
||||
@ -248,7 +248,7 @@ sub create_nickserv {
|
||||
|
||||
sub update_nickserv_account {
|
||||
my ($self, $id, $nickserv, $timestamp) = @_;
|
||||
|
||||
|
||||
#$self->{pbot}->{logger}->log("Updating nickserv account for id $id to $nickserv with timestamp [$timestamp]\n");
|
||||
|
||||
$self->create_nickserv($id, $nickserv);
|
||||
@ -330,7 +330,7 @@ sub find_message_account_by_nick {
|
||||
my $row = $sth->fetchrow_hashref();
|
||||
return ($row->{id}, $row->{hostmask});
|
||||
};
|
||||
|
||||
|
||||
$self->{pbot}->{logger}->log($@) if $@;
|
||||
return ($id, $hostmask);
|
||||
}
|
||||
@ -551,7 +551,7 @@ sub get_message_account {
|
||||
return ($rows, $self->{alias_type}->{STRONG});
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# cloaked hostmask
|
||||
if ($host =~ m{/}) {
|
||||
$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) {
|
||||
$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});
|
||||
}
|
||||
}
|
||||
@ -703,7 +703,7 @@ sub get_message_account {
|
||||
my @nickserv_accounts = $self->get_nickserv_accounts($rows->[0]->{id});
|
||||
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}->{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};
|
||||
}
|
||||
@ -786,7 +786,7 @@ sub get_hostmasks_for_channel {
|
||||
$sth->execute($channel);
|
||||
return $sth->fetchall_arrayref({});
|
||||
};
|
||||
|
||||
|
||||
$self->{pbot}->{logger}->log($@) if $@;
|
||||
return $hostmasks;
|
||||
}
|
||||
@ -1055,7 +1055,7 @@ sub recall_message_by_count {
|
||||
|
||||
sub recall_message_by_text {
|
||||
my ($self, $id, $channel, $text, $ignore_command) = @_;
|
||||
|
||||
|
||||
my $regex = '(?i)';
|
||||
$regex .= ($text =~ m/^\w/) ? '\b' : '\B';
|
||||
$regex .= quotemeta $text;
|
||||
|
@ -2,7 +2,7 @@
|
||||
# Author: pragma_
|
||||
#
|
||||
# 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.
|
||||
|
||||
# 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.public', sub { $self->on_activity(@_) });
|
||||
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_activity(@_) });
|
||||
|
||||
|
||||
# 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.part', sub { $self->on_part_channel(@_) });
|
||||
@ -113,7 +113,7 @@ sub get_channels {
|
||||
push @channels, $channel;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
return \@channels;
|
||||
}
|
||||
|
||||
@ -236,7 +236,7 @@ sub random_nick {
|
||||
if (exists $self->{nicklist}->{$channel}) {
|
||||
my $now = gettimeofday;
|
||||
my @nicks = grep { $now - $self->{nicklist}->{$channel}->{$_}->{timestamp} < 3600 * 2 } keys %{ $self->{nicklist}->{$channel} };
|
||||
|
||||
|
||||
my $nick = $nicks[rand @nicks];
|
||||
return $self->{nicklist}->{$channel}->{$nick}->{nick};
|
||||
} else {
|
||||
|
16
PBot/PBot.pm
16
PBot/PBot.pm
@ -36,7 +36,7 @@ use PBot::AntiSpam;
|
||||
use PBot::Interpreter;
|
||||
use PBot::Commands;
|
||||
use PBot::ChanOps;
|
||||
use PBot::Factoids;
|
||||
use PBot::Factoids;
|
||||
use PBot::BotAdmins;
|
||||
use PBot::IgnoreList;
|
||||
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', 'identify_password', $conf{identify_password} // 'none');
|
||||
$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_path', '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', 'debug', sub { $self->irc_debug_trigger(@_) });
|
||||
|
||||
|
||||
$self->{event_dispatcher} = PBot::EventDispatcher->new(pbot => $self, %conf);
|
||||
$self->{irchandlers} = PBot::IRCHandlers->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");
|
||||
|
||||
while (not $self->{conn} = $self->{irc}->newconn(
|
||||
while (not $self->{conn} = $self->{irc}->newconn(
|
||||
Nick => random_nick,
|
||||
Username => $self->{registry}->get_value('irc', 'username'),
|
||||
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(@_) });
|
||||
|
||||
# ignore these events
|
||||
$self->{conn}->add_handler(['whoisserver',
|
||||
'whoiscountry',
|
||||
$self->{conn}->add_handler(['whoisserver',
|
||||
'whoiscountry',
|
||||
'whoischannels',
|
||||
'whoisidle',
|
||||
'motdstart',
|
||||
@ -216,9 +216,9 @@ sub do_one_loop {
|
||||
|
||||
sub start {
|
||||
my $self = shift;
|
||||
while (1) {
|
||||
while (1) {
|
||||
$self->connect() if not $self->{connected};
|
||||
$self->do_one_loop() if $self->{connected};
|
||||
$self->do_one_loop() if $self->{connected};
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -70,7 +70,7 @@ sub load {
|
||||
|
||||
$self->{pbot}->{refresher}->{refresher}->refresh_module("PBot/Plugins/$plugin.pm");
|
||||
|
||||
my $ret = eval {
|
||||
my $ret = eval {
|
||||
eval "require $class";
|
||||
|
||||
if ($@) {
|
||||
|
@ -358,12 +358,12 @@ sub check_trigger {
|
||||
my $action = $trigger->{action};
|
||||
my @stuff = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
|
||||
my $i;
|
||||
map { ++$i; $action =~ s/\$$i/$_/g; } @stuff;
|
||||
|
||||
map { ++$i; $action =~ s/\$$i/$_/g; } @stuff;
|
||||
|
||||
my $delay = 0;
|
||||
|
||||
my ($n, $u, $h) = $trigger->{owner} =~ /^([^!]+)!([^@]+)\@(.*)$/;
|
||||
my $command = {
|
||||
my $command = {
|
||||
nick => $n,
|
||||
user => $u,
|
||||
host => $h,
|
||||
|
@ -63,7 +63,7 @@ sub on_public {
|
||||
|
||||
my $antirepeat = $self->{pbot}->{registry}->get_value($channel, 'antirepeat');
|
||||
return 0 if defined $antirepeat and not $antirepeat;
|
||||
|
||||
|
||||
return 0 if $channel !~ m/^#/;
|
||||
return 0 if $event->{interpreted};
|
||||
return 0 if $self->{pbot}->{antiflood}->whitelisted($channel, "$nick!$user\@$host", 'antiflood');
|
||||
|
@ -49,7 +49,7 @@ sub on_public {
|
||||
if ($self->{pbot}->{nicklist}->is_present_similar($channel, $n, 0.05)) {
|
||||
$self->{offenses}->{$channel}->{$nick}->{offenses}++;
|
||||
$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");
|
||||
|
||||
given ($self->{offenses}->{$channel}->{$nick}->{offenses}) {
|
||||
|
@ -366,7 +366,7 @@ sub battleship_cmd {
|
||||
if (not $self->{pbot}->{admins}->loggedin($self->{channel}, "$nick!$user\@$host")) {
|
||||
return "$nick: Sorry, only admins may see the full board.";
|
||||
}
|
||||
|
||||
|
||||
if ($self->{current_state} eq 'nogame' or $self->{current_state} eq 'accept'
|
||||
or $self->{current_state} eq 'genboard' or $self->{current_state} eq 'gameover') {
|
||||
return "$nick: There is no board to show right now.";
|
||||
@ -383,7 +383,7 @@ sub battleship_cmd {
|
||||
}
|
||||
$self->show_battlefield(4, $nick);
|
||||
}
|
||||
|
||||
|
||||
default {
|
||||
return $usage;
|
||||
}
|
||||
@ -675,7 +675,7 @@ sub generate_ship {
|
||||
}
|
||||
|
||||
$self->{ship_length}->[$ship] = $l;
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if (++$fail >= 5000) {
|
||||
@ -899,7 +899,7 @@ sub show_battlefield {
|
||||
$self->{pbot}->{logger}->log("showing battlefield for player $player\n");
|
||||
|
||||
$buf = "$color{cyan} ";
|
||||
|
||||
|
||||
for($x = 1; $x < $self->{N_X} + 1; $x++) {
|
||||
if ($x % 10 == 0) {
|
||||
$buf .= $color{yellow} if $self->{N_X} > 10;
|
||||
@ -952,7 +952,7 @@ sub show_battlefield {
|
||||
$buf .= "$self->{board}->[$y][$x] ";
|
||||
}
|
||||
} 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 '=') {
|
||||
$buf .= "$color{blue}~ ";
|
||||
next;
|
||||
@ -989,7 +989,7 @@ sub show_battlefield {
|
||||
|
||||
# bottom border
|
||||
$buf .= "$color{cyan} ";
|
||||
|
||||
|
||||
for($x = 1; $x < $self->{N_X} + 1; $x++) {
|
||||
if ($x % 10 == 0) {
|
||||
$buf .= $color{yellow} if $self->{N_X} > 10;
|
||||
|
@ -44,7 +44,7 @@ sub initialize {
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
$self->{pbot}->{commands}->unregister('counteradd');
|
||||
$self->{pbot}->{commands}->unregister('counterdel');
|
||||
$self->{pbot}->{commands}->unregister('counterreset');
|
||||
@ -297,7 +297,7 @@ sub get_trigger {
|
||||
|
||||
sub counteradd {
|
||||
my ($self, $from, $nick, $user, $host, $arguments) = @_;
|
||||
|
||||
|
||||
if (not $self->dbi_begin) {
|
||||
return "Internal error.";
|
||||
}
|
||||
|
@ -57,7 +57,7 @@ sub initialize {
|
||||
|
||||
sub uniq { my %seen; grep !$seen{$_}++, @_ }
|
||||
|
||||
sub export_quotegrabs {
|
||||
sub export_quotegrabs {
|
||||
my $self = shift;
|
||||
return "Quotegrabs exporting not enabled." if not defined $self->{export_path};
|
||||
|
||||
@ -125,9 +125,9 @@ sub export_quotegrabs {
|
||||
$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 "<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";
|
||||
@ -237,7 +237,7 @@ sub grab_quotegrab {
|
||||
$quotegrab->{grabbed_by} = "$nick!$user\@$host";
|
||||
$quotegrab->{text} = validate_string($grab_text);
|
||||
$quotegrab->{id} = undef;
|
||||
|
||||
|
||||
$quotegrab->{id} = $self->{database}->add_quotegrab($quotegrab);
|
||||
|
||||
if (not defined $quotegrab->{id}) {
|
||||
@ -245,7 +245,7 @@ sub grab_quotegrab {
|
||||
}
|
||||
|
||||
$self->export_quotegrabs();
|
||||
|
||||
|
||||
my $text = $quotegrab->{text};
|
||||
($grab_nick) = split /\+/, $grab_nicks, 2;
|
||||
|
||||
@ -330,8 +330,8 @@ sub show_random_quotegrab {
|
||||
};
|
||||
|
||||
$arguments =~ s/(?<!\\)'/\\'/g;
|
||||
my ($ret, $args) = GetOptionsFromString($arguments,
|
||||
'channel|c=s' => \$channel_search,
|
||||
my ($ret, $args) = GetOptionsFromString($arguments,
|
||||
'channel|c=s' => \$channel_search,
|
||||
'text|t=s' => \$text_search);
|
||||
|
||||
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 !~ /^#/;
|
||||
|
||||
my $quotegrab = $self->{database}->get_random_quotegrab($nick_search, $channel_search, $text_search);
|
||||
|
||||
|
||||
if (not defined $quotegrab) {
|
||||
my $result = "No quotes grabbed ";
|
||||
|
||||
@ -365,7 +365,7 @@ sub show_random_quotegrab {
|
||||
if (defined $channel_search) {
|
||||
$result .= "in channel $channel_search ";
|
||||
}
|
||||
|
||||
|
||||
if (defined $text_search) {
|
||||
$result .= "matching text '$text_search' ";
|
||||
}
|
||||
|
@ -55,7 +55,7 @@ sub load_quotegrabs {
|
||||
return if not defined $filename;
|
||||
|
||||
$self->{pbot}->{logger}->log("Loading quotegrabs from $filename ...\n");
|
||||
|
||||
|
||||
open(FILE, "< $filename") or die "Couldn't open $filename: $!\n";
|
||||
my @contents = <FILE>;
|
||||
close(FILE);
|
||||
@ -143,7 +143,7 @@ sub get_random_quotegrab {
|
||||
$text = '.*' if not defined $text;
|
||||
|
||||
my @quotes;
|
||||
|
||||
|
||||
eval {
|
||||
for(my $i = 0; $i <= $#{ $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");
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
if ($#quotes < 0) {
|
||||
return undef;
|
||||
}
|
||||
|
@ -124,7 +124,7 @@ sub get_random_quotegrab {
|
||||
push @params, "$nick";
|
||||
$where = '';
|
||||
$and = 'AND ';
|
||||
}
|
||||
}
|
||||
|
||||
if (defined $channel) {
|
||||
$sql .= $where . $and . 'channel LIKE ? ';
|
||||
|
@ -43,7 +43,7 @@ sub initialize {
|
||||
|
||||
sub unload {
|
||||
my $self = shift;
|
||||
|
||||
|
||||
$self->dbi_end;
|
||||
|
||||
$self->{pbot}->{commands}->unregister('remindme');
|
||||
@ -191,7 +191,7 @@ sub delete_reminder {
|
||||
|
||||
sub remindme {
|
||||
my ($self, $from, $nick, $user, $host, $arguments) = @_;
|
||||
|
||||
|
||||
if (not $self->{dbh}) {
|
||||
return "Internal error.";
|
||||
}
|
||||
|
@ -1930,7 +1930,7 @@ sub getlies {
|
||||
if ($needed <= 0) {
|
||||
$state->{reroll_question} = 1;
|
||||
$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) {
|
||||
$mentions = "$player->{name}: " . $self->commify($player->{score}) . "$comma$mentions";
|
||||
$mentions = "$player->{name}: " . $self->commify($player->{score}) . "$comma$mentions";
|
||||
$comma = "; ";
|
||||
if ($i == 4) {
|
||||
$mentions = "Honorable mentions: $mentions";
|
||||
|
@ -73,10 +73,10 @@ sub print_bad_lies {
|
||||
sub sort_mentions {
|
||||
my ($self) = @_;
|
||||
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};
|
||||
} 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};
|
||||
}
|
||||
}
|
||||
@ -84,7 +84,7 @@ sub sort_mentions {
|
||||
sub print_mentions {
|
||||
my ($self, $player) = @_;
|
||||
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";
|
||||
}
|
||||
|
||||
@ -181,11 +181,11 @@ sub rank {
|
||||
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' },
|
||||
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' },
|
||||
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' },
|
||||
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' },
|
||||
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' },
|
||||
|
@ -36,7 +36,7 @@ sub unload {
|
||||
sub on_public {
|
||||
my ($self, $event_type, $event) = @_;
|
||||
my ($nick, $user, $host, $msg) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->args);
|
||||
|
||||
|
||||
if ($event->{interpreted}) {
|
||||
$self->{pbot}->{logger}->log("Message was already handled by the interpreter.\n");
|
||||
return 0;
|
||||
|
@ -96,7 +96,7 @@ sub remove {
|
||||
$section = lc $section;
|
||||
|
||||
delete $self->{registry}->hash->{$section}->{$item};
|
||||
|
||||
|
||||
if (not scalar keys %{ $self->{registry}->hash->{$section} }) {
|
||||
delete $self->{registry}->hash->{$section};
|
||||
}
|
||||
|
@ -30,7 +30,7 @@ sub initialize {
|
||||
|
||||
my $pbot = delete $conf{pbot} // Carp::croak("Missing pbot reference to FactoidCommands");
|
||||
$self->{pbot} = $pbot;
|
||||
|
||||
|
||||
$pbot->{commands}->register(sub { return $self->regadd(@_) }, "regadd", 60);
|
||||
$pbot->{commands}->register(sub { return $self->regrem(@_) }, "regrem", 60);
|
||||
$pbot->{commands}->register(sub { return $self->regshow(@_) }, "regshow", 0);
|
||||
@ -220,12 +220,12 @@ sub regchange {
|
||||
if (defined $arguments) {
|
||||
if ($arguments =~ /^([^\s]+) ([^\s]+)\s+s(.)/) {
|
||||
$section = $1;
|
||||
$item = $2;
|
||||
$item = $2;
|
||||
$delim = $3;
|
||||
}
|
||||
|
||||
|
||||
if ($arguments =~ /$delim(.*?)$delim(.*)$delim(.*)?$/) {
|
||||
$tochange = $1;
|
||||
$tochange = $1;
|
||||
$changeto = $2;
|
||||
$modifier = $3;
|
||||
}
|
||||
|
@ -21,17 +21,17 @@ our $max_seconds = 1000000;
|
||||
our $seconds = 0;
|
||||
our @timer_funcs;
|
||||
|
||||
$SIG{ALRM} = sub {
|
||||
$seconds += $min_timeout;
|
||||
alarm $min_timeout;
|
||||
$SIG{ALRM} = sub {
|
||||
$seconds += $min_timeout;
|
||||
alarm $min_timeout;
|
||||
|
||||
# print "ALARM! $seconds $min_timeout\n";
|
||||
|
||||
# print "ALARM! $seconds $min_timeout\n";
|
||||
|
||||
# call timer func subroutines
|
||||
foreach my $func (@timer_funcs) { &$func; }
|
||||
|
||||
|
||||
# prevent $seconds over-flow
|
||||
$seconds -= $max_seconds if $seconds > $max_seconds;
|
||||
$seconds -= $max_seconds if $seconds > $max_seconds;
|
||||
};
|
||||
|
||||
sub new {
|
||||
|
@ -15,7 +15,7 @@ sub validate_string {
|
||||
return $string if not defined $string or not length $string;
|
||||
$max_length = 1024 * 8 if not defined $max_length;
|
||||
|
||||
eval {
|
||||
eval {
|
||||
my $h = decode_json($string);
|
||||
foreach my $k (keys %$h) {
|
||||
$h->{$k} = substr $h->{$k}, 0, $max_length unless $max_length <= 0;
|
||||
|
@ -205,8 +205,8 @@ my @rename_rules = (
|
||||
{ old => qr/^BABY NAMES BEG/, new => "BABY NAMES" },
|
||||
{ old => qr/^CURRENCY & FLAGS$/, new => "CURRENCIES & FLAGS" },
|
||||
{ old => qr/^CURRENCIES$/, new => "CURRENCIES & FLAGS" },
|
||||
{ old => qr/^FUN$/, new => "FUN & GAMES" },
|
||||
{ old => qr/^GAMES$/, new => "FUN & GAMES" },
|
||||
{ old => qr/^FUN$/, new => "FUN & GAMES" },
|
||||
{ old => qr/^GAMES$/, new => "FUN & GAMES" },
|
||||
{ old => qr/^HOBBIES & LEISURE$/, new => "FUN & GAMES" },
|
||||
{ old => qr/^MISC GAMES$/, new => "FUN & GAMES" },
|
||||
{ old => qr/^SIMPSONS$/, new => "THE SIMPSONS" },
|
||||
@ -235,8 +235,8 @@ my @rename_rules = (
|
||||
{ old => qr/^EPL$/, new => "SOCCER" },
|
||||
{ old => qr/^NZ$/, new => "NEW ZEALAND" },
|
||||
{ old => qr/^NZ /, new => "NEW ZEALAND" },
|
||||
{ old => qr/[NB]URSERY RHYME/, new => "FAIRYTALES & NURSERY RHYMES" },
|
||||
{ old => qr/NURESRY RHYME/, new => "FAIRYTALES & NURSERY RHYMES" },
|
||||
{ old => qr/[NB]URSERY RHYME/, new => "FAIRYTALES & NURSERY RHYMES" },
|
||||
{ old => qr/NURESRY RHYME/, new => "FAIRYTALES & NURSERY RHYMES" },
|
||||
{ old => qr/^GEOGRAPH/, new => "GEOGRAPHY" },
|
||||
{ old => qr/TREKKIE/, new => "STAR TREK" },
|
||||
{ old => qr/^STAR TREK/, new => "STAR TREK" },
|
||||
@ -313,8 +313,8 @@ my %refilter_rules = (
|
||||
],
|
||||
"MUSIC" => [
|
||||
{ regex => qr/theme song/i, category => "THEME SONGS" },
|
||||
{ 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/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/50's chart toppers/i, category => "1950'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" },
|
||||
@ -694,7 +694,7 @@ for my $i (0 .. $#lines) {
|
||||
|
||||
if (not $l[0] =~ m/ /) {
|
||||
print STDERR "Skipping doc $i (no spaces): $l[0] ($l[1])\n";
|
||||
next;
|
||||
next;
|
||||
}
|
||||
|
||||
# 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";
|
||||
|
||||
if (@{$docs{$cat}} < $minimum_category_size) {
|
||||
$small++
|
||||
$small++
|
||||
} else {
|
||||
$total += @{$docs{$cat}};
|
||||
$approved{$cat} = 1;
|
||||
@ -837,7 +837,7 @@ $total = @uncat;
|
||||
foreach my $doc (sort { $lines[$a] cmp $lines[$b] } @uncat) {
|
||||
if ($i % 1000 == 0) {
|
||||
print STDERR "-" x 80, "\n";
|
||||
print STDERR "$i / $total\n";
|
||||
print STDERR "$i / $total\n";
|
||||
print STDERR "-" x 80, "\n";
|
||||
}
|
||||
$i++;
|
||||
@ -899,7 +899,7 @@ foreach my $doc (@remaining_uncat) {
|
||||
push @{$docs{$cat}}, $doc;
|
||||
if (@{$docs{$cat}} == $minimum_category_size) {
|
||||
$approved{$cat} = 1;
|
||||
}
|
||||
}
|
||||
print STDERR "Using uncat rules $cat for doc $i: $l[0] ($l[1])\n";
|
||||
} else {
|
||||
$new_uncat{$doc} = 1;
|
||||
|
@ -173,7 +173,7 @@ while ($text =~ m/^\s{0,4}([0-9A-Z]+\.[0-9\.]*)/msg) {
|
||||
}
|
||||
|
||||
last if $found && $paragraph_specified == $USER_SPECIFIED;
|
||||
|
||||
|
||||
if ($paragraph_specified == $USER_SPECIFIED) {
|
||||
if (length $search) {
|
||||
print "No such text '$search' in paragraph $paragraph of section $section of n1570.\n";
|
||||
|
@ -169,7 +169,7 @@ $white_code =~ s/(?:\'((?:\\\'|(?!\').)*)\')/"'" . ('-' x length $1) . "'"/ge;
|
||||
|
||||
my $precode;
|
||||
if ($white_code =~ m/#include/) {
|
||||
$precode = $code;
|
||||
$precode = $code;
|
||||
} else {
|
||||
$precode = $prelude . $code;
|
||||
}
|
||||
|
@ -172,7 +172,7 @@ while ($text =~ m/^\s{0,4}([0-9A-Z]+\.[0-9\.]*)/msg) {
|
||||
}
|
||||
|
||||
last if $found && $paragraph_specified == $USER_SPECIFIED;
|
||||
|
||||
|
||||
if ($paragraph_specified == $USER_SPECIFIED) {
|
||||
if (length $search) {
|
||||
print "No such text '$search' found within paragraph $paragraph of section $section of n1256.\n";
|
||||
|
@ -43,7 +43,7 @@ if (defined $ret) {
|
||||
my $last_question = <$fh>;
|
||||
my $last_answer = <$fh>;
|
||||
my $last_timestamp = <$fh>;
|
||||
|
||||
|
||||
if (scalar gettimeofday - $last_timestamp <= $TIMELIMIT) {
|
||||
my $duration = duration($TIMELIMIT - scalar gettimeofday - $last_timestamp);
|
||||
print "$color{magneta}The current question is$color{reset}: $last_question";
|
||||
|
@ -170,7 +170,7 @@ foreach my $answer (@valid_answers) {
|
||||
my $percentage = $distance / $length * 100;
|
||||
|
||||
if ($percentage < $incorrect_percentage) {
|
||||
$incorrect_percentage = $percentage;
|
||||
$incorrect_percentage = $percentage;
|
||||
}
|
||||
|
||||
if ($percentage < 15) {
|
||||
@ -319,7 +319,7 @@ foreach my $answer (@valid_answers) {
|
||||
|
||||
if ($channel eq '#cjeopardy') {
|
||||
my $question = `./cjeopardy.pl $channel`;
|
||||
|
||||
|
||||
if ($hint_only_mode) {
|
||||
my $hint = `./cjeopardy_hint.pl candide $channel`;
|
||||
$hint =~ s/^Hint: //;
|
||||
|
@ -102,7 +102,7 @@ while (@indices <= $hidden_character_count - $spaces - $dashes - $underscores -
|
||||
next if $char eq '_';
|
||||
next if $char eq '"';
|
||||
next if grep { $index eq $_ } @indices;
|
||||
push @indices, $index;
|
||||
push @indices, $index;
|
||||
}
|
||||
|
||||
foreach my $index (@indices) {
|
||||
|
@ -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 .= "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: ";
|
||||
|
||||
if ($player_data->{quickest_correct} == 0) {
|
||||
|
@ -68,13 +68,13 @@ $code = '';
|
||||
|
||||
if ($lang eq "C" or $lang eq "C++") {
|
||||
my $has_main = 0;
|
||||
|
||||
|
||||
my $prelude = '';
|
||||
$prelude = "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//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 @extract = extract_codeblock($potential_body, '{}');
|
||||
my $body;
|
||||
if (not defined $extract[0]) {
|
||||
|
@ -16,8 +16,8 @@ use IO::Socket::INET;
|
||||
use JSON;
|
||||
|
||||
my $sock = IO::Socket::INET->new(
|
||||
PeerAddr => '192.168.0.42',
|
||||
PeerPort => 9000,
|
||||
PeerAddr => '192.168.0.42',
|
||||
PeerPort => 9000,
|
||||
Proto => 'tcp');
|
||||
|
||||
if (not defined $sock) {
|
||||
|
@ -12,24 +12,21 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use IO::Socket::INET;
|
||||
use IO::Socket;
|
||||
use JSON;
|
||||
|
||||
my $sock = IO::Socket::INET->new(
|
||||
PeerAddr => '127.0.0.1',
|
||||
PeerPort => 9000,
|
||||
PeerPort => 9000,
|
||||
Proto => 'tcp');
|
||||
|
||||
if (not defined $sock) {
|
||||
if(not defined $sock) {
|
||||
print "Fatal error compiling: $!; try again later\n";
|
||||
die $!;
|
||||
}
|
||||
|
||||
my $json = join ' ', @ARGV;
|
||||
my $length = length $json;
|
||||
|
||||
print STDERR "got $length bytes of argv json: [$json]\n";
|
||||
|
||||
print STDERR "join = $json?\n";
|
||||
my $h = decode_json $json;
|
||||
my $lang = $h->{lang} // "c11";
|
||||
|
||||
@ -40,13 +37,9 @@ if ($h->{code} =~ s/-lang=([^ ]+)//) {
|
||||
$h->{lang} = $lang;
|
||||
$json = encode_json $h;
|
||||
|
||||
$length = length $json;
|
||||
print $sock "$json\n";
|
||||
|
||||
print STDERR "got $length bytes of json: [$json]\n";
|
||||
|
||||
syswrite($sock, "$json\n");
|
||||
|
||||
while (my $line = <$sock>) {
|
||||
while(my $line = <$sock>) {
|
||||
print "$line";
|
||||
}
|
||||
|
||||
|
@ -17,7 +17,7 @@ use JSON;
|
||||
|
||||
my $sock = IO::Socket::INET->new(
|
||||
PeerAddr => '127.0.0.1',
|
||||
PeerPort => 9000,
|
||||
PeerPort => 9000,
|
||||
Proto => 'tcp');
|
||||
|
||||
if(not defined $sock) {
|
||||
|
@ -23,7 +23,7 @@ my $NOGRAPHIC = 1;
|
||||
sub server_listen {
|
||||
my $port = shift @_;
|
||||
|
||||
my $server = IO::Socket::INET->new(
|
||||
my $server = IO::Socket::INET->new(
|
||||
Proto => 'tcp',
|
||||
LocalPort => $port,
|
||||
Listen => SOMAXCONN,
|
||||
@ -54,7 +54,7 @@ sub vm_start {
|
||||
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_list = split / /, $command;
|
||||
exec(@command_list);
|
||||
exec(@command_list);
|
||||
} else {
|
||||
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"; };
|
||||
alarm($COMPILE_TIMEOUT);
|
||||
|
||||
|
||||
while(my $line = <$fh>) {
|
||||
$result .= $line;
|
||||
}
|
||||
@ -294,7 +294,7 @@ sub compiler_server {
|
||||
vm_stop $vm_pid;
|
||||
$running = 0;
|
||||
last;
|
||||
}
|
||||
}
|
||||
print "Compiler server no longer running, restarting...\n";
|
||||
}
|
||||
waitpid($heartbeat_pid, 0);
|
||||
|
@ -29,7 +29,7 @@ $SIG{INT} = sub { vm_stop(); exit 1; };
|
||||
sub server_listen {
|
||||
my $port = shift @_;
|
||||
|
||||
my $server = IO::Socket::INET->new(
|
||||
my $server = IO::Socket::INET->new(
|
||||
Proto => 'tcp',
|
||||
LocalPort => $port,
|
||||
Listen => SOMAXCONN,
|
||||
@ -262,7 +262,7 @@ sub compiler_server {
|
||||
$ns->setvar('running', 0);
|
||||
vm_stop;
|
||||
last;
|
||||
}
|
||||
}
|
||||
print "Compiler server no longer running, restarting...\n";
|
||||
}
|
||||
print "Waiting for heartbeat $heartbeat_pid to die\n";
|
||||
|
@ -18,7 +18,7 @@ my $COMPILE_TIMEOUT = 10;
|
||||
sub server_listen {
|
||||
my $port = shift @_;
|
||||
|
||||
my $server = IO::Socket::INET->new(
|
||||
my $server = IO::Socket::INET->new(
|
||||
Proto => 'tcp',
|
||||
LocalPort => $port,
|
||||
Listen => SOMAXCONN,
|
||||
@ -41,9 +41,9 @@ sub vm_start {
|
||||
|
||||
sub vm_reset {
|
||||
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 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";
|
||||
}
|
||||
|
||||
@ -85,7 +85,7 @@ sub execute {
|
||||
|
||||
my $ret = $? >> 8;
|
||||
alarm 0;
|
||||
|
||||
|
||||
print "[$ret, $result]\n";
|
||||
return ($ret, $result);
|
||||
};
|
||||
@ -174,7 +174,7 @@ sub compiler_server {
|
||||
if ($heartbeat == -1) {
|
||||
print "fucking dead, restarting\n";
|
||||
waitpid $heartbeat_pid, 0;
|
||||
# vm_stop;
|
||||
#vm_stop;
|
||||
next;
|
||||
}
|
||||
|
||||
@ -259,10 +259,10 @@ sub compiler_server {
|
||||
next;
|
||||
|
||||
print "stopping vm\n";
|
||||
vm_stop;
|
||||
#vm_stop;
|
||||
$running = 0;
|
||||
last;
|
||||
}
|
||||
}
|
||||
print "Compiler server no longer running, restarting...\n";
|
||||
}
|
||||
print "waiting on heartbeat pid?\n";
|
||||
|
@ -39,7 +39,7 @@ while (1) {
|
||||
|
||||
foreach $p (@{$t->table}) {
|
||||
$pids->{$p->pid} = { fname => $p->fname, ppid => $p->ppid };
|
||||
}
|
||||
}
|
||||
|
||||
foreach $p (keys %$pids) {
|
||||
if ($pids->{$p}->{fname} eq $QEMU) {
|
||||
|
@ -12,7 +12,7 @@ use File::Basename;
|
||||
use JSON;
|
||||
|
||||
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';
|
||||
|
||||
|
@ -180,7 +180,7 @@ sub preprocess_code {
|
||||
my $precode;
|
||||
|
||||
if($white_code =~ m/#include/) {
|
||||
$precode = $self->{code};
|
||||
$precode = $self->{code};
|
||||
} else {
|
||||
$precode = $default_prelude . $self->{code};
|
||||
}
|
||||
|
@ -383,7 +383,7 @@ sub execute {
|
||||
#print FILE "Sending $length bytes [$compile_json] to vm_server\n";
|
||||
|
||||
$chunk_size -= 1; # account for newline in syswrite
|
||||
|
||||
|
||||
while ($chunks_sent < $length) {
|
||||
my $chunk = substr $compile_json, $chunks_sent, $chunk_size;
|
||||
#print FILE "Sending chunk [$chunk]\n";
|
||||
@ -617,7 +617,7 @@ sub process_interactive_edit {
|
||||
print "No recent code to $self->{got_run}.\n";
|
||||
exit 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if($subcode =~ m/^\s*(and)?\s*remove \s*([^']+)?\s*'/) {
|
||||
$last_keyword = 'remove';
|
||||
@ -824,7 +824,7 @@ sub process_interactive_edit {
|
||||
$before = $`;
|
||||
$after = $';
|
||||
} 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);
|
||||
$before = $`;
|
||||
$after = $';
|
||||
|
@ -3,7 +3,7 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
package _c_base;
|
||||
package _c_base;
|
||||
use parent '_default';
|
||||
|
||||
sub preprocess {
|
||||
|
@ -3,7 +3,7 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
package java;
|
||||
package java;
|
||||
use parent '_default';
|
||||
|
||||
sub preprocess {
|
||||
@ -28,7 +28,7 @@ sub postprocess {
|
||||
print "Executing java\n";
|
||||
my $input_quoted = quotemeta $self->{input};
|
||||
$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 = "";
|
||||
open(FILE, '.output');
|
||||
|
@ -17,7 +17,7 @@ sub postprocess {
|
||||
$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;
|
||||
|
||||
|
@ -3,7 +3,7 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
package tcl;
|
||||
package tcl;
|
||||
use parent '_default';
|
||||
|
||||
sub initialize {
|
||||
|
@ -166,7 +166,7 @@ while ($text =~ m/^\s{4,6}(\d+\.[0-9\.]*)/msg) {
|
||||
}
|
||||
|
||||
last if $found && $paragraph_specified == $USER_SPECIFIED;
|
||||
|
||||
|
||||
if ($paragraph_specified == $USER_SPECIFIED) {
|
||||
print "No such paragraph '$paragraph' in section '$section' of n1256.\n";
|
||||
exit 0;
|
||||
|
@ -34,7 +34,7 @@ if ($text =~ m/no dictionary results/i)
|
||||
{
|
||||
print "No entry found for '$phrase'. ";
|
||||
|
||||
|
||||
|
||||
if ($text =~ m/Did you mean <a class.*?>(.*?)<\/a>/g)
|
||||
{
|
||||
print "Did you mean '$1'? Alternate suggestions: ";
|
||||
@ -54,7 +54,7 @@ if ($text =~ m/no dictionary results/i)
|
||||
# print "Suggestions: ";
|
||||
#
|
||||
# $i = 30;
|
||||
# while ($text =~ m/<a href=".*?\/search\?r=13&q=.*?>(.*?)<\/a>/g
|
||||
# while ($text =~ m/<a href=".*?\/search\?r=13&q=.*?>(.*?)<\/a>/g
|
||||
# && $i > 0)
|
||||
# {
|
||||
# print "$1, ";
|
||||
|
@ -15,7 +15,7 @@ use LWP::UserAgent;
|
||||
|
||||
my $debug = 0;
|
||||
|
||||
my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
|
||||
my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
|
||||
|
||||
my $output = "";
|
||||
my $nooutput = 'No output.';
|
||||
|
@ -3,12 +3,12 @@
|
||||
# This Source Code Form is subject to the terms of the Mozilla Public
|
||||
# License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
|
||||
|
||||
# quick and dirty by :pragma
|
||||
|
||||
|
||||
use strict;
|
||||
use LWP::UserAgent;
|
||||
|
||||
|
||||
my ($defint, $phrase, $text, $entry, $entries, $i);
|
||||
my @defs;
|
||||
|
||||
@ -17,26 +17,26 @@ if ($#ARGV < 0)
|
||||
print "What phrase would you like to define?\n";
|
||||
die;
|
||||
}
|
||||
|
||||
|
||||
$phrase = join("+", @ARGV);
|
||||
|
||||
|
||||
$entry = 1;
|
||||
|
||||
|
||||
if ($phrase =~ m/([0-9]+)\+(.*)/)
|
||||
{
|
||||
$entry = $1;
|
||||
$phrase = $2;
|
||||
}
|
||||
|
||||
|
||||
my $ua = LWP::UserAgent->new;
|
||||
$ua->agent("howdy");
|
||||
my $response = $ua->get("http://www.google.com/search?q=define:$phrase");
|
||||
$phrase =~ s/\+/ /g;
|
||||
|
||||
|
||||
if (not $response->is_success) {
|
||||
exit(1);
|
||||
}
|
||||
|
||||
|
||||
$text = $response->content;
|
||||
if ($text =~ m/No definitions were found/i)
|
||||
{
|
||||
@ -44,11 +44,11 @@ if ($text =~ m/No definitions were found/i)
|
||||
print "\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
|
||||
print "$phrase: ";
|
||||
|
||||
|
||||
$i = $entry;
|
||||
|
||||
|
||||
while ($i <= $entry + 5)
|
||||
{
|
||||
if ($text =~ m/<li>(.*?)<br>/gs)
|
||||
|
@ -4,7 +4,7 @@
|
||||
# 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/.
|
||||
|
||||
# ugly and hacked together
|
||||
# ugly and hacked together
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
@ -12,7 +12,7 @@ use strict;
|
||||
use HTML::Entities;
|
||||
use Data::Dumper;
|
||||
|
||||
my $debug = 1000;
|
||||
my $debug = 1000;
|
||||
|
||||
sub gen_data;
|
||||
sub gen_txt;
|
||||
@ -58,7 +58,7 @@ sub gen_data {
|
||||
my $diff = $section_number - $last_section_number;
|
||||
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";
|
||||
last;
|
||||
}
|
||||
@ -176,7 +176,7 @@ sub gen_data {
|
||||
sub bysection {
|
||||
my $inverse = 1;
|
||||
print STDERR "section cmp $a <=> $b\n" if $debug > 10;
|
||||
|
||||
|
||||
my ($a1, $p1) = split /p/, $a;
|
||||
my ($b1, $p2) = split /p/, $b;
|
||||
|
||||
|
@ -70,7 +70,7 @@ if ($text =~ m/Showing web page information/g)
|
||||
$header = $1;
|
||||
$header =~ s/<.*?>//g;
|
||||
print "$header";
|
||||
|
||||
|
||||
if ($text =~ m/Description:(.*?)<br>/)
|
||||
{
|
||||
$header = $1;
|
||||
|
@ -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
|
||||
# && ord($1) < 48 && ord($1) > 57);
|
||||
|
||||
|
||||
# $result .= $1;
|
||||
# }
|
||||
}
|
||||
|
@ -13,10 +13,10 @@ use LWP::Simple;
|
||||
|
||||
my %news_sites = (
|
||||
"jbad" => [ "http://jalalabad.us/backend/geeklog.rdf",
|
||||
"Jalalabad.us"
|
||||
"Jalalabad.us"
|
||||
],
|
||||
"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 News"
|
||||
@ -86,19 +86,19 @@ sub check_news {
|
||||
$rss->parse($content);
|
||||
};
|
||||
if (my $error = $@) {
|
||||
$error =~ s/\n//g;
|
||||
$error =~ s/\n//g;
|
||||
print "Got error: $error\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
foreach my $item (@{$rss->{'items'}}) {
|
||||
next unless defined($item->{'title'}) && defined($item->{'link'});
|
||||
|
||||
|
||||
if ($links == 1)
|
||||
{
|
||||
$text = " $item->{'title'} : ( $item->{'link'} )";
|
||||
$text =~ s/\n//g;
|
||||
$text =~ s/\n//g;
|
||||
$text =~ s/\t//g;
|
||||
$text =~ s/\r//g;
|
||||
print "$text\n";
|
||||
|
@ -91,7 +91,7 @@ my %languages = (
|
||||
# C99 34
|
||||
# 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",
|
||||
'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",
|
||||
@ -133,7 +133,7 @@ if ($code =~ m/^\s*run\s*$/i) {
|
||||
print "$nick: No recent code to run.\n";
|
||||
exit 0;
|
||||
}
|
||||
} else {
|
||||
} else {
|
||||
my $subcode = $code;
|
||||
my $got_undo = 0;
|
||||
my $got_sub = 0;
|
||||
@ -344,7 +344,7 @@ if ($code =~ m/^\s*run\s*$/i) {
|
||||
$before = $`;
|
||||
$after = $';
|
||||
} elsif ($suffix =~ /^i$/) {
|
||||
$ret = $code =~ s|$regex|$to|i;
|
||||
$ret = $code =~ s|$regex|$to|i;
|
||||
$a = $1;
|
||||
$b = $2;
|
||||
$c = $3;
|
||||
@ -564,10 +564,10 @@ $code = '';
|
||||
|
||||
if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{$lang}{'id'} == 34) {
|
||||
my $has_main = 0;
|
||||
|
||||
|
||||
my $prelude = '';
|
||||
$prelude = "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//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);
|
||||
|
||||
@ -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
|
||||
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;
|
||||
@ -735,7 +735,7 @@ if ($result->{result} == $INTERNAL_ERROR) {
|
||||
}
|
||||
|
||||
$output .= "\n" . $result->{stderr};
|
||||
$output .= "\n" . $result->{output};
|
||||
$output .= "\n" . $result->{output};
|
||||
|
||||
$output = decode_entities($output);
|
||||
|
||||
|
@ -6,7 +6,7 @@
|
||||
|
||||
use strict;
|
||||
use LWP::Simple;
|
||||
|
||||
|
||||
$_ = get("http://www.randominsults.net/");
|
||||
if (/<strong><i>(.*?)\s*<\/i><\/strong>/) {
|
||||
print @ARGV,': ' if @ARGV;
|
||||
|
1538
modules/lookupbot.pl
1538
modules/lookupbot.pl
File diff suppressed because it is too large
Load Diff
@ -31,7 +31,7 @@ my @quotes;
|
||||
while (1) {
|
||||
my $arguments = "love you";
|
||||
my $author = "";
|
||||
|
||||
|
||||
$arguments =~ s/\$nick/me/gi;
|
||||
$arguments =~ s/\s/+/g;
|
||||
|
||||
@ -71,7 +71,7 @@ while (1) {
|
||||
push @quotes, $t;
|
||||
print "Added '$t'\n" if $debug;
|
||||
print "$#quotes\n" if $debug;
|
||||
}
|
||||
}
|
||||
|
||||
if ($text =~ m/Page \d+ of (\d+)/) {
|
||||
$pages = $1;
|
||||
@ -81,7 +81,7 @@ while (1) {
|
||||
} else {
|
||||
last;
|
||||
}
|
||||
|
||||
|
||||
if ($#quotes < 0) {
|
||||
print "No results found.\n";
|
||||
die;
|
||||
|
@ -30,13 +30,13 @@ $manpage =~ s/\+.*$//;
|
||||
my $get_text;
|
||||
do {
|
||||
# $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");
|
||||
|
||||
|
||||
$text = substr($get_text, 0, 5000);
|
||||
# print '['.length($text).']'."\n";
|
||||
|
||||
|
||||
if ($text =~ m/Sorry, no data found/)
|
||||
{
|
||||
$section--;
|
||||
|
@ -13,7 +13,7 @@ if ($#ARGV < 0)
|
||||
print "Try again. Please specify the location you would like to search for nearby cities around.\n";
|
||||
die;
|
||||
}
|
||||
|
||||
|
||||
$location = join("+", @ARGV);
|
||||
|
||||
$location =~ s/,/%2C/;
|
||||
@ -31,7 +31,7 @@ $location =~ s/%2C/,/g;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
@ -52,7 +52,7 @@ if ($text =~ m/location matches\:/g)
|
||||
$buffer =~ s/<\/b>//g;
|
||||
$buffer =~ s/^\s+//;
|
||||
|
||||
$buf = $buf . "$buffer - ";
|
||||
$buf = $buf . "$buffer - ";
|
||||
|
||||
if ($location =~ m/$buffer/i)
|
||||
{
|
||||
|
@ -11,7 +11,7 @@ use Math::Units qw(convert);
|
||||
my ($arguments, $response, $invalid, @conversion);
|
||||
|
||||
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',
|
||||
'pi', 'deg2rad', 'rad2deg', 'atan2', 'cbrt'
|
||||
);
|
||||
|
@ -65,24 +65,24 @@ sub nickometer ($) {
|
||||
if ($_ =~ m/^.$/) {
|
||||
&punish(1000, "single letter nick");
|
||||
}
|
||||
|
||||
|
||||
while (m/[A-Z]([^A-Z]+)\b/g) {
|
||||
&punish(250, "length 1 between capitals") if length $1 == 1;
|
||||
}
|
||||
|
||||
# Allow Perl referencing
|
||||
s/^\\([A-Za-z])/$1/;
|
||||
|
||||
|
||||
# Keep me safe from Pudge ;-)
|
||||
s/\^(pudge)/$1/i;
|
||||
|
||||
# C-- ain't so bad either
|
||||
s/^C--$/C/;
|
||||
|
||||
|
||||
# Punish consecutive non-alphas
|
||||
s/([^A-Za-z0-9]{2,})
|
||||
/my $consecutive = length($1);
|
||||
&punish(&slow_pow(10, $consecutive),
|
||||
&punish(&slow_pow(10, $consecutive),
|
||||
"$consecutive total consecutive non-alphas")
|
||||
if $consecutive;
|
||||
$1
|
||||
@ -91,12 +91,12 @@ sub nickometer ($) {
|
||||
# Remove balanced brackets and punish for unmatched
|
||||
while (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;
|
||||
}
|
||||
my $parentheses = tr/(){}[]/(){}[]/;
|
||||
&punish(&slow_pow(10, $parentheses),
|
||||
&punish(&slow_pow(10, $parentheses),
|
||||
"$parentheses unmatched " .
|
||||
($parentheses == 1 ? 'parenthesis' : 'parentheses'))
|
||||
if $parentheses;
|
||||
@ -116,11 +116,11 @@ sub nickometer ($) {
|
||||
# alpha is caps.
|
||||
my $orig_case = $_;
|
||||
s/^([^A-Za-z]*[A-Z].*[a-z].*?)[_-]?([A-Z])/$1\l$2/;
|
||||
|
||||
|
||||
# A caps first alpha is sometimes not lame
|
||||
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
|
||||
my $case_shifts = &case_shifts($orig_case);
|
||||
&punish(&slow_pow(5, $case_shifts),
|
||||
@ -133,7 +133,7 @@ sub nickometer ($) {
|
||||
|
||||
# Punish letter to numeric shifts and vice-versa
|
||||
my $number_shifts = &number_shifts($_);
|
||||
&punish(&slow_pow(9, $number_shifts),
|
||||
&punish(&slow_pow(9, $number_shifts),
|
||||
$number_shifts . ' letter/number ' .
|
||||
(($number_shifts == 1) ? 'shift' : 'shifts'))
|
||||
if $number_shifts > 1;
|
||||
@ -155,8 +155,8 @@ sub nickometer ($) {
|
||||
print "\nRaw lameness score is $score\n" if $verbose;
|
||||
|
||||
# Use an appropriate function to map [0, +inf) to [0, 100)
|
||||
my $percentage = 100 *
|
||||
(1 + tanh(($score-400)/400)) *
|
||||
my $percentage = 100 *
|
||||
(1 + tanh(($score-400)/400)) *
|
||||
(1 - 1/(1+$score/5)) / 2;
|
||||
|
||||
my $digits = 2 * (2 - &round_up(log(100 - $percentage) / log(10)));
|
||||
|
@ -33,7 +33,7 @@ while (1) {
|
||||
} else {
|
||||
my $arguments = join('+', @ARGV);
|
||||
my $author = "";
|
||||
|
||||
|
||||
$arguments =~ s/\$nick/me/gi;
|
||||
$arguments =~ s/\s/+/g;
|
||||
|
||||
@ -74,7 +74,7 @@ while (1) {
|
||||
#print "Added '$t'\n";
|
||||
#print "$#quotes\n";
|
||||
last if ($#ARGV < 0);
|
||||
}
|
||||
}
|
||||
|
||||
if ($text =~ m/Page \d+ of (\d+)/) {
|
||||
$pages = $1;
|
||||
@ -84,7 +84,7 @@ while (1) {
|
||||
} else {
|
||||
last;
|
||||
}
|
||||
|
||||
|
||||
if ($#quotes < 0) {
|
||||
print "No results found.\n";
|
||||
exit;
|
||||
|
@ -37,7 +37,7 @@ while (seek(FILE, $pos--, 0))
|
||||
|
||||
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)
|
||||
{
|
||||
|
@ -51,11 +51,6 @@ if (@$args == 0) {
|
||||
close $fh;
|
||||
}
|
||||
|
||||
if ($args =~ m/afroman/) {
|
||||
print "Oh fuck off.\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my $ud = WebService::UrbanDictionary->new;
|
||||
my $results = $ud->request($args);
|
||||
|
||||
|
@ -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
|
||||
# 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";
|
||||
die;
|
||||
}
|
||||
|
||||
|
||||
$location = join("+", @ARGV);
|
||||
|
||||
$location =~ s/,/%2C/;
|
||||
@ -33,7 +33,7 @@ $location =~ s/%2C/,/g;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
@ -54,7 +54,7 @@ if ($text =~ m/location matches\:/g)
|
||||
$weather =~ s/<\/b>//g;
|
||||
$weather =~ s/^\s+//;
|
||||
|
||||
$buf = $buf . "$weather - ";
|
||||
$buf = $buf . "$weather - ";
|
||||
|
||||
if ($location =~ m/$weather/i)
|
||||
{
|
||||
@ -70,8 +70,8 @@ if ($text =~ m/location matches\:/g)
|
||||
}
|
||||
}
|
||||
|
||||
my ($update, $temp, $high, $low, $tempc, $highc, $lowc, $cond,
|
||||
$today, $tonight, $country, $state, $city, $humid, $wind,
|
||||
my ($update, $temp, $high, $low, $tempc, $highc, $lowc, $cond,
|
||||
$today, $tonight, $country, $state, $city, $humid, $wind,
|
||||
$sunup, $sundown, $feels, $feelsc);
|
||||
|
||||
$text =~ m/<a href="\/">Weather<\/a>\s>/g;
|
||||
@ -84,7 +84,7 @@ if ($text =~ m/location matches\:/g)
|
||||
$country = $1;
|
||||
}
|
||||
|
||||
if ($country ne "Canada")
|
||||
if ($country ne "Canada")
|
||||
{
|
||||
$text =~ m/<a href=.*?>(.*?)<\/a>\s>/g;
|
||||
$state = $1;
|
||||
@ -97,7 +97,7 @@ if ($text =~ m/location matches\:/g)
|
||||
if $text =~ m/at:\s(.*?)<\/font><\/td>/gi;
|
||||
|
||||
|
||||
while ($text =~
|
||||
while ($text =~
|
||||
m/<td\swidth\=\".*?align\=center\scolspan\=.*?\sface\=.*?\s.*?<b>(.*?)<\/b>/g)
|
||||
{
|
||||
push(@days, $1);
|
||||
@ -110,7 +110,7 @@ m/<td\swidth\=\".*?align\=center\scolspan\=.*?\sface\=.*?\s.*?<b>(.*?)<\/b>/g)
|
||||
$date = $i;
|
||||
last;
|
||||
}
|
||||
$i = $i + 1;
|
||||
$i = $i + 1;
|
||||
}
|
||||
|
||||
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++)
|
||||
{
|
||||
$text =~
|
||||
$text =~
|
||||
m/<td\salign=right\scolspan=1.*?face=Arial>High\:.*?size=3\sface=Arial>\n\s\s(.*?)\&/sgi;
|
||||
$high = $1;
|
||||
}
|
||||
|
||||
for($i = 0; $i <= $date; $i++)
|
||||
{
|
||||
$text =~
|
||||
$text =~
|
||||
m/<td\salign=right\scolspan=1.*?face=Arial>Low\:.*?size=3\sface=Arial>\n\s(.*?)\&/sgi;
|
||||
$low = $1;
|
||||
}
|
||||
|
@ -21,8 +21,8 @@ my $entry = $wiki->search($term);
|
||||
|
||||
if ($entry) {
|
||||
my $text = $entry->text();
|
||||
|
||||
if ($text) {
|
||||
|
||||
if ($text) {
|
||||
$text =~ s/{{.*?}}//msg;
|
||||
$text =~ s/\[\[//g;
|
||||
$text =~ s/\]\]//g;
|
||||
@ -30,13 +30,13 @@ if ($entry) {
|
||||
$text =~ s/__[A-Z]+__//g;
|
||||
$text =~ s/\s+\(\)//msg;
|
||||
$text = HTML::FormatText->new->format(parse_html($text));
|
||||
print $text;
|
||||
print $text;
|
||||
} else {
|
||||
print "Specific entry not found, see also: ";
|
||||
my $semi = "";
|
||||
foreach ($entry->related()) { print "$semi$_"; $semi = "; "; }
|
||||
}
|
||||
} else {
|
||||
print qq("$term" not found in Wikipedia\n)
|
||||
} else {
|
||||
print qq("$term" not found in Wikipedia\n)
|
||||
}
|
||||
|
||||
|
6
pbot.pl
6
pbot.pl
@ -1,4 +1,4 @@
|
||||
#!/usr/bin/env perl
|
||||
#!/usr/bin/env perl
|
||||
#
|
||||
# File: pbot.pl
|
||||
# Author: pragma_
|
||||
@ -29,11 +29,11 @@ use PBot::PBot;
|
||||
#
|
||||
# !! 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.
|
||||
my $bothome = "$ENV{HOME}/pbot";
|
||||
|
||||
my %config = (
|
||||
my %config = (
|
||||
# -----------------------------------------------------
|
||||
# Be sure to set your IRC information to a registered NickServ account
|
||||
# if you want channel auto-join to work.
|
||||
|
Loading…
Reference in New Issue
Block a user