From 24ceaefd4ef0fb9100d60261f260233613611aab Mon Sep 17 00:00:00 2001 From: dondelelcaro Date: Tue, 25 Aug 2009 23:35:13 +0000 Subject: [PATCH] merge in changes from 1810:1870 git-svn-id: https://svn.code.sf.net/p/infobot/code/branches/don/dpkg@1871 c11ca15a-4712-0410-83d8-924469b57eb5 --- BUGS | 3 + ChangeLog | 47 +++ FAQ | 39 ++- INSTALL | 22 -- README | 43 +-- README.quick | 17 - THANKS | 8 + TODO | 24 +- VERSION | 2 +- files/infobot.help | 13 +- files/sample/infobot.chan | 6 +- files/sample/infobot.config | 2 + scripts/factpack.pl | 87 +++++ scripts/insertDB.pl | 38 -- src/CommandStubs.pl | 31 +- src/Factoids/Core.pl | 16 +- src/Factoids/Question.pl | 13 +- src/Factoids/Statement.pl | 18 + src/IRC/Irc.pl | 6 +- src/IRC/IrcHooks.pl | 19 +- src/IRC/Schedulers.pl | 6 +- src/{Modules => IRC}/UserDCC.pl | 0 src/Misc.pl | 14 +- src/Modules/BZFlag.pl | 0 src/Modules/Google.pl | 79 +++++ src/Modules/W3Search.pl | 67 ---- src/Modules/babelfish.pl | 64 ++-- src/Modules/dice.pl | 0 src/Modules/upsidedown.pl | 8 + src/PoCiCommon.pm | 597 ++++++++++++++++++++++++++++++++ src/Process.pl | 10 +- src/logger.pl | 2 + 32 files changed, 1029 insertions(+), 272 deletions(-) delete mode 100644 README.quick create mode 100755 scripts/factpack.pl delete mode 100755 scripts/insertDB.pl rename src/{Modules => IRC}/UserDCC.pl (100%) mode change 100755 => 100644 src/Modules/BZFlag.pl create mode 100644 src/Modules/Google.pl delete mode 100644 src/Modules/W3Search.pl mode change 100755 => 100644 src/Modules/dice.pl create mode 100644 src/PoCiCommon.pm diff --git a/BUGS b/BUGS index 79763d4..c3b3eb8 100644 --- a/BUGS +++ b/BUGS @@ -1,5 +1,8 @@ Known bugs that should be dealt with soon as possible: + * Multiple nick per server is in need of some testing and make be + incomplete or buggy in some parts of the bot + * Older CMD: foo's cannot be used or removed. Must be removed manually from the database with SQL diff --git a/ChangeLog b/ChangeLog index 4864c93..ff2ced0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,50 @@ +1.5.4 +===== +* scripts/insertDB.pl +- renamed to factpack.pl +- should work properly now (needs testing) + +* Updates to DebianExtra.pl: +- use soap for bug_info +- totally replace do_id with the copy from DebianBugs.pl +- fix ||= typo +- fix url->uri typo +- fix -> typo +- add some more debugging code to the do_id code +- remove useless bug => +- disable debugging output of the soap object returned +- soap returns multiple bugs in a single shot +- use strftime on the date + +* check for and use of old blootbot.(users|chan) files + +* Retired the old broken W3Search module in favour of a working Google search + +* Removed +W3Search in infobot.chan, added +Google (don't forget to update your +configs) + + +1.5.3 +===== + +* New maxVolunteerLength to govern max size of non addressed replies + +* Cleaned up some of the regex code for what the bot considers a question + +* Fixed an obscure and undocumented variable that was disabling "query?" +questions in non addressed mode + +* Fixed bug in babelfish module due to site/html changes + +* Added chanset and help for verstats to allow disabling of command to prevent abuse + +* Fixed verstats to warn the channel about who involked the command and bug that +was causing the output to go to random channels due to loss of variable scope + +* Added infobot client to verstats and cleaned up a few other client regex + +* Fixed talkok bug with 'how are you' statement + 1.5.2 ===== diff --git a/FAQ b/FAQ index f7a8dcc..6f24c06 100644 --- a/FAQ +++ b/FAQ @@ -1,12 +1,49 @@ # $Id$ +Q: What are factpacks and how do I install them? +A: A factpack is a partial database of factoids that you can import into + your configured infobot by running the script called "factpack.pl". + + # IMPORTANT: Run from the bots base directory! + eg: ./scripts/factpack.pl /path/to/areacodes.fact + +Q: Can I remove a fact pack I have installed? +A: Yes, but at the moment, you need to manually use SQL commands in your + favorite SQL program. The "created_by" field in the factoids will be + set to the filename of the fact pack you installed. For example, if + you installed the "areacodes.fact" file, "created_by" would be set to + "areacodes.fact". The SQL to remove the above example would be: + + sql> DELETE FROM factoids WHERE created_by = 'areacodes.fact'; + +Q: Where can I download some existing fact packs? +A: As of yet, the fact packs aren't available in SVN. You can try the + original infobot web site at: + + http://www.infobot.org/factpacks/ + + NOTE: The import script can't yet handle compressed files, so you must + extract the factpacks in advance. + +Q: How can I make my own fact packs? +A: The syntax is pretty basic. You just need a plain text file that has + one key/value pair per line. Comment lines begin with a "#" character + and are ignored, as are blank lines. Extra whitespace around key/value + pairs should hopefully be stripped out as well. A few example lines from + the areacodes.fact file: + + # Sample comment here + area code 011 => the International Access Code + area code 201 => Hackensack, Morristown and Newark, New Jersey + area code 202 => Washington, District of Columbia + + Q: The bot exits after I run 'factstats testing' or 'kernel' or anything that uses fork(). Is this a bug in the bot? A: No, this is not a bug in the bot but rather Net::IRC. A cheap hack is to edit /usr/lib/perl5/Net/IRC/Connection.pm, search for DESTROY, and comment out '$self->quit();' -A: Apply the patches in the patches/ directory. Q: I notice that, in the bot logs, the bot attempts to close all current diff --git a/INSTALL b/INSTALL index 12f1b3e..9729d65 100644 --- a/INSTALL +++ b/INSTALL @@ -40,28 +40,6 @@ Finally, start your bot by changing to the base dir and type: - ------------- - -- Patches -- - ------------- - -- apply *.patch patches inside patches/ - - cd /usr/lib/perl5/WWW/Search - - patch -p0 < WWW::Search::Google.patch - -- alternatively, move the files from patches/ - - mv patches/Google.pm /usr/lib/perl5/WWW/Search/ - - -Net::IRC DCC CHAT ------------------ -Unfortunately, Net::IRC 0.70 has buggy code that does not detect DCC CHAT -properly. to patch: - - cd /usr/share/perl5/Net/IRC/ - - cat ~bot/patches/Net_IRC_Connection_pm.patch | patch -p0 - - - - ---------------- -- PostgreSQL -- ---------------- diff --git a/README b/README index 32197d3..4629cda 100644 --- a/README +++ b/README @@ -9,35 +9,30 @@ INTRODUCTION Kevin Lenzo , which is now officially rebranded back to infobot! The basis of infobot is still there but _many_ wild features have been added. Along the way, many issues were spotted in the original -infobot source and fixed in this version. Many new bugs have been added as well +infobot source and fixed in this version. Many new bugs have been added as well. Thanks to kevin for bringing infobot in the first place. FEATURES * Additional information stored with factoids. (factinfo) - * Wide range of statistics for Bot, Factoids, IRC, Debian. + * Wide range of statistics for Bot, Factoids, IRC, Debian (status, factstats, ircstats, chanstats, cmdstats) - * Advanced topic management. (the first cool feature) - * Improved factoid search, allowing search by key or value. + * Advanced topic management + * Improved factoid search, allowing search by key or value * Freshmeat support (freshmeat.net) - * Debian Contents and Packages, search and info. - * ChanServ/NickServ (OPN) support. - * WWW-Search (eg: google for BLAH) - * Slashdot, Kernel and Freshmeat auto-update announcements. - * Units conversion (provided by external module, Units-Module) + * Debian Contents and Packages, search and info + * ChanServ/NickServ (freenode) support + * WWW-Search (eg: google for BLAH) (NOTE: Currently broken) + * Slashdot, Kernel, RSS and Freshmeat auto-update announcements + * Units conversion (provided by external "units" program) DESIGN - - Modularity. Ability to disable IRC or Factoid support. + - Modularity. Ability to disable IRC or Factoid support - Funky pseudo Module autoloader support - - Eleet Forker() function - - -IMPROVEMENTS - * log file is not opened and closed for each line of data - => unblocked logging is used. - * seen data is not flushed for each public message on IRC - => caching and flushing over an interval is used. + - Modules called via Forker() to avoid blocking + - Non blocking logs + - Seen data periodicaly flushed for efficiency HISTORY @@ -77,10 +72,6 @@ However, these people do not realize the potential of open wingates. test all modifications properly (and extensively). Suggestions are welcomed. - 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. - MODIFICATIONS All modifications are that of the blootbot author unless otherwise @@ -126,11 +117,11 @@ through DCC CHAT. /chat . All commands must be prepended by UNTESTED: - - user statistics shown by 'seen'. bug in this? + - user statistics shown by 'seen'. - User Information Services. - new wingate caching/file-read code. - disabling IRC/factoid support code. - - PG supports need to be worked and thoroughly tested. + - PGSql support needs to be more thoroughly tested. CONTRIBUTIONS @@ -139,13 +130,13 @@ modifications, aswell as giving suggestions and ideas in the early development stages. Bashing of modifications courtesy of larne, irq, lilo and \broken. - mu@OPN for the SAR (=~ s///) and Topic history patch. + mu@freenode for the SAR (=~ s///) and Topic history patch. someone emailed me a patch to fix up telnet but I accidently deleted the message together with the patch after replying to the guy. I hope to get that same guy to re-send me the patch... - MbM@OPN sent a patch to clean up behaviour of factoids + MbM@freenode sent a patch to clean up behaviour of factoids (adding, removing, modifying). Thanks. diff --git a/README.quick b/README.quick deleted file mode 100644 index 6ffa1a2..0000000 --- a/README.quick +++ /dev/null @@ -1,17 +0,0 @@ -See INSTALL file on how to install the bot. - -Quick usage instructions: -------------------------- - -DCC CHAT: -.+chan #chan -.chanset #chan +autojoin -.chanset +autojoin -.chanunset -autojoin -.chanset -autojoin - -for list of configuration options, run: - perl scripts/findparam.pl - - -# vim:ts=4:sw=4:expandtab:tw=80 diff --git a/THANKS b/THANKS index 20cb949..3699e19 100644 --- a/THANKS +++ b/THANKS @@ -12,6 +12,10 @@ other another, or people who we feel we owe thanks to in one way or another. If we missed you from this list, drop us a line and we will be sure to give credit where it is due. +#People +------- + +Brett Cave (Google search) #perl@freenode.net ------------------ @@ -28,5 +32,9 @@ Limbic_Region mmap__ jagerman +#infobot@freenode.net +--------------------- +quin - many thanks for ctcp version bug help + # vim:ts=4:sw=4:expandtab:tw=80 diff --git a/TODO b/TODO index 579c6c3..cca767e 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,10 @@ +Other TODO items may be listed on sourceforge. Please access it from the +website or this link: + + http://sourceforge.net/tracker/?group_id=2241 + + TODO: - - Normalize the SQL tables a little better to reduce size and increase speed - - Keep the Changelog, TODO and BUGS files up to date. Clean things up a bit - - rename ^[+-] commands - remind - like this and others: http://jibble.org/reminderbot/ - kill SHM and and move to a pipe - add CIA like support - http://cia.navi.cx/ @@ -32,26 +35,17 @@ TODO: - add &checkSet() or &_chanset(); - attempt to move userDCC to hooks. - need to modify parseCmdHooks for user flags? - - make timers below 5 or 10 mins non-random values. - create a .csv import/export program --- EFFORT 1. - make IRC/Schedulers.pl work 100%. - intervals must be multiple of the smallest one otherwise auto-fixed. - make intervals chan-specific - need to store info in $sched{$what}{$chan} = time(); when last run or next run? - -Other TODO items may be listed on sourceforge. Please access it from the -website or this link: -http://sourceforge.net/pm/task.php?group_id=2241 - ----------------------------------------------------- ------------- FUTURE, NON-IMPORTANT - ~country ua - - xk: add it :) and my imdb feature :) - - xk: and ~bugs :) - - "HACKING" text file, documentation of where things start, + xk: add it :) and my imdb feature :) + xk: and ~bugs :) + - "HACKING" text file, documentation of where things start, what "core" or reuseable functions are used and what for. - web interface - on join message - customizeable, option. diff --git a/VERSION b/VERSION index 4cda8f1..0475227 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.5.2 +1.5.4 (SVN) diff --git a/files/infobot.help b/files/infobot.help index 5b3853c..0d37789 100644 --- a/files/infobot.help +++ b/files/infobot.help @@ -1,5 +1,6 @@ -# Revised: 20071016 +# Revised: 20090320 # Author: Tim Riker +# Contributors: Simon C., Tim M., others (see AUTHORS) ### # Special entry @@ -205,6 +206,11 @@ freshmeat: D: Frontend to www.freshmeat.net freshmeat: U: ## freshmeat: E: ## infobot +google: D: What Is: Google Search frontend +google: D: Configuration: "chanset [_default or channelname] +Google" +google: U: ## google +google: E: ## google infobot + hex: D: Convert ascii to hex hex: U: ## hex: E: ## carrot @@ -481,6 +487,11 @@ userdel: D: Administrative command to remove a user from the .users file userdel: U: ## userdel: E: ## SomeAccount +verstats: D: Commnd to CTCP VERSION the specified channel for client statistics +verstats: U: ## +verstats: E: ## #infobot +verstats: E: < infobot> IRC Client versions for #infobot (2): unknown/cloak - 3 (75%) ;; irssi - 1 (25%). + wantnick: If someone's taken my nick (I hope not) and I'm using some temporary nick, I can change back to my original nick if it's not taken (again). whois: D: List available information for an account on the bot diff --git a/files/sample/infobot.chan b/files/sample/infobot.chan index adb5dc1..07a2811 100644 --- a/files/sample/infobot.chan +++ b/files/sample/infobot.chan @@ -37,6 +37,7 @@ _default +Dict +Exchange +Factoids + +Google +HTTPDtype +Kernel +Math @@ -48,7 +49,6 @@ _default +Topic +Units +UserInfo - +W3Search +Weather +Zippy addressCharacter ~ @@ -76,7 +76,8 @@ _default maxListReplyCount 15 maxListReplyLength 400 +md5 - minVolunteerLength 50 + minVolunteerLength 2 + maxVolunteerLength 512 +nickometer +pager +piglatin @@ -100,6 +101,7 @@ _default +spell +tell +upsidedown + +verstats +wikipedia +wtf +zfi diff --git a/files/sample/infobot.config b/files/sample/infobot.config index 073a81e..837461d 100644 --- a/files/sample/infobot.config +++ b/files/sample/infobot.config @@ -4,6 +4,8 @@ ##### # Basic IRC info ##### +# NOTE: If you would like multiple nick support, use the following format: +# set ircNick nick1,nick2,nick3 set ircNick infobot set ircUser infobot set ircName infobot experimental bot diff --git a/scripts/factpack.pl b/scripts/factpack.pl new file mode 100755 index 0000000..6a6e60c --- /dev/null +++ b/scripts/factpack.pl @@ -0,0 +1,87 @@ +#!/usr/bin/perl -w + +$| = 1; + +use strict; +use File::Basename; +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_pid $memusage %param +); + + +# Check for arguments +if ( !scalar @ARGV ) { + print "Usage: $0 [ ...]\n"; + print "Example: $0 areacodes.fact usazips.fact\n"; + exit 1; +} + + +# set any $bot_*_dir var's +$bot_base_dir = '.'; +$bot_config_dir = 'files/'; +$bot_data_dir = 'files/'; +$bot_state_dir = 'files/'; +$bot_run_dir = '.'; +$bot_src_dir = "$bot_base_dir/src"; +$bot_log_dir = "$bot_base_dir/log"; +$bot_misc_dir = "$bot_base_dir/files"; +$bot_pid = $$; + +require "$bot_src_dir/logger.pl"; +require "$bot_src_dir/core.pl"; +require "$bot_src_dir/modules.pl"; + +# Initialize enough to get DB access +&setupConfig(); +&loadCoreModules(); +&loadDBModules(); +&loadFactoidsModules(); +&setup(); + +if ( !scalar @ARGV ) { + print "Usage: $0 [ ...]\n"; + print "Example: $0 areacodes.fact usazips.fact\n"; + exit 0; +} + +foreach (@ARGV) { + next unless ( -f $_ ); + my $file = $_; + + open( IN, $file ) or die "error: cannot open $file\n"; + print "Opened $file for input...\n"; + + print "inserting... "; + while () { + chomp; + next if /^#/; + next unless (/=>/); + + # Split into "key => value" pairs + my ($key, $value) = split(/=>/,$_,2); + + # Strip extra begin/end whitespace + $key =~ s/^\s*(.*?)\s*$/$1/; + $value =~ s/^\s*(.*?)\s*$/$1/; + + # convert tabs + $key =~ s/\t/ /g; + $value =~ s/\t/ /g; + + # The key needs to be lower case to match query case + $key = lc $key; + + ### TODO: check if it already exists. if so, don't add. + ### TODO: combine 2 setFactInfo's into single + &setFactInfo( $key, "factoid_value", $value ); + &setFactInfo( $key, "created_by", basename($file) ); + print ":: $key "; + } + + close IN; +} +print "...Done!\n"; + +# vim:ts=4:sw=4:expandtab:tw=80 diff --git a/scripts/insertDB.pl b/scripts/insertDB.pl deleted file mode 100755 index 1206414..0000000 --- a/scripts/insertDB.pl +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/perl -w - -$| = 1; - -use strict; - -require "src/core.pl"; -require "src/logger.pl"; -require "src/modules.pl"; -require "src/Factoids/DBCommon.pl"; - -&loadConfig( $bot_config_dir . "/infobot.config" ); -&loadDBModules(); - -unless (@_) { - print "hrm.. usage\n"; - exit 0; -} - -foreach (@_) { - next unless ( -f $_ ); - - open( IN, $_ ) or die "error: cannot open $_\n"; - print "Opened $_ for input...\n"; - - print "inserting... "; - while () { - next unless (/^(.*?) => (.*)$/); - - ### TODO: check if it already exists. if so, don't add. - &setFactInfo( $1, "factoid_value", $2 ); - print ":: $1 "; - } - - close IN; -} - -# vim:ts=4:sw=4:expandtab:tw=80 diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl index d3c4e4d..e66e6d8 100644 --- a/src/CommandStubs.pl +++ b/src/CommandStubs.pl @@ -182,17 +182,16 @@ sub Modules { return; } - # google searching. Simon++ - my $w3search_regex = 'google'; + # google searching -- thanks Brett Cave if ( $message =~ - /^(?:search\s+)?($w3search_regex)\s+(?:for\s+)?['"]?(.*?)["']?\s*\?*$/i + /^(\s+)?google\s+['"]?(.*?)["']?\s*\?*$/i ) { - return unless ( &IsChanConfOrWarn('W3Search') ); + return unless ( &IsChanConfOrWarn('Google') ); - &Forker( 'W3Search', sub { &W3Search::W3Search( $1, $2 ); } ); + &Forker( 'Google', sub { &Google::GoogleSearch( $2 ); } ); - $cmdstats{'W3Search'}++; + $cmdstats{'Google'}++; return; } @@ -591,8 +590,14 @@ sub do_verstats { return; } - &msg( $who, "Sending CTCP VERSION to $chan; results in 60s." ); - $conn->ctcp( 'VERSION', $chan ); + &msg( $who, "Sending CTCP VERSION to $chan; results in 60s." ); + &msg( $chan, "WARNING: $who has forced me to CTCP VERSION the channel!" ); + + # Workaround for bug in Net::Irc, provided by quin@freenode. Details at: + # http://rt.cpan.org/Public/Bug/Display.html?id=11421 + # $conn->ctcp( 'VERSION', $chan ); + $conn->sl("PRIVMSG $chan :\001VERSION\001"); + $cache{verstats}{chan} = $chan; $cache{verstats}{who} = $who; $cache{verstats}{msgType} = $msgType; @@ -618,7 +623,6 @@ sub do_verstats { my $vtotal = 0; my $c = lc $cache{verstats}{chan}; my $total = keys %{ $channels{$c}{''} }; - $chan = $c; $who = $cache{verstats}{who}; $msgType = $cache{verstats}{msgType}; delete $cache{verstats}; # sufficient? @@ -651,8 +655,7 @@ sub do_verstats { } # hack. this is one major downside to scheduling. - $chan = $c; - &performStrictReply( + &msg($c, &formListReply( 0, "IRC Client versions for $c ", @list ) ); # clean up not-needed data structures. @@ -669,7 +672,9 @@ sub verstats_flush { last unless ( scalar @vernicktodo ); my $n = shift(@vernicktodo); - $conn->ctcp( 'VERSION', $n ); + #$conn->ctcp( 'VERSION', $n ); + # See do_verstats $conn->sl for explantaion + $conn->sl("PRIVMSG $n :\001VERSION\001"); } return unless ( scalar @vernicktodo ); @@ -837,7 +842,7 @@ sub do_text_counters { &addCmdHook('upsidedown', ('CODEREF' => 'upsidedown::upsidedown', 'Identifier' => 'upsidedown', 'Cmdstats' => 'upsidedown', 'Forker' => 1, 'Module' => 'upsidedown') ); &addCmdHook('Uptime', ('CODEREF' => 'uptime', 'Identifier' => 'Uptime', 'Cmdstats' => 'Uptime') ); &addCmdHook('u(ser)?info', ('CODEREF' => 'userinfo', 'Identifier' => 'UserInfo', 'Help' => 'userinfo', 'Module' => 'UserInfo') ); -&addCmdHook('verstats', ('CODEREF' => 'do_verstats' ) ); +&addCmdHook('verstats', ('CODEREF' => 'do_verstats', 'Identifier' => 'verstats', 'Help' => 'verstats', 'Cmdstats' => 'verstats') ); &addCmdHook('Weather', ('CODEREF' => 'Weather::Weather', 'Identifier' => 'Weather', 'Help' => 'weather', 'Cmdstats' => 'Weather', 'Forker' => 1, 'Module' => 'Weather') ); &addCmdHook('wiki(pedia)?', ('CODEREF' => 'wikipedia::wikipedia', 'Identifier' => 'wikipedia', 'Cmdstats' => 'wikipedia', 'Forker' => 1, 'Help' => 'wikipedia', 'Module' => 'wikipedia') ); &addCmdHook('wtf', ('CODEREF' => 'wtf::query', 'Identifier' => 'wtf', 'Cmdstats' => 'wtf', 'Forker' => 1, 'Help' => 'wtf', 'Module' => 'wtf') ); diff --git a/src/Factoids/Core.pl b/src/Factoids/Core.pl index c255207..7e5f26c 100644 --- a/src/Factoids/Core.pl +++ b/src/Factoids/Core.pl @@ -20,7 +20,7 @@ sub validFactoid { # allow the following only if they have been made on purpose. if ( $rhs ne '' and $rhs !~ /^ 0; - return '' if ( length $query < &::getChanConf('minVolunteerLength') ); + return '' + if ( + length $query < + &::getChanConfDefault( 'minVolunteerLength', 2, $chan ) or + $param{'addressing'} =~ m/require/i ); + return '' + if ( + length $query > + &::getChanConfDefault( 'maxVolunteerLength', 512, $chan ) or + $param{'addressing'} =~ m/require/i ); } else { ### TODO: this should be caught in Process.pl? diff --git a/src/Factoids/Statement.pl b/src/Factoids/Statement.pl index 2c5a8e2..48b10cb 100644 --- a/src/Factoids/Statement.pl +++ b/src/Factoids/Statement.pl @@ -58,6 +58,24 @@ sub doStatement { if ( $in =~ /(^|\s)(is|are)(\s|$)/i ) { my ( $lhs, $mhs, $rhs ) = ( $`, $&, $' ); + # Quit if they are over the limits. Check done here since Core.pl calls + # this mid sub and Question.pl needs its own check as well. NOTE: $in is + # used in this place since lhs and rhs are really undefined for unwanted + # teaching. Mainly, the "is" could be anywhere within a 510 byte or so + # block of text, so the total size was choosen since the sole purpose of + # this logic is to not hammer the db with pointless factoids that were + # only meant to be general conversation. + return '' + if ( + length $in < + &::getChanConfDefault( 'minVolunteerLength', 2, $chan ) or + $param{'addressing'} =~ m/require/i ) and not $addressed; + return '' + if ( + length $in > + &::getChanConfDefault( 'maxVolunteerLength', 512, $chan ) or + $param{'addressing'} =~ m/require/i ) and not $addressed; + # allows factoid arguments to be updated. -lear. $lhs =~ s/^(cmd: )?(.*)/$1||'' . lc $2/e; diff --git a/src/IRC/Irc.pl b/src/IRC/Irc.pl index e4c43a8..b3e5a90 100644 --- a/src/IRC/Irc.pl +++ b/src/IRC/Irc.pl @@ -117,6 +117,7 @@ sub irc { "Connecting to port $port of server $server ($resolve) as $mynick ..." ); $args{'Nick'} = $mynick; + $args{'Username'} = $mynick; $conns{$mynick} = $irc->newconn(%args); if ( !defined $conns{$mynick} ) { &ERROR('IRC: connection failed.'); @@ -172,7 +173,7 @@ sub irc { $conns{$mynick}->add_global_handler( 352, \&on_who ); $conns{$mynick}->add_global_handler( 353, \&on_names ); $conns{$mynick}->add_global_handler( 366, \&on_endofnames ); - $conns{$mynick}->add_global_handler( 376, \&on_endofmotd ) + $conns{$mynick}->add_global_handler( "001", \&on_connected ) ; # on_connect. $conns{$mynick}->add_global_handler( 433, \&on_nick_taken ); $conns{$mynick}->add_global_handler( 439, \&on_targettoofast ); @@ -522,6 +523,7 @@ sub joinchan { my ( $chan, $key ) = @_; $key ||= &getChanConf( 'chankey', $chan ); $key ||= ''; + my $mynick = $conn->nick(); # forgot for about 2 years to implement channel keys when moving # over to Net::IRC... @@ -532,7 +534,7 @@ sub joinchan { } #} else { - &status("joining $b_blue$chan $key$ob"); + &status("$mynick joining $b_blue$chan $key$ob"); return if ( $conn->join( $chan, $key ) ); return if ( &validChan($chan) ); diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl index af96470..409b818 100644 --- a/src/IRC/IrcHooks.pl +++ b/src/IRC/IrcHooks.pl @@ -150,7 +150,7 @@ sub on_ison { &DEBUG("on_ison: x1 = '$x1', x2 => '$x2'"); } -sub on_endofmotd { +sub on_connected { $conn = shift(@_); # update IRCStats. @@ -1201,11 +1201,17 @@ sub on_crversion { } push( @vernick, $nick ); + &DEBUG("on_crversion: Got '$ver' from $nick"); + if ( $ver =~ /bitchx/i ) { $ver{bitchx}{$nick} = $ver; } - elsif ( $ver =~ /xc\!|xchat/i ) { + elsif ( $ver =~ /infobot/i ) { + $ver{infobot}{$nick} = $ver; + + } + elsif ( $ver =~ /(xc\!|xchat)/i ) { $ver{xchat}{$nick} = $ver; } @@ -1213,20 +1219,19 @@ sub on_crversion { $ver{irssi}{$nick} = $ver; } - elsif ( $ver =~ /epic|(Third Eye)/i ) { + elsif ( $ver =~ /(epic|Third Eye)/i ) { $ver{epic}{$nick} = $ver; } - elsif ( $ver =~ /ircII|PhoEniX/i ) { + elsif ( $ver =~ /(ircII|PhoEniX)/i ) { $ver{ircII}{$nick} = $ver; } elsif ( $ver =~ /mirc/i ) { - - # &DEBUG("verstats: mirc: $nick => '$ver'."); + # Apparently, mIRC gets the reply as "VERSION " and doesnt like the + # space, so mirc matching is considered bugged. $ver{mirc}{$nick} = $ver; - # ok... then we get to the lesser known/used clients. } elsif ( $ver =~ /ircle/i ) { $ver{ircle}{$nick} = $ver; diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl index 925ce1e..14721dc 100644 --- a/src/IRC/Schedulers.pl +++ b/src/IRC/Schedulers.pl @@ -752,9 +752,9 @@ sub ircCheck { $conn = $conns{$_}; my $mynick = $conn->nick(); &DEBUG("ircCheck for $_"); - my @join = - &getJoinChans(900) - ; # Display with min of 900sec delay between redisplay + # Display with min of 900sec delay between redisplay + # FIXME: should only use 900sec when we are on the LAST %conns + my @join = &getJoinChans(900); if ( scalar @join ) { &FIXME( 'ircCheck: found channels to join! ' . join( ',', @join ) ); &joinNextChan(); diff --git a/src/Modules/UserDCC.pl b/src/IRC/UserDCC.pl similarity index 100% rename from src/Modules/UserDCC.pl rename to src/IRC/UserDCC.pl diff --git a/src/Misc.pl b/src/Misc.pl index e999a2f..9545f6c 100644 --- a/src/Misc.pl +++ b/src/Misc.pl @@ -688,8 +688,8 @@ sub closeStats { 'stats', 'counter', { - nick => $type, - type => 'cmdstats', + 'nick' => $type, + 'type' => 'cmdstats', } ); my $z = 0; @@ -699,11 +699,13 @@ sub closeStats { &sqlSet( 'stats', - { 'nick' => $type }, { - type => 'cmdstats', - 'time' => time(), - counter => $i, + 'nick' => $type, + 'type' => 'cmdstats', + }, + { + 'time' => time(), + 'counter' => $i, } ); } diff --git a/src/Modules/BZFlag.pl b/src/Modules/BZFlag.pl old mode 100755 new mode 100644 diff --git a/src/Modules/Google.pl b/src/Modules/Google.pl new file mode 100644 index 0000000..dd585cc --- /dev/null +++ b/src/Modules/Google.pl @@ -0,0 +1,79 @@ +# W3Search drastically altered back to GoogleSearch as Search::Google +# was deprecated and requires a key that google no longer provides. +# This new module uses REST::Google::Search +# Modified by db 12-01-2008. +# +# Usage: 'chanset _default +Google' in query window with your bot +# to enable it in all channels +# /msg botnick google OR google to use + +package Google; + +use strict; + +my $maxshow = 5; + +sub GoogleSearch { + my ( $what, $type ) = @_; + # $where set to official google colors ;) + my $where = "\00312G\0034o\0038o\00312g\0033l\0034e\003"; + my $retval = "$where can't find \002$what\002"; + my $Search; + my $referer = "irc://$::server/$::chan/$::who"; + + return unless &::loadPerlModule("REST::Google::Search"); + + &::DEBUG( "Google::GoogleSearch->referer = $referer" ); + &::status( "Google::GoogleSearch> Searching Google for: $what"); + REST::Google::Search->http_referer( $referer ); + $Search = REST::Google::Search->new( q => $what ); + + if ( !defined $Search ) { + &::msg( $::who, "$where is invalid search." ); + &::WARN( "Google::GoogleSearch> $::who generated an invalid search: $where"); + return; + } + + if ( $Search->responseStatus != 200 ) { + &::msg( $::who, "http error returned." ); + &::WARN( "Google::GoogleSearch> http error returned: $Search->responseStatus"); + return; + } + + # No results found + if ( not $Search->responseData->results ) { + &::DEBUG( "Google::GoogleSearch> $retval" ); + &::msg( $::who, $retval); + return; + } + + my $data = $Search->responseData; + my $cursor = $data->cursor; + my @results = $data->results; + my $count; + + $retval = "$where says \"\002$what\002\" is at "; + foreach my $r (@results) { + my $url = $r->url; + + # Returns a string with each %XX sequence replaced with the actual byte + # (octet). From URI::Escape uri_unescape() + $url =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + + $retval .= " \002or\002 " if ( $count > 0 ); + $retval .= $url; + last if ++$count >= $maxshow; # Only seems to return max of 4? + } + + &::performStrictReply($retval); +} + +1; + +# vim:ts=4:sw=4:expandtab:tw=80 +# Local Variables: +# mode: cperl +# tab-width: 4 +# fill-column: 80 +# indent-tabs-mode: nil +# End: diff --git a/src/Modules/W3Search.pl b/src/Modules/W3Search.pl deleted file mode 100644 index 27bdbd7..0000000 --- a/src/Modules/W3Search.pl +++ /dev/null @@ -1,67 +0,0 @@ -# WWWSearch backend, with queries updating the is-db (optionally) -# Uses WWW::Search::Google and WWW::Search -# originally Google.pl, drastically altered. - -package W3Search; - -use strict; -use vars qw(@W3Search_engines $W3Search_regex); - -@W3Search_engines = qw(AltaVista Dejanews Excite Gopher HotBot Infoseek - Lycos Magellan PLweb SFgate Simple Verity Google z); -$W3Search_regex = join '|', @W3Search_engines; - -my $maxshow = 5; - -sub W3Search { - my ( $where, $what, $type ) = @_; - my $retval = "$where can't find \002$what\002"; - my $Search; - - my @matches = grep { lc($_) eq lc($where) ? $_ : undef } @W3Search_engines; - if (@matches) { - $where = shift @matches; - } - else { - &::msg( $::who, "i don't know how to check '$where'" ); - return; - } - - return unless &::loadPerlModule("WWW::Search"); - - eval { $Search = new WWW::Search( $where, agent_name => 'Mozilla/4.5' ); }; - - if ( !defined $Search ) { - &::msg( $::who, "$where is invalid search." ); - return; - } - - my $Query = WWW::Search::escape_query($what); - $Search->native_query( - $Query, - { - num => 10, - - # search_debug => 2, - # search_parse_debug => 2, - } - ); - $Search->http_proxy( $::param{'httpProxy'} ) if ( &::IsParam('httpProxy') ); - - #my $max = $Search->maximum_to_retrieve(10); # DOES NOT WORK. - - my ( @results, $count, $r ); - $retval = "$where says \002$what\002 is at "; - while ( $r = $Search->next_result() ) { - my $url = $r->url(); - $retval .= ' or ' if ( $count > 0 ); - $retval .= $url; - last if ++$count >= $maxshow; - } - - &::performStrictReply($retval); -} - -1; - -# vim:ts=4:sw=4:expandtab:tw=80 diff --git a/src/Modules/babelfish.pl b/src/Modules/babelfish.pl index 8898bda..920bf2e 100644 --- a/src/Modules/babelfish.pl +++ b/src/Modules/babelfish.pl @@ -14,7 +14,8 @@ package babelfish; use strict; my $no_babelfish; -my $url = 'http://babelfish.av.com/tr'; +#my $url = 'http://babelfish.av.com/tr'; +my $url = 'http://babelfish.yahoo.com/translate_txt'; BEGIN { eval "use URI::Escape"; # utility functions for encoding the @@ -73,11 +74,8 @@ sub babelfishParam { my $req = HTTP::Request->new( 'POST', $url ); - # babelfish ignored this, but it SHOULD work - # Accept-Charset: iso-8859-1 - # $req->header('Accept-Charset' => 'iso-8859-1'); - # print $req->header('Accept-Charset'); - $req->header( 'Accept-Language' => 'en' ); + $req->header('Accept-Language' => 'en-us'); + $req->header('Accept-Charset' => 'UTF-8,*'); $req->content_type('application/x-www-form-urlencoded'); return translate( $phrase, "${from}_${to}", $req, $ua ); @@ -98,27 +96,33 @@ sub translate { if ( $res->is_success ) { my $html = $res->content; - # This method subject to change with the whims of Altavista's design - # staff. + # This method subject to change with the whims of Babelfish design staff. ($translated) = $html; - - $translated =~ s/<[^>]*>//sg; + # strip page head + $translated =~ s/.*<\/head>//sg; + # clean before doc-body + $translated =~ s/.*
]*>//sg; + # clean after first form + $translated =~ s/<\/form>.*//sg; + # convert back to spaces $translated =~ s/ / /sg; + &::DEBUG("================================\n$translated\n========================\n"); + # strip up to result + $translated =~ s/.*
//sg; + # strip rest of page + $translated =~ s/<\/div.*//sg; + # strip all markup + $translated =~ s/<[^>]*>/ /sg; + # \n to space + $translated =~ s/[\n\r\t]/ /g; + # strip leading whitespace + $translated =~ s/^\s+//sg; + # strip trailing whitespace + $translated =~ s/\s+$//sg; + # strip multiple whitespace $translated =~ s/\s+/ /sg; - #&::DEBUG("$translated\n===remove \n"); - - $translated =~ s/\s*Translate again.*//i; - &::DEBUG("$translated\n===remove after 'Translate again'\n"); - - $translated =~ s/[^:]*?:\s*(Help\s*)?//s; - &::DEBUG( "len=" - . length($translated) - . " $translated\n===remove to first ':', optional Help\n" ); - - $translated =~ s/\n/ /g; - - # FIXME: should we do unicode->iso (no. use utf8!) + # FIXME: any entities to utf8? } else { $translated = ":("; # failure @@ -148,20 +152,6 @@ sub babelfish { return; } -if (0) { - if ( -t STDIN ) { - -#my $result = babelfish::babelfish('en sp hello world'); -#my $result = babelfish::babelfish('en sp The cheese is old and moldy, where is the bathroom?'); - my $result = - babelfish::babelfish( - 'en gr doesn\'t seem to translate things longer than 40 characters' - ); - $result =~ s/; /\n/g; - print "Babelfish says: \"$result\"\n"; - } -} - 1; # vim:ts=4:sw=4:expandtab:tw=80 diff --git a/src/Modules/dice.pl b/src/Modules/dice.pl old mode 100755 new mode 100644 diff --git a/src/Modules/upsidedown.pl b/src/Modules/upsidedown.pl index 81c6e05..751d298 100644 --- a/src/Modules/upsidedown.pl +++ b/src/Modules/upsidedown.pl @@ -126,7 +126,13 @@ sub turnedstr { my $turned = ''; my $tlength = 0; + # add reverse mappings + foreach my $up (keys %updown) { + $updown{$updown{$up}} = $up if ! exists $updown{$updown{$up}}; + } + for my $char ( $str =~ /(\X)/g ) { +#print STDERR "str=\"$str\" char=\"$char\"\n"; if ( exists $updown{$char} ) { my $t = $updown{$char}; $t = $missing if !length($t); @@ -153,6 +159,8 @@ sub upsidedown { &::performStrictReply( turnedstr( $message ) ); } +#binmode(STDERR, "encoding(UTF-8)"); +#print STDERR turnedstr("upsidedown ɟǝpɔqɐabcdef") . "\n"; 1; # vim:ts=4:sw=4:expandtab:tw=80 diff --git a/src/PoCiCommon.pm b/src/PoCiCommon.pm new file mode 100644 index 0000000..058a1fb --- /dev/null +++ b/src/PoCiCommon.pm @@ -0,0 +1,597 @@ +# This is a transitional file +#package POE::Component::IRC::Common; +package src::PoCiCommon; + +use strict; +use warnings; + +our $VERSION = '5.18'; + +require Exporter; +use base qw(Exporter); +our @EXPORT_OK = qw( + u_irc l_irc parse_mode_line parse_ban_mask matches_mask matches_mask_array + parse_user irc_ip_get_version irc_ip_is_ipv4 irc_ip_is_ipv6 has_color + has_formatting strip_color strip_formatting NORMAL BOLD UNDERLINE REVERSE + WHITE BLACK DARK_BLUE DARK_GREEN RED BROWN PURPLE ORANGE YELLOW LIGHT_GREEN + TEAL CYAN LIGHT_BLUE MAGENTA DARK_GREY LIGHT_GREY +); +our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] ); + +my ($ERROR, $ERRNO); + +use constant { + NORMAL => "\x0f", + + # formatting + BOLD => "\x02", + UNDERLINE => "\x1f", + REVERSE => "\x16", + ITALIC => "\x1d", + FIXED => "\x11", + + # mIRC colors + WHITE => "\x0300", + BLACK => "\x0301", + DARK_BLUE => "\x0302", + DARK_GREEN => "\x0303", + RED => "\x0304", + BROWN => "\x0305", + PURPLE => "\x0306", + ORANGE => "\x0307", + YELLOW => "\x0308", + LIGHT_GREEN => "\x0309", + TEAL => "\x0310", + CYAN => "\x0311", + LIGHT_BLUE => "\x0312", + MAGENTA => "\x0313", + DARK_GREY => "\x0314", + LIGHT_GREY => "\x0315", +}; + +sub u_irc { + my $value = shift || return; + my $type = shift || 'rfc1459'; + $type = lc $type; + + if ( $type eq 'ascii' ) { + $value =~ tr/a-z/A-Z/; + } + elsif ( $type eq 'strict-rfc1459' ) { + $value =~ tr/a-z{}|/A-Z[]\\/; + } + else { + $value =~ tr/a-z{}|^/A-Z[]\\~/; + } + + return $value; +} + +sub l_irc { + my $value = shift || return; + my $type = shift || 'rfc1459'; + $type = lc $type; + + if ( $type eq 'ascii' ) { + $value =~ tr/A-Z/a-z/; + } + elsif ( $type eq 'strict-rfc1459' ) { + $value =~ tr/A-Z[]\\/a-z{}|/; + } + else { + $value =~ tr/A-Z[]\\~/a-z{}|^/; + } + + return $value; +} + +sub parse_mode_line { + my @args = @_; + + my $chanmodes = [qw(beI k l imnpstaqr)]; + my $statmodes = 'ov'; + my $hashref = { }; + my $count = 0; + + while (my $arg = shift @args) { + if ( ref $arg eq 'ARRAY' ) { + $chanmodes = $arg; + next; + } + elsif ( ref $arg eq 'HASH' ) { + $statmodes = join '', keys %{ $arg }; + next; + } + elsif ( $arg =~ /^(\+|-)/ or $count == 0 ) { + my $action = '+'; + for my $char ( split (//,$arg) ) { + if ($char eq '+' or $char eq '-') { + $action = $char; + } + else { + push @{ $hashref->{modes} }, $action . $char; + } + + if ($char =~ /[$statmodes$chanmodes->[0]$chanmodes->[1]]/) { + push @{ $hashref->{args} }, shift @args; + } + + if ($action eq '+' && $char =~ /[$chanmodes->[2]]/) { + push @{ $hashref->{args} }, shift @args; + } + } + } + else { + push @{ $hashref->{args} }, $arg; + } + $count++; + } + + return $hashref; +} + +sub parse_ban_mask { + my $arg = shift || return; + + $arg =~ s/\x2a{2,}/\x2a/g; + my @ban; + my $remainder; + if ($arg !~ /\x21/ and $arg =~ /\x40/) { + $remainder = $arg; + } + else { + ($ban[0], $remainder) = split /\x21/, $arg, 2; + } + + $remainder =~ s/\x21//g if defined $remainder; + @ban[1..2] = split(/\x40/, $remainder, 2) if defined $remainder; + $ban[2] =~ s/\x40//g if defined $ban[2]; + + for my $i (1..2) { + $ban[$i] = '*' if !$ban[$i]; + } + + return $ban[0] . '!' . $ban[1] . '@' . $ban[2]; +} + +sub matches_mask_array { + my ($masks, $matches, $mapping) = @_; + + return if !$masks || !$matches; + return if ref $masks ne 'ARRAY'; + return if ref $matches ne 'ARRAY'; + my $ref = { }; + + for my $mask ( @{ $masks } ) { + for my $match ( @{ $matches } ) { + if ( matches_mask($mask, $match, $mapping) ) { + push @{ $ref->{ $mask } }, $match; + } + } + } + + return $ref; +} + +sub matches_mask { + my ($mask,$match,$mapping) = @_; + + return if !$mask || !$match; + $mask = parse_ban_mask($mask); + $mask =~ s/\x2A+/\x2A/g; + + my $umask = quotemeta u_irc( $mask, $mapping ); + $umask =~ s/\\\*/[\x01-\xFF]{0,}/g; + $umask =~ s/\\\?/[\x01-\xFF]{1,1}/g; + $match = u_irc $match, $mapping; + + return 1 if $match =~ /^$umask$/; + return; +} + +sub parse_user { + my $user = shift || return; + my ($n, $u, $h) = split /[!@]/, $user; + return ($n, $u, $h) if wantarray(); + return $n; +} + +sub has_color { + my $string = shift; + return 1 if $string =~ /[\x03\x04]/; + return; +} + +sub has_formatting { + my $string = shift; + return 1 if $string =~/[\x02\x1f\x16\x1d\x11]/; + return; +} + +sub strip_color { + my $string = shift; + + # mIRC colors + $string =~ s/\x03(?:,\d{1,2}|\d{1,2}(?:,\d{1,2})?)?//g; + $string =~ s/\x0f//g; + + # RGB colors supported by some clients + $string =~ s/\x04[0-9a-fA-F]{0,6}//ig; + + return $string; +} + +sub strip_formatting { + my $string = shift; + $string =~ s/[\x0f\x02\x1f\x16\x1d\x11]//g; + return $string; +} + +#------------------------------------------------------------------------------ +# Subroutine ip_get_version +# Purpose : Get an IP version +# Params : IP address +# Returns : 4, 6, 0(don't know) +sub irc_ip_get_version { + my $ip = shift || return; + + # If the address does not contain any ':', maybe it's IPv4 + return 4 if $ip !~ /:/ && irc_ip_is_ipv4($ip); + + # Is it IPv6 ? + return 6 if irc_ip_is_ipv6($ip); + + return; +} + +#------------------------------------------------------------------------------ +# Subroutine ip_is_ipv4 +# Purpose : Check if an IP address is version 4 +# Params : IP address +# Returns : 1 (yes) or 0 (no) +sub irc_ip_is_ipv4 { + my $ip = shift || return; + + # Check for invalid chars + if ($ip !~ /^[\d\.]+$/) { + $ERROR = "Invalid chars in IP $ip"; + $ERRNO = 107; + return; + } + + if ($ip =~ /^\./) { + $ERROR = "Invalid IP $ip - starts with a dot"; + $ERRNO = 103; + return; + } + + if ($ip =~ /\.$/) { + $ERROR = "Invalid IP $ip - ends with a dot"; + $ERRNO = 104; + return; + } + + # Single Numbers are considered to be IPv4 + return 1 if $ip =~ /^(\d+)$/ && $1 < 256; + + # Count quads + my $n = ($ip =~ tr/\./\./); + + # IPv4 must have from 1 to 4 quads + if ($n <= 0 || $n > 4) { + $ERROR = "Invalid IP address $ip"; + $ERRNO = 105; + return; + } + + # Check for empty quads + if ($ip =~ /\.\./) { + $ERROR = "Empty quad in IP address $ip"; + $ERRNO = 106; + return; + } + + for my $quad (split /\./, $ip) { + # Check for invalid quads + if ($quad < 0 || $quad >= 256) { + $ERROR = "Invalid quad in IP address $ip - $_"; + $ERRNO = 107; + return; + } + } + return 1; +} + +#------------------------------------------------------------------------------ +# Subroutine ip_is_ipv6 +# Purpose : Check if an IP address is version 6 +# Params : IP address +# Returns : 1 (yes) or 0 (no) +sub irc_ip_is_ipv6 { + my $ip = shift || return; + + # Count octets + my $n = ($ip =~ tr/:/:/); + return if ($n <= 0 || $n >= 8); + + # $k is a counter + my $k; + + for my $octet (split /:/, $ip) { + $k++; + + # Empty octet ? + next if $octet eq ''; + + # Normal v6 octet ? + next if $octet =~ /^[a-f\d]{1,4}$/i; + + # Last octet - is it IPv4 ? + if ($k == $n + 1) { + next if (ip_is_ipv4($octet)); + } + + $ERROR = "Invalid IP address $ip"; + $ERRNO = 108; + return; + } + + # Does the IP address start with : ? + if ($ip =~ m/^:[^:]/) { + $ERROR = "Invalid address $ip (starts with :)"; + $ERRNO = 109; + return; + } + + # Does the IP address finish with : ? + if ($ip =~ m/[^:]:$/) { + $ERROR = "Invalid address $ip (ends with :)"; + $ERRNO = 110; + return; + } + + # Does the IP address have more than one '::' pattern ? + if ($ip =~ s/:(?=:)//g > 1) { + $ERROR = "Invalid address $ip (More than one :: pattern)"; + $ERRNO = 111; + return; + } + + return 1; +} + +1; +__END__ + +=head1 NAME + +src::PoCiCommon - provides a set of common functions for the +infobot suite. Code originally from POE::Component::IRC::Common. + +=head1 SYNOPSIS + + use strict; + use warnings; + + use src::PoCiCommon qw( :ALL ); + + my $nickname = '^Lame|BOT[moo]'; + my $uppercase_nick = u_irc( $nickname ); + my $lowercase_nick = l_irc( $nickname ); + + my $mode_line = 'ov+b-i Bob sue stalin*!*@*'; + my $hashref = parse_mode_line( $mode_line ); + + my $banmask = 'stalin*'; + my $full_banmask = parse_ban_mask( $banmask ); + + if ( matches_mask( $full_banmask, 'stalin!joe@kremlin.ru' ) ) { + print "EEK!"; + } + + if ( has_color($message) ) { + print 'COLOR CODE ALERT!"; + } + + my $results_hashref = matches_mask_array( \@masks, \@items_to_match_against ); + + my $nick = parse_user( 'stalin!joe@kremlin.ru' ); + my ($nick, $user, $host) = parse_user( 'stalin!joe@kremlin.ru' ); + +=head1 DESCRIPTION + +src::PoCiCommon provides a set of common functions for the infobot suite. +Original code from POE::Component::IRC::Common. There are included functions +for uppercase and lowercase nicknames/channelnames and for parsing mode lines +and ban masks. + +=head1 CONSTANTS + +Use the following constants to add formatting and mIRC color codes to IRC +messages. + +Normal text: + + NORMAL + +Formatting: + + BOLD + UNDERLINE + REVERSE + ITALIC + FIXED + +Colors: + + WHITE + BLACK + DARK_BLUE + DARK_GREEN + RED + BROWN + PURPLE + ORANGE + YELLOW + LIGHT_GREEN + TEAL + CYAN + LIGHT_BLUE + MAGENTA + DARK_GREY + LIGHT_GREY + +Individual formatting codes can be cancelled with their corresponding constant, +but you can also cancel all of them at once with C. To cancel the effect +of previous color codes, you must use C. which of course has the side +effect of cancelling the effect of all previous formatting codes as well. + + $irc->yield('This word is ' . YELLOW . 'yellow' . NORMAL + . ' while this word is ' . BOLD . 'bold' . BOLD); + + $irc->yield(UNDERLINE . BOLD . 'This sentence is both underlined and bold.' + . NORMAL); + + + +=head1 FUNCTIONS + +=head2 C + +Takes one mandatory parameter, a string to convert to IRC uppercase, and one +optional parameter, the casemapping of the ircd ( which can be 'rfc1459', +'strict-rfc1459' or 'ascii'. Default is 'rfc1459' ). Returns the IRC uppercase +equivalent of the passed string. + +=head2 C + +Takes one mandatory parameter, a string to convert to IRC lowercase, and one +optional parameter, the casemapping of the ircd ( which can be 'rfc1459', +'strict-rfc1459' or 'ascii'. Default is 'rfc1459' ). Returns the IRC lowercase +equivalent of the passed string. + +=head2 C + +Takes a list representing an IRC mode line. Returns a hashref. If the modeline +couldn't be parsed the hashref will be empty. On success the following keys +will be available in the hashref: + + 'modes', an arrayref of normalised modes; + 'args', an arrayref of applicable arguments to the modes; + +Example: + + my $hashref = parse_mode_line( 'ov+b-i', 'Bob', 'sue', 'stalin*!*@*' ); + + # $hashref will be: + { + modes => [ '+o', '+v', '+b', '-i' ], + args => [ 'Bob', 'sue', 'stalin*!*@*' ], + } + +=head2 C + +Takes one parameter, a string representing an IRC ban mask. Returns a +normalised full banmask. + +Example: + + $fullbanmask = parse_ban_mask( 'stalin*' ); + + # $fullbanmask will be: 'stalin*!*@*'; + +=head2 C + +Takes two parameters, a string representing an IRC mask ( it'll be processed +with parse_ban_mask() to ensure that it is normalised ) and something to match +against the IRC mask, such as a nick!user@hostname string. Returns a true +value if they match, a false value otherwise. Optionally, one may pass the +casemapping (see L|/"u_irc">), as this function uses C +internally. + +=head2 C + +Takes two array references, the first being a list of strings representing +IRC masks, the second a list of somethings to test against the masks. Returns +an empty hashref if there are no matches. Otherwise, the keys will be the +masks matched, each value being an arrayref of the strings that matched it. +Optionally, one may pass the casemapping (see L|/"u_irc">), as +this function uses C internally. + +=head2 C + +Takes one parameter, a string representing a user in the form +nick!user@hostname. In a scalar context it returns just the nickname. +In a list context it returns a list consisting of the nick, user and hostname, +respectively. + +=head2 C + +Takes one parameter, a string of IRC text. Returns 1 if it contains any IRC +color codes, 0 otherwise. Useful if you want your bot to kick users for +(ab)using colors. :) + +=head2 C + +Takes one parameter, a string of IRC text. Returns 1 if it contains any IRC +formatting codes, 0 otherwise. + +=head2 C + +Takes one paramter, a string of IRC text. Returns the string stripped of all +IRC color codes. Due to the fact that both color and formatting codes can +be cancelled with the same character, this might strip more than you hoped for +if the string contains both color and formatting codes. Stripping both will +always do what you expect it to. + +=head2 C + +Takes one paramter, a string of IRC text. Returns the string stripped of all +IRC formatting codes. Due to the fact that both color and formatting codes can +be cancelled with the same character, this might strip more than you hoped for +if the string contains both color and formatting codes. Stripping both will +always do what you expect it to. + +=head2 C + +Try to guess the IP version of an IP address. + +Params: IP address +Returns: 4, 6, 0(unable to determine) + +C<$version = ip_get_version ($ip)> + +=head2 C + +Check if an IP address is of type 4. + +Params: IP address +Returns: 1 (yes) or 0 (no) + +C + +=head2 C + +Check if an IP address is of type 6. + +Params: IP address +Returns: 1 (yes) or 0 (no) + + ip_is_ipv6($ip) && print "$ip is IPv6"; + +=head1 AUTHOR + +Dan 'troubled' McGrath + +This whole module is shamelessly 'borrowed' from L +by Chris 'BinGOs' Williams + +=head1 SEE ALSO + +L + +L + +L + +=cut diff --git a/src/Process.pl b/src/Process.pl index 91b3f9d..21c2a69 100644 --- a/src/Process.pl +++ b/src/Process.pl @@ -26,8 +26,9 @@ sub process { $learnok = 1 if ($addressed); if ( $param{'learn'} =~ /^HUNGRY$/i ) { $learnok = 1; - $addrchar = 1; - $talkok = 1; + #FIXME: why can we talk if we just want to learn? + #$addrchar = 1; + #$talkok = 1; } &shmFlush(); # hack. @@ -274,7 +275,7 @@ sub process { } # greetings. - if ( $message =~ /how (the hell )?are (ya|you)( doin\'?g?)?\?*$/ ) { + if ( $message =~ /how (the hell )?are (ya|you)( doin\'?g?)?\?*$/ && $talkok ) { &performReply( &getRandom( keys %{ $lang{'howareyou'} } ) ); return; @@ -349,7 +350,8 @@ sub process { # allow administration of bot via messages (default is DCC CHAT only) if ( &IsFlag('A') ) { - &loadMyModule('UserDCC'); + # UserDCC.pl should autoload now from IRC/. Remove if desired + #&loadMyModule('UserDCC'); $er = &userDCC(); if ( !defined $er ) { return 'SOMETHING 2'; diff --git a/src/logger.pl b/src/logger.pl index f100fd6..37de334 100644 --- a/src/logger.pl +++ b/src/logger.pl @@ -7,6 +7,7 @@ # use strict; +use utf8; use vars qw($statcount $bot_pid $forkedtime $statcountfix $addressed); use vars qw($logDate $logold $logcount $logtime $logrepeat $running); @@ -91,6 +92,7 @@ sub cl { # logging support. sub openLog { + binmode( STDOUT, ':encoding(UTF-8)' ); return unless ( &IsParam('logfile') ); $file{log} = $param{'logfile'}; -- 2.39.5