diff --git a/PBot/AntiFlood.pm b/PBot/AntiFlood.pm index 1061e179..c0071cd4 100644 --- a/PBot/AntiFlood.pm +++ b/PBot/AntiFlood.pm @@ -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/\?\*!\*@\*$/) { diff --git a/PBot/AntiSpam.pm b/PBot/AntiSpam.pm index 0635e171..03382230 100644 --- a/PBot/AntiSpam.pm +++ b/PBot/AntiSpam.pm @@ -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'; diff --git a/PBot/BlackList.pm b/PBot/BlackList.pm index 89afd732..fedf44a9 100644 --- a/PBot/BlackList.pm +++ b/PBot/BlackList.pm @@ -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 = ; 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"; } diff --git a/PBot/BotAdminCommands.pm b/PBot/BotAdminCommands.pm index 19d82cd0..0b8b5dd3 100644 --- a/PBot/BotAdminCommands.pm +++ b/PBot/BotAdminCommands.pm @@ -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) { diff --git a/PBot/BotAdmins.pm b/PBot/BotAdmins.pm index e4745aa9..66595988 100644 --- a/PBot/BotAdmins.pm +++ b/PBot/BotAdmins.pm @@ -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; } diff --git a/PBot/DualIndexHashObject.pm b/PBot/DualIndexHashObject.pm index 62c69fbd..ce80c2a3 100644 --- a/PBot/DualIndexHashObject.pm +++ b/PBot/DualIndexHashObject.pm @@ -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); diff --git a/PBot/FactoidCommands.pm b/PBot/FactoidCommands.pm index fa458ed0..d225fb15 100644 --- a/PBot/FactoidCommands.pm +++ b/PBot/FactoidCommands.pm @@ -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 "; } @@ -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; diff --git a/PBot/FactoidModuleLauncher.pm b/PBot/FactoidModuleLauncher.pm index 2ebd579c..f30654a4 100644 --- a/PBot/FactoidModuleLauncher.pm +++ b/PBot/FactoidModuleLauncher.pm @@ -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") { diff --git a/PBot/Factoids.pm b/PBot/Factoids.pm index dd4cdcf2..2fab714b 100644 --- a/PBot/Factoids.pm +++ b/PBot/Factoids.pm @@ -164,7 +164,7 @@ sub export_factoids { print FILE '' . "\n"; print FILE "\nLast updated at $time\n"; print FILE "

Candide's factoids

\n"; - + my $i = 0; my $table_id = 1; @@ -201,7 +201,7 @@ sub export_factoids { } else { print FILE "\n"; } - + print FILE "" . encode_entities($self->{factoids}->hash->{$channel}->{$trigger}->{owner}) . "\n"; print FILE "" . encode_entities(strftime "%Y/%m/%d %H:%M:%S", localtime $self->{factoids}->hash->{$channel}->{$trigger}->{created_on}) . "\n"; @@ -225,7 +225,7 @@ sub export_factoids { print FILE "" . encode_entities($trigger) . " is $action\n"; } - if (exists $self->{factoids}->hash->{$channel}->{$trigger}->{edited_by}) { + if (exists $self->{factoids}->hash->{$channel}->{$trigger}->{edited_by}) { print FILE "" . $self->{factoids}->hash->{$channel}->{$trigger}->{edited_by} . "\n"; print FILE "" . encode_entities(strftime "%Y/%m/%d %H:%M:%S", localtime $self->{factoids}->hash->{$channel}->{$trigger}->{edited_on}) . "\n"; } else { @@ -240,7 +240,7 @@ sub export_factoids { } else { print FILE "\n"; } - + print FILE "\n"; } } @@ -261,9 +261,9 @@ sub export_factoids { print FILE "});\n"; print FILE "\n"; print FILE "\n\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 ' 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"; } } diff --git a/PBot/HashObject.pm b/PBot/HashObject.pm index 3c677b3d..df72047a 100644 --- a/PBot/HashObject.pm +++ b/PBot/HashObject.pm @@ -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"; diff --git a/PBot/IRC.pm b/PBot/IRC.pm index 356a9d9f..3d0158bd 100644 --- a/PBot/IRC.pm +++ b/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 1>". - + =back =head2 Handlers @@ -756,4 +756,4 @@ http://www.irchelp.org/, home of fine IRC resources. =cut - + diff --git a/PBot/IRC/Connection.pm b/PBot/IRC/Connection.pm index 0a8f2cf4..dab023df 100644 --- a/PBot/IRC/Connection.pm +++ b/PBot/IRC/Connection.pm @@ -61,7 +61,7 @@ my %_udef = (); # Creates a new IRC object and assigns some default attributes. sub new { my $proto = shift; - + my $self = { # obvious defaults go here, rest are user-set _debug => $_[0]->{_debug}, _port => 6667, @@ -83,11 +83,11 @@ sub new { _ssl_ca_file => undef, _format => { 'default' => "[%f:%t] %m <%d>", }, }; - + bless $self, $proto; # do any necessary initialization here $self->connect(@_) if @_; - + return $self; } @@ -102,22 +102,22 @@ sub AUTOLOAD { # absolute power corrupts absolutely, but it's a helluva lot # of fun. # =) - + ($meth = $AUTOLOAD) =~ s/^.*:://; ## strip fully qualified portion unless (exists $autoloaded{$meth}) { croak "No method called \"$meth\" for $class object."; } - + eval <{"_$meth"}; - + \$self->{"_$meth"} = shift; - + return \$old; } else { @@ -125,7 +125,7 @@ sub $meth { } } EOSub - + # no reason to play this game every time goto &$meth; } @@ -136,21 +136,21 @@ sub _add_generic_handler { my ($self, $event, $ref, $rp, $hash_ref, $real_name) = @_; my $ev; my %define = ( "replace" => 0, "before" => 1, "after" => 2 ); - + unless (@_ >= 3) { croak "Not enough arguments to $real_name()"; } unless (ref($ref) eq 'CODE') { croak "Second argument of $real_name isn't a coderef"; } - + # Translate REPLACE, BEFORE and AFTER. if (not defined $rp) { $rp = 0; } elsif ($rp =~ /^\D/) { $rp = $define{lc $rp} || 0; } - + foreach $ev (ref $event eq "ARRAY" ? @{$event} : $event) { # Translate numerics to names if ($ev =~ /^\d/) { @@ -160,7 +160,7 @@ sub _add_generic_handler { return; } } - + $hash_ref->{lc $ev} = [ $ref, $rp ]; } return 1; @@ -204,7 +204,7 @@ sub add_default_handler { sub admin { my $self = shift; # Thank goodness for AutoLoader, huh? # Perhaps we'll finally use it soon. - + $self->sl("ADMIN" . ($_[0] ? " $_[0]" : "")); } @@ -219,10 +219,10 @@ sub away { sub connect { my $self = shift; my ($password, $sock); - + if (@_) { my (%arg) = @_; - + $self->hostname($arg{'LocalAddr'}) if exists $arg{'LocalAddr'}; $password = $arg{'Password'} if exists $arg{'Password'}; $self->nick($arg{'Nick'}) if exists $arg{'Nick'}; @@ -235,7 +235,7 @@ sub connect { $self->ssl_ca_path($arg{'SSL_ca_path'}) if exists $arg{'SSL_ca_path'}; $self->ssl_ca_file($arg{'SSL_ca_file'}) if exists $arg{'SSL_ca_file'}; } - + # Lots of error-checking claptrap first... unless ($self->server) { unless ($ENV{IRCSERVER}) { @@ -258,12 +258,12 @@ sub connect { $self->username(eval { scalar getpwuid($>) } || $ENV{USER} || $ENV{LOGNAME} || "japh"); } - + # Now for the socket stuff... if ($self->connected) { $self->quit("Changing servers"); } - + if ($self->ssl) { require IO::Socket::SSL; @@ -292,27 +292,27 @@ sub connect { } } else { - + $self->socket(IO::Socket::INET->new(PeerAddr => $self->server, PeerPort => $self->port, Proto => "tcp", LocalAddr => $self->hostname, )); } - + if (!$self->socket) { carp (sprintf "Can't connect to %s:%s!", $self->server, $self->port); $self->error(1); return; } - + # Send a PASS command if they specified a password. According to # the RFC, we should do this as soon as we connect. if (defined $password) { $self->sl("PASS $password"); } - + # Now, log in to the server... unless ($self->sl('NICK ' . $self->nick()) and $self->sl(sprintf("USER %s %s %s :%s", @@ -325,7 +325,7 @@ sub connect { $! = "Couldn't send NICK/USER introduction to " . $self->server; return; } - + $self->{_connected} = 1; $self->parent->addconn($self); } @@ -333,7 +333,7 @@ sub connect { # Returns a boolean value based on the state of the object's socket. sub connected { my $self = shift; - + return ( $self->{_connected} and $self->socket() ); } @@ -344,11 +344,11 @@ sub connected { sub ctcp { my ($self, $type, $target) = splice @_, 0, 3; $type = uc $type; - + unless ($target) { croak "Not enough arguments to ctcp()"; } - + if ($type eq "PING") { unless ($self->sl("PRIVMSG $target :\001PING " . int(time) . "\001")) { carp "Socket error sending $type request in ctcp()"; @@ -371,7 +371,7 @@ sub ctcp { return; } } else { - unless ($self->sl("PRIVMSG $target :\001$type " . + unless ($self->sl("PRIVMSG $target :\001$type " . CORE::join(" ",@_) . "\001")) { carp "Socket error sending $type request in ctcp()"; return; @@ -384,7 +384,7 @@ sub ctcp { # the text of the reply sub ctcp_reply { my $self = shift; - + $self->notice($_[0], "\001" . $_[1] . "\001"); } @@ -407,22 +407,22 @@ sub debug { sub dequote { my $line = shift; my ($order, @chunks) = (0, ()); # CHUNG! CHUNG! CHUNG! - + # Filter misplaced \001s before processing... (Thanks, Tom!) substr($line, rindex($line, "\001"), 1) = '\\a' unless ($line =~ tr/\001//) % 2 == 0; - + # Thanks to Abigail (abigail@fnx.com) for this clever bit. if (index($line, "\cP") >= 0) { # dequote low-level \n, \r, ^P, and \0. my (%h) = (n => "\012", r => "\015", 0 => "\0", "\cP" => "\cP"); $line =~ s/\cP([nr0\cP])/$h{$1}/g; } $line =~ s/\\([^\\a])/$1/g; # dequote unnecessarily quoted characters. - + # If true, it's in odd order... ctcp commands start with first chunk. $order = 1 if index($line, "\001") == 0; @chunks = map { s/\\\\/\\/g; $_ } (split /\cA/, $line); - + return ($order, @chunks); } @@ -439,7 +439,7 @@ sub DESTROY { # Takes at least 1 arg: the format and args parameters to Event->new(). sub disconnect { my $self = shift; - + $self->{_connected} = 0; $self->parent->removeconn($self); $self->socket( undef ); @@ -455,7 +455,7 @@ sub disconnect { # Takes 1 optional arg: the new value for $self->{'iserror'} sub error { my $self = shift; - + $self->{'iserror'} = $_[0] if @_; return $self->{'iserror'}; } @@ -465,11 +465,11 @@ sub error { # (optional) the new format to use for this event sub format { my ($self, $ev) = splice @_, 0, 2; - + unless ($ev) { croak "Not enough arguments to format()"; } - + if (@_) { $self->{'_format'}->{$ev} = $_[0]; } else { @@ -483,11 +483,11 @@ sub format { # the arguments to the handler function sub handler { my ($self, $event) = splice @_, 0, 2; - + unless (defined $event) { croak 'Too few arguments to Connection->handler()'; } - + # Get name of event. my $ev; if (ref $event) { @@ -498,15 +498,15 @@ sub handler { } else { croak "Not enough arguments to handler()"; } - + print STDERR "Trying to handle event '$ev'.\n" if $self->{_debug}; - + if ($self->{_debug}) { use Data::Dumper; print STDERR "ev: ", Dumper($ev), "\nevent: ", Dumper($event), "\n"; } - + my $handler = undef; if (exists $self->{_handler}->{$ev}) { $handler = $self->{_handler}->{$ev}; @@ -515,9 +515,9 @@ sub handler { } else { return $self->_default($event, @_); } - + my ($code, $rp) = @{$handler}; - + # If we have args left, try to call the handler. if ($rp == 0) { # REPLACE &$code($self, $event, @_); @@ -530,9 +530,9 @@ sub handler { } else { confess "Bad parameter passed to handler(): rp=$rp"; } - + print STDERR "Handler for '$ev' called.\n" if $self->{_debug}; - + return 1; } @@ -542,11 +542,11 @@ sub handler { # (optional) [mask(s) to be added to list of specified type] sub ignore { my $self = shift; - + unless (@_) { croak "Not enough arguments to ignore()"; } - + if (@_ == 1) { if (exists $self->{_ignore}->{$_[0]}) { return @{ $self->{_ignore}->{$_[0]} }; @@ -555,16 +555,16 @@ sub ignore { } } elsif (@_ > 1) { # code defensively, remember... my $type = shift; - + # I moved this part further down as an Obsessive Efficiency # Initiative. It shouldn't be a problem if I do _parse right... # ... but those are famous last words, eh? unless (grep {$_ eq $type} - qw(public msg ctcp notice channel nick other all)) { + qw(public msg ctcp notice channel nick other all)) { carp "$type isn't a valid type to ignore()"; return; } - + if ( exists $self->{_ignore}->{$type} ) { push @{$self->{_ignore}->{$type}}, @_; } else { @@ -578,7 +578,7 @@ sub ignore { # Takes 1 optional arg: the name of the server to query. sub info { my $self = shift; - + $self->sl("INFO" . ($_[0] ? " $_[0]" : "")); } @@ -589,11 +589,11 @@ sub info { # I hate the syntax of this command... always seemed like a protocol flaw. sub invite { my $self = shift; - + unless (@_ > 1) { croak "Not enough arguments to invite()"; } - + $self->sl("INVITE $_[0] $_[1]"); } @@ -601,11 +601,11 @@ sub invite { # Takes at least 1 arg: nickname(s) to look up. sub ison { my $self = shift; - + unless (@_) { croak 'Not enough args to ison().'; } - + $self->sl("ISON " . CORE::join(" ", @_)); } @@ -615,16 +615,16 @@ sub ison { # optional channel password, for +k channels sub join { my $self = shift; - + unless ( $self->connected ) { carp "Can't join() -- not connected to a server"; return; } - + unless (@_) { croak "Not enough arguments to join()"; } - + return $self->sl("JOIN $_[0]" . ($_[1] ? " $_[1]" : "")); } @@ -634,7 +634,7 @@ sub join { # (optional) a parting comment to the departing bastard sub kick { my $self = shift; - + unless (@_ > 1) { croak "Not enough arguments to kick()"; } @@ -646,7 +646,7 @@ sub kick { # now, so read the RFC. sub links { my ($self) = (shift, undef); - + $self->sl("LINKS" . (scalar(@_) ? " " . CORE::join(" ", @_[0,1]) : "")); } @@ -655,7 +655,7 @@ sub links { # channel (the server returns channel name, # of users, and topic for each). sub list { my $self = shift; - + $self->sl("LIST " . CORE::join(",", @_)); } @@ -663,7 +663,7 @@ sub list { # Takes 1 optional arg: the name of a server to request the info from. sub lusers { my $self = shift; - + $self->sl("LUSERS" . ($_[0] ? " $_[0]" : "")); } @@ -672,11 +672,11 @@ sub lusers { # Takes 1 (optional) arg: the maximum line length (in bytes) sub maxlinelen { my $self = shift; - + my $ret = $self->{_maxlinelen}; - + $self->{_maxlinelen} = shift if @_; - + return $ret; } @@ -686,7 +686,7 @@ sub maxlinelen { # the action to send (e.g., "weed-whacks billn's hand off.") sub me { my $self = shift; - + $self->ctcp("ACTION", $_[0], $_[1]); } @@ -696,7 +696,7 @@ sub me { # (optional) operands of the mode string (nicks, hostmasks, etc.) sub mode { my $self = shift; - + unless (@_ >= 1) { croak "Not enough arguments to mode()"; } @@ -707,7 +707,7 @@ sub mode { # Takes 1 optional arg: the server to query (defaults to current server) sub motd { my $self = shift; - + $self->sl("MOTD" . ($_[0] ? " $_[0]" : "")); } @@ -716,9 +716,9 @@ sub motd { # Takes 1 or more optional args: name(s) of channel(s) to list the users from. sub names { my $self = shift; - + $self->sl("NAMES " . CORE::join(",", @_)); - + } # Was this the easiest sub in the world, or what? # Creates and returns a DCC CHAT object, analogous to IRC.pm's newconn(). @@ -733,18 +733,18 @@ sub names { sub new_chat { my $self = shift; my ($init, $nick, $address, $port); - + if (ref($_[0]) =~ /Event/) { # If it's from an Event object, we can't be initiating, right? ($init, undef, undef, undef, $address, $port) = (0, $_[0]->args); $nick = $_[0]->nick; - + } elsif (ref($_[0]) eq "ARRAY") { ($init, $nick, $address, $port) = @{$_[0]}; } else { ($init, $nick, $address, $port) = @_; } - + PBot::IRC::DCC::CHAT->new($self, $init, $nick, $address, $port); # pragma_ 2011/21/01 } @@ -765,7 +765,7 @@ sub new_chat { sub new_get { my $self = shift; my ($nick, $name, $address, $port, $size, $offset, $handle); - + if (ref($_[0]) =~ /Event/) { (undef, undef, $name, $address, $port, $size) = $_[0]->args; $nick = $_[0]->nick; @@ -776,7 +776,7 @@ sub new_get { } else { ($nick, $name, $address, $port, $size, $handle) = @_; } - + unless (defined $handle and ref $handle and (ref $handle eq "GLOB" or $handle->can('print'))) { @@ -784,10 +784,10 @@ sub new_get { "a glob reference or object"); return; # is this behavior OK? } - + my $dcc = PBot::IRC::DCC::GET->new( $self, $nick, $address, $port, $size, # pragma_ 2011/21/01 $name, $handle, $offset ); - + $self->parent->addconn($dcc) if $dcc; return $dcc; } @@ -799,13 +799,13 @@ sub new_get { sub new_send { my $self = shift; my ($nick, $filename, $blocksize); - + if (ref($_[0]) eq "ARRAY") { ($nick, $filename, $blocksize) = @{$_[0]}; } else { ($nick, $filename, $blocksize) = @_; } - + PBot::IRC::DCC::SEND->new($self, $nick, $filename, $blocksize); # pragma_ 2011/21/01 } @@ -816,7 +816,7 @@ sub new_send { # Takes 1 arg: the nick. (I bet you could have figured that out...) sub nick { my $self = shift; - + if (@_) { $self->{'_nick'} = shift; if ($self->connected) { @@ -830,18 +830,18 @@ sub nick { # Sends a notice to a channel or person. # Takes 2 args: the target of the message (channel or nick) # the text of the message to send -# The message will be chunked if it is longer than the _maxlinelen +# The message will be chunked if it is longer than the _maxlinelen # attribute, but it doesn't try to protect against flooding. If you # give it too much info, the IRC server will kick you off! sub notice { my ($self, $to) = splice @_, 0, 2; - + unless (@_) { croak "Not enough arguments to notice()"; } - + my ($buf, $length, $line) = (CORE::join("", @_), $self->{_maxlinelen}); - + while (length($buf) > 0) { ($line, $buf) = unpack("a$length a*", $buf); $self->sl("NOTICE $to :$line"); @@ -853,11 +853,11 @@ sub notice { # Operator's password sub oper { my $self = shift; - + unless (@_ > 1) { croak "Not enough arguments to oper()"; } - + $self->sl("OPER $_[0] $_[1]"); } @@ -867,7 +867,7 @@ sub oper { sub parse { my ($self) = shift; my ($from, $type, $message, @stuff, $itype, $ev, @lines, $line); - + if (defined ($self->ssl ? $self->socket->read($line, 10240) : $self->socket->recv($line, 10240, 0)) @@ -876,27 +876,27 @@ sub parse { # grab any remnant from the last go and split into lines my $chunk = $self->{_frag} . $line; @lines = split /\012/, $chunk; - + # if the last line was incomplete, pop it off the chunk and # stick it back into the frag holder. $self->{_frag} = (substr($chunk, -1) ne "\012" ? pop @lines : ''); - - } else { + + } else { # 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... $self->disconnect('error', 'Connection reset by peer'); return; } - + PARSELOOP: foreach $line (@lines) { - + # Clean the lint filter every 2 weeks... $line =~ s/[\012\015]+$//; next unless $line; - + print STDERR "<<< $line\n" if $self->{_debug}; - + # Like the RFC says: "respond as quickly as possible..." if ($line =~ /^PING/) { $ev = (PBot::IRC::Event->new( "ping", # pragma_ 2011/21/01 @@ -905,7 +905,7 @@ sub parse { "serverping", # FIXME? substr($line, 5) )); - + # Had to move this up front to avoid a particularly pernicious bug. } elsif ($line =~ /^NOTICE/) { $ev = PBot::IRC::Event->new( "snotice", # pragma_ 2011/21/01 @@ -913,8 +913,8 @@ sub parse { '', 'server', (split /:/, $line, 2)[1] ); - - + + # Spurious backslashes are for the benefit of cperl-mode. # Assumption: all non-numeric message types begin with a letter } elsif ($line =~ /^:? @@ -929,14 +929,14 @@ sub parse { /x) # That ought to do it for now... { $line = substr $line, 1 if $line =~ /^:/; - + # Patch submitted for v.0.72 # Fixes problems with IPv6 hostnames. # ($from, $line) = split ":", $line, 2; ($from, $line) = $line =~ /^(?:|)(\S+\s+[^:]+):?(.*)/; print STDERR "from: [$from], line: [$line]\n" if $self->{_debug}; - + ($from, $type, @stuff) = split /\s+/, $from; $type = lc $type; @@ -968,38 +968,38 @@ sub parse { } else { $itype = "other"; } - + # This goes through the list of ignored addresses for this message # type and drops out of the sub if it's from an ignored hostmask. - + study $from; foreach ( $self->ignore($itype), $self->ignore("all") ) { $_ = quotemeta; s/\\\*/.*/g; next PARSELOOP if $from =~ /$_/i; } - + # It used to look a lot worse. Here was the original version... # the optimization above was proposed by Silmaril, for which I am # eternally grateful. (Mine still looks cooler, though. :) - + # return if grep { $_ = join('.*', split(/\\\*/, # quotemeta($_))); /$from/ } # ($self->ignore($type), $self->ignore("all")); - + # Add $line to @stuff for the handlers push @stuff, $line if defined $line; - + # Now ship it off to the appropriate handler and forget about it. if ( $itype eq "ctcp" ) { # it's got CTCP in it! $self->parse_ctcp($type, $from, $stuff[0], $line); next; - + } elsif ($type eq "public" or $type eq "msg" or $type eq "notice" or $type eq "mode" or $type eq "join" or $type eq "part" or $type eq "topic" or $type eq "invite" or $type eq "whoisaccount" or $type eq "cap") { - + $ev = PBot::IRC::Event->new( $type, # pragma_ 2011/21/01 $from, shift(@stuff), @@ -1007,7 +1007,7 @@ sub parse { @stuff, ); } elsif ($type eq "quit" or $type eq "nick" or $type eq "account") { - + $ev = PBot::IRC::Event->new( $type, # pragma_ 2011/21/01 $from, $from, @@ -1015,14 +1015,14 @@ sub parse { @stuff, ); } elsif ($type eq "kick") { - + $ev = PBot::IRC::Event->new( $type, # pragma_ 2011/21/01 $from, $stuff[1], $type, @stuff[0,2..$#stuff], ); - + } elsif ($type eq "kill") { $ev = PBot::IRC::Event->new($type, # pragma_ 2011/21/01 $from, @@ -1034,13 +1034,13 @@ sub parse { $from, '', $type, - $line); + $line); } elsif ($type eq "pong") { $ev = PBot::IRC::Event->new($type, # pragma_ 2011/21/01 $from, '', $type, - $line); + $line); } else { carp "Unknown event type: $type"; } @@ -1052,14 +1052,14 @@ sub parse { \b/x # Some other crap, whatever... ) { $ev = $self->parse_num($line); - + } elsif ($line =~ /^:(\w+) MODE \1 /) { $ev = PBot::IRC::Event->new( 'umode', # pragma_ 2011/21/01 $self->server, $self->nick, 'server', substr($line, index($line, ':', 1) + 1)); - + } elsif ($line =~ /^:? # Here's Ye Olde Server Notice handler! .+? # the servername (can't assume RFC hostname) \s+? # Some spaces here... @@ -1071,14 +1071,14 @@ sub parse { '', 'server', (split /\s+/, $line, 3)[2] ); - - + + } elsif ($line =~ /^ERROR/) { if ($line =~ /^ERROR :Closing [Ll]ink/) { # is this compatible? - + $ev = 'done'; $self->disconnect( 'error', ($line =~ /(.*)/) ); - + } else { $ev = PBot::IRC::Event->new( "error", # pragma_ 2011/21/01 $self->server, @@ -1089,16 +1089,16 @@ sub parse { } elsif ($line =~ /^Closing [Ll]ink/) { $ev = 'done'; $self->disconnect( 'error', ($line =~ /(.*)/) ); - + } - + if ($ev) { - + # We need to be able to fall through if the handler has # already been called (i.e., from within disconnect()). - + $self->handler($ev) unless $ev eq 'done'; - + } else { # If it gets down to here, it's some exception I forgot about. carp "Funky parse case: $line\n"; @@ -1114,14 +1114,14 @@ sub parse { # the line from the server. sub parse_ctcp { my ($self, $type, $from, $stuff, $line) = @_; - + my ($one, $two); my ($odd, @foo) = (&dequote($line)); - + while (($one, $two) = (splice @foo, 0, 2)) { - + ($one, $two) = ($two, $one) if $odd; - + my ($ctype) = $one =~ /^(\w+)\b/; my $prefix = undef; if ($type eq 'notice') { @@ -1133,15 +1133,15 @@ sub parse_ctcp { carp "Unknown CTCP type: $type"; return; } - + if ($prefix) { my $handler = $prefix . lc $ctype; # unit. value prob with $ctype - + $one =~ s/^$ctype //i; # strip the CTCP type off the args $self->handler(PBot::IRC::Event->new( $handler, $from, $stuff, # pragma_ 2011/21/01 $handler, $one )); } - + $self->handler(PBot::IRC::Event->new($type, $from, $stuff, $type, $two)) # pragma_ 2011/21/01 if $two; } @@ -1156,8 +1156,8 @@ sub parse_num { # Figlet protection? This seems to be a bit closer to the RFC than # the original version, which doesn't seem to handle :trailers quite - # correctly. - + # correctly. + my ($from, $type, $stuff) = split(/\s+/, $line, 3); my ($blip, $space, $other, @stuff); while ($stuff) { @@ -1172,9 +1172,9 @@ sub parse_num { $stuff = $other; } } - + $from = substr $from, 1 if $from =~ /^:/; - + return PBot::IRC::Event->new( $type, # pragma_ 2011/21/01 $from, '', @@ -1186,7 +1186,7 @@ sub parse_num { # Takes at least one arg: name(s) of channel(s) to leave. sub part { my $self = shift; - + unless (@_) { croak "No arguments provided to part()"; } @@ -1199,7 +1199,7 @@ sub part { # Takes no args. sub peer { my $self = shift; - + return ($self->server(), "IRC connection"); } @@ -1221,25 +1221,25 @@ sub print { # Takes 2 args: the target of the message (channel or nick) # the text of the message to send # Don't use this for sending CTCPs... that's what the ctcp() function is for. -# The message will be chunked if it is longer than the _maxlinelen +# The message will be chunked if it is longer than the _maxlinelen # attribute, but it doesn't try to protect against flooding. If you # give it too much info, the IRC server will kick you off! sub privmsg { my ($self, $to) = splice @_, 0, 2; - + unless (@_) { croak 'Not enough arguments to privmsg()'; } - + my $buf = CORE::join '', @_; my $length = $self->{_maxlinelen} - 11 - length($to); my $line; - + if (ref($to) =~ /^(GLOB|IO::Socket)/) { while (length($buf) > 0) { ($line, $buf) = unpack("a$length a*", $buf); send($to, $line . "\012", 0); - } + } } else { while (length($buf) > 0) { ($line, $buf) = unpack("a$length a*", $buf); @@ -1257,23 +1257,23 @@ sub privmsg { # Takes 1 optional arg: parting message, defaults to "Leaving" by custom. sub quit { my $self = shift; - + # Do any user-defined stuff before leaving $self->handler("leaving"); - + unless ( $self->connected ) { return (1) } - + # Why bother checking for sl() errors now, after all? :) # We just send the QUIT command and leave. The server will respond with # a "Closing link" message, and parse() will catch it, close the # connection, and throw a "disconnect" event. Neat, huh? :-) - + $self->sl("QUIT :" . (defined $_[0] ? $_[0] : "Leaving")); - + # since the quit sends a line to the server, we need to flush the # output queue to make sure it gets there so the disconnect $self->parent->flush_output_queue(); - + return 1; } @@ -1286,7 +1286,7 @@ sub rehash { } -# As per the RFC, "force a server restart itself." (Love that RFC.) +# As per the RFC, "force a server restart itself." (Love that RFC.) # Takes no arguments. If it succeeds, you will likely be disconnected, # but I assume you already knew that. This sub is too simple... sub restart { @@ -1339,7 +1339,7 @@ sub schedule_output_event { # servers to communicate with each other. sub sconnect { my $self = shift; - + unless (@_) { croak "Not enough arguments to sconnect()"; } @@ -1351,7 +1351,7 @@ sub sconnect { # ((syntaxen? syntaxi? syntaces?)) sub server { my ($self) = shift; - + if (@_) { # cases like "irc.server.com:6668" if (index($_[0], ':') > 0) { @@ -1362,17 +1362,17 @@ sub server { } $self->{_server} = $serv; $self->port($port); - + # cases like ":6668" (buried treasure!) } elsif (index($_[0], ':') == 0 and $_[0] =~ /^:(\d+)/) { $self->port($1); - + # cases like "irc.server.com" } else { $self->{_server} = shift; } return (1); - + } else { return $self->{_server}; } @@ -1383,11 +1383,11 @@ sub server { sub sl { my $self = shift; my $line = CORE::join '', @_; - + unless (@_) { croak "Not enough arguments to sl()"; } - + if (! $self->pacing) { return $self->sl_real($line); } @@ -1411,7 +1411,7 @@ sub sl { if ($seconds == 0) { $self->{_slcount} = 0; } - + ### DEBUG DEBUG DEBUG if ($self->{_debug}) { print STDERR "S-> $seconds $line\n"; @@ -1427,18 +1427,18 @@ sub sl { sub sl_real { my $self = shift; my $line = shift; - + unless ($line) { croak "Not enough arguments to sl_real()"; } - + ### DEBUG DEBUG DEBUG if ($self->{_debug}) { print STDERR ">>> $line\n"; } return unless defined $self->socket; - + # RFC compliance can be kinda nice... my $rv = $self->ssl ? $self->socket->print("$line\015\012") : @@ -1455,11 +1455,11 @@ sub sl_real { # (optional) a comment about why it was disconnected sub squit { my $self = shift; - + unless (@_) { croak "Not enough arguments to squit()"; } - + $self->sl("SQUIT $_[0]" . ($_[1] ? " :$_[1]" : "")); } @@ -1468,24 +1468,24 @@ sub squit { # (optional) the server to request from (default is current server) sub stats { my $self = shift; - + unless (@_) { croak "Not enough arguments passed to stats()"; } - + $self->sl("STATS $_[0]" . ($_[1] ? " $_[1]" : "")); } # If anyone still has SUMMON enabled, this will implement it for you. -# If not, well...heh. Sorry. First arg mandatory: user to summon. +# If not, well...heh. Sorry. First arg mandatory: user to summon. # Second arg optional: a server name. sub summon { my $self = shift; - + unless (@_) { croak "Not enough arguments passed to summon()"; } - + $self->sl("SUMMON $_[0]" . ($_[1] ? " $_[1]" : "")); } @@ -1494,7 +1494,7 @@ sub summon { # renamed to not collide with things... -- aburke sub timestamp { my ($self, $serv) = (shift, undef); - + $self->sl("TIME" . ($_[0] ? " $_[0]" : "")); } @@ -1503,11 +1503,11 @@ sub timestamp { # (optional) the new topic you want to impress everyone with sub topic { my $self = shift; - + unless (@_) { croak "Not enough arguments to topic()"; } - + # Can you tell I've been reading the Nethack source too much? :) $self->sl("TOPIC $_[0]" . ($_[1] ? " :$_[1]" : "")); } @@ -1516,16 +1516,16 @@ sub topic { # Take 1 optional arg: the server or nickname to trace. sub trace { my $self = shift; - + $self->sl("TRACE" . ($_[0] ? " $_[0]" : "")); } # This method submitted by Dave Schmitt . Thanks, Dave! sub unignore { my $self = shift; - + croak "Not enough arguments to unignore()" unless @_; - + if (@_ == 1) { if (exists $self->{_ignore}->{$_[0]}) { return @{ $self->{_ignore}->{$_[0]} }; @@ -1534,16 +1534,16 @@ sub unignore { } } elsif (@_ > 1) { # code defensively, remember... my $type = shift; - + # I moved this part further down as an Obsessive Efficiency # Initiative. It shouldn't be a problem if I do _parse right... # ... but those are famous last words, eh? unless (grep {$_ eq $type} qw(public msg ctcp notice channel nick other all)) { carp "$type isn't a valid type to unignore()"; - return; + return; } - + if ( exists $self->{_ignore}->{$type} ) { # removes all specifed entries ala _Perl_Cookbook_ recipe 4.7 my @temp = @{$self->{_ignore}->{$type}}; @@ -1565,11 +1565,11 @@ sub unignore { # Takes at least 1 arg: nickname(s) to look up. sub userhost { my $self = shift; - + unless (@_) { croak 'Not enough args to userhost().'; } - + $self->sl("USERHOST " . CORE::join (" ", @_)); } @@ -1577,7 +1577,7 @@ sub userhost { # Take 1 optional arg: the server to query. sub users { my $self = shift; - + $self->sl("USERS" . ($_[0] ? " $_[0]" : "")); } @@ -1585,7 +1585,7 @@ sub users { # Takes 1 optional arg: the server name/glob. (default is current server) sub version { my $self = shift; - + $self->sl("VERSION" . ($_[0] ? " $_[0]" : "")); } @@ -1593,11 +1593,11 @@ sub version { # Takes 1 arg: the text to send. sub wallops { my $self = shift; - + unless ($_[0]) { croak 'No arguments passed to wallops()'; } - + $self->sl("WALLOPS :" . CORE::join("", @_)); } @@ -1606,7 +1606,7 @@ sub wallops { # an "o" (nobody ever uses this...) sub who { my $self = shift; - + # Obfuscation! $self->sl("WHO" . (@_ ? " @_" : "")); } @@ -1615,7 +1615,7 @@ sub who { # Takes at least 1 arg: nickmasks or channels to /whois sub whois { my $self = shift; - + unless (@_) { croak "Not enough arguments to whois()"; } @@ -1628,7 +1628,7 @@ sub whois { # (optional) server or servermask to query sub whowas { my $self = shift; - + unless (@_) { croak "Not enough arguments to whowas()"; } @@ -1642,24 +1642,24 @@ sub whowas { sub _default { my ($self, $event) = @_; my $verbose = $self->verbose; - + # Users should only see this if the programmer (me) fucked up. unless ($event) { croak "You EEEEEDIOT!!! Not enough args to _default()!"; } - + # Reply to PING from server as quickly as possible. if ($event->type eq "ping") { $self->sl("PONG " . (CORE::join ' ', $event->args)); - + } elsif ($event->type eq "disconnect") { - + # I violate OO tenets. (It's consensual, of course.) unless (keys %{$self->parent->{_connhash}} > 0) { die "No active connections left, exiting...\n"; } } - + return 1; } diff --git a/PBot/IRC/DCC.pm b/PBot/IRC/DCC.pm index 2f653010..1a797313 100644 --- a/PBot/IRC/DCC.pm +++ b/PBot/IRC/DCC.pm @@ -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); diff --git a/PBot/IRC/Event.pm b/PBot/IRC/Event.pm index 4d016f20..e6e0623a 100644 --- a/PBot/IRC/Event.pm +++ b/PBot/IRC/Event.pm @@ -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", diff --git a/PBot/IRC/EventQueue.pm b/PBot/IRC/EventQueue.pm index 5d11adb2..212de7c1 100644 --- a/PBot/IRC/EventQueue.pm +++ b/PBot/IRC/EventQueue.pm @@ -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; diff --git a/PBot/IRC/EventQueue/Entry.pm b/PBot/IRC/EventQueue/Entry.pm index 2615e404..8483087c 100644 --- a/PBot/IRC/EventQueue/Entry.pm +++ b/PBot/IRC/EventQueue/Entry.pm @@ -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; diff --git a/PBot/IRCHandlers.pm b/PBot/IRCHandlers.pm index d3344456..5ef0c728 100644 --- a/PBot/IRCHandlers.pm +++ b/PBot/IRCHandlers.pm @@ -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}); diff --git a/PBot/IgnoreList.pm b/PBot/IgnoreList.pm index 3c379ad2..73d9496f 100644 --- a/PBot/IgnoreList.pm +++ b/PBot/IgnoreList.pm @@ -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 = ; 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 } diff --git a/PBot/IgnoreListCommands.pm b/PBot/IgnoreListCommands.pm index 2dd3bfd7..2bf1d5df 100644 --- a/PBot/IgnoreListCommands.pm +++ b/PBot/IgnoreListCommands.pm @@ -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"; diff --git a/PBot/Interpreter.pm b/PBot/Interpreter.pm index c254852d..f951aceb 100644 --- a/PBot/Interpreter.pm +++ b/PBot/Interpreter.pm @@ -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 diff --git a/PBot/LagChecker.pm b/PBot/LagChecker.pm index 0bcfd1f1..7701fb7e 100644 --- a/PBot/LagChecker.pm +++ b/PBot/LagChecker.pm @@ -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 diff --git a/PBot/Logger.pm b/PBot/Logger.pm index a4feed67..08d0834f 100644 --- a/PBot/Logger.pm +++ b/PBot/Logger.pm @@ -40,7 +40,7 @@ sub log { if (defined $self->{log_file}) { print PLOG_FILE "$time :: $text"; - } + } print "$time :: $text"; } diff --git a/PBot/MessageHistory.pm b/PBot/MessageHistory.pm index eb790f2b..9cb4415b 100644 --- a/PBot/MessageHistory.pm +++ b/PBot/MessageHistory.pm @@ -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 ] [-t,text,h,history ] [-b,before ] [-a,after ] [-x,context ] [-n,count ] [+ ...]'; if (not defined $arguments or not length $arguments) { - return $usage; + return $usage; } $arguments = lc $arguments; diff --git a/PBot/MessageHistory_SQLite.pm b/PBot/MessageHistory_SQLite.pm index d1e3756a..b11508ee 100644 --- a/PBot/MessageHistory_SQLite.pm +++ b/PBot/MessageHistory_SQLite.pm @@ -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(<{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; diff --git a/PBot/NickList.pm b/PBot/NickList.pm index 9d9eab96..bc223e8e 100644 --- a/PBot/NickList.pm +++ b/PBot/NickList.pm @@ -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 { diff --git a/PBot/PBot.pm b/PBot/PBot.pm index 3c0259df..f398a305 100644 --- a/PBot/PBot.pm +++ b/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}; } } diff --git a/PBot/Plugins.pm b/PBot/Plugins.pm index 7785c6c8..30579d56 100644 --- a/PBot/Plugins.pm +++ b/PBot/Plugins.pm @@ -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 ($@) { diff --git a/PBot/Plugins/ActionTrigger.pm b/PBot/Plugins/ActionTrigger.pm index 153c0ce2..f6f82e15 100644 --- a/PBot/Plugins/ActionTrigger.pm +++ b/PBot/Plugins/ActionTrigger.pm @@ -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, diff --git a/PBot/Plugins/AntiRepeat.pm b/PBot/Plugins/AntiRepeat.pm index 6404f767..96bb592f 100644 --- a/PBot/Plugins/AntiRepeat.pm +++ b/PBot/Plugins/AntiRepeat.pm @@ -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'); diff --git a/PBot/Plugins/AntiTwitter.pm b/PBot/Plugins/AntiTwitter.pm index 4227f68c..62615957 100644 --- a/PBot/Plugins/AntiTwitter.pm +++ b/PBot/Plugins/AntiTwitter.pm @@ -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}) { diff --git a/PBot/Plugins/Battleship.pm b/PBot/Plugins/Battleship.pm index 119b2813..3faae1f1 100644 --- a/PBot/Plugins/Battleship.pm +++ b/PBot/Plugins/Battleship.pm @@ -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; diff --git a/PBot/Plugins/Counter.pm b/PBot/Plugins/Counter.pm index 9ce5264f..1fa5abe5 100644 --- a/PBot/Plugins/Counter.pm +++ b/PBot/Plugins/Counter.pm @@ -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."; } diff --git a/PBot/Plugins/Quotegrabs.pm b/PBot/Plugins/Quotegrabs.pm index df59fb2d..51bfe43f 100644 --- a/PBot/Plugins/Quotegrabs.pm +++ b/PBot/Plugins/Quotegrabs.pm @@ -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 = "". encode_entities($nick) . " " . encode_entities($text) . "\n"; + $text = "". encode_entities($nick) . " " . encode_entities($text) . "\n"; print FILE $text; - + print FILE "" . encode_entities(strftime "%Y/%m/%d %a %H:%M:%S", localtime $quotegrab->{timestamp}) . "\n"; print FILE "" . encode_entities($quotegrab->{grabbed_by}) . "\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/(? \$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' "; } diff --git a/PBot/Plugins/Quotegrabs/Quotegrabs_Hashtable.pm b/PBot/Plugins/Quotegrabs/Quotegrabs_Hashtable.pm index e90e1ce0..802987b5 100644 --- a/PBot/Plugins/Quotegrabs/Quotegrabs_Hashtable.pm +++ b/PBot/Plugins/Quotegrabs/Quotegrabs_Hashtable.pm @@ -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 = ; 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; } diff --git a/PBot/Plugins/Quotegrabs/Quotegrabs_SQLite.pm b/PBot/Plugins/Quotegrabs/Quotegrabs_SQLite.pm index 9ad55402..2c305b49 100644 --- a/PBot/Plugins/Quotegrabs/Quotegrabs_SQLite.pm +++ b/PBot/Plugins/Quotegrabs/Quotegrabs_SQLite.pm @@ -124,7 +124,7 @@ sub get_random_quotegrab { push @params, "$nick"; $where = ''; $and = 'AND '; - } + } if (defined $channel) { $sql .= $where . $and . 'channel LIKE ? '; diff --git a/PBot/Plugins/RemindMe.pm b/PBot/Plugins/RemindMe.pm index 04eef08a..db078f6b 100644 --- a/PBot/Plugins/RemindMe.pm +++ b/PBot/Plugins/RemindMe.pm @@ -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."; } diff --git a/PBot/Plugins/Spinach.pm b/PBot/Plugins/Spinach.pm index ba445777..947104a6 100644 --- a/PBot/Plugins/Spinach.pm +++ b/PBot/Plugins/Spinach.pm @@ -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"; diff --git a/PBot/Plugins/Spinach/Rank.pm b/PBot/Plugins/Spinach/Rank.pm index 2d02f52d..2bc054b2 100644 --- a/PBot/Plugins/Spinach/Rank.pm +++ b/PBot/Plugins/Spinach/Rank.pm @@ -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' }, diff --git a/PBot/Plugins/_Example.pm b/PBot/Plugins/_Example.pm index a2abcef8..45d42e7a 100644 --- a/PBot/Plugins/_Example.pm +++ b/PBot/Plugins/_Example.pm @@ -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; diff --git a/PBot/Registry.pm b/PBot/Registry.pm index 61b63346..b8bdd032 100644 --- a/PBot/Registry.pm +++ b/PBot/Registry.pm @@ -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}; } diff --git a/PBot/RegistryCommands.pm b/PBot/RegistryCommands.pm index 94c9071d..b8e2eedd 100644 --- a/PBot/RegistryCommands.pm +++ b/PBot/RegistryCommands.pm @@ -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; } diff --git a/PBot/Timer.pm b/PBot/Timer.pm index 3c8dad98..08930640 100644 --- a/PBot/Timer.pm +++ b/PBot/Timer.pm @@ -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 { diff --git a/PBot/Utils/ValidateString.pm b/PBot/Utils/ValidateString.pm index 289d7e12..0ffabf97 100644 --- a/PBot/Utils/ValidateString.pm +++ b/PBot/Utils/ValidateString.pm @@ -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; diff --git a/misc/spinach/cat.pl b/misc/spinach/cat.pl index c4d4c397..e1ec76a2 100755 --- a/misc/spinach/cat.pl +++ b/misc/spinach/cat.pl @@ -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; diff --git a/modules/c11std.pl b/modules/c11std.pl index f2033f04..8d9168e7 100755 --- a/modules/c11std.pl +++ b/modules/c11std.pl @@ -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"; diff --git a/modules/c2english.pl b/modules/c2english.pl index 1ffa61b7..dbb15088 100755 --- a/modules/c2english.pl +++ b/modules/c2english.pl @@ -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; } diff --git a/modules/c99std.pl b/modules/c99std.pl index 4c041a84..19e6048c 100755 --- a/modules/c99std.pl +++ b/modules/c99std.pl @@ -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"; diff --git a/modules/cjeopardy/cjeopardy.pl b/modules/cjeopardy/cjeopardy.pl index 7c18d06f..37be3680 100755 --- a/modules/cjeopardy/cjeopardy.pl +++ b/modules/cjeopardy/cjeopardy.pl @@ -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"; diff --git a/modules/cjeopardy/cjeopardy_answer.pl b/modules/cjeopardy/cjeopardy_answer.pl index aba1c781..d28a774a 100755 --- a/modules/cjeopardy/cjeopardy_answer.pl +++ b/modules/cjeopardy/cjeopardy_answer.pl @@ -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: //; diff --git a/modules/cjeopardy/cjeopardy_hint.pl b/modules/cjeopardy/cjeopardy_hint.pl index 9557945d..d4136103 100755 --- a/modules/cjeopardy/cjeopardy_hint.pl +++ b/modules/cjeopardy/cjeopardy_hint.pl @@ -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) { diff --git a/modules/cjeopardy/cjeopardy_scores.pl b/modules/cjeopardy/cjeopardy_scores.pl index f559ac58..d07381d8 100755 --- a/modules/cjeopardy/cjeopardy_scores.pl +++ b/modules/cjeopardy/cjeopardy_scores.pl @@ -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) { diff --git a/modules/codepad.pl b/modules/codepad.pl index 114bbe21..3aa06edc 100755 --- a/modules/codepad.pl +++ b/modules/codepad.pl @@ -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]) { diff --git a/modules/compiler_block.pl b/modules/compiler_block.pl index e9578737..6abc8011 100755 --- a/modules/compiler_block.pl +++ b/modules/compiler_block.pl @@ -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) { diff --git a/modules/compiler_client.pl b/modules/compiler_client.pl index 198da163..49172a64 100755 --- a/modules/compiler_client.pl +++ b/modules/compiler_client.pl @@ -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"; } diff --git a/modules/compiler_vm/compiler_client.pl b/modules/compiler_vm/compiler_client.pl index 969b56dd..e7b6ccf8 100755 --- a/modules/compiler_vm/compiler_client.pl +++ b/modules/compiler_vm/compiler_client.pl @@ -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) { diff --git a/modules/compiler_vm/compiler_server.pl b/modules/compiler_vm/compiler_server.pl index b4f5c7a2..42cc2733 100755 --- a/modules/compiler_vm/compiler_server.pl +++ b/modules/compiler_vm/compiler_server.pl @@ -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); diff --git a/modules/compiler_vm/compiler_server_vbox_win32.pl b/modules/compiler_vm/compiler_server_vbox_win32.pl index ac2c9070..9c6d9489 100755 --- a/modules/compiler_vm/compiler_server_vbox_win32.pl +++ b/modules/compiler_vm/compiler_server_vbox_win32.pl @@ -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"; diff --git a/modules/compiler_vm/compiler_server_virsh.pl b/modules/compiler_vm/compiler_server_virsh.pl index 2fc16328..0841af11 100755 --- a/modules/compiler_vm/compiler_server_virsh.pl +++ b/modules/compiler_vm/compiler_server_virsh.pl @@ -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"; diff --git a/modules/compiler_vm/compiler_server_watchdog.pl b/modules/compiler_vm/compiler_server_watchdog.pl index 2992ee3a..c071c653 100755 --- a/modules/compiler_vm/compiler_server_watchdog.pl +++ b/modules/compiler_vm/compiler_server_watchdog.pl @@ -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) { diff --git a/modules/compiler_vm/compiler_vm_server.pl b/modules/compiler_vm/compiler_vm_server.pl index f08ee7c6..fc022397 100755 --- a/modules/compiler_vm/compiler_vm_server.pl +++ b/modules/compiler_vm/compiler_vm_server.pl @@ -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'; diff --git a/modules/compiler_vm/languages/_c_base.pm b/modules/compiler_vm/languages/_c_base.pm index 909d006d..095a50fe 100755 --- a/modules/compiler_vm/languages/_c_base.pm +++ b/modules/compiler_vm/languages/_c_base.pm @@ -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}; } diff --git a/modules/compiler_vm/languages/_default.pm b/modules/compiler_vm/languages/_default.pm index 374777b1..a5bc900a 100755 --- a/modules/compiler_vm/languages/_default.pm +++ b/modules/compiler_vm/languages/_default.pm @@ -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 = $'; diff --git a/modules/compiler_vm/languages/server/_c_base.pm b/modules/compiler_vm/languages/server/_c_base.pm index 6e84f3d9..9d1d0b8c 100755 --- a/modules/compiler_vm/languages/server/_c_base.pm +++ b/modules/compiler_vm/languages/server/_c_base.pm @@ -3,7 +3,7 @@ use warnings; use strict; -package _c_base; +package _c_base; use parent '_default'; sub preprocess { diff --git a/modules/compiler_vm/languages/server/java.pm b/modules/compiler_vm/languages/server/java.pm index df058e41..f0a0b9cf 100755 --- a/modules/compiler_vm/languages/server/java.pm +++ b/modules/compiler_vm/languages/server/java.pm @@ -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'); diff --git a/modules/compiler_vm/languages/server/tendra.pm b/modules/compiler_vm/languages/server/tendra.pm index 60d3d909..f85ad86c 100755 --- a/modules/compiler_vm/languages/server/tendra.pm +++ b/modules/compiler_vm/languages/server/tendra.pm @@ -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; diff --git a/modules/compiler_vm/languages/tcl.pm b/modules/compiler_vm/languages/tcl.pm index e64427de..21302939 100755 --- a/modules/compiler_vm/languages/tcl.pm +++ b/modules/compiler_vm/languages/tcl.pm @@ -3,7 +3,7 @@ use warnings; use strict; -package tcl; +package tcl; use parent '_default'; sub initialize { diff --git a/modules/cstd.pl b/modules/cstd.pl index e27634d3..c010034c 100755 --- a/modules/cstd.pl +++ b/modules/cstd.pl @@ -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; diff --git a/modules/define.pl b/modules/define.pl index e48a4a1e..508338fb 100755 --- a/modules/define.pl +++ b/modules/define.pl @@ -34,7 +34,7 @@ if ($text =~ m/no dictionary results/i) { print "No entry found for '$phrase'. "; - + if ($text =~ m/Did you mean (.*?)<\/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>/g # && $i > 0) # { # print "$1, "; diff --git a/modules/expand_macros.pl b/modules/expand_macros.pl index 66a23757..f168aa8b 100755 --- a/modules/expand_macros.pl +++ b/modules/expand_macros.pl @@ -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.'; diff --git a/modules/gdefine.pl b/modules/gdefine.pl index 3d7d317f..dd17b814 100755 --- a/modules/gdefine.pl +++ b/modules/gdefine.pl @@ -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/
  • (.*?)
    /gs) diff --git a/modules/gencstd.pl b/modules/gencstd.pl index 6f74621f..35e3da79 100755 --- a/modules/gencstd.pl +++ b/modules/gencstd.pl @@ -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; diff --git a/modules/google.pl b/modules/google.pl index 4d90f40b..e7cb8335 100755 --- a/modules/google.pl +++ b/modules/google.pl @@ -70,7 +70,7 @@ if ($text =~ m/Showing web page information/g) $header = $1; $header =~ s/<.*?>//g; print "$header"; - + if ($text =~ m/Description:(.*?)
    /) { $header = $1; diff --git a/modules/gtop15.pl b/modules/gtop15.pl index 32ce2ced..1de97492 100755 --- a/modules/gtop15.pl +++ b/modules/gtop15.pl @@ -103,7 +103,7 @@ while ($html =~ m/    \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; # } } diff --git a/modules/headlines.pl b/modules/headlines.pl index 09c72089..a8bf75d0 100755 --- a/modules/headlines.pl +++ b/modules/headlines.pl @@ -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"; diff --git a/modules/ideone.pl b/modules/ideone.pl index ea640c91..daf6ffa6 100755 --- a/modules/ideone.pl +++ b/modules/ideone.pl @@ -91,7 +91,7 @@ my %languages = ( # C99 34 # C++ 1 -my %preludes = ( +my %preludes = ( '34' => "#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n", '11' => "#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n", '1' => "#include \n#include \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); diff --git a/modules/insult.pl b/modules/insult.pl index 900e3a45..7863d692 100755 --- a/modules/insult.pl +++ b/modules/insult.pl @@ -6,7 +6,7 @@ use strict; use LWP::Simple; - + $_ = get("http://www.randominsults.net/"); if (/(.*?)\s*<\/i><\/strong>/) { print @ARGV,': ' if @ARGV; diff --git a/modules/lookupbot.pl b/modules/lookupbot.pl index 65822025..e6f5d7bf 100755 --- a/modules/lookupbot.pl +++ b/modules/lookupbot.pl @@ -1,769 +1,769 @@ -#!/usr/bin/perl -T - -use strict; -use LWP::Simple; -use LWP::UserAgent; -use Encode qw/ decode is_utf8 /; -use CGI qw/escape unescapeHTML/; -use HTML::Entities; -use utf8; - -my $VERSION = '1.0.2'; - -my %IRSSI = ( - 'authors' => 'Craig Andrews', - 'contact' => 'craig@simplyspiffing.com', - 'name' => 'lookupbot', - 'description' => 'Some kind of magical internet searcher', - 'license' => 'Craig\'s Magical Freebie License'); - -## Changes ## -# 0.0.1 - Initial version, not very good -# 1.0.0 - Finished! -# 1.0.1 - Added 'pre' and 'escape' options to give more flexibility -# Added tinyurl and !cndb -# 1.0.2 - Changed privmsg handling -# Removed !dict and !thes because they're too badly broken -# Added !memetic, !horoscope, !cricket -# Added different handling for public/private responders -# 1.0.3 - Added !tdm -# Split request processing away from event handling -# Added the start of a simple cache -# 1.1.0 - Completion of refactoring, so officially a new version! - -## -# Clean up the input data and separate the -# trigger and parameter portions -## -sub get_data { - my $data = shift; - - my @params = split / +/, $data; - my $trigger = shift @params; - - $data = join ' ', @params; - $data =~ s/[^[:print:]]/ /g; - $data =~ s/ */ /g; - - return $trigger, $data; -} - -## -# Retrieve the content from a url -# Params: -# $url - The URL to query -# $data - If defined, data to insert into the URL using sprintf -# $escape - URL encode the data before insertion? 1 = true, 0 = false -## -my %url_cache; -sub get_content { - my ($url, $data, $escape, $cache) = @_; - - $data = escape($data) unless $escape == 0; - $url = sprintf($url, $data) if defined $data; - - # Use the cache if requested - my $timeout = time() - $cache; - if (defined $cache && - $cache > 0 && - exists $url_cache{$url} && - $url_cache{$url}->{'time'} > $timeout) { - - return $url_cache{$url}->{'content'}; - } - - my $ua = LWP::UserAgent->new(agent => "ME"); - my $result = $ua->get($url, ('Accept-Charset' => 'utf-8,iso-8859-1,*')); - - my $content; - if ($result->is_success) - { - my $encoding = $result->content_encoding; - if ($encoding eq "") { - $encoding = is_utf8($result->content)?'utf-8':'iso-8859-1'; - } - $content = decode($encoding, $result->content()) if $result->is_success; - $url_cache{$url} = {'time' => time(), 'content' => $content}; - } - - return $content; -} - -## -# Google image search -## -sub image_search { - my $content = shift; - - my $lines = join ' ', $content =~ /imgurl=(.*?)\&/is; - return $lines; -} - -## -# Basic google search -## -sub google_search { - my $content = shift; - - my ($calcs) = $content =~ /

    (.+?)<\/b>/sm; - return $calcs if defined $calcs and length $calcs; - - my $lines = join ' ', $content =~ /
    )(.+?)(?=
    |
  • )/is; - return $lines; -} - -## -# Urban dictionary search -## -sub urban_search { - my $content = shift; - my $term = shift; - - my @rawlines = $content =~ /
    (.+?)<\/?div/gism; - my @lines; - foreach (@rawlines) { - my @s = split /(?:\n|)/; - push @lines, $_ for @s; - } - - my $definition; - my $def_word = 0; - my $paragraphs = 0; - - while ($def_word <= 1 && - $paragraphs <= 4 && - scalar(@lines) > 0) { - - my $s = shift(@lines); - $s =~ s/^\s*//; - $s =~ s/\s*$//; - $s =~ s/<.+?>//g; - - if ($s =~ /(meaning|definition|def_p)/) { - $def_word++; - } elsif ($s =~ /example/) { -# Do nothing - } elsif (length $s > 0) { - $definition .= "$s\n"; - $paragraphs++; - } - } - - return decode_entities($definition); -} - -## -# Profanisaurus search -## -sub profan_search { - my $content = shift; - - my @matches = $content =~ /(.+?)(.+)/; - - return join "\n", @matches; -} - -## -# Urban word of the day -## -sub uwotd_search { - my $content = shift; - - my ($word) = $content =~ /()/s; - my ($title, $description) = $word =~ /<(?:title|description)>(.+?)<\//gs; - - $description = unescapeHTML($description); - $description =~ s//\n/g; - - my @lines = $description =~ /

    (.+?)<\/p>/gs; - unshift @lines, $title; - - return join("\n", @lines); -} - -## -# Worthless word of the day -## -sub wwotd_search { - my $content = shift; - - my ($matches) = $content =~ m|(?<=

    \s)(the worthless word for the day is:.+?)(?=
    )|ism; - my @lines = split "\n", $matches; - return if length @lines == 0; - - my $blanks = 2; - my @result; - while ($blanks > 0 && scalar(@lines)) { - my $line = shift @lines; - if (length $line) { - push @result, $line; - } else { - $blanks --; - } - } - - return join "\n", @result; -} - -## -# Dictionary.com word of the day -## -=cut -sub wotd_search { - my $content = shift; - - my @lines = $content =~ m|(?<=).+?(?=

    )|igosm; - return if length @lines == 0; - s/<.+?>//g foreach (@lines); - @lines = grep { /^.+$/ } split (/\n/, @lines[0]); - - return join ("\n", @lines); -} -=cut -## -# Sloganizer -## -sub slogan_search { - my $content = shift; - - my ($lines) = $content =~ /
    .(.*?)<\/b>.<\/div>/is; - return $lines; -} - -## -# Compliment generator -## -sub compliment_search { - my $content = shift; - - my $lines = join ' ', $content =~ /

    (.*?)<\/h2>/is; - $lines =~ s/[\r\n]/ /g; - return $lines; -} - -## -# Insult generator -## -sub insult_search { - my $content = shift; - - my $lines = join ' ', $content =~ /
    (.+?)<\/div>/is; - $lines =~ s/[\r\n]/ /g; - return $lines; -} - -## -# Limerick DB search -## -sub limerick_preprocessor { - my $parameter = shift; - - if (!defined($parameter) || $parameter == 0) { - $parameter = 'random'; - } - - return $parameter; -} - -sub limerick_search { - my $content = shift; - - my $lines = join ' ', $content =~ /
    (.*?)<\/div>/is; - $lines =~ s/\t//g; - $lines =~ s//\n/g; - - return $lines; -} - -## -# Bash.org ID search -## -sub bash_preprocessor { - my $parameter = shift; - - if (!defined($parameter) || $parameter == 0) { - $parameter = 'random'; - } - - return $parameter; -} - -sub bash_search { - my $content = shift; - - my $lines = join ' ', $content =~ /

    (.*?)<\/p>/is; - $lines =~ s//\n/g; - return $lines; -} - -## -# Memetic.org ID search -# Preprocessor converts empty parameter to 'random' search -## -sub memetic_preprocessor { - my $parameter = shift; - - if (!defined($parameter) || $parameter == 0) { - $parameter = 'random'; - } - - return $parameter; -} - -sub memetic_search { - my $content = shift; - - my @lines = $content =~ /(.*?)<\/font>/isg; - my $lines = $lines[1]; - $lines =~ s//\n/g; - return $lines; -} - -## -# Generate a tinyurl for a given URL -# Only really useful as a privmsg -## -sub tinyurl_search { - my $content = shift; - my $term = shift; - my $server = shift; - my $nick = shift; - - my @lines = $content =~ /

    (.+?)CNdb: (.+?)<\/title>/igosm; - return "" unless defined $name && length $name; - - my @raw = $content =~ m/class="bold">(.+?)<\/td>/gosm; - return "" unless scalar(@raw); - my @lines; - while (scalar(@raw) && - $raw[0] !~ /(was this review helpful|login to rate this review|^\s*$)/i) { - - my $l = shift @raw; - push @lines, $l if $l !~ /\ /; - } - - my $output = "$name has appeared nude in:\n"; - $output .= join "\n", @lines; - - return $output; -} - -sub cndb_preprocessor { - my $parameter = shift; - - $parameter =~ s/(?<=\b)(\w)/\u$1/g; - my @parts = split /\s+/, $parameter; - my $last = pop @parts; - $last .= "," if scalar(@parts); - unshift @parts, $last; - - return join " ", @parts; -} - -## -# Horoscope search -## -sub horoscope_search { - my $content = shift; - my $term = shift; - - $content =~ s/[\r\n]/ /gsm; - my ($line) = $content =~ m|CHANGE $term HERE -->(.+)(.+)