# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
#
-if (&IsParam("useStrict")) { use strict; }
+use strict;
+
+use vars qw(%file %mask %param %cmdstats %myModules);
+use vars qw($msgType $who $bot_pid $nuh $shm $force_public_reply
+ $no_timehires $bot_data_dir $addrchar);
sub help {
- my $topic = $_[0];
- my $file = $bot_misc_dir."/blootbot.help";
+ my $topic = shift;
+ my $file = $bot_data_dir . '/infobot.help';
my %help = ();
- if (!open(FILE, $file)) {
- &ERROR("FAILED loadHelp ($file): $!");
- return;
+ # crude hack for performStrictReply() to work as expected.
+ $msgType = 'private' if ( $msgType eq 'public' );
+
+ if ( !open( FILE, $file ) ) {
+ &ERROR("Failed reading help file ($file): $!");
+ return;
}
- while (defined(my $help = <FILE>)) {
- $help =~ s/^[\# ].*//;
- chomp $help;
- next unless $help;
- my ($key, $val) = split(/:/, $help, 2);
+ while ( defined( my $help = <FILE> ) ) {
+ $help =~ s/^[\# ].*//;
+ chomp $help;
+ next unless $help;
+ my ( $key, $val ) = split( /:/, $help, 2 );
- $val =~ s/^\s+//;
- $val =~ s/^D:/\002 Desc\002:/;
- $val =~ s/^E:/\002Example\002:/;
- $val =~ s/^N:/\002 NOTE\002:/;
- $val =~ s/^U:/\002 Usage\002:/;
- $val =~ s/##/$key/;
- $val =~ s/__/\037/g;
- $val =~ s/==/ /;
+ $val =~ s/^\s+//;
+ $val =~ s/^D:/\002 Desc\002:/;
+ $val =~ s/^E:/\002Example\002:/;
+ $val =~ s/^N:/\002 NOTE\002:/;
+ $val =~ s/^U:/\002 Usage\002:/;
+ $val =~ s/##/$key/;
+ $val =~ s/__/\037/g;
+ $val =~ s/==/ /;
- $help{$key} = "" if (!exists $help{$key});
- $help{$key} .= $val."\n";
+ $help{$key} = '' if ( !exists $help{$key} );
+ $help{$key} .= $val . "\n";
}
close FILE;
- if (!defined $topic) {
- &msg($who, $help{'main'});
+ if ( !defined $topic or $topic eq '' ) {
+ &msg( $who, $help{'main'} );
- my $i = 0;
- my @array;
- my $count = scalar(keys %help);
- my $reply;
- foreach (sort keys %help) {
- push(@array,$_);
- $reply = scalar(@array) ." topics: ".
- join("\002,\002 ", @array);
- $i++;
+ my $i = 0;
+ my @array;
+ my $count = scalar( keys %help );
+ my $reply;
+ foreach ( sort keys %help ) {
+ push( @array, $_ );
+ $reply =
+ scalar(@array) . ' topics: ' . join( "\002,\002 ", @array );
+ $i++;
- if (length $reply > 400 or $count == $i) {
- &msg($who,$reply);
- undef @array;
- }
- }
+ if ( length $reply > 400 or $count == $i ) {
+ &msg( $who, $reply );
+ undef @array;
+ }
+ }
- return '';
+ return '';
}
- $topic = &fixString(lc $topic);
+ $topic = &fixString( lc $topic );
- if (exists $help{$topic}) {
- foreach (split /\n/, $help{$topic}) {
- &msg($who,$_);
- }
- } else {
- &msg($who, "no help on $topic. Use 'help' without arguments.");
+ if ( exists $help{$topic} ) {
+ foreach ( split /\n/, $help{$topic} ) {
+ &performStrictReply($_);
+ }
+ }
+ else {
+ &performStrictReply(
+ "no help on $topic. Use 'help' without arguments.");
}
return '';
my ($pathnfile) = @_;
### TODO: gotta hate an if statement.
- if ($pathnfile =~ /(.*)\/(.*?)$/) {
- return $1;
- } else {
- return ".";
+ if ( $pathnfile =~ /(.*)\/(.*?)$/ ) {
+ return $1;
+ }
+ else {
+ return '.';
}
}
-sub gettimeofday {
- if ($no_syscall) { # fallback.
- return time();
- } else { # the real thing.
- my $time = pack("LL", 0);
+sub timeget {
+ if ($no_timehires) { # fallback.
+ return time();
+ }
+ else { # the real thing.
+ return [ gettimeofday() ];
+ }
+}
- syscall(&SYS_gettimeofday, $time, 0);
- my @time = unpack("LL",$time);
+sub timedelta {
+ my ($start_time) = shift;
- return sprintf("%d.%d", @time);
+ if ($no_timehires) { # fallback.
+ return time() - $start_time;
+ }
+ else { # the real thing.
+ return tv_interval($start_time);
}
}
###
# Usage; &formListReply($rand, $prefix, @list);
sub formListReply {
- my($rand, $prefix, @list) = @_;
- my $total = scalar @list;
- my $maxshow = $param{'maxListReplyCount'} || 10;
- my $maxlen = $param{'maxListReplyLength'} || 400;
+ my ( $rand, $prefix, @list ) = @_;
+ my $total = scalar @list;
+ my $maxshow = &getChanConfDefault( 'maxListReplyCount', 15, $chan );
+ my $maxlen = &getChanConfDefault( 'maxListReplyLength', 400, $chan );
my $reply;
+ # remove irc overhead
+ $maxlen -= 30;
+
# no results.
- return $prefix ."returned no results." unless ($total);
+ return $prefix . 'returned no results.' unless ($total);
# random.
if ($rand) {
- my @rand;
- foreach (&makeRandom($total)) {
- push(@rand, $list[$_]);
- last if (scalar @rand == $maxshow);
- }
- @list = @rand;
- } elsif ($total > $maxshow) {
- &status("formListReply: truncating list.");
+ my @rand;
+ foreach ( &makeRandom($total) ) {
+ push( @rand, $list[$_] );
+ last if ( scalar @rand == $maxshow );
+ }
+ if ( $total > $maxshow ) {
+ @list = sort @rand;
+ }
+ else {
+ @list = @rand;
+ }
+ }
+ elsif ( $total > $maxshow ) {
+ &status('formListReply: truncating list.');
- @list = @list[0..$maxshow-1];
+ @list = @list[ 0 .. $maxshow - 1 ];
}
# form the reply.
+ # FIXME: should grow and exit when full, not discard any that are oversize
while () {
- $reply = $prefix ."(\002". scalar(@list). "\002 shown";
- $reply .= "; \002$total\002 total" if ($total != scalar @list);
- $reply .= "): ". join(" \002;;\002 ",@list) .".";
+ $reply = $prefix . "(\002" . scalar(@list) . "\002";
+ $reply .= " of \002$total\002" if ( $total != scalar @list );
+ $reply .= '): ' . join( " \002;;\002 ", @list ) . '.';
- last if (length($reply) < $maxlen and scalar(@list) <= $maxshow);
- last if (scalar(@list) == 1);
+ last if ( length($reply) < $maxlen and scalar(@list) <= $maxshow );
+ last if ( scalar(@list) == 1 );
- pop @list;
+ pop @list;
}
return $reply;
### Intelligence joining of arrays.
# Usage: &IJoin(@array);
sub IJoin {
- if (!scalar @_) {
- return "NULL";
- } elsif (scalar @_ == 1) {
- return $_[0];
- } else {
- return join(', ',@{_}[0..$#_-1]) . " and $_[$#_]";
+ if ( !scalar @_ ) {
+ return 'NULL';
+ }
+ elsif ( scalar @_ == 1 ) {
+ return $_[0];
+ }
+ else {
+ return join( ', ', @{_}[ 0 .. $#_ - 1 ] ) . " and $_[$#_]";
}
}
#####
# Usage: &Time2String(seconds);
sub Time2String {
- my $time = shift;
- my $retval;
+ my ($time) = @_;
+ my $prefix = '';
+ my ( @s, @t );
- return("0s") if ($time !~ /\d+/ or $time <= 0);
+ return 'NULL' if ( !defined $time );
+ return $time if ( $time !~ /\d+/ );
- my $s = int($time) % 60;
- my $m = int($time / 60) % 60;
- my $h = int($time / 3600) % 24;
- my $d = int($time / 86400);
+ if ( $time < 0 ) {
+ $time = -$time;
+ $prefix = '- ';
+ }
- $retval .= sprintf(" \002%d\002d", $d) if ($d != 0);
- $retval .= sprintf(" \002%d\002h", $h) if ($h != 0);
- $retval .= sprintf(" \002%d\002m", $m) if ($m != 0);
- $retval .= sprintf(" \002%d\002s", $s) if ($s != 0);
+ $t[0] = int($time) % 60;
+ $t[1] = int( $time / 60 ) % 60;
+ $t[2] = int( $time / 3600 ) % 24;
+ $t[3] = int( $time / 86400 );
- return substr($retval, 1);
+ push( @s, "$t[3]d" ) if ( $t[3] != 0 );
+ push( @s, "$t[2]h" ) if ( $t[2] != 0 );
+ push( @s, "$t[1]m" ) if ( $t[1] != 0 );
+ push( @s, "$t[0]s" ) if ( $t[0] != 0 or !@s );
+
+ my $retval = $prefix . join( ' ', @s );
+ $retval =~ s/(\d+)/\002$1\002/g;
+ return $retval;
}
###
# generate a hash list.
foreach (@files) {
- if (/^(.*\/)(.*?)$/) {
- $files{$1}{$2} = 1;
- }
+ next unless /^(.*\/)(.*?)$/;
+
+ $files{$1}{$2} = 1;
}
- @files = (); # reuse the array.
+ @files = (); # reuse the array.
# sort the hash list appropriately.
- foreach (sort keys %files) {
- my $file = $_;
- my @keys = sort keys %{$files{$file}};
- my $i = scalar(@keys);
+ foreach ( sort keys %files ) {
+ my $file = $_;
+ my @keys = sort keys %{ $files{$file} };
+ my $i = scalar(@keys);
- if ($i > 1) {
- $file .= "\002{\002". join("\002|\002", @keys) ."\002}\002";
- } else {
- $file .= $keys[0];
- }
+ if ( scalar @keys > 3 ) {
+ pop @keys while ( scalar @keys > 3 );
+ push( @keys, '...' );
+ }
- push(@files,$file);
+ if ( $i > 1 ) {
+ $file .= "\002{\002" . join( "\002|\002", @keys ) . "\002}\002";
+ }
+ else {
+ $file .= $keys[0];
+ }
+
+ push( @files, $file );
}
return @files;
# Usage: &fixString($str);
sub fixString {
- my ($str, $level) = @_;
- if (!defined $str) {
- &WARN("fixString: str == NULL.");
- return '';
+ my ( $str, $level ) = @_;
+ if ( !defined $str ) {
+ &WARN('fixString: str == NULL.');
+ return '';
}
for ($str) {
- s/^\s+//; # remove start whitespaces.
- s/\s+$//; # remove end whitespaces.
- s/\s+/ /g; # remove excessive whitespaces.
+ s/^\s+//; # remove start whitespaces.
+ s/\s+$//; # remove end whitespaces.
+ s/\s+/ /g; # remove excessive whitespaces.
- next unless (defined $level);
- &DEBUG("strip control chars?");
- s/[\cA-\c_]//ig # remove control characters.
+ next unless ( defined $level );
+ if (s/[\cA-\c_]//ig) { # remove control characters.
+ &DEBUG('stripped control chars');
+ }
}
return $str;
# Usage: &fixPlural($str,$int);
sub fixPlural {
- my ($str,$int) = @_;
-
- if ($str eq "has") {
- $str = "have" if ($int > 1);
- } elsif ($str eq "is") {
- $str = "are" if ($int > 1);
- } elsif ($str eq "was") {
- $str = "were" if ($int > 1);
- } elsif ($str eq "this") {
- $str = "these" if ($int > 1);
- } elsif ($str =~ /y$/) {
- if ($int > 1) {
- if ($str =~ /ey$/) {
- $str .= "s"; # eg: "money" => "moneys".
- } else {
- $str =~ s/y$/ies/;
- }
- }
- } else {
- $str .= "s" if ($int != 1);
+ my ( $str, $int ) = @_;
+
+ if ( !defined $str ) {
+ &WARN('fixPlural: str == NULL.');
+ return;
}
- return $str;
-}
+ if ( !defined $int or $int =~ /^\D+$/ ) {
+ &WARN('fixPlural: int != defined or int');
+ return $str;
+ }
+ if ( $str eq 'has' ) {
+ $str = 'have' if ( $int > 1 );
+ }
+ elsif ( $str eq 'is' ) {
+ $str = 'are' if ( $int > 1 );
+ }
+ elsif ( $str eq 'was' ) {
+ $str = 'were' if ( $int > 1 );
+ }
+ elsif ( $str eq 'this' ) {
+ $str = 'these' if ( $int > 1 );
+ }
+ elsif ( $str =~ /y$/ ) {
+ if ( $int > 1 ) {
+ if ( $str =~ /ey$/ ) {
+ $str .= 's'; # eg: 'money' => 'moneys'.
+ }
+ else {
+ $str =~ s/y$/ies/;
+ }
+ }
+ }
+ else {
+ $str .= 's' if ( $int != 1 );
+ }
+ return $str;
+}
##########
### get commands.
###
sub getRandomLineFromFile {
- my($file) = @_;
+ my ($file) = @_;
- if (! -f $file) {
- &WARN("gRLfF: file '$file' does not exist.");
- return;
+ if ( !open( IN, $file ) ) {
+ &WARN("gRLfF: could not open ($file): $!");
+ return;
}
- if (open(IN,$file)) {
- my @lines = <IN>;
+ my @lines = <IN>;
+ close IN;
- if (!scalar @lines) {
- &ERROR("GRLF: nothing loaded?");
- return;
- }
+ if ( !scalar @lines ) {
+ &ERROR('GRLF: nothing loaded?');
+ return;
+ }
- while (my $line = &getRandom(@lines)) {
- chop $line;
+ # could we use the filehandler instead and put it through getRandom?
+ while ( my $line = &getRandom(@lines) ) {
+ chop $line;
- next if ($line =~ /^\#/);
- next if ($line =~ /^\s*$/);
+ next if ( $line =~ /^\#/ );
+ next if ( $line =~ /^\s*$/ );
- return $line;
- }
- } else {
- &WARN("gRLfF: could not open file '$file'.");
- return;
+ return $line;
}
}
sub getLineFromFile {
- my($file,$lineno) = @_;
+ my ( $file, $lineno ) = @_;
- if (! -f $file) {
- &ERROR("getLineFromFile: file '$file' does not exist.");
- return 0;
+ if ( !-f $file ) {
+ &ERROR("getLineFromFile: file '$file' does not exist.");
+ return 0;
}
- if (open(IN,$file)) {
- my @lines = <IN>;
- close IN;
+ if ( open( IN, $file ) ) {
+ my @lines = <IN>;
+ close IN;
- if ($lineno > scalar @lines) {
- &ERROR("getLineFromFile: lineno exceeds line count from file.");
- return 0;
- }
+ if ( $lineno > scalar @lines ) {
+ &ERROR('getLineFromFile: lineno exceeds line count from file.');
+ return 0;
+ }
- my $line = $lines[$lineno-1];
- chop $line;
- return $line;
- } else {
- &ERROR("getLineFromFile: could not open file '$file'.");
- return 0;
+ my $line = $lines[ $lineno - 1 ];
+ chop $line;
+ return $line;
+ }
+ else {
+ &ERROR("gLFF: Could not open file ($file): $!");
+ return 0;
}
}
my @array = @_;
srand();
- return $array[int(rand(scalar @array))];
+ return $array[ int( rand( scalar @array ) ) ];
}
-# Usage: &getRandomInt("30-60");
+# Usage: &getRandomInt('30-60'); &getRandomInt(5);
+# Desc : Returns a randomn integer between 'X-Y' or 1 and the value passed
sub getRandomInt {
- my $str = $_[0];
+ my $str = shift;
- srand();
+ if ( !defined $str ) {
+ &WARN('getRandomInt: str == NULL.');
+ return undef;
+ }
- if ($str =~ /^(\d+)$/) {
- my $i = $1;
- my $fuzzy = int(rand 5);
- if ($i < 10) {
- return $i*60;
- }
- if (rand > 0.5) {
- return ($i - $fuzzy)*60;
- } else {
- return ($i + $fuzzy)*60;
- }
- } elsif ($str =~ /^(\d+)-(\d+)$/) {
- return ($2 - $1)*int(rand $1)*60;
- } else {
- return $str; # hope we're safe.
- }
-
- &ERROR("getRandomInt: invalid arg '$str'.");
- return 1800;
+ if ( $str =~ /^(\d+(\.\d+)?)$/ ) {
+ return int( rand $str ) + 1;
+ }
+ elsif ( $str =~ /^(\d+)-(\d+)$/ ) {
+ return $1 if $1 == $2;
+ my $min = $1 < $2 ? $1 : $2; # Swap is backwords
+ my $max = $2 > $1 ? $2 : $1;
+ return int( rand( $max - $min + 1 ) ) + $min;
+ }
+ else {
+
+ # &ERROR("getRandomInt: invalid arg '$str'.");
+ return undef;
+ }
}
##########
###
sub iseq {
- my ($left,$right) = @_;
+ my ( $left, $right ) = @_;
return 0 unless defined $right;
return 0 unless defined $left;
- return 1 if ($left =~ /^\Q$right$/i);
+ return 1 if ( $left =~ /^\Q$right$/i );
}
sub isne {
# Usage: &IsHostMatch($nuh);
sub IsHostMatch {
my ($thisnuh) = @_;
- my (%this,%local);
+ my ( %this, %local );
- if ($nuh =~ /^(\S+)!(\S+)@(\S+)/) {
- $local{'nick'} = lc $1;
- $local{'user'} = lc $2;
- $local{'host'} = &makeHostMask(lc $3);
+ if ( $nuh =~ /^(\S+)!(\S+)@(\S+)/ ) {
+ $local{'nick'} = lc $1;
+ $local{'user'} = lc $2;
+ $local{'host'} = &makeHostMask( lc $3 );
}
- if ($thisnuh =~ /^(\S+)!(\S+)@(\S+)/) {
- $this{'nick'} = lc $1;
- $this{'user'} = lc $2;
- $this{'host'} = &makeHostMask(lc $3);
- } else {
- &WARN("IHM: thisnuh is invalid '$thisnuh'.");
- return 1 if ($thisnuh eq "");
- return 0;
+ if ( !defined $thisnuh ) {
+ &WARN('IHM: thisnuh == NULL.');
+ return 0;
+ }
+ elsif ( $thisnuh =~ /^(\S+)!(\S+)@(\S+)/ ) {
+ $this{'nick'} = lc $1;
+ $this{'user'} = lc $2;
+ $this{'host'} = &makeHostMask( lc $3 );
+ }
+ else {
+ &WARN("IHM: thisnuh is invalid '$thisnuh'.");
+ return 1 if ( $thisnuh eq '' );
+ return 0;
}
# auth if 1) user and host match 2) user and nick match.
# this may change in the future.
- if ($this{'user'} =~ /^\Q$local{'user'}\E$/i) {
- return 2 if ($this{'host'} eq $local{'host'});
- return 1 if ($this{'nick'} eq $local{'nick'});
+ if ( $this{'user'} =~ /^\Q$local{'user'}\E$/i ) {
+ return 2 if ( $this{'host'} eq $local{'host'} );
+ return 1 if ( $this{'nick'} eq $local{'nick'} );
}
return 0;
}
####
# Usage: &isStale($file, $age);
sub isStale {
- my ($file, $age) = @_;
+ my ( $file, $age ) = @_;
+
+ if ( !defined $age ) {
+ &WARN('isStale: age == NULL.');
+ return 1;
+ }
+
+ if ( !defined $file ) {
+ &WARN('isStale: file == NULL.');
+ return 1;
+ }
- return 1 unless ( -f $file);
- return 1 if (time() - (stat($file))[9] > $age*60*60*24);
- my $delta = time() - (stat($file))[9];
- my $hage = $age*60*60*24;
+ &DEBUG("!exist $file") if ( !-f $file );
+
+ return 1 unless ( -f $file );
+ if ( $file =~ /idx/ ) {
+ my $age2 = time() - ( stat($file) )[9];
+ &VERB( "stale: $age2. (" . &Time2String($age2) . ')', 2 );
+ }
+ $age *= 60 * 60 * 24 if ( $age >= 0 and $age < 30 );
+
+ return 1 if ( time() - ( stat($file) )[9] > $age );
return 0;
}
+sub isFileUpdated {
+ my ( $file, $time ) = @_;
+
+ if ( !-f $file ) {
+ return 1;
+ }
+
+ my $time_file = ( stat $file )[9];
+
+ if ( $time <= $time_file ) {
+ return 0;
+ }
+ else {
+ return 1;
+ }
+}
+
##########
### make commands.
###
# Usage: &makeHostMask($host);
sub makeHostMask {
my ($host) = @_;
+ my $nu = '';
+
+ if ( $host =~ s/^(\S+!\S+\@)// ) {
+ &DEBUG("mHM: detected nick!user\@ for host arg; fixing");
+ &DEBUG("nu => $nu");
+ $nu = $1;
+ }
- if ($host =~ /^$mask{ip}$/) {
- return "$1.$2.$3.*";
+ if ( $host =~ /^$mask{ip}$/ ) {
+ return $nu . "$1.$2.$3.*";
}
- my @array = split(/\./, $host);
- return $host if (scalar @array <= 3);
- return "*.".join('.',@{array}[1..$#array]);
+ my @array = split( /\./, $host );
+ return $nu . $host if ( scalar @array <= 3 );
+ return $nu . '*.' . join( '.', @{array}[ 1 .. $#array ] );
}
# Usage: &makeRandom(int);
my @retval;
my %done;
- if ($max =~ /^\D+$/) {
- &ERROR("makeRandom: arg ($max) is not integer.");
- return 0;
+ if ( $max =~ /^\D+$/ ) {
+ &ERROR("makeRandom: arg ($max) is not integer.");
+ return 0;
}
- if ($max < 1) {
- &ERROR("makeRandom: arg ($max) is not positive.");
- return 0;
+ if ( $max < 1 ) {
+ &ERROR("makeRandom: arg ($max) is not positive.");
+ return 0;
}
srand();
- while (scalar keys %done < $max) {
- my $rand = int(rand $max);
- next if (exists $done{$rand});
+ while ( scalar keys %done < $max ) {
+ my $rand = int( rand $max );
+ next if ( exists $done{$rand} );
- push(@retval,$rand);
- $done{$rand} = 1;
+ push( @retval, $rand );
+ $done{$rand} = 1;
}
return @retval;
sub checkMsgType {
my ($reply) = @_;
- return unless (&IsParam("minLengthBeforePrivate"));
+ return unless ( &IsParam('minLengthBeforePrivate') );
return if ($force_public_reply);
- if (length $reply > $param{'minLengthBeforePrivate'}) {
- &status("Reply: len reply > minLBP ($param{'minLengthBeforePrivate'}); msgType now private.");
- $msgType = 'private';
+ if ( length $reply > $param{'minLengthBeforePrivate'} ) {
+ &status(
+"Reply: len reply > minLBP ($param{'minLengthBeforePrivate'}); msgType now private."
+ );
+ $msgType = 'private';
}
}
sub validExec {
my ($str) = @_;
- if ($str =~ /[\'\"\|]/) { # invalid.
- return 0;
- } else { # valid.
- return 1;
+ if ( $str =~ /[\`\'\"\|]/ ) { # invalid.
+ return 0;
+ }
+ else { # valid.
+ return 1;
}
-}
-
-# Usage: &validFactoid($lhs,$rhs);
-sub validFactoid {
- my ($lhs,$rhs) = @_;
- my $valid = 0;
-
- for (lc $lhs) {
- # allow the following only if they have been made on purpose.
- if ($rhs ne "" and $rhs !~ /^</) {
- / \Q$ident$/i and last; # someone said i'm something.
- /^i('m)? / and last;
- /^(it|that|there|what)('s)?(\s+|$)/ and last;
- /^you('re)?(\s+|$)/ and last;
-
- /^(where|who|why|when|how)(\s+|$)/ and last;
- /^(this|that|these|those|they)(\s+|$)/ and last;
- /^(every(one|body)|we) / and last;
-
- /^say / and last;
- }
-
- # uncaught commands.
- /^add topic / and last; # topic management.
- /( add$| add |^add )/ and last; # borked teach statement.
- /^learn / and last; # teach. damn morons.
- /^tell (\S+) about / and last; # tell.
- /\=\~/ and last; # substituition.
- /^\S+ to \S+ \S+/ and last; # babelfish.
-
- /^\=/ and last; # botnick = heh is.
- /wants you to know/ and last;
-
- # symbols.
- /(\"\*)/ and last;
- /, / and last;
- /^\'/ and last;
-
- # delimiters.
- /\=\>/ and last; # '=>'.
- /\;\;/ and last; # ';;'.
- /\|\|/ and last; # '||'.
-
- /^\Q$ident\E[\'\,\: ]/ and last;# dupe addressed.
- /^[\-\, ]/ and last;
- /\\$/ and last; # forgot shift for '?'.
- /^all / and last;
- /^also / and last;
- / also$/ and last;
- / and$/ and last;
- /^because / and last;
- /^gives / and last;
- /^h(is|er) / and last;
- /^if / and last;
- / is,/ and last;
- / it$/ and last;
- / says$/ and last;
- /^should / and last;
- /^so / and last;
- /^supposedly/ and last;
- /^to / and last;
- /^was / and last;
- / which$/ and last;
-
- # nasty bug I introduced _somehow_, probably by fixMySQLBug().
- /\\\%/ and last;
- /\\\_/ and last;
-
- # weird/special stuff. also old blootbot or stock infobot bugs.
- $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership.
-
- # duplication.
- $rhs =~ /^\Q$lhs /i and last;
- last if ($rhs =~ /^is /i and / is$/);
-
- $valid++;
- }
-
- return $valid;
}
# Usage: &hasProfanity($string);
my ($string) = @_;
my $profanity = 1;
- for (lc $string) {
- /fuck/ and last;
- /dick|dildo/ and last;
- /shit|turd|crap/ and last;
- /pussy|[ck]unt/ and last;
- /wh[0o]re|bitch|slut/ and last;
+ for ( lc $string ) {
+ /fuck/ and last;
+ /dick|dildo/ and last;
+ /shit/ and last;
+ /pussy|[ck]unt/ and last;
+ /wh[0o]re|bitch|slut/ and last;
- $profanity = 0;
+ $profanity = 0;
}
return $profanity;
}
-sub hasParam {
+sub IsChanConfOrWarn {
my ($param) = @_;
- if (&IsParam($param)) {
- return 1;
- } else {
- &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
- return 0;
+ if ( &IsChanConf($param) > 0 ) {
+ return 1;
+ }
+ else {
+ ### TODO: specific reason why it failed.
+ &msg( $who,
+ "unfortunately, \002$param\002 is disabled in my configuration" )
+ unless ($addrchar);
+ return 0;
}
}
sub Forker {
- my ($label, $code) = @_;
+ my ( $label, $code ) = @_;
my $pid;
&shmFlush();
- &VERB("double fork detected; not forking.",2) if ($$ != $bot_pid);
+ &VERB( 'double fork detected; not forking.', 2 ) if ( $$ != $bot_pid );
+
+ if ( &IsParam('forking') and $$ == $bot_pid ) {
+ return unless &addForked($label);
- if (&IsParam("forking") and $$ == $bot_pid) {
- return $noreply unless (&addForked($label));
- $SIG{CHLD} = 'IGNORE';
- $pid = eval { fork() };
- return $noreply if $pid; # parent does nothing
- &status("fork starting for '$label', PID == $$.");
- &shmWrite($shm,"SET FORKPID $label $$");
+ $SIG{CHLD} = 'IGNORE';
+ $pid = eval { fork() };
+ return if $pid; # parent does nothing
+
+ select( undef, undef, undef, 0.2 );
+
+ # &status("fork starting for '$label', PID == $$.");
+ &status(
+ "--- fork starting for '$label', PID == $$, bot_pid == $bot_pid ---"
+ );
+ &shmWrite( $shm, "SET FORKPID $label $$" );
+
+ sleep 1;
}
### TODO: use AUTOLOAD
- if (!&loadMyModule($myModules{$label})) {
- &DEBUG("Forker: failed?");
- return;
+ ### very lame hack.
+ if ( $label !~ /-/ and !&loadMyModule($label) ) {
+ &DEBUG('Forker: failed?');
+ &delForked($label);
}
- if (defined $code) {
- $code->(); # weird, hey?
- } else {
- &WARN("Forker: code not defined!");
+ if ( defined $code ) {
+ $code->(); # weird, hey?
}
-
- if (defined $pid) { # child.
- &delForked($label);
- &status("fork finished for '$label'.");
- exit 0;
+ else {
+ &WARN('Forker: code not defined!');
}
+
+ &delForked($label);
}
sub closePID {
- return 1 unless (exists $file{PID});
- return 1 unless ( -f $file{PID});
- return 1 if (unlink $file{PID});
- return 0 if ( -f $file{PID});
+ return 1 unless ( exists $file{PID} );
+ return 1 unless ( -f $file{PID} );
+ return 1 if ( unlink $file{PID} );
+ return 0 if ( -f $file{PID} );
+}
+
+sub mkcrypt {
+ my ($str) = @_;
+ my $salt = join '',
+ ( '.', '/', 0 .. 9, 'A' .. 'Z', 'a' .. 'z' )[ rand 64, rand 64 ];
+
+ return crypt( $str, $salt );
+}
+
+sub closeStats {
+ return unless ( &getChanConfList('ircTextCounters') );
+
+ foreach ( keys %cmdstats ) {
+ my $type = $_;
+ my $i = &sqlSelect(
+ 'stats',
+ 'counter',
+ {
+ 'nick' => $type,
+ 'type' => 'cmdstats',
+ }
+ );
+ my $z = 0;
+ $z++ unless ($i);
+
+ $i += $cmdstats{$type};
+
+ &sqlSet(
+ 'stats',
+ {
+ 'nick' => $type,
+ 'type' => 'cmdstats',
+ },
+ {
+ 'time' => time(),
+ 'counter' => $i,
+ }
+ );
+ }
}
1;
+
+# vim:ts=4:sw=4:expandtab:tw=80
projects / infobot.git / blobdiff