and opt-out (news unnotify)
irchooks: splitted into IrcHelpers.pl so we can reload it on the fly.
factoids: added debugging for short factoids that may be botched up
- references
+ references
2001-04-12 21:12 dms
- Fixed warning in Modules/Uptime.pl for clean install.
- More fixes for scripts/*mysql*.pl from GmLB.
- Added command 'hex'.
- - GmLB fixed mysql2txt.pl and txt2mysql.pl. You can now import and
+ - GmLB fixed mysql2txt.pl and txt2mysql.pl. You can now import and
export to inforbot 'factpacks'.-
v1.0.0RC3 (20000720): bug fixes mainly.
- - Debian.pl's infoPackages() now checks for incoming
+ - Debian.pl's infoPackages() now checks for incoming
automatically and shows the new file.
- irq/dan found the bot wouldn't run if a stale (invalid) pid
file exists. Fixed.
- Fixed Freshmeat.pl not to show duplicate packages found by
'name' and 'oneliner' search. Made showPackage() function.
- Debian modules now does multi distro. (woody's non-us appears to
- be different structure so does not work :(, very crude hack...
+ be different structure so does not work :(, very crude hack...
may not even work).
- Added subfactoid randomising. eg: '(one|two|three)'.
- 'dauthor' now works!
v0.99pre11 (20000123):
- Fixes here and there...
- - Debian find now searches Package names. Fallback automatically
+ - Debian find now searches Package names. Fallback automatically
to contents file search.
- Fixed typo related to log cycling.
- Added netsplit detection code.
- Ability to turn off minVolunteerLength.
- More changes to prevent chatter in unaddressed manner.
- We remove any ansi or control chars when piping to the log file.
- RevHippie++.
+ RevHippie++.
- Added 'thanks' language.
- Typo in Freshmeat.pl; Fixed.
- Added $rootwarnmode = passive || aggressive to satisfy lilo@OPN.
- Edit files/blootbot.chan to set which channels to join.
- Install the following Perl modules:
- - Net::IRC perl module
- - Debian: (apt-get install libnet-irc-perl)
- - WWW::Search
- - Debian: (apt-get install libwww-search-perl)
- - LWP
- - Debian: (apt-get install libwww-perl)
- - HTML::Parser
- - Debian: (apt-get install libhtml-parser-perl)
+ - Net::IRC perl module
+ - Debian: (apt-get install libnet-irc-perl)
+ - WWW::Search
+ - Debian: (apt-get install libwww-search-perl)
+ - LWP
+ - Debian: (apt-get install libwww-perl)
+ - HTML::Parser
+ - Debian: (apt-get install libhtml-parser-perl)
- Choose your database:
- - MySQL, read INSTALL.mysql (supported)
- - SQLite, read INSTALL.sqlite (supported)
- - PgSQL, read INSTALL.pgsql (unsupported, may work)
+ - MySQL, read INSTALL.mysql (supported)
+ - SQLite, read INSTALL.sqlite (supported)
+ - PgSQL, read INSTALL.pgsql (unsupported, may work)
- There are "bugs" in the perl modules. Read INSTALL.patches on how to fix.
= Possible problems
- if connection to localhost is (short) refused, run
- '/etc/init.d/mysql stop'
- '/etc/init.d/mysql start'
+ '/etc/init.d/mysql stop'
+ '/etc/init.d/mysql start'
- if connection for user is refused, reload grant tables with
- 'mysqladmin -u root -p reload'
+ 'mysqladmin -u root -p reload'
* [OPTIONAL]
- run 'scripts/dbm2mysql.pl old-db' to convert dbm database file
SQLite sources:
-http://www.hwaci.com/sw/sqlite/
+http://www.hwaci.com/sw/sqlite/
DBD::SQLite sources:
knowledge needs to fix it up or at least unify the module with mysql.
INSTALLATION
- - Read the included INSTALL file
+ - Read the included INSTALL file
NOTICE
Be warned that this bot consumes quite a lot of memory upon start
test all modifications properly (and extensively). Suggestions are
welcomed.
- gp@OPN is currently working on a C version of infobot or
+ gp@OPN is currently working on a C version of infobot or
blootbot, not based on the above source base. Core factoid code and
mysql support works - but that is it.
you to find the cookies than for me to hand-feed them to you ;)
See 'EXAMPLES' for various usage of factoids and "hidden"
-variables. If you're hardcore, check out 'CommandStubs.pl' and
+variables. If you're hardcore, check out 'CommandStubs.pl' and
'UserExtras.pl' for cool features.
topic [help] - Topic help.
use strict;
use vars qw($bot_base_dir $bot_src_dir $bot_misc_dir $bot_state_dir
- $bot_data_dir $bot_config_dir $bot_log_dir $bot_run_dir
+ $bot_data_dir $bot_config_dir $bot_log_dir $bot_run_dir
$bot_pid $memusage %param
);
# prevent duplicate processes of the same bot
&duperuncheck();
-# initialize everything
+# initialize everything
&startup(); # first time initialization.
&setup();
if ($message =~ /^wantNick$/i) {
&addCmdHook("main", 'chan(stats|info)', ('CODEREF' => 'chaninfo', ) );
&addCmdHook("main", 'cmd(stats|info)', ('CODEREF' => 'cmdstats', ) );
-&addCmdHook("main", 'factinfo', ('CODEREF' => 'factinfo',
-&addCmdHook("main", 'factstats?', ('CODEREF' => 'factstats',
-&addCmdHook("main", 'help', ('CODEREF' => 'help',
+&addCmdHook("main", 'factinfo', ('CODEREF' => 'factinfo',
+&addCmdHook("main", 'factstats?', ('CODEREF' => 'factstats',
+&addCmdHook("main", 'help', ('CODEREF' => 'help',
&addCmdHook("main", 'karma', ('CODEREF' => 'karma', ) );
-&addCmdHook("main", 'i?spell', ('CODEREF' => 'ispell',
-&addCmdHook("main", 'd?nslookup', ('CODEREF' => 'DNS',
-&addCmdHook("main", 'tell|explain', ('CODEREF' => 'tell',
-&addCmdHook("main", 'news', ('CODEREF' => 'News::Parse',
-&addCmdHook("main", 'countrystats', ('CODEREF' => 'countryStats',
+&addCmdHook("main", 'i?spell', ('CODEREF' => 'ispell',
+&addCmdHook("main", 'd?nslookup', ('CODEREF' => 'DNS',
+&addCmdHook("main", 'tell|explain', ('CODEREF' => 'tell',
+&addCmdHook("main", 'news', ('CODEREF' => 'News::Parse',
+&addCmdHook("main", 'countrystats', ('CODEREF' => 'countryStats',
# Modules/UserDCC.pl
if ($message =~ /^(exit|quit)$/i) {
if ($message =~ /^who$/) {
has not received notification of the new topic before
changing to the second modification of the topic, it
would use the absolute first (0) topic as a reference,
- therefore missing out on the first alteration of the
+ therefore missing out on the first alteration of the
topic.
A very cheap solution exists. Edit IrcHooks.pl, search for
just 1 (total of 2), depending on the return of SELECT. If this
still persists and memory leaks are happening, first make
sure you are not using broken mysql tables, secondly bitch at the
- mysql-perl author that there is a memory leak when a broken table
+ mysql-perl author that there is a memory leak when a broken table
is in use.
Problem #5:
since __WARN__ hooks are not called from inside one.
### From 'perlvar'...
- Note that __DIE__/__WARN__ handlers are very special in one
+ Note that __DIE__/__WARN__ handlers are very special in one
respect: they may be called to report (probable) errors found by
the parser. In such a case the parser may be in inconsistent
state, so any attempt to evaluate Perl code from such a handler
= === === ==== ====== ===== ==== ====== ====
==========================================================================
- ======================================
- USER COMMANDS
- ======================================
+ ======================================
+ USER COMMANDS
+ ======================================
Command: 4op
=============
Example:
> blootbot: chanstats
<blootbot> i am on 2 channels: #blootbot #debian
- <blootbot> i've cached 5 users distributed over 2 channels.
+ <blootbot> i've cached 5 users distributed over 2 channels.
> blootbot: chanstats #blootbot
<blootbot> On #blootbot, there have been 1 Join, 1 Op and 20
- ======================================
- MODULE COMMANDS
- ======================================
+ ======================================
+ MODULE COMMANDS
+ ======================================
Command: babelfish
=============
- ======================================
- MISCELLANEOUS/FACTOID COMMANDS
- ======================================
+ ======================================
+ MISCELLANEOUS/FACTOID COMMANDS
+ ======================================
Command: forget
=============
### lets get on with business.
# set the last refresh time. fixes multiple spawn bug.
- &::dbSet("freshmeat",
+ &::dbSet("freshmeat",
{ "projectname_short" => "_" },
{ "latest_version" => time(),
"desc_short" => "dummy project to track date" }
if ($i % 200 == 0 and $i != 0) {
&::showProc();
- &::status("FM: unlocking and locking ($i): ".
+ &::status("FM: unlocking and locking ($i): ".
&::Time2String( time() - $locktime ) );
$locktime = time();
if ($flags eq "") {
$done++ if (!$done and $mod_news =~ s/\Q$op\E/$np/);
$done++ if (!$done and $mod_nnews =~ s/\Q$op\E/$np/);
- } elsif ($flags eq "g") {
+ } elsif ($flags eq "g") {
$done++ if ($mod_news =~ s/\Q$op\E/$np/g);
$done++ if ($mod_nnews =~ s/\Q$op\E/$np/g);
}
if (!$flag) {
return unless ($unread);
- # just a temporary measure not to flood ourself off the
+ # just a temporary measure not to flood ourself off the
# network with news until we get global notice() and msg()
# throttling.
if (time() - ($::cache{newsTime} || 0) < 5) {
$i = &newsS2N($_);
$sorted[$i] = $_;
}
-
+
for ($i=0; $i<=scalar(@sorted); $i++) {
my $news = $sorted[$i];
next unless (defined $news);
if (!scalar &dbGetColInfo($table)) {
return;
- }
+ }
my @results;
foreach (keys %{$table}) {
}
&ERROR("gFI: should never happen.");
-}
+}
#####
# Usage: &getFactoid($faqtoid);
=head1 NAME
-WWW::Search::Google - class for searching Google
+WWW::Search::Google - class for searching Google
=head1 SYNOPSIS
C<native_retrieve_some> is called (from C<WWW::Search::retrieve_some>)
whenever more hits are needed. It calls C<WWW::Search::http_request>
to fetch the page specified by C<{_next_url}>.
-It then parses this page, appending any search hits it finds to
+It then parses this page, appending any search hits it finds to
C<{cache}>. If it finds a ``next'' button in the text,
it sets C<{_next_url}> to point to the page for the next
set of results, otherwise it sets it to undef to indicate we''re done.
=head1 TESTING
-This module adheres to the C<WWW::Search> test suite mechanism.
+This module adheres to the C<WWW::Search> test suite mechanism.
=head1 AUTHOR
=head1 BUGS
-Google is not an easy search engine to parse in that it is capable
+Google is not an easy search engine to parse in that it is capable
of altering it's output ever so slightly on different search terms.
There may be new slight results output the author has not yet seen that
will pop at any given time for certain searches. So, if you think you see
Forgot to add new next url regex in 2.19!
2.19
-Regex work on some search results url's that has changed. Number found
+Regex work on some search results url's that has changed. Number found
return should be right now.
2.17
-Insert url as a title when no title is found.
+Insert url as a title when no title is found.
2.13
New regexp to parse newly found results format with certain search terms.
Fixed missing links / regexp crap.
2.05
-Matching overhaul to get the code parsing right due to multiple
+Matching overhaul to get the code parsing right due to multiple
tags being used by google on the hit lines. 9/25/99
2.02
=cut
#'
-
-
+
+
#####################################################################
-
+
require Exporter;
@EXPORT = qw();
@EXPORT_OK = qw();
&test('Google', '$MAINTAINER', 'one_page', '+LS'.'AM +rep'.'lication', \$TEST_RANGE, 2,99);
&test('Google', '$MAINTAINER', 'multi', 'dir'.'ty ha'.'rr'.'y bimbo', \$TEST_GREATER_THAN, 101);
ENDTESTCASES
-
+
use Carp ();
use WWW::Search(qw(generic_option strip_tags));
require WWW::SearchResult;
-
-
+
+
sub undef_to_emptystring {
return defined($_[0]) ? $_[0] : "";
}
$self->user_agent('user');
$self->{_next_to_retrieve} = 0;
$self->{'_num_hits'} = 100;
- if (!defined($self->{_options})) {
- $self->{_options} = {
- 'search_url' => 'http://www.google.com/search',
- 'num' => $self->{'_num_hits'},
- };
- };
+ if (!defined($self->{_options})) {
+ $self->{_options} = {
+ 'search_url' => 'http://www.google.com/search',
+ 'num' => $self->{'_num_hits'},
+ };
+ };
my($options_ref) = $self->{_options};
if (defined($native_options_ref)) {
# Copy in new options.
$self->{_debug} = $options_ref->{'search_debug'};
$self->{_debug} = 2 if ($options_ref->{'search_parse_debug'});
$self->{_debug} = 0 if (!defined($self->{_debug}));
-
+
# Finally figure out the url.
$self->{_base_url} =
$self->{_next_url} =
"?" . $options .
"q=" . $native_query;
}
-
+
# private
sub begin_new_hit {
my($self) = shift;
foreach ($self->split_lines($response->content())) {
next if m@^$@; # short circuit for blank lines
- if ($state == $HEADER && m/about <b>([\d,]+)<\/b>/)
+ if ($state == $HEADER && m/about <b>([\d,]+)<\/b>/)
{
my($n) = $1;
$self->approximate_result_count($n);
print STDERR "Found Total: $n\n" ;
$state = $HITS;
- }
+ }
if ($state == $HITS &&
m|<p><a href=([^\>]*)\>(.*?)</a\><br\>|i) {
my ($url, $title) = ($1,$2);
$title = "No Title" if ($title =~ /^\s+/);
$hit->title(strip_tags($title));
$state = $HITS;
- }
+ }
elsif ($state == $HITS &&
m|<a href=(.*)\>(.*?)</a><font size=-1><br><font color=green><.*?>|i) {
my ($url, $title) = ($1,$2);
$title = "No Title" if ($title =~ /^\s+/);
$hit->title(strip_tags($title));
$state = $HITS;
- }
+ }
elsif ($state == $HITS &&
m@^<p><a href=/url\?sa=U&start=\d+&q=([^<]+)\&.*?>(.*)</a><font size=-1><br>(.*)@i ||
m@^<p><a href=([^<]+)>(.*)</a>.*?<font size=-1><br>(.*)@i)
$mDesc = $mDesc . '<br>' if not $mDesc =~ m@<br>@;
$hit->description($mDesc) if (defined($hit));
$state = $HITS;
- }
- elsif ($state == $HITS && m@^(\.\.(.+))@i)
+ }
+ elsif ($state == $HITS && m@^(\.\.(.+))@i)
{
print STDERR "**Parsing Description Line**\n" if ($self->{_debug});
$raw .= $_;
$hit->description($sDesc) if $sDesc =~ m@^\.@;
$sDesc = '';
$state = $HITS;
- }
- elsif ($state == $HITS && m@<div class=nav>@i)
+ }
+ elsif ($state == $HITS && m@<div class=nav>@i)
{
($hit, $raw) = $self->begin_new_hit($hit, $raw);
print STDERR "**Found Last Line**\n" if ($self->{_debug});
# end of hits
$state = $TRAILER;
- }
- elsif ($state == $TRAILER &&
- m|<a href=([^<]+)><IMG SRC=/nav_next.gif.*?>.*?|i)
+ }
+ elsif ($state == $TRAILER &&
+ m|<a href=([^<]+)><IMG SRC=/nav_next.gif.*?>.*?|i)
{
my($relative_url) = $1;
print STDERR "**Fetching >>Next<< Page**\n" if ($self->{_debug});
}
} else {
# infobot dbm to blootbot sql support.
- &sqlReplace("factoids", {
+ &sqlReplace("factoids", {
factoid_key => $_,
factoid_value => $db{$_},
} );
elsif ($line =~ /^>\;>\;>\; /) {
$line =~ s/^>\;>\;>\; /\*\*\* /;
-
+
# Process changed nick results, and remember colours accordingly #
if ($line =~ /\*\*\* (.*?) are|is now known as (.*)/) {
my $nick_old;
my $what = $_[0];
my $salt = chr(65+rand(27)).chr(65+rand(27));
$salt =~ s/\W/x/g;
-
+
return crypt($what, $salt);
}
sub pretty_print {
my $var;
foreach $var (@_) {
- if (ref ($var)) {
- print_ref($var);
- } else {
- print_scalar($var);
- }
+ if (ref ($var)) {
+ print_ref($var);
+ } else {
+ print_scalar($var);
+ }
}
}
sub print_ref {
my $r = $_[0];
if (exists ($already_seen{$r})) {
- print_indented ("$r (Seen earlier)");
- return;
+ print_indented ("$r (Seen earlier)");
+ return;
} else {
- $already_seen{$r}=1;
+ $already_seen{$r}=1;
}
my $ref_type = ref($r);
if ($ref_type eq "ARRAY") {
- print_array($r);
+ print_array($r);
} elsif ($ref_type eq "SCALAR") {
- print "Ref -> $r";
- print_scalar($$r);
+ print "Ref -> $r";
+ print_scalar($$r);
} elsif ($ref_type eq "HASH") {
- print_hash($r);
+ print_hash($r);
} elsif ($ref_type eq "REF") {
- ++$level;
- print_indented("Ref -> ($r)");
- print_ref($$r);
- --$level;
+ ++$level;
+ print_indented("Ref -> ($r)");
+ print_ref($$r);
+ --$level;
} else {
- print_indented ("$ref_type (not supported)");
+ print_indented ("$ref_type (not supported)");
}
}
++$level;
print_indented ("[ # $r_array");
foreach $var (@$r_array) {
- if (ref ($var)) {
- print_ref($var);
- } else {
- print_scalar($var);
- }
+ if (ref ($var)) {
+ print_ref($var);
+ } else {
+ print_scalar($var);
+ }
}
print_indented ("]");
--$level;
sub print_hash {
my($r_hash) = @_;
my($key, $val);
- ++$level;
+ ++$level;
print_indented ("{ # $r_hash");
while (($key, $val) = each %$r_hash) {
- $val = ($val ? $val : '""');
- ++$level;
- if (ref ($val)) {
- print_indented ("$key => ");
- print_ref($val);
- } else {
- print_indented ("$key => $val");
- }
- --$level;
+ $val = ($val ? $val : '""');
+ ++$level;
+ if (ref ($val)) {
+ print_indented ("$key => ");
+ print_ref($val);
+ } else {
+ print_indented ("$key => $val");
+ }
+ --$level;
}
print_indented ("}");
--$level;
sub pretty_print {
my $var;
foreach $var (@_) {
- if (ref ($var)) {
- print_ref($var);
- } else {
- print_scalar($var);
- }
+ if (ref ($var)) {
+ print_ref($var);
+ } else {
+ print_scalar($var);
+ }
}
}
sub print_ref {
my $r = $_[0];
if (exists ($already_seen{$r})) {
- print_indented ("$r (Seen earlier)");
- return;
+ print_indented ("$r (Seen earlier)");
+ return;
} else {
- $already_seen{$r}=1;
+ $already_seen{$r}=1;
}
my $ref_type = ref($r);
if ($ref_type eq "ARRAY") {
- print_array($r);
+ print_array($r);
} elsif ($ref_type eq "SCALAR") {
- print "Ref -> $r";
- print_scalar($$r);
+ print "Ref -> $r";
+ print_scalar($$r);
} elsif ($ref_type eq "HASH") {
- print_hash($r);
+ print_hash($r);
} elsif ($ref_type eq "REF") {
- ++$level;
- print_indented("Ref -> ($r)");
- print_ref($$r);
- --$level;
+ ++$level;
+ print_indented("Ref -> ($r)");
+ print_ref($$r);
+ --$level;
} else {
- print_indented ("$ref_type (not supported)");
+ print_indented ("$ref_type (not supported)");
}
}
++$level;
print_indented ("[ # $r_array");
foreach $var (@$r_array) {
- if (ref ($var)) {
- print_ref($var);
- } else {
- print_scalar($var);
- }
+ if (ref ($var)) {
+ print_ref($var);
+ } else {
+ print_scalar($var);
+ }
}
print_indented ("]");
--$level;
sub print_hash {
my($r_hash) = @_;
my($key, $val);
- ++$level;
+ ++$level;
print_indented ("{ # $r_hash");
while (($key, $val) = each %$r_hash) {
- $val = ($val ? $val : '""');
- ++$level;
- if (ref ($val)) {
- print_indented ("$key => ");
- print_ref($val);
- } else {
- print_indented ("$key => $val");
- }
- --$level;
+ $val = ($val ? $val : '""');
+ ++$level;
+ if (ref ($val)) {
+ print_indented ("$key => ");
+ print_ref($val);
+ } else {
+ print_indented ("$key => $val");
+ }
+ --$level;
}
print_indented ("}");
--$level;
### COMMAND HOOK IMPLEMENTATION.
# addCmdHook("SECTION", 'TEXT_HOOK',
-# (CODEREF => 'Blah',
+# (CODEREF => 'Blah',
# Forker => 1,
# CheckModule => 1, # ???
# Module => 'blah.pl' # preload module.
'Forker' => 1, 'Identifier' => 'kernel',
'Cmdstats' => 'Kernel', 'NoArgs' => 1) );
&addCmdHook("extra", 'listauth', ('CODEREF' => 'CmdListAuth',
- 'Identifier' => 'search', Module => 'factoids',
+ 'Identifier' => 'search', Module => 'factoids',
'Help' => 'listauth') );
&addCmdHook("extra", 'quote', ('CODEREF' => 'Quote::Quote',
'Forker' => 1, 'Identifier' => 'quote',
s/,?\s*(pretty )*please\??\s*$/\?/i;
# what country is ...
- if ($in =~
+ if ($in =~
s/wh(at|ich)\s+(add?res?s|country|place|net (suffix|domain))/wh$1 /ig) {
if ((length($in) == 2) && ($in !~ /^\./)) {
$in = '.'.$in;
$message =~ tr/A-Z/a-z/;
$message =~ s/^cmd:/CMD:/;
- my ($count, $fauthor, $result) = &sqlSelect("factoids",
+ my ($count, $fauthor, $result) = &sqlSelect("factoids",
"requested_count,created_by,factoid_value",
{ factoid_key => $message }
);
foreach $type (keys %dcc) {
next if ($type ne uc($type));
-
+
my $nick;
foreach $nick (keys %{ $dcc{$type} }) {
next unless (defined $nick);
$v++;
# don't allow ppl to cheat the stats :-)
- if (defined $t && $time - $t > 60) {
+ if (defined $t && $time - $t > 60) {
&sqlReplace("stats", {
nick => $who,
type => $x,
my $time = time();
foreach (@list) {
- my $age = &getFactInfo($_, "modified_time");
+ my $age = &getFactInfo($_, "modified_time");
if (!defined $age or $age !~ /^\d+$/) {
if (scalar @list > 50) {
} else { # the real thing.
return [gettimeofday()];
}
-}
+}
sub timedelta {
my($start_time) = shift;
$monname = (&sqlRawReturn("SELECT MONTHNAME('$sqldate')"))[0];
} elsif ($param{'DBType'} =~ /^pgsql$/i) {
- $to_days = (&sqlRawReturn("SELECT date_trunc('day',
+ $to_days = (&sqlRawReturn("SELECT date_trunc('day',
'now'::timestamp - '$sqldate')"))[0];
$dayname = qw(Sun Mon Tue Wed Thu Fri Sat)[(&sqlRawReturn("SELECT extract(dow from timestamp '$sqldate')"))[0]];
$monname = qw(BAD Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[(&sqlRawReturn("SELECT extract(month from timestamp '$sqldate')"))[0]];
my ($message) = @_;
&::DEBUG("exchange(@_)");
- return "Exchange.pl needs LWP::UserAgent and HTTP::Request::Common"
+ return "Exchange.pl needs LWP::UserAgent and HTTP::Request::Common"
if ($no_exchange);
my ($From, $To, $Amount, $Country);
}
my $ua = new LWP::UserAgent;
- #$ua->agent("Mozilla/5.0 " . $ua->agent); # Let's pretend
- $ua->agent("Mozilla/5.0"); # Let's pretend
+ # Let's pretend
+ #$ua->agent("Mozilla/5.0 " . $ua->agent);
+ $ua->agent("Mozilla/5.0");
$ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
$ua->timeout(10);
if ($Country) {
# Country lookup
- # crysflame++ for the space fix.
+ # crysflame++ for the space fix.
$retval = '';
foreach my $Found (grep /$Country/i, keys %CurrLookup){
$Found =~ s/,/ uses/g;
# Falsify where we came from
$req->referer($Referer);
- my $res = $ua->request($req); # Submit request
+ # Submit request
+ my $res = $ua->request($req);
- if ($res->is_success) { # Went through ok
+ if ($res->is_success) {
+ # Went through ok
my $html = $res->as_string;
# parse each one to avoid undefined warnings
my ($When) = ($html =~ m/ as of (\d{4}\.\d\d.\d\d\s\d\d:\d\d:\d\d\s\S+)/gi);
} else {
return "i got some error trying that";
}
- } else { # Oh dear.
+ } else {
+ # Oh dear.
return "EXCHANGE: ". $res->status_line;
}
} else {
return &formListReply(0, $prefix, @list);
} elsif ($type =~ /^vandalism$/i) {
- &status("factstats(vandalism): starting...");
+ &status("factstats(vandalism): starting...");
my $start_time = &timeget();
my %data = &sqlSelectColHash("factoids",
"factoid_key,factoid_value", undef,
my @list;
my $delta_time = &timedelta($start_time);
- &status(sprintf("factstats(vandalism): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
+ &status(sprintf("factstats(vandalism): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
$start_time = &timeget();
# parse the factoids.
}
$delta_time = &timedelta($start_time);
- &status(sprintf("factstats(vandalism): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
+ &status(sprintf("factstats(vandalism): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
# bail out on no results.
if (scalar @list == 0) {
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^total$/i) {
- &status("factstats(total): starting...");
+ &status("factstats(total): starting...");
my $start_time = &timeget();
my @list;
my $str;
### end of "job".
my $delta_time = &timedelta($start_time);
- &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
+ &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
$start_time = &timeget();
# bail out on no results.
return &formListReply(1, $prefix, @newlist);
} elsif ($type =~ /^dup(licate|e)$/i) {
- &status("factstats(dupe): starting...");
+ &status("factstats(dupe): starting...");
my $start_time = &timeget();
- my %hash = &sqlSelectColHash("factoids",
+ my %hash = &sqlSelectColHash("factoids",
"factoid_key,factoid_value", undef,
"WHERE factoid_value IS NOT NULL", 1
);
&status("factstats(dupe): (good) dupe refs: $refs.");
my $delta_time = &timedelta($start_time);
- &status(sprintf("factstats(dupe): %.02f sec to complete", $delta_time)) if ($delta_time > 0);
+ &status(sprintf("factstats(dupe): %.02f sec to complete", $delta_time)) if ($delta_time > 0);
# bail out on no results.
if (scalar @list == 0) {
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^locked$/i) {
- my %hash = &sqlSelectColhash("factoids",
+ my %hash = &sqlSelectColhash("factoids",
"factoid_key,locked_by", undef,
"WHERE locked_by IS NOT NULL"
);
}
my $delta_time = sprintf("%.02fs", &timedelta($start_time) );
- &status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0);
+ &status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0);
# bail out on no results.
if (scalar @list == 0) {
return unless &::loadPerlModule("Net::HTTP::NB");
return unless &::loadPerlModule("IO::Select");
- my $s = Net::HTTP::NB->new(Host => $HOST) || return;
- $s->write_request(HEAD => "/");
+ my $s = Net::HTTP::NB->new(Host => $HOST) || return;
+ $s->write_request(HEAD => "/");
- my $sel = IO::Select->new($s);
- $line = "Header timeout" unless $sel->can_read(10);
- ($code, $mess, %h) = $s->read_response_headers;
+ my $sel = IO::Select->new($s);
+ $line = "Header timeout" unless $sel->can_read(10);
+ ($code, $mess, %h) = $s->read_response_headers;
- $line = (length($h{Server}) > 0) ? $h{Server} :
- "Couldn't fetch headers from $HOST";
+ $line = (length($h{Server}) > 0) ? $h{Server} :
+ "Couldn't fetch headers from $HOST";
&::pSReply($line||"Unknown Error Condition");
if ($flags eq "") {
$done++ if (!$done and $mod_news =~ s/\Q$op\E/$np/);
$done++ if (!$done and $mod_nnews =~ s/\Q$op\E/$np/);
- } elsif ($flags eq "g") {
+ } elsif ($flags eq "g") {
$done++ if ($mod_news =~ s/\Q$op\E/$np/g);
$done++ if ($mod_nnews =~ s/\Q$op\E/$np/g);
}
if (!$flag) {
return unless ($unread);
- # just a temporary measure not to flood ourself off the
+ # just a temporary measure not to flood ourself off the
# network with news until we get global notice() and msg()
# throttling.
if (time() - ($::cache{newsTime} || 0) < 5) {
$i = &newsS2N($_);
$sorted[$i] = $_;
}
-
+
for ($i=0; $i<=scalar(@sorted); $i++) {
my $news = $sorted[$i];
next unless (defined $news);
my ($ticker, $recent, $date, $time, $change, $open,
$high, $low, $volume) = split(',',$result);
- # add some commas
- # "+ 0" removes trailing cr/lf/etc.
+ # add some commas
+ # "+ 0" removes trailing cr/lf/etc.
my $newvol = commify($volume + 0);
$reply .= ' ;; ' if $reply;
# Units.pl: convert units of measurement
# Author: M-J. Dominus (mjd-perl-units-id-iut+buobvys+@plover.com)
-# License: GPL, Copyright (C) 1996,1999
+# License: GPL, Copyright (C) 1996,1999
# NOTE: Integrated into blootbot by xk.
package Units;
} else {
&::performStrictReply("$from cannot be correctly converted to $to.");
-# print
+# print
# "conformability (Not the same dimension)\n",
# "\t", $from, " is ", text_unit($hu), "\n",
# "\t", $to, " is ", text_unit($wu), "\n",
print ">>> $_\n" if $DEBUG_d;
my $r = definition_line($_);
unless (defined $r) {
- warn "Error in line $. of $file: $PARSE_ERROR. Skipping.\n";
+ warn "Error in line $. of $file: $PARSE_ERROR. Skipping.\n";
}
}
print STDERR "Loaded file `$file'.\n" if $show_file_loading;
$text .= " $d";
$text .= "^$e" if $e > 1;
}
-
+
$text;
}
################################################################
BEGIN {
sub sh { ['shift', $_[0]] };
sub go { ['goto', $_[0]] };
- @actions =
+ @actions =
(
# Initial state
{PREFIX => sh(1),
DIVIDE => sh(12),
_ => ['reduce', 1, 'topunit'],
},
- # State 8: unit -> constant . unit
+ # State 8: unit -> constant . unit
# unit -> constant .
{PREFIX => sh(1),
NUMBER => sh(2), # Shift-reduce conflict resolved in favor of shift
},
# State 11: unit -> unit TIMES . unit
{PREFIX => sh(1),
- NUMBER => sh(2),
+ NUMBER => sh(2),
NAME => sh(3),
FUNDAMENTAL => sh(4),
FRACTION => sh(5),
},
# State 12: unit -> unit DIVIDE . unit
{PREFIX => sh(1),
- NUMBER => sh(2),
+ NUMBER => sh(2),
NAME => sh(3),
FUNDAMENTAL => sh(4),
FRACTION => sh(5),
},
# State 13: unit -> unit . TIMES unit
# unit -> unit . DIVIDE unit
- # unit -> constant unit .
+ # unit -> constant unit .
# unit -> unit . NUMBER
{NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift
TIMES => sh(11), # Shift-reduce conflict resolved in favor of shift
# State 14: unit => '(' unit ')' .
{ _ => ['reduce', 3, 'unit', sub {$_[1]}] },
# State 15: unit -> unit . TIMES unit
- # unit -> unit TIMES unit .
+ # unit -> unit TIMES unit .
# unit -> unit . DIVIDE unit
- # unit -> unit . NUMBER
+ # unit -> unit . NUMBER
{NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift
_ => ['reduce', 3, 'unit', sub {unit_multiply($_[0], $_[2])}],
},
# State 16: unit -> unit . TIMES unit
- # unit -> unit DIVIDE unit .
- # unit -> unit . DIVIDE unit
- # unit -> unit . NUMBER
+ # unit -> unit DIVIDE unit .
+ # unit -> unit . DIVIDE unit
+ # unit -> unit . NUMBER
{NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift
_ => ['reduce', 3, 'unit', sub{unit_divide($_[2], $_[0])}],
},
$PARSE_ERROR = 'Syntax error';
return Zero;
}
-
+
my ($primary, @actargs) = @$action;
print STDERR " $primary (@actargs)\n" if $DEBUG_p;
if ($primary eq 'accept') {
push @state_st, $STATE;
# $STATE = $state_st[-1];
print STDERR "Post-reduction state is $STATE.\n" if $DEBUG_p;
-
+
# Now look for `goto' actions
my $goto = $actions[$STATE]{$result_type};
unless ($goto && $goto->[0] eq 'goto') {
sub lex {
my ($s) = @_;
my @t = split /(
- \*{3} # Special `new unit' symbol
- | [()*-] # Symbol
- | \s*(?:\/|\bper\b)\s* # Division
- | \d*\.\d+(?:[eE]-?\d+)? # Decimal number
- | \d+\|\d+ # Fraction
- | \d+ # Integer
-# | (?:$PREF)-? # Prefix (handle differently)
+ \*{3} # Special `new unit' symbol
+ | [()*-] # Symbol
+ | \s*(?:\/|\bper\b)\s* # Division
+ | \d*\.\d+(?:[eE]-?\d+)? # Decimal number
+ | \d+\|\d+ # Fraction
+ | \d+ # Integer
+# | (?:$PREF)-? # Prefix (handle differently)
| [A-Za-z_][A-Za-z_.]* # identifier
- | \s+ # White space
- )/ox, $s;
+ | \s+ # White space
+ )/ox, $s;
@t = grep {$_ ne ''} @t; # Discard empty and all-white tokens
\@t;
}
$ua->timeout(10);
my $request = new HTTP::Request('GET', "http://weather.noaa.gov/weather/current/$station.html");
- my $response = $ua->request($request);
+ my $response = $ua->request($request);
if (!$response->is_success) {
if ($response->code == 404) {
# expects.
use vars qw!%lang_code $lang_regex!;
%lang_code = (
- 'fr' => 'fr',
- 'sp' => 'es',
- 'es' => 'es',
- 'po' => 'pt',
- 'pt' => 'pt',
- 'it' => 'it',
- 'ge' => 'de',
- 'de' => 'de',
- 'gr' => 'de',
- 'en' => 'en',
- 'zh' => 'zh',
- 'ja' => 'ja',
- 'jp' => 'ja',
- 'ko' => 'ko',
- 'kr' => 'ko',
- 'ru' => 'ru'
- );
+ 'fr' => 'fr',
+ 'sp' => 'es',
+ 'es' => 'es',
+ 'po' => 'pt',
+ 'pt' => 'pt',
+ 'it' => 'it',
+ 'ge' => 'de',
+ 'de' => 'de',
+ 'gr' => 'de',
+ 'en' => 'en',
+ 'zh' => 'zh',
+ 'ja' => 'ja',
+ 'jp' => 'ja',
+ 'ko' => 'ko',
+ 'kr' => 'ko',
+ 'ru' => 'ru'
+ );
# Here's how we recognize the language you're asking for. It looks
# like RTSL saves you a few keystrokes in #perl, huh?
my $ua = new LWP::UserAgent;
$ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
- $ua->agent("Mozilla/4.5 " . $ua->agent); # Let's pretend
+ # Let's pretend
+ $ua->agent("Mozilla/4.5 " . $ua->agent);
$ua->timeout(5);
my $req =
if (0) {
if (-t STDIN) {
- #my $result = babel::babelfish('en','sp','hello world');
- #my $result = babel::babelfish('en','sp','The cheese is old and moldy, where is the bathroom?');
- my $result = babel::babelfish('en','gr','doesn\'t seem to translate things longer than 40 characters');
- $result =~ s/; /\n/g;
- print "Babelfish says: \"$result\"\n";
+ #my $result = babel::babelfish('en','sp','hello world');
+ #my $result = babel::babelfish('en','sp','The cheese is old and moldy, where is the bathroom?');
+ my $result = babel::babelfish('en','gr','doesn\'t seem to translate things longer than 40 characters');
+ $result =~ s/; /\n/g;
+ print "Babelfish says: \"$result\"\n";
}
}
$line = "No luck, $::who" unless (defined $line);
- if ($insultwho ne $::who) {
+ if ($insultwho ne $::who) {
$line =~ s/^\s*You are/$insultwho is/i;
}
}
my $request = new HTTP::Request('GET', "$searchpath");
- my $response = $ua->request($request);
+ my $response = $ua->request($request);
if (!$response->is_success) {
return "Something failed in connecting to the ZFI web server. Try again later.";
}
my $request = new HTTP::Request('GET', "$searchpath");
- my $response = $ua->request($request);
+ my $response = $ua->request($request);
if (!$response->is_success) {
return "Something failed in connecting to the ZSI web server. Try again later.";
my $time;
my $shmmsg = &shmRead($shm);
- $shmmsg =~ s/\0//g; # remove padded \0's.
+ # remove padded \0's.
+ $shmmsg =~ s/\0//g;
return if (length($shmmsg) == 0);
if ($shmmsg =~ s/^(\S+):(\d+):(\d+): //) {
my $n = $1;
sub karma {
my $target = lc( shift || $who );
my $karma = &sqlSelect("stats", "counter",
- { nick => $target, type => "karma" }) || 0;
+ { nick => $target, type => "karma" }) || 0;
if ($karma != 0) {
&pSReply("$target has karma of $karma");
$target = $talkchannel if ($target =~ /^us$/i);
$target = $who if ($target =~ /^(me|myself)$/i);
- &status("tell: target = $target, query = $query");
+ &status("tell: target = $target, query = $query");
# "intrusive".
# if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) {
$result = $match." is ".$x unless ($x =~ /^\s*$/);
} else {
$result = "I can't seem to find that address in DNS";
- }
+ }
} else {
);
### hash. MUST BE REDUCED IN SIZE!!!
-#
+#
use vars qw(%count %netsplit %netsplitservers %flood %dcc %orig
%nuh %talkWho %seen %floodwarn %param %dbh %ircPort
%topic %moduleAge %last %time %mask %file
return 0;
}
- # should we use IsParam() externally where needed or hack it in
+ # should we use IsParam() externally where needed or hack it in
# here just in case? fix it later.
if (&IsParam($param)) {
&DEBUG("ICC: found '$param' option in main config file.");
return 0;
}
- # this looks evil...
+ # this looks evil...
if (0 and !defined $chan) {
&DEBUG("gCC: ok !chan... doing _default instead.");
}
$str =~ s/\*/%/g;
# end of string fix.
- my $query = "SELECT $select FROM $table WHERE $key LIKE ".
+ my $query = "SELECT $select FROM $table WHERE $key LIKE ".
&sqlQuote($str);
my $sth = $dbh->prepare($query);
&ERROR("require \"$mod\" => $@");
&shutdown();
exit 1;
- }
+ }
$moduleAge{$mod} = (stat $mod)[9];
&showProc(" ($_)") if (&IsParam("DEBUG"));
# obscure usage of map and regex :)
foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) {
- $retval .= &reloadModule($_);
+ $retval .= &reloadModule($_);
}
&VERB("Module: reloading done.",2);
my ($tmp) = @_;
if (!defined $tmp) {
&WARN("loadMyModule: module is NULL.");
- return 0;
+ return 0;
}
my ($modulename, $modulebase);
my($dir) = @_;
if (!opendir(DIR, $dir)) {
- &ERROR("Cannot open source directory ($dir): $!");
- exit 1;
+ &ERROR("Cannot open source directory ($dir): $!");
+ exit 1;
}
my @mods;
projects / infobot.git / commitdiff