Bot-BasicBot-Pluggable-1.00000755001750001750 012727613416 15454 5ustar00davidpdavidp000000000000TODO100644001750001750 43612727613416 16210 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00* B:BB:P::Message module * replied handler is still not working ... maybe lift tell from B::BB * better error message and not just echoing into the channel * converting store script * is the special case of return 1 in said() really needed? * remove modules with a lot of dependiencies README100644001750001750 2153112727613416 16437 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00NAME Bot::BasicBot::Pluggable - extended simple IRC bot for pluggable modules SYNOPSIS Creating the bot module # with all defaults. my $bot = Bot::BasicBot->new(); # with useful options. pass any option # that's valid for Bot::BasicBot. my $bot = Bot::BasicBot::Pluggable->new( channels => ["#bottest"], server => "irc.example.com", port => "6667", nick => "pluggabot", altnicks => ["pbot", "pluggable"], username => "bot", name => "Yet Another Pluggable Bot", ignore_list => [qw(hitherto blech muttley)], ); Running the bot (simple) There's a shell script installed to run the bot. $ bot-basicbot-pluggable --nick MyBot --server irc.perl.org Then connect to the IRC server, /query the bot, and set a password. See Bot::BasicBot::Pluggable::Module::Auth for further details. Running the bot (advanced) There are two useful ways to create a Pluggable bot. The simple way is: # Load some useful modules. my $infobot_module = $bot->load("Infobot"); my $google_module = $bot->load("Google"); my $seen_module = $bot->load("Seen"); # Set the Google key (see http://www.google.com/apis/). $google_module->set("google_key", "some google key"); $bot->run(); The above lets you run a bot with a few modules, but not change those modules during the run of the bot. The complex, but more flexible, way is as follows: # Load the Loader module. $bot->load('Loader'); # run the bot. $bot->run(); This is simpler but needs further setup once the bot is joined to a server. The Loader module lets you talk to the bot in-channel and tell it to load and unload other modules. The first one you'll want to load is the 'Auth' module, so that other people can't load and unload modules without permission. Then you'll need to log in as an admin and change the default password, per the following /query: !load Auth !auth admin julia !password julia new_password !auth admin new_password Once you've done this, your bot is safe from other IRC users, and you can tell it to load and unload other installed modules at any time. Further information on module loading is in Bot::BasicBot::Pluggable::Module::Loader. !load Seen !load Google !load Join The Join module lets you tell the bot to join and leave channels: , join #mychannel , leave #someotherchannel The perldoc pages for the various modules will list other commands. DESCRIPTION Bot::BasicBot::Pluggable started as Yet Another Infobot replacement, but now is a generalised framework for writing infobot-type bots that lets you keep each specific function seperate. You can have seperate modules for factoid tracking, 'seen' status, karma, googling, etc. Included default modules are below. Use "perldoc Bot::BasicBot::Pluggable::Module:: for help on their individual terminology. Auth - user authentication and admin access. DNS - host lookup (e.g. nslookup and dns). Google - search Google for things. Infobot - handles infobot-style factoids. Join - joins and leaves channels. Karma - tracks the popularity of things. Loader - loads and unloads modules as bot commands. Seen - tells you when people were last seen. Title - gets the title of URLs mentioned in channel. Vars - changes module variables. The way the Pluggable bot works is very simple. You create a new bot object and tell it to load various modules (or, alternatively, load just the Loader module and then interactively load modules via an IRC /query). The modules receive events when the bot sees things happen and can, in turn, respond. See "perldoc Bot::BasicBot::Pluggable::Module" for the details of the module API. METHODS new(key => value, ...) Create a new Bot. Except of the additional attributes loglevel and logconfig identical to the "new" method in Bot::BasicBot. Please refer to their accessor for documentation. load($module) Load a module for the bot by name from "./ModuleName.pm" or "./modules/ModuleName.pm" in that order if one of these files exist, and falling back to "Bot::BasicBot::Pluggable::Module::$module" if not. reload($module) Reload the module $module - equivalent to unloading it (if it's already loaded) and reloading it. Will stomp the old module's namespace - warnings are expected here. Not toally clean - if you're experiencing odd bugs, restart the bot if possible. Works for minor bug fixes, etc. unload($module) Removes a module from the bot. It won't get events any more. module($module) Returns the handler object for the loaded module $module. Used, e.g., to get the 'Auth' hander to check if a given user is authenticated. modules Returns a list of the names of all loaded modules as an array. available_modules Returns a list of all available modules whether loaded or not add_handler($handler_object, $handler_name) Adds a handler object with the given name to the queue of modules. There is no order specified internally, so adding a module earlier does not guarantee it'll get called first. Names must be unique. remove_handler($handler_name) Remove a handler with the given name. store Returns the bot's object store; see Bot::BasicBot::Pluggable::Store. log Logs all of its argument to loglevel info. Please do not use this function in new code, it's simple provided as fallback for old modules. loglevel Returns the bots loglevel or sets it if an argument is supplied. It expects trace, debug, info, warn, error or fatal as value. logconfig Returns the bot configuration file for logging. Please refer to Log::Log4perl::Config for the configurations files format. Setting this to a differant file after calling init() has no effect. Returns or set dispatch($method_name, $method_params) Call the named $method on every loaded module with that method name. help Returns help for the ModuleName of message 'help ModuleName'. If no message has been passed, return a list of all possible handlers to return help for. run Runs the bot. POE core gets control at this point; you're unlikely to get it back. BUGS During the "make", "make test", "make install" process, POE will moan about its kernel not being run. This is a "Bot::BasicBot problem", apparently. Reloading a module causes warnings as the old module gets its namespace stomped. Not a lot you can do about that. All modules must be in Bot::Pluggable::Module:: namespace. Well, that's not really a bug. REQUIREMENTS Bot::BasicBot::Pluggable is based on POE, and really needs the latest version. Because POE is like that sometimes. You also need POE::Component::IRC. Oh, and Bot::BasicBot. Some of the modules will need more modules, e.g. Google.pm needs Net::Google. See the module docs for more details. LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. AUTHOR Mike Eldridge I am merely the current maintainer; however, the AUTHOR heading is traditional. CONTRIBUTORS * Mario Domgoergen * Tom Insam CREDITS Bot::BasicBot was written initially by Mark Fowler, and worked on heavily by Simon Kent, who was kind enough to apply some patches we needed for Pluggable. Eventually. Oh, yeah, and I stole huge chunks of docs from the Bot::BasicBot source too. I spent a lot of time in the mozbot code, and that has influenced my ideas for Pluggable. Mostly to get round its awfulness. Various people helped with modules. Convert was almost ported from the infobot code by blech. But not quite. Thanks for trying... blech has also put a lot of effort into the chump.cgi & chump.tem files in the examples/ folder, including some /inspired/ calendar evilness. And thanks to the rest of #2lmc who were my unwilling guinea pigs during development. And who kept suggesting totally stupid ideas for modules that I then felt compelled to go implement. Shout.pm owes its existence to #2lmc. SEE ALSO * POE * POE::Component::IRC * Bot::BasicBot * Infobot: http://www.infobot.org/ * Mozbot: http://www.mozilla.org/projects/mozbot/ Changes100644001750001750 4261112727613416 17054 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00Revision history for Perl extension Bot::BasicBot::Pluggable. 1.00 - 2016-06-13 - Match only one "word" in seen responses Avoid silly mis-triggers. GH PR-3 (bigpresh) - Ignore links in messages from ourselves, so we avoid turtle situations. GH PR-2 (bigpresh) - Karma plugin - match nicks with \S+, not \w+, so nicks with hyphens in can have karma. GH PR-1 (bigpresh) - Better-document how said() resturn value is handled, to avoid potential confusion. GH PR-4 (bigpresh) ********************************************************************* David Precious (BIGPRESH) taking over maintainership at this point, kind thanks to Mike Eldridge (DIZ) for kindly handing over maintainership to me. I still make active use of this bot framework, and want to see it continue to be loved and supported, so bug reports and pull requests are welcome! ********************************************************************* 0.97 - Thu Jun 14 10:39:29 CDT 2012 - more fixes from bigpresh - fix regression in ChanOp->isop() introduced in 0.95 (thanks to ambs for finding it) 0.96 - Wed Feb 29 21:05:58 CST 2012 - more fixes from bigpresh: - fix tests busted by karma changes - fix regression in the seen module 0.95 - Tue Nov 15 20:58:25 CST 2011 - a number of fixes and enhancements from bigpresh: - new feature: ability to hide channels from being "seen" by the Seen module - new feature: ability for the Karma module to report karma upon change - cleanup in the Karma module (plus an easter egg) - eliminate warnings in ChanOp module - typo fixes - allow the configfile to be undef from adamtaylor - handle interrogatives in the Karma module 0.94 - Tue Nov 15 20:45:32 CST 2011 - botched release (forgot to pull before releasing - *sigh*) 0.93 - Mon Jun 27 10:40:24 CDT 2011 - when creating temporary files for Store::Storable->save, make sure they are created in the same directory that the final file will be moved to. if not, the rename may fail if the source and destination are on separate filesystems. (RT #68886) - correctly parse relative paths from *.storable file globbing in the Storable backend store. this was preventing the store from restoring data for modules. (RT #68887) 0.92 - Thu May 5 08:39:08 CDT 2011 - added ability to load modules of arbitrary depth, courtesy of david precious (bigpresh) - refactor Auth module so that it doesn't step on other modules by eating all bang commands, also courtesy of bigpresh. - added Crypt::SaltedHash to the prereqs list 0.91 - Tue Dec 7 00:05:51 CST 2010 - added transparent support for salted password hashes (RT #63232), courtesy of david precious (bigpresh) - fix busted flood protection (RT #62864), courtesy of david precious (bigpresh) - fix minor warning-producing exception in ChanOp->isop, also courtesy of the B.P. 0.90 - Fri Nov 5 17:14:30 CDT 2010 - bumped dependency on Log::Log4perl from 0 to 1.11 due to dependency on the trace log level (RT #56540) 0.89 - Thu Oct 28 18:09:18 CDT 2010 - Added DBD::SQLite and YAML::XS to the test dependency list - Quote table identifiers in Bot::BasicBot::Pluggable::Store::DBI - Bot::BasicBot::Pluggable is under new maintenance \o/ 0.88 2010/08/29 Removing build dependencies for Test::Perl::Critic and Test::Tidy. Bot::BasicBot::Pluggable is looking for a new maintainer (again...) as the current maintainer is not using it anymore. Please mail to if you are interested in taking over this fine module. 0.87 2010/05/09 Remove all recommends due some failing tests. In a future release, some of the modules with long dependencies will be removed from this distribution and form their own on CPAN. I look at you DBI... Switched to Dist::Zilla 0.86 2010/03/28 Thanks to Jacob Helwig for the follwoing changes: Join: Check for auth after checking whether we should handle the message at Add a new check to Bot::BasicBot::Pluggable::Module::Join to see whether the module should handle the message at all, and move the "is the user authed" after this check. By doing this we no longer send out "Sorry, ..." messages if someone happens to say "botname: Hi there!" without being authorized. 0.85 2010/02/13 This is the David-Precious-aka-bigpresh-release, who commited all changes via Github. Thanks! - Join: Don't accept commands to join/part channels unless the user asking us to do so is auth'd to the bot - ChanOp: Make the ChanOp module actually work (uhm...) 0.84 2009/12/11 - Log4Perl: Instead of just printing error messages to stdout, the bot now uses Log4perl to emit warnings and debugging information. For now i just added this new capability to Bot::BasicBot::Pluggable but this will be expanded to all the modules in one of the next releases. The bot's old log() function will now emit a message with priority warning to mimic the old behaviour. The command line bots now have two new options: --loglevel and --logconfig. - Commandline Bot: A simple command line bot was part of the github repository for quite some time now, but it was never shipped with a release before. To close #46875 and as it's a really neat way to test some modules, i'll reworked bot-basicbot-pluggable-cli, added App::Bot::BasicBot::Pluggable::Console and Bot::BasicBot::Pluggable::Console and use Test::Bot::BasicBot::Pluggable as its basis. You can call it with the same arguments as its irc cousin, but some options like --server or even --channel does not (yet?) make any sense in this context. - Auth: Added allow_anonymous as requested and implemented by Toni Spets. Setting this value to true, does basically disable authentication for all modules, that are not explicitly checking for the users authentication level. You only ever want to set this value to true, if you want to develop modules that need to prefix commands with ! for unauthenticated users. You've been warned. - Loader, Vars: As direct consequence Loader.pm and Vars.pm do now check explicitly. - Loader: !list does now also return all available but not loaded modules (thanks to Manuel Hachtkemper for the hint). I can see that the old behaviour might be a little bit confusing for some users. - available_modules() returns really all available modules ... till this release the bot just returned modules in PERL5LIB and ignored modules in ./modules and ./ - Store: DBI, DBM::Deep and DBD::SQLite are no langer hard requirements of this module. Bot::BasicBot::Pluggable now tries to load all storage types in a predefined order until one returns successfully. Normally you should just select one explicitly. - Base.pm: Removed Base.pm from the list of available modules und depracate its usage - Try::Tiny: Error handling is now performed by try::tiny instead of writing all the eval boilerplate. Although it does lack some convenience, i selected it as we'll get it through moose in any case. - ChanOp.pm: New core module to handle channel managment operations like oping, deoping, kicking and flood control. Please take a closer look at this module, it definitly needs some testing! 0.83 2009/11/08 - added four missing dispatch events from Bot::Basicbot: nick_change, kicked, topic and userquit. All four can now be handled by modules. - converted some evaled expressions to code blocks - documented a problem with hash signs in yaml configuration files 0.82 2009/08/31 - Failing tests on cpantesters as two tests are creating intermediate files. I'm just using the memory backend again. 0.81 2009/08/30 - redfined logic of --store option Although i added a store option in the last version of the command line bot, it wasn't really helpful as you just could load storage backend without any options. The --store option is now a hashref, with the only drawback that you have to specify a storage type even if you just want load a backend without any options. - moved store_from_hashref from B::BB::P to B::BB::P::Store and renamed it to new_from_hashref. This could possibly *break* code, but i didn't expect it to. *hrhr* 0.80 2009/08/15 - new command line bot big rewrite of the command line bot with the help of MooseX::Getopt and MooseX::SimpleConfig. It should be possible to call a lot of aspects of the pluggable infrastructure without writing perl code. 0.79 2009/07/12 - the need-more-sleep-release ... sorry, that's the last for today - replied was never called ... now we put it back in front again but shallow copy the message first 0.78 2009/07/12 - replied is now called after reply so that modules really can't change the message 0.77 2009/07/12 - added a new event 'replied' to give any module the chance to act on that - Join: - corrected missing command in help - Seen: - now also reckognize joins and parts - Infobot: - there's an user defineable http_timeout variabe that defaults to ten seconds (fixes #3239) - settable limit on how many RSS items to return - just shorten entries when @entries is bigger than user_max_entries - Vars: - checking the definedness of $value so you can set a variable to 0 for example 0.76 2009/06/28 - the store paramter to B:BB:P->new() can now also be a string - new config interface for modules - search for keywords in Infobot.pm now returns the right number of factoids - when deleting factoids return the right answer - total rewrite of the join module (old database format will be converted on the fly) - a lot of new tests - new module Bot::BasicBot::Pluggable::Store::Memory (kind of) - new module Test::Bot::BasicBot::Pluggable::Store - testbot now intercepts the help call 0.74 2009/06/20 - added additional slash to fix #46928 (t/05infobot.t) - added t/03store_storable.t - closes #3258: instead of just overwriting the storable file it creates a tempfile and the move it - Moved FakeBot to Test::Bot::BasicBot::Pluggable so that it's accessable for other Modules - renamed infobot.t and title.t - only create a new table if it doesn't exists yet in Store::DBI 0.72 2009/06/04 - Fixed absolute path in t/infobot.t ... stupid! - Added me (Mario) to the author list - Added the git repository to the meta resources 0.71 2009/06/01 - Add a test for unparsable rss feeds to Infobot - Better error message for unparsable rss feeds in Infobot - Added ignore_re option to Title (by osfameron) - Adjusting documentation for Load to refer to the real behaviour 0.7 2009/03/10 - Missing t/FakeBot.pm added to MANIFEST - Adjusted number of tests for Test::More - Karma: - Testsuide added - Listing of explainations works again (settable by num_comments) - New variable random_reasons - Documentation updated 0.6 2009/03/04 It's been.. uh.. 4 years. There are tickets in RT that simply don't apply to the current codebase. Personally, I never work on this module, use it for one small thing that never changes, and have started to really dislike programming in perl recently. Thus I'm just going to release trunk as-is. It's got a lot of changes. Things might break. Sorry. I dislike other people doing this, and I dislike _me_ doing this, but I see very few other options at this point. I'm putting all the code in a github repository at http://github.com/jerakeen/bot-basicbot-pluggable if people want to actually track what goes on. Anyone want to take B::B::P over? -- This is the "Morbus release". Why the "Morbus release"? Quite simply because he did everything you see below. You can chastise him for his ego at http://disobey.com/. - Revised documentation for Pluggable.pm and Module.pm. - Auth: Revised documentation, switched to admin() not said(). - DNS: Revised documentation, switched to told() not said(). - Google: - Revised documentation, switched to told() not said(). - Removed deprecated Net::Google ie() and oe() methods. - Default language restriction set to just 'en'; removed 'fr'. - Removed explicit starts_at of 0, which is the default. - New option added: num_results (default: 3). - New option added: languages (default: en). - New option added: require_addressing (default: 1). - Join: Revised documentation, switched to told() not said(). - Karma: - Revised documentation, switched to told() and seen(). - Replaced fisher_yates with newer version from Perl 5.8. - Fixed a bunch of little nigglies here and there. - New option added: num_comments (default: 3). - New option added: show_givers (default: 1). - New option added: ignore_selfkarma (default: 1). - If only "karma", we assume $mess->{who} now. - Now understands "++" and "--"; - Loader: Revised documentation, switched to told() not said(). - Seen: - Revised documentation, switched to seen() and told(). - Echoed $who is now what the user typed, not lc'd version. - New option added: allow_hiding (default: 1). - Title: Revised documentation, switched to admin() not said(). - Vars: - Revised documentation, switched to told() not said(). - Removed the check for the existence of $value on a !set. This check would fail whenever anyone tried to set the $value to 0, which makes perfect sense when you're trying to turn off a boolean'd feature. !unset doesn't work because that entirely deletes the $variable, which means it'll be reset to the default the next time the module is reloaded or the bot is restarted. - Revised documentation for Store.pm and Store/* modules. - Infobot: - Revised all the documentation, added more examples. - Removed the 'ask' option; it was never actually used. - Renamed option 'passive_ask' to 'passive_answer'. More sense. - Added a small but decent list of common stopwords. - New option: num_results (for "search for "; default 20). - New option: require_question ("water?" or "water"; default 1). - Entirely removed the "literal $object" feature. - New option: min_length (minimum $object length; default 3). - New option: max_length (maximum $object length; default 25). - New option: unknown_responses (random list of "No clue." responses). - You can now replace facts with "no, $bot, $object is..." too. - $who in a factoid is now replaced by $mess->{who}. - Stopwords were NOT being stopped on word boundaries. Fixed. - "no, $bot, $object is also $fact" now works for appending. - Added handling of "my" as in "my cat is named chloe". 0.50 2004/01/18 - Moved Bot::BasicBot::Pluggble::Module::Base to B::B::P::Module.pm, and added Base.pm as an empty subclass, for neatness. - Documented the object store methods better. - Changed all core modules to use the proget get/set store methods. - Loader now uses the standard store system. - Installed shell script to run B::B::P. - The Infobot module can now passively learn and passively answer questions (without direct addressing) and you can set these options seperately. - The storage system is decently abstracted out, and has a default that does the same thing as the last one. - Gave the bot a default charset of utf8, because I'm a fan of utf8. - Utterly changed the Infobot back-end store system. Updating it will be a pain, I'm sorry, but the last one really sucked. Re-wrote the Infobot module to be _readable_, or at least slightly less nasty than before. 0.30 - Improved docs. - Synced version number with Bot::BasicBot again. - Added NINJA support. - Moved to Module::Build-based module layout. - Huge docs improvement, based on feedback from people who clearly had no idea what I was smoking at the time. - Decent examples in examples/, and web page copies for people who use CPAN. - Removed Blog and Shout modules - Blog to be spun off into a seperate module, Shout was just stupid. - Support for loading modules from 'Modules' in cwd as well as main lib path. - The bot is a lot less case-sensitive. Still sensitive for loading modules, but all the help, etc commands are more friendly. - Removed 'reply' method (now in Bot::BasicBot). - Slight module API changes, nothing significant: - Added a 'tick' callback that happens every 5 seconds. - Added a 'reply' local method that mirrors the Bot::BasicBot reply. - Added a 'say' method that calls the Bot::BasicBot say. - Added a very simple 'tell' method for simple statements. - Added an 'emoted' callback that works identically to 'said'. - Added a 'chanjoin' callback, called when someone joins a channel. - Added a 'chanpart' callback, called when someone leaves a channel. - Module changes (other than doc improvements): - Auth: - Fixed silly bug that meant you didn't actually need to auth. - Smarter about ignoring things that aren't admin commands. - Now requires direct addressing. - Blog: removed. Look for Bot::BasicBot::Pluggable::Module::Blog. - Spell: Fixed a spelling mistake. - Infobot: Fixed annoying parser bugs. Needs to re-write whole thing soon. - Karma: Removed case-sensitivity in karma objects. 0.05 2003/06/09 - Better documentation. - Vars changable through better interface. 0.04 2003/03/05 - Release coincides with Simon's release of Bot::Basicbot, version matched. - Therefore the first release that actually Worked out the box. 0.011 2003/02/24 - oops. 0.01 2003/02/24 - original version; created by h2xs 1.22. LICENSE100644001750001750 4366712727613416 16602 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00This software is copyright (c) 2016 by Mario Domgoergen. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2016 by Mario Domgoergen. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2016 by Mario Domgoergen. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644001750001750 67612727613416 17172 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00name = Bot-BasicBot-Pluggable version = 1.00 author = David Precious license = Perl_5 copyright_holder = Mario Domgoergen [@Filter] bundle = @Classic remove = Readme remove = PodCoverageTests [ModuleBuild] [AutoPrereqs] skip = ^Net::Google|Template|Test::Perl::Critic|Test::PerlTidy|Test::Builder::Module$ [Prereqs] Log::Log4perl = 1.11 Crypt::SaltedHash = 0.06 [Prereqs / TestRequires] DBD::SQLite = 0 YAML::XS = 0 META.yml100644001750001750 215612727613416 17012 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00--- abstract: 'extended simple IRC bot for pluggable modules' author: - 'David Precious ' build_requires: DBD::SQLite: 0 FindBin: 0 Module::Build: 0.28 Test::More: 0 YAML::XS: 0 configure_requires: ExtUtils::MakeMaker: 0 Module::Build: 0.28 dynamic_config: 0 generated_by: 'Dist::Zilla version 5.040, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Bot-BasicBot-Pluggable requires: Bot::BasicBot: 0.60 CGI: 0 Carp: 0 Config::Find: 0 Crypt::SaltedHash: 0.06 DBI: 0 DBM::Deep: 0 Data::Dumper: 0 File::Copy: 0 File::Spec: 0 File::Temp: 0 LWP::UserAgent: 0 List::MoreUtils: 0 Log::Log4perl: 1.11 Log::Log4perl::Level: 0 Module::Load: 0 Module::Pluggable: 0 Moose: 0 Moose::Util::TypeConstraints: 0 MooseX::Getopt::Dashes: 0 MooseX::SimpleConfig: 0 POE: 0 Socket: 0 Storable: 0 Text::Unidecode: 0 Try::Tiny: 0 URI: 0 URI::Find::Simple: 0 URI::Title: 0 XML::Feed: 0 base: 0 lib: 0 perl: v5.8.0 strict: 0 warnings: 0 version: 1.00 MANIFEST100644001750001750 341612727613416 16672 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.040. Build.PL Changes LICENSE MANIFEST META.yml Makefile.PL README TODO bin/bot-basicbot-pluggable bin/bot-basicbot-pluggable-cgi bin/bot-basicbot-pluggable-cli bin/bot-basicbot-pluggable-infobot-upgrade bin/storable2dbi.pl dist.ini examples/chump.cgi examples/chump.tem examples/mind.pl examples/simple.pl lib/App/Bot/BasicBot/Pluggable.pm lib/App/Bot/BasicBot/Pluggable/Terminal.pm lib/Bot/BasicBot/Pluggable.pm lib/Bot/BasicBot/Pluggable/Module.pm lib/Bot/BasicBot/Pluggable/Module/Auth.pm lib/Bot/BasicBot/Pluggable/Module/Base.pm lib/Bot/BasicBot/Pluggable/Module/ChanOp.pm lib/Bot/BasicBot/Pluggable/Module/DNS.pm lib/Bot/BasicBot/Pluggable/Module/Google.pm lib/Bot/BasicBot/Pluggable/Module/Infobot.pm lib/Bot/BasicBot/Pluggable/Module/Join.pm lib/Bot/BasicBot/Pluggable/Module/Karma.pm lib/Bot/BasicBot/Pluggable/Module/Loader.pm lib/Bot/BasicBot/Pluggable/Module/Seen.pm lib/Bot/BasicBot/Pluggable/Module/Title.pm lib/Bot/BasicBot/Pluggable/Module/Vars.pm lib/Bot/BasicBot/Pluggable/Store.pm lib/Bot/BasicBot/Pluggable/Store/DBI.pm lib/Bot/BasicBot/Pluggable/Store/Deep.pm lib/Bot/BasicBot/Pluggable/Store/Memory.pm lib/Bot/BasicBot/Pluggable/Store/Storable.pm lib/Bot/BasicBot/Pluggable/Terminal.pm lib/Test/Bot/BasicBot/Pluggable.pm lib/Test/Bot/BasicBot/Pluggable/Store.pm t/00bootstrap.t t/01module_base.t t/02module_auth.t t/03store.t t/03store_dbi.t t/03store_deep.t t/03store_memory.t t/03store_storable.t t/04karma.t t/05infobot.t t/06title.t t/07app_defaults.t t/08app_commandline.t t/09app_configfile.t t/100critic.t t/101tidy.t t/10modules_not_in_inc.t t/author-pod-syntax.t t/configfiles/bot-basicbot-pluggable.yaml t/configfiles/empty.yaml t/modules/Foo.pm t/modules/modules/Bar.pm t/perlcriticrc t/test.rss Build.PL100644001750001750 426712727613416 17042 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00 # This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v5.040. use strict; use warnings; use Module::Build 0.28; my %module_build_args = ( "build_requires" => { "Module::Build" => "0.28" }, "configure_requires" => { "ExtUtils::MakeMaker" => 0, "Module::Build" => "0.28" }, "dist_abstract" => "extended simple IRC bot for pluggable modules", "dist_author" => [ "David Precious " ], "dist_name" => "Bot-BasicBot-Pluggable", "dist_version" => "1.00", "license" => "perl", "module_name" => "Bot::BasicBot::Pluggable", "recursive_test_files" => 1, "requires" => { "Bot::BasicBot" => "0.60", "CGI" => 0, "Carp" => 0, "Config::Find" => 0, "Crypt::SaltedHash" => "0.06", "DBI" => 0, "DBM::Deep" => 0, "Data::Dumper" => 0, "File::Copy" => 0, "File::Spec" => 0, "File::Temp" => 0, "LWP::UserAgent" => 0, "List::MoreUtils" => 0, "Log::Log4perl" => "1.11", "Log::Log4perl::Level" => 0, "Module::Load" => 0, "Module::Pluggable" => 0, "Moose" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Getopt::Dashes" => 0, "MooseX::SimpleConfig" => 0, "POE" => 0, "Socket" => 0, "Storable" => 0, "Text::Unidecode" => 0, "Try::Tiny" => 0, "URI" => 0, "URI::Find::Simple" => 0, "URI::Title" => 0, "XML::Feed" => 0, "base" => 0, "lib" => 0, "perl" => "v5.8.0", "strict" => 0, "warnings" => 0 }, "script_files" => [ "bin/bot-basicbot-pluggable", "bin/bot-basicbot-pluggable-cgi", "bin/bot-basicbot-pluggable-cli", "bin/bot-basicbot-pluggable-infobot-upgrade", "bin/storable2dbi.pl" ], "test_requires" => { "DBD::SQLite" => 0, "FindBin" => 0, "Test::More" => 0, "YAML::XS" => 0 } ); my %fallback_build_requires = ( "DBD::SQLite" => 0, "FindBin" => 0, "Module::Build" => "0.28", "Test::More" => 0, "YAML::XS" => 0 ); unless ( eval { Module::Build->VERSION(0.4004) } ) { delete $module_build_args{test_requires}; $module_build_args{build_requires} = \%fallback_build_requires; } my $build = Module::Build->new(%module_build_args); $build->create_build_script; t000755001750001750 012727613416 15640 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00test.rss100644001750001750 113112727613416 17504 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t jerakeen.org http://jerakeen.org achieved discursive power Thu, 17 Mar 2005 17:51:38 +0000 http://backend.userland.com/rss092 en title desc http://jerakeen.org/2005/03/17/oops 06title.t100644001750001750 126112727613416 17454 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!perl use warnings; use strict; use Test::More tests => 6; use Test::Bot::BasicBot::Pluggable; my $bot = Test::Bot::BasicBot::Pluggable->new(); my $title = $bot->load("Title"); ok( $title, "loaded Title module" ); like( $bot->tell_direct("http://google.com"), qr/Google/, "got title of google ok" ); # test to make sure that Title.pm isn't eating urls. ok( $bot->load("Infobot"), "loaded Infobot module" ); my $t = $bot->tell_direct("google is at http://google.com"); like( $t, qr/Google/, "got title of google ok" ); like( $t, qr/Okay/, "infobot still there" ); $title->set( 'user_ignore_re' => 'perl' ); is( $bot->tell_direct("http://use.perl.org"), '', 'ignore_re works' ); 101tidy.t100644001750001750 57612727613416 17350 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/tuse strict; use warnings; use File::Spec; use Test::More; use Try::Tiny; if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } try { require Test::PerlTidy; } catch { my $msg = 'Test::PerlTidy required to criticise code'; plan( skip_all => $msg ); }; Test::PerlTidy::run_tests(); 03store.t100644001750001750 64412727613416 17450 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/tuse warnings; use strict; use Test::More tests => 3; use Bot::BasicBot::Pluggable::Store; my $store; isa_ok( Bot::BasicBot::Pluggable::Store->new("Memory"), 'Bot::BasicBot::Pluggable::Store::Memory' ); isa_ok( Bot::BasicBot::Pluggable::Store->new( { type => "Memory" } ), 'Bot::BasicBot::Pluggable::Store::Memory' ); isa_ok( Bot::BasicBot::Pluggable::Store->new(), 'Bot::BasicBot::Pluggable::Store' ); 04karma.t100644001750001750 1120012727613416 17436 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!/usr/bin/perl use warnings; use strict; use Test::More tests => 27; use Test::Bot::BasicBot::Pluggable; my $bot = Test::Bot::BasicBot::Pluggable->new(); my $karma = $bot->load('Karma'); ## We start testing without giving any reasons $karma->set( "user_num_comments", 0 ); is( $bot->tell_indirect('karma alice'), 'alice has karma of 0.', 'inital karma of alice' ); is( $bot->tell_indirect('explain karma alice'), 'positive: 0; negative: 0; overall: 0.', 'explain initial karma of alice' ); $bot->tell_indirect('alice--'); is( $bot->tell_indirect('karma alice'), 'alice has karma of -1.', 'karma of alice after first --' ); $bot->tell_indirect('alice++'); $bot->tell_indirect('alice++'); is( $bot->tell_indirect('karma alice'), 'alice has karma of 1.', 'karma of alice after first ++' ); $bot->tell_indirect('alice++'); is( $bot->tell_indirect('karma alice'), 'alice has karma of 2.', 'karma of alice after second ++' ); is( $bot->tell_indirect('explain karma alice'), 'positive: 3; negative: 1; overall: 2.', 'explain karma of Alice' ); is( $bot->tell_indirect('test_bot++'), 'Karma for test_bot is now 1 (thanks!)', 'thanking for karming up bot' ); is( $bot->tell_indirect( 'test_bot--', 'alice' ), 'Karma for test_bot is now 0 (pffft)', 'complaining about karming down bot' ); $bot->tell_indirect('test_user++'); test_karma( 'test_user', 0, 'user is not allowed to use positiv selfkarma' ); $bot->tell_indirect('test_user--'); test_karma( 'test_user', 0, 'user is not allowed to use negative selfkarma' ); $karma->set( 'user_ignore_selfkarma', 0 ); $bot->tell_indirect('test_user++'); test_karma( 'test_user', 1, 'user is allowed to use positive selfkarma' ); $bot->tell_indirect('test_user--'); test_karma( 'test_user', 0, 'user is allowed to use negativ selfkarma' ); is( $karma->help(), 'Gives karma for or against a particular thing. Usage: ++ # comment, -- # comment, karma , explain .', 'help for karma' ); is( $bot->tell_indirect('karma'), 'test_user has karma of 0.', 'asking for own karma without arguments' ); is( $bot->tell_indirect( 'foobar', 'alice' ), '', 'ignoring karma unrelated issues' ); $bot->tell_indirect('(alice code)--'); is( $bot->tell_indirect('karma alice code'), 'alice code has karma of -1.', 'decrease karma of things with spaces ' ); $bot->tell_indirect('(alice code)++'); is( $bot->tell_indirect('karma alice code'), 'alice code has karma of 0.', 'increasing karma of things with spaces ' ); $bot->tell_indirect('alice: ++'); is( $bot->tell_indirect('karma alice'), 'alice has karma of 2.', 'positiv karma in sentance' ); is( $bot->tell_indirect( 'explain', '' ), '', 'ignore explain without argument' ); is( $bot->tell_indirect('++'), '', 'ignoring ++ without thing or address' ); is( $bot->tell_indirect('--'), '', 'ignoring -- without thing or address' ); ## Now we start testing reasons $karma->set( "user_num_comments", 2 ); $karma->set( "user_show_givers", 0 ); $karma->set( "user_randomize_reasons", 0 ); $bot->tell_indirect('alice++ # good cipher'); is( $bot->tell_indirect('explain alice'), 'positive: good cipher; negative: nothing; overall: 3.', 'explaining karma of alice with one positive reason' ); $bot->tell_indirect('alice-- # bad cipher'); is( $bot->tell_indirect('explain alice'), 'positive: good cipher; negative: bad cipher; overall: 2.', 'explaining karma of alice with one positive and negative reason' ); $bot->tell_indirect('alice-- # Friend of Eve'); is( $bot->tell_indirect('explain alice'), 'positive: good cipher; negative: Friend of Eve, bad cipher; overall: 1.', 'explaining karma of alice with one positive and two negative reason' ); $bot->tell_indirect('alice-- # Friend of Mallory'); is( $bot->tell_indirect('explain alice'), 'positive: good cipher; negative: Friend of Mallory, Friend of Eve; overall: 0.', 'explaining karma of alice with more than two reasons (user_num_commments=2)' ); $karma->set( "user_show_givers", 1 ); is( $bot->tell_indirect('explain alice'), 'positive: good cipher (test_user); negative: Friend of Mallory (test_user), Friend of Eve (test_user); overall: 0.', 'explaining karma of alice with reasons and givers' ); $karma->set( "user_randomize_reasons", 1 ); { my %explanations; for ( 1 .. 100 ) { $explanations{ $bot->tell_indirect('explain alice') }++; } is( keys %explanations, 6, 'Testing randomness of reason list... (uh!)' ) } sub test_karma { my ( $thing, $value, $message ) = @_; is( $karma->get_karma($thing), $value, $message ); } Makefile.PL100644001750001750 600212727613416 17505 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.040. use strict; use warnings; use 5.008000; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "extended simple IRC bot for pluggable modules", "AUTHOR" => "David Precious ", "BUILD_REQUIRES" => { "Module::Build" => "0.28" }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "Module::Build" => "0.28" }, "DISTNAME" => "Bot-BasicBot-Pluggable", "EXE_FILES" => [ "bin/bot-basicbot-pluggable", "bin/bot-basicbot-pluggable-cgi", "bin/bot-basicbot-pluggable-cli", "bin/bot-basicbot-pluggable-infobot-upgrade", "bin/storable2dbi.pl" ], "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008000", "NAME" => "Bot::BasicBot::Pluggable", "PREREQ_PM" => { "Bot::BasicBot" => "0.60", "CGI" => 0, "Carp" => 0, "Config::Find" => 0, "Crypt::SaltedHash" => "0.06", "DBI" => 0, "DBM::Deep" => 0, "Data::Dumper" => 0, "File::Copy" => 0, "File::Spec" => 0, "File::Temp" => 0, "LWP::UserAgent" => 0, "List::MoreUtils" => 0, "Log::Log4perl" => "1.11", "Log::Log4perl::Level" => 0, "Module::Load" => 0, "Module::Pluggable" => 0, "Moose" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Getopt::Dashes" => 0, "MooseX::SimpleConfig" => 0, "POE" => 0, "Socket" => 0, "Storable" => 0, "Text::Unidecode" => 0, "Try::Tiny" => 0, "URI" => 0, "URI::Find::Simple" => 0, "URI::Title" => 0, "XML::Feed" => 0, "base" => 0, "lib" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "DBD::SQLite" => 0, "FindBin" => 0, "Test::More" => 0, "YAML::XS" => 0 }, "VERSION" => "1.00", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Bot::BasicBot" => "0.60", "CGI" => 0, "Carp" => 0, "Config::Find" => 0, "Crypt::SaltedHash" => "0.06", "DBD::SQLite" => 0, "DBI" => 0, "DBM::Deep" => 0, "Data::Dumper" => 0, "File::Copy" => 0, "File::Spec" => 0, "File::Temp" => 0, "FindBin" => 0, "LWP::UserAgent" => 0, "List::MoreUtils" => 0, "Log::Log4perl" => "1.11", "Log::Log4perl::Level" => 0, "Module::Build" => "0.28", "Module::Load" => 0, "Module::Pluggable" => 0, "Moose" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Getopt::Dashes" => 0, "MooseX::SimpleConfig" => 0, "POE" => 0, "Socket" => 0, "Storable" => 0, "Test::More" => 0, "Text::Unidecode" => 0, "Try::Tiny" => 0, "URI" => 0, "URI::Find::Simple" => 0, "URI::Title" => 0, "XML::Feed" => 0, "YAML::XS" => 0, "base" => 0, "lib" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); 05infobot.t100644001750001750 2015612727613416 20016 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!perl use warnings; use strict; use Test::More tests => 89; use Test::Bot::BasicBot::Pluggable; use FindBin qw( $Bin ); use lib $Bin; my $bot = Test::Bot::BasicBot::Pluggable->new(); ok( my $ib = $bot->load("Infobot"), "Loaded infobot module" ); ok( my $uur = $ib->get("user_unknown_responses"), "got list of unknown responses" ) or die; my $no_regex = qr/($uur)/; # ok, the intent here is to test / document the infobot grammar, because # every time I mess with it I get annoying regressions. In general, B::B::P # wasn't built with Test-Driven techniques, and this is hurting me recently, # it's way too hard to write tests retroactively.. ok( $ib->help, "module has help text" ); # by default, the infobot doesn't learn things that it merely overhears ok( !$bot->tell_indirect("foo is red"), "passive learning off by default" ); ok( !$bot->tell_indirect("foo?"), "no answer to passive learn" ); like( $bot->tell_direct("foo?"), $no_regex, "no info on foo" ); # ..but it will learn things it's told $bot->tell_directly. like( $bot->tell_direct("foo?"), $no_regex, "no info on foo" ); is( $bot->tell_direct("foo is red"), "Okay.", "active learning works" ); is( $bot->tell_direct("foo?"), "foo is red", "correct answer to active learn" ); like( $bot->tell_direct("quux?"), $no_regex, "no info on quux" ); is( $bot->tell_direct("quux are blue"), "Okay.", "active learning works" ); is( $bot->tell_direct("quux?"), "quux are blue", "correct answer to active learn" ); # you can tell someone about foo is( $bot->tell_direct("tell testbot about foo"), "Told testbot about foo.", "tell someone about foo" ); ok( !$bot->tell_indirect("foo?"), "passive questioning off by default" ); # you can turn on the ability to ask questions without addressing the bot ok( $ib->set( "user_passive_answer", 1 ), "activate passive ask" ); is( $bot->tell_indirect("foo?"), "foo is red", "passive questioning now on" ); # and the ability to add factoids without addressing the bot ok( $ib->set( "user_passive_learn", 1 ), "activate passive learn" ); is( $bot->tell_direct("bar is green"), "Okay.", "passive learning now works" ); is( $bot->tell_indirect("bar?"), "bar is green", "passive questioning works" ); # you can search factoids, but not in public is( $bot->tell_direct("search for foo"), "privmsg only, please", "not searched in public" ); $ib->set( "user_allow_searching", 0 ); is( $bot->tell_private("search for foo"), "searching disabled", "searched for 'foo' disabled" ); $ib->set( "user_allow_searching", 1 ); is( $bot->tell_private("search for foo"), "I know about: 'foo'.", "searched for 'foo'" ); is( $bot->tell_private("search for foobar"), "I don't know anything about foobar.", "searched for 'foobar' (which we know nothing about)" ); is( $bot->tell_private("search for foo bar"), "I know about: 'foo', 'bar'.", "searched for 'foo' and 'bar'" ); $ib->set( 'user_num_results' => 1 ); is( $bot->tell_private("search for foo bar"), "I know about: 'foo'.", "searched for 'foo' and 'bar' with user_num_results set to 1" ); # you can append strings to factoids is( $bot->tell_direct("foo is also blue"), "Okay.", "can append to faactoids" ); is( $bot->tell_direct("foo?"), "foo is red or blue", "works" ); is( $bot->tell_direct("foo is also pink"), "Okay.", "can append to faactoids" ); is( $bot->tell_direct("foo?"), "foo is red or blue or pink", "works" ); # factoids can be forgotten is( $bot->tell_direct("forget foo"), "I forgot about foo.", "forgotten foo" ); like( $bot->tell_direct("foo?"), $no_regex, "no info on foo" ); is( $bot->tell_direct("forget foo"), "I don't know anything about foo.", "can't forget something i don't know" ); # factoids can be replaced my $but_reply = '... but bar is green ...'; # ok, why does this get interpreted as '1' is( $bot->tell_direct("bar is yellow"), $but_reply, "Can't just redefine factoids" ); is( $bot->tell_indirect("bar is yellow"), '', "Can't just redefine factoids" ); is( $bot->tell_indirect("bar?"), "bar is green", "not changed" ); is( $bot->tell_direct("no, bar is yellow"), "Okay.", "Can explicitly redefine factoids" ); is( $bot->tell_indirect("bar?"), "bar is yellow", "changed" ); # factoids can contain RSS SKIP: { eval "use XML::Feed"; skip 'XML::Feed not installed', 4 if $@; is( $bot->tell_direct("rsstest is "), "Okay.", "set RSS" ); is( $bot->tell_indirect("rsstest?"), "title", "can read rss" ); $bot->tell_direct("rsstest2 is "); like( $bot->tell_indirect("rsstest2?"), qr{rsstest2 is << Error parsing RSS from file:///.*/05infobot.t: Cannot detect feed type >>}, "can't read rss" ); is( $bot->tell_direct("literal rsstest?"), "rsstest =is= ", "literal of rsstest" ); } my $old_stopwords = $ib->get("user_stopwords"); # certain things can't be factoid keys. ok( $ib->set( "user_stopwords", "and" ), "set stopword 'and'" ); ok( !$bot->tell_direct("and is mumu"), "can't set 'and' as factoid" ); ok( !$bot->tell_direct("dkjsdlfkdsjfglkdsfjglfkdjgldksfjglkdfjglds is mumu"), "can't set very long factoid" ); $ib->set( "user_stopwords", $old_stopwords ); # literal syntax ok( $bot->tell_direct("bar is also fum"), "bar also fum" ); is( $bot->tell_direct("literal bar?"), "bar =is= yellow =or= fum", "bar" ); # alternate factoids ('|') is( $bot->tell_direct("foo is one"), "Okay.", "foo is one" ); is( $bot->tell_direct("foo is also two"), "Okay.", "foo is also two" ); is( $bot->tell_direct("foo is also |maybe"), "Okay.", "foo is also maybe" ); ok( my $reply = $bot->tell_direct("foo?"), "got one of the foos" ); ok( ( $reply eq 'foo is maybe' or $reply eq 'foo is one or two' ), "it's one of the two" ); # blech's torture test, all three in one # notes on dipsy differences: # * 'ok' is 'okay.' in a true infobot # * literal doesn't highlight =or= like it does =is= # * infobots attempt to parse english # * there's a difference between 'is' and 'are' # * doesn't respond to a passive attempt to reset an item is( $bot->tell_direct("forget foo"), "I forgot about foo.", "forgotten foo" ); is( $bot->tell_direct("foo is foo"), "Okay.", "simple set" ); is( $bot->tell_direct("foo?"), "foo is foo", "simple get" ); is( $bot->tell_direct("what is foo?"), "foo is foo", "English-language get" ) ; # fails is( $bot->tell_direct("where is foo?"), "foo is foo", "Another English get" ); is( $bot->tell_direct("who is foo?"), "foo is foo", "Yet another English get" ); is( $bot->tell_direct("hoogas are things"), "Okay.", "simple 'are' set" ) ; # fails is( $bot->tell_direct("what are hoogas?"), "hoogas are things", "English-language 'are' get" ); is( $bot->tell_direct("foo is a silly thing"), "... but foo is foo ...", "warning about overwriting" ); is( $bot->tell_indirect("foo is a silly thing"), "", "shouldn't get a reply" ); is( $bot->tell_direct("foo is also bar"), "Okay.", "simple append" ); is( $bot->tell_direct("foo?"), "foo is foo or bar", "appended ok" ); is( $bot->tell_direct("foo is also baz or quux"), "Okay.", "complex append" ); is( $bot->tell_direct("foo?"), "foo is foo or bar or baz or quux", "also ok" ); is( $bot->tell_direct("foo is also | a silly thing"), "Okay.", "alternate appended" ); is( $bot->tell_direct("literal foo?"), "foo =is= foo =or= bar =or= baz =or= quux =or= |a silly thing", "entire factoid looks right" ); is( $bot->tell_direct("foo is also |this is a very silly thing"), "Okay.", "and a reply" ); is( $bot->tell_direct("literal foo?"), "foo =is= foo =or= bar =or= baz =or= quux =or= |a silly thing =or= |this is a very silly thing", "entire entry looks fine to me" ); # run through a few times, and see what we get out foreach my $i ( 0 .. 9 ) { ok( $reply = $bot->tell_direct("foo?"), "got one of the foos" ); ok( ( $reply eq 'foo is foo or bar or baz or quux' or $reply eq 'foo is a silly thing' or $reply eq 'this is a very silly thing' ), "it's '$reply'" ); } 100critic.t100644001750001750 74512727613416 17651 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/tuse strict; use warnings; use File::Spec; use Test::More; use Try::Tiny; if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } try { require Test::Perl::Critic; } catch { my $msg = 'Test::Perl::Critic required to criticise code'; plan( skip_all => $msg ); }; my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); Test::Perl::Critic->import( -profile => $rcfile ); all_critic_ok(); perlcriticrc100644001750001750 012727613416 20316 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t00bootstrap.t100755001750001750 17612727613416 20331 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!/usr/bin/perl use warnings; use strict; use lib qw(./lib); use Test::More tests => 1; use_ok('Bot::BasicBot::Pluggable'); 03store_dbi.t100644001750001750 47112727613416 20264 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!perl use warnings; use strict; use Test::Bot::BasicBot::Pluggable::Store; # Calling tempfile hangs the process under MacOSX... so we live with the race condition use File::Temp qw(tmpnam); my $tempfile = tmpnam(); store_ok( 'DBI', { dsn => "dbi:SQLite:$tempfile", table => "basic-bot" } ); unlink($tempfile); 03store_deep.t100644001750001750 30012727613416 20432 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!perl use warnings; use strict; use Test::Bot::BasicBot::Pluggable::Store; use File::Temp qw(tmpnam); my $tempfile = tmpnam(); store_ok( 'Deep', { file => $tempfile } ); unlink($tempfile); modules000755001750001750 012727613416 17310 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/tFoo.pm100644001750001750 14112727613416 20505 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t/modulespackage Bot::BasicBot::Pluggable::Module::Foo; use base qw(Bot::BasicBot::Pluggable::Module); 1; examples000755001750001750 012727613416 17213 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00mind.pl100755001750001750 130012727613416 20634 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/examples#!/usr/bin/perl # A standard Bot::BasicBot::Pluggable interface. You can /query the bot to # load in more modules, I suggest Auth is a good start, so other people # can't load modules, and CHANGE THE ADMIN PASSWORD. # See perldoc Bot::BasicBot::Pluggable::Auth for details of this. use warnings; use strict; use Bot::BasicBot::Pluggable; my $bot = Bot::BasicBot::Pluggable->new( channels => [ ], server => "london.rhizomatic.net", nick => "jerabot", ); print "Loading Loader\n"; print $bot->load("Loader"); print "\n"; $bot->run(); 02module_auth.t100755001750001750 456612727613416 20653 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!/usr/bin/perl use warnings; use strict; use Test::More tests => 27; use Test::Bot::BasicBot::Pluggable; my $bot = Test::Bot::BasicBot::Pluggable->new(); ok( my $auth = $bot->load('Auth'), "created auth module" ); is( $bot->tell_private("!auth"), "Usage: !auth ", "auth without arguments" ); is( $bot->tell_private("!adduser"), "Usage: !adduser ", "adduser without arguments" ); is( $bot->tell_private("!deluser"), "Usage: !deluser ", "deluser without arguments" ); is( $bot->tell_private("!adduser foo bar"), "You need to authenticate.", "adding users without authentication" ); is( $bot->tell_private("!deluser foo"), "You need to authenticate.", "deleting users without authentication" ); ok( !$auth->authed('test_user'), "test_user not authed yet" ); ok( $bot->tell_private("!auth admin muppet"), "sent bad login" ); ok( !$auth->authed('test_user'), "test_user not authed yet" ); ok( $bot->tell_private("!auth admin julia"), "sent good login" ); ok( $auth->authed('test_user'), "test_user authed now" ); ok( $bot->tell_private("!adduser test_user test_user"), "added test_user user" ); ok( $bot->tell_private("!auth test_user fred"), "not logged in as test_user" ); ok( !$auth->authed('test_user'), "not still authed" ); ok( $bot->tell_private("!auth test_user test_user"), "logged in as test_user" ); ok( $auth->authed('test_user'), "still authed" ); ok( $bot->tell_private("!deluser admin"), "deleted admin user" ); ok( $bot->tell_private("!auth admin julia"), "tried login" ); ok( !$auth->authed('test_user'), "not authed" ); ok( $bot->tell_private("!auth test_user test_user"), "logged in as test_user" ); ok( $bot->tell_private("!password test_user dave"), "changed password" ); ok( $bot->tell_private("!auth test_user dave"), "tried login" ); ok( $auth->authed('test_user'), "authed" ); is( $bot->tell_private("auth test_user dave"), "", "ignore commands without leading !" ); is( $bot->tell_indirect("!auth test_user dave"), "", "ignore public commands" ); is( $bot->tell_private("!users"), "Users: test_user.", "listing of users" ); like( $bot->tell_direct("help Auth"), qr/Authenticator for admin-level commands. Usage:.+/, 'checking help text' ); 01module_base.t100755001750001750 164012727613416 20611 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!/usr/bin/perl use warnings; use strict; use lib qw(./lib); use Test::More tests => 13; use Bot::BasicBot::Pluggable; use Bot::BasicBot::Pluggable::Module; our $store; no warnings 'redefine'; sub Bot::BasicBot::Pluggable::Module::store { $store ||= Bot::BasicBot::Pluggable::Store->new; } ok( my $base = Bot::BasicBot::Pluggable::Module->new(), "created base module" ); ok( $base->var( 'test', 'value' ), "set variable" ); ok( $base->var('test') eq 'value', 'got variable' ); ok( $base = Bot::BasicBot::Pluggable::Module->new(), "created new base module" ); ok( $base->var('test') eq 'value', 'got old variable' ); ok( $base->unset('test'), 'unset variable' ); ok( !defined( $base->var('test') ), "it's gone" ); # very hard to do anything but check existence of these methods ok( $base->can($_), "'$_' exists" ) for (qw(said connected tick emoted init)); ok( $base->help, "help returns something" ); 03store_memory.t100644001750001750 14112727613416 21030 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!perl use warnings; use strict; use Test::Bot::BasicBot::Pluggable::Store; store_ok('Memory'); 07app_defaults.t100644001750001750 222112727613416 21000 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/tuse strict; use warnings; use Test::More tests => 11; use App::Bot::BasicBot::Pluggable; ## Testing defaults # We need to specify configfile here explicitly in case the user # has already written a configuration file that would be found by # Config::Find, unlikely but oh my... our @ARGV = ( '--configfile', 't/configfiles/empty.yaml' ); my $app = App::Bot::BasicBot::Pluggable->new_with_options(); is( $app->server, 'localhost', 'checking default for server' ); is( $app->port, 6667, 'checking default for port' ); is( $app->nick, 'basicbot', 'checking default for basicbot' ); is( $app->charset, 'utf8', 'checking default for charset' ); is( $app->loglevel, 'warn', 'checking default for loglevel' ); ok( !$app->list_modules, 'checking default for list_modules' ); ok( !$app->list_stores, 'checking default for list_stores' ); is_deeply( $app->settings, {}, 'checking default for settings' ); is_deeply( $app->module, [ 'Auth', 'Loader' ], 'checking default for modules' ); is_deeply( $app->channel, [], 'checking default for channel' ); isa_ok( $app->store, 'Bot::BasicBot::Pluggable::Store::Memory', 'default store' ); chump.cgi100755001750001750 2646712727613416 21215 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/examples#!/usr/bin/perl -w # this won't work out the box. I'll fix it in a later release. But it's what # we use to look at the output from the chumping module (Blog). See # http://2lmc.org/blog use strict; use Template; use CGI; use Time::Local; use Calendar::Simple; use Digest::MD5 qw(md5_hex); use LWP::Simple; use Image::Size; use DBI; my $vars = {}; my $db = DBI->connect("DBI:mysql:database=jerakeen", "2lmc", "2lmc"); my %title; if (open(TITLES, "titles.txt")) { while () { chomp; next unless $_; my ($url, $title) = split(/\s+/, $_, 2); $title{$url} = $title if $title; } close(TITLES); } my $timestamp = CGI::param("timestamp"); my $blog_id = CGI::param("blog_id"); my $upper = CGI::param("upper"); my $lower = CGI::param("lower"); my $search = CGI::param("search"); my $day = CGI::param("day"); my $month = CGI::param("month"); my $year = CGI::param("year"); my $title; if ($day and $month and $year) { $lower = timegm(0, 0, 0, $day, $month-1, $year-1900); $upper = timegm(59, 59, 23, $day, $month-1, $year-1900); $title = sprintf("%04d/%02d/%02d", $year, $month, $day); } elsif ($month and $year) { $lower = timegm(0, 0, 0, 1, $month-1, $year-1900); $upper = timegm(0, 0, 0, 1, $month, $year-1900) if $month < 12; $upper = timegm(0, 0, 0, 1, 0, $year-1899) if $month >= 12; $title = sprintf("%04d/%02d", $year, $month); } elsif ($year) { $lower = timegm(0, 0, 0, 1, 0, $year-1900); $upper = timegm(59, 59, 23, 1, 0, $year-1899); $title = sprintf("%04d", $year); } $upper = 1500000000 unless defined($upper); # TODO - fix before Fri Jul 14 02:40:00 2017 $lower = 0 unless defined($lower); my @calendar = calendar($month, $year, 1); my $dates_ref = get_link_days($month, $year); @calendar = merge(\@calendar, $dates_ref); my @lt = localtime; $vars->{calendar} = \@calendar; $vars->{month} = $month || $lt[4]+1; $vars->{year} = $year || $lt[5]+1900; $vars->{today} = $day || $lt[3]; my @monthnames = (qw(dummy Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)); $vars->{monthnames} = \@monthnames; my @entries; my $entry; my $query; if ($search) { my $sql = "SELECT DISTINCT mindblog.* FROM mindblog,mindblog_comments "; $sql .= "WHERE mindblog.blog_id=mindblog_comments.blog_id AND ("; my @terms = split(/[\s,]+/, $search); $sql .= join(" AND ", map { "(mindblog.data LIKE '%$_%' OR mindblog_comments.data LIKE '%$_%')" } @terms); $sql .= ") ORDER BY mindblog.timestamp DESC LIMIT 20"; print STDERR $sql; $query = $db->prepare($sql); $query->execute(); $title = "search results for ".join(", ", @terms); } elsif ($blog_id) { $query = $db->prepare("SELECT * FROM mindblog WHERE blog_id=? ORDER BY timestamp DESC"); $query->execute($blog_id); } elsif ($timestamp) { $query = $db->prepare("SELECT * FROM mindblog WHERE timestamp=? ORDER BY timestamp DESC"); $query->execute($timestamp); } elsif ($upper and $lower) { $query = $db->prepare("SELECT * FROM mindblog WHERE timestamp>? AND timestampexecute($lower, $upper); } else { $query = $db->prepare("SELECT * FROM mindblog ORDER BY timestamp DESC LIMIT 20"); $query->execute(); $title = "recent entries"; } my $comment_query = $db->prepare("SELECT * FROM mindblog_comments WHERE blog_id=? ORDER BY timestamp"); while (my $row = $query->fetchrow_hashref) { $row->{data} =~ s/#\s*$//; if ($row->{data} =~ /^http:\S+$/) { my $title = get_title($row->{data}); $row->{data} = "[$row->{data}|$title]" if $title; } $row->{message} = blog_filter($row->{data}); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime($row->{timestamp}); $row->{date} = sprintf("%04d/%02d/%02d %02d:%02d", $year+1900, $mon+1, $mday, $hour, $min); $comment_query->execute($row->{blog_id}); my $comments = []; while (my $comment = $comment_query->fetchrow_hashref) { $comment->{message} = blog_filter($comment->{data}); push(@$comments, $comment); } $row->{comments} = $comments; push(@{$vars->{entries}}, $row); } if ($vars->{entries} and length(@{$vars->{entries}}) == 1) { $title ||= $vars->{entries}->[0]->{message}; $title =~ s/<[^>]+>//g; } $title ||= "ramblings"; $vars->{title} = "2lmc blog - $title"; $vars->{sub_title} = $title; $vars->{url} = CGI::url(); my @desc = ( "on the internet, nobody knows you're not the Gartner Group", "Lasciate ogni speranza voi ch'entrate", "We laugh at Devil Bunny", "as despised by muttley", ); $vars->{description} = $desc[3]; my $tt = Template->new(POST_FOLD=>1, PRE_FOLD=>1); my $template = "chump.tem"; if (defined(CGI::param("rss"))) { $template = "rss.tem"; print CGI::header("text/xml"); for (@{$vars->{entries}}) { $_->{title} = $_->{message}; $_->{title} =~ s/<[^>]+>//g; } } else { print CGI::header(); } $tt->process($template, $vars) || print $tt->error(); sub blog_filter { my $text = shift; return '' if (!defined $text); # catch empty 'bc' mistakes $text =~ s/&/&/g; $text =~ s//>/g; $text =~ s/((?:^|[\b\s]))(http:\/\/[^>\s\"]+)/$1$2<\/a>/gi; $text =~ s/\+\[([^\]]+)\]/chump_image($1)/eig; $text =~ s/\[([^\]]+)\]/chump($1)/eig; $text =~ s/\*([\w']+)\*/$1<\/b>/ig; $text =~ s/\s\/(\w+)\/\s/$1<\/i>/ig; return $text; } sub chump { my $text = shift; my ($one, $two) = split(/\|/, $text); $one =~ s/^\s+//; $one =~ s/\s+$//; $two =~ s/^\s+// if $two; $two =~ s/\s+$// if $two; if ($two) { # Ok, so we have [|]. We want to Do The Right Thing, and # not require people to remember which way round to put the link and # title. This is pretty easy to get right - 90% of the time, the link # is really obvious. These tests will catch 99% of the cases. # catch 'real' urls - http://, ftp://, etc. if ($one =~ /^\w+:\/\//) { return "$two"; } elsif ($two =~ /^\w+:\/\//) { return "$one"; # catch just numbers, guess if it's a blog_id or a timestamp # TODO if we ever have >10^8 blog entries, this will break. # Hopefuly, time() will be larger by then, and I can adjust this # number. } elsif ($one =~ /^\d{8,}$/) { return "$two"; } elsif ($one =~ /^\d+$/) { return "$two"; } elsif ($two =~ /^\d{8,}$/) { return "$one"; } elsif ($two =~ /^\d+$/) { return "$one"; # Finally, if we've matched neither end so far, try to pick up a # simpler form of uri, things like mailto:me@address.com. } elsif ($one =~ /^\w+:/) { return "$two"; } elsif ($two =~ /^\w+:/) { return "$one"; # ok, you got me. I'm stumped. Print /something/, at least. } else { return "[$one|$two]"; } } else { if ($one =~ /^\w+:\/\//) { return "$one"; } elsif ($one =~ /^\d{8,}$/) { return "$one"; } elsif ($one =~ /^\d+$/) { return "$one"; } else { my $query = $db->prepare("SELECT * FROM infobot WHERE object=?"); $query->execute("blog_shortcut $one"); my $row = $query->fetchrow_hashref(); return "[$one]" unless $row; return $row->{description} unless ($row->{description} =~ /\[(.*)\]/); return chump($1); } } } sub chump_image { my $text = shift; unless ($text =~ /(?:gif|jpe?g|png)$/i) { return "
[$text]
"; } my $link = $text; my $hash = md5_hex($text); my $file = "cache/$hash"; unless (-e "$file.jpg") { $text =~ s/&/&/ig; $text =~ s/%2E/./ig; $text =~ s/%3A/:/ig; $text =~ s/%2F/\//ig; print STDERR "Getting $text to $hash\n"; mirror($text, $file); print STDERR "Converting to jpg\n"; print STDERR `convert \"$file\" \"$file.jpg\"`; my ($width, $height) = imgsize("$file.jpg"); if (($width > 300) or ($height > 150)) { print STDERR "Resizing\n"; `convert -resize 300x150 \"$file.jpg\" \"$file.jpg\"`; } else { undef $link; } } my $ret = "
"; $ret .= "" if $link; $ret .= "\"$text\""; $ret .= "" if $link; $ret .= "
"; return $ret; } sub get_title { my $url = shift; return $title{$url} if $title{$url}; print STDERR "title for $url not cached\n"; my $title; my $data = get($url); unless ($data) { print STDERR " Can't get page\n"; } elsif ($data =~ /([^<]+)<\/title>/i) { $title = $1; $title =~ s/\|//g; $title =~ s/\n//g; $title =~ s/^\s+//; $title =~ s/\s+$//; print STDERR " Found title $title\n"; } else { print STDERR " Can't find title\n"; } $title ||= $url; $title{$url} = $title; save_titles(); return $url; } sub save_titles { if (open(TITLES, ">titles.txt")) { for (keys(%title)) { print TITLES "$_ $title{$_}\n"; } close(TITLES); } else { print STDERR "Can't save titles: $!\n"; } } sub get_link_days { my ($month, $year) = @_; my ($start, $end) = get_epochs($month, $year); my %dates; my $sql = "SELECT DISTINCT(FLOOR(timestamp/86400)) FROM mindblog WHERE timestamp > ? AND timestamp < ?"; my $query = $db->prepare($sql); $query->execute($start, $end); my $comment_query = $db->prepare("SELECT * FROM mindblog_comments WHERE blog_id=? ORDER BY timestamp"); while (my $row = $query->fetchrow_arrayref) { # print "Got ", Dumper($row); my ($day, $link) = get_url($row->[0]); $dates{$day} = $link; } return \%dates; } sub merge { my ($cal, $dates) = @_; foreach my $week (@{ $cal }) { foreach my $day (@{ $week }) { next if (!defined $day); if (exists $dates->{$day}) { $day = { $day => $dates->{$day} }; } else { $day = { $day => undef }; } } } return @{ $cal }; } sub get_epochs { my ($mon, $year) = @_; my @lt = localtime; $mon = $lt[4]+1 if (!$mon); $year = $lt[5]+1900 if (!$year); my $start_time = timelocal(0,0,0,1,$mon-1,$year-1900); my $end_time; if ($mon < 12) { $end_time = timelocal(0,0,0,1,$mon,$year-1900); } else { $end_time = timelocal(0,0,0,1,0,$year-1900+1); } return ($start_time, $end_time); } sub get_url { my $date = shift; my $epoch = $date*86400; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime($epoch); my $link = sprintf("?day=%d;month=%d;year=%d", $mday, $mon+1, $year+1900); return ($mday, $link); } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������chump.tem�������������������������������������������������������������������������������������������100644��001750��001750�� 6260�12727613416� 21202� 0����������������������������������������������������������������������������������������������������ustar�00davidp��������������������������davidp��������������������������000000��000000��Bot-BasicBot-Pluggable-1.00/examples�����������������������������������������������������������������������������������������������������������������������������������<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/1999/REC-html401-19991224/loose.dtd"> <html> <head> <title>[% title %] [%# Note the one month offset. Remember the rhyme! %] [% IF month == "1" %] [% ELSIF month == "5" || month == "7" || month == "10" || month == "12" %] [% ELSIF month == "3" %] [% ELSE %] [% END %] [% IF month == "12" %] [% ELSE %] [% END %] [% FOR week = calendar %] [% FOR day = week %][% END %] [% END %]
<<<<<<<< [% monthnames.$month %] [% year %] >>>>
MonTueWedThuFriSatSun
[% IF day.values.0 %][% END %][% IF day.keys.0 == today %][% END %][% day.keys.0 %] [% IF day.keys.0 == today %][% END %][% IF day.values.0 %][% END %]
recent
RSS Feed

2lmc blog


as despised by muttley


[% sub_title %]



Entries:


[% FOR entry = entries %]
[% entry.date %] [% entry.who %] [% entry.message %] [% IF entry.comments.size %] [% FOR comment = entry.comments %] [% END %]
[% comment.who %]: [% comment.message %]
[% END %] (permalink)
[% END %]
DISCLAIMER

We hate you all. Yes, especially you. Sod off and DIE

simple.pl100755001750001750 101412727613416 21200 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/examples#!/usr/bin/perl # A standard Bot::BasicBot::Pluggable interface. This implements a very # simple bot, with a 'seen' module, a 'google' module and an 'infobot' # module. use warnings; use strict; use Bot::BasicBot::Pluggable; my $bot = Bot::BasicBot::Pluggable->new( channels => [], server => "london.irc.perl.org", nick => "jerabot", ); $bot->load("Seen"); #my $google = $bot->load("Google"); #$google->set("google_key", "xxxxxxxxxxxxxxx"); $bot->load("Infobot"); $bot->load("Title"); $bot->run(); bin000755001750001750 012727613416 16145 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00storable2dbi.pl100644001750001750 52112727613416 21174 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/bin#!perl use warnings; use strict; use Bot::BasicBot::Pluggable::Store::Storable; use Bot::BasicBot::Pluggable::Store::DBI; my $from = Bot::BasicBot::Pluggable::Store::Storable->new; my $to = Bot::BasicBot::Pluggable::Store::DBI->new( dsn => "dbi:mysql:test", table => "basicbot", user => "root", ); $to->restore( $from->dump ); 03store_storable.t100644001750001750 27412727613416 21342 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!perl use warnings; use strict; use Test::Bot::BasicBot::Pluggable::Store; use File::Temp qw(tempdir); my $tmpdir = tempdir( CLEANUP => 1 ); store_ok( 'Storable', { dir => $tmpdir } ); 09app_configfile.t100644001750001750 201212727613416 21276 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/tuse strict; use warnings; use Test::More tests => 9; use App::Bot::BasicBot::Pluggable; our @ARGV = ( qw( --configfile t/configfiles/bot-basicbot-pluggable.yaml ) ); my $app = App::Bot::BasicBot::Pluggable->new_with_options(); is( $app->server, 'irc.example.com', 'setting server via configfile' ); is( $app->loglevel, 'fatal', 'setting loglevel via configfile' ); is( $app->port, 6668, 'setting port via configfile' ); is( $app->nick, 'botbot', 'setting basicbot via configfile' ); is( $app->charset, 'ascii', 'setting charset via configfile' ); isa_ok( $app->store, 'Bot::BasicBot::Pluggable::Store::Memory', 'store via configfile' ); is_deeply( $app->module, [ 'Loader', 'Karma', 'Auth' ], 'setting modules via configfile and implcit loading of modules via settings' ); is_deeply( $app->channel, [ '#baz', '#quux' ], 'setting channel via configfile' ); isa_ok( $app->bot(), 'Bot::BasicBot::Pluggable', 'checking bot' ); 08app_commandline.t100644001750001750 241512727613416 21465 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/tuse strict; use warnings; use Test::More tests => 10; use App::Bot::BasicBot::Pluggable; our @ARGV = ( qw( --server irc --port 6666 --nick botbasic --charset latin1 --store type=Memory --module Karma --channel foo --channel bar --list-modules --list-stores --loglevel fatal --password foobar --configfile t/configfiles/empty.yaml ) ); my $app = App::Bot::BasicBot::Pluggable->new_with_options(); is( $app->server, 'irc', 'setting server via commandline' ); is( $app->loglevel, 'fatal', 'setting fatal via commandline' ); is( $app->port, 6666, 'setting port via commandline' ); is( $app->nick, 'botbasic', 'setting basicbot via commandline' ); is( $app->charset, 'latin1', 'setting charset via commandline' ); isa_ok( $app->store, 'Bot::BasicBot::Pluggable::Store::Memory', 'store via commandline' ); ok( $app->list_modules, 'setting list_modules via commandline' ); ok( $app->list_stores, 'setting list_stores via commandline' ); is_deeply( $app->module, [ 'Karma', 'Auth' ], 'setting modules via commandline and implicit loading of Auth for --password' ); is_deeply( $app->channel, [ '#foo', '#bar' ], 'setting channel via commandline' ); author-pod-syntax.t100644001750001750 50312727613416 21551 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); 10modules_not_in_inc.t100644001750001750 64212727613416 22157 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/tuse Test::More tests => 4; use Test::Bot::BasicBot::Pluggable; chdir("t/modules/"); my $bot = Test::Bot::BasicBot::Pluggable->new(); my %available = map { $_ => 1 } $bot->available_modules; ok( $available{Foo}, 'modules in curdir are available' ); ok( $available{Bar}, 'modules in ./modules are available' ); ok( $bot->load('Foo'), 'load modules in curdir' ); ok( $bot->load('Bar'), 'load modules in ./modules' ); configfiles000755001750001750 012727613416 20130 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/tempty.yaml100644001750001750 1512727613416 22246 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t/configfiles--- foo: bar modules000755001750001750 012727613416 20760 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t/modulesBar.pm100644001750001750 14112727613416 22136 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t/modules/modulespackage Bot::BasicBot::Pluggable::Module::Bar; use base qw(Bot::BasicBot::Pluggable::Module); 1; bot-basicbot-pluggable100755001750001750 1124512727613416 22566 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/bin#!/usr/bin/perl use warnings; use strict; use App::Bot::BasicBot::Pluggable; my $app = App::Bot::BasicBot::Pluggable->new_with_options(); $app->run(); __END__ =head1 NAME bot-basicbot-pluggable - A standard Bot::BasicBot::Pluggable script =head1 VERSION version 1.00 =head1 DESCRIPTION This script acts as standard interface for Bot::BasicBot::Pluggable, a generic framework for writing pluggable IRC bots in perl. It enables the user to administrate a full-fledged bot without writing any perl code. =head1 SYNOPSIS bot-basicbot-pluggable --nick MyBot --server irc.perl.org =head1 OPTIONS =over 4 =item --server The server to connect to. Defaults to I. =item --configfile FILE Read config options from specified FILE. For a discussion of possible value and format refer to the section CONFIGFILE. The default to read the configfile found by L. =item --logconfig FILE The logging configuration will be read from the specified file. Please refer to L for its format. The paramter loglevel will be ignored if this options is supplied. =item --loglevel LEVEL Sets the bots loglevel to one of the following levels in decreasing order of output: trace, debug, info, warn, error or fatal. Defaults to warn. =item --nick NICKNAME Nickname to use. Defaults to I. =item --channel CHANNELNAME Channel to connect to. This paramter may be provided several times. You do not have to prefix the channel name with a hash symbol, which would have to be escaped in shell. It's automatically added for you. =item --password Sets the admin password of the I module. This also loads the I module implicitly. Please be warned that this password will probably been seen on any process listing as on I or I. =item --module Modules to load. This paramter may be profided several times. You can call --list-modules to get a list of all available modules. If you do not define any module via this option, I and I are loaded by default. =item --list-modules Lists all installed modules and exits afterwards. No bot is started. =item --list-stores Lists all installed storage modules and exits afterwards. No bot is started. =item --store Defines which storage module is used to save module settings. The default is I, which does not save any settings between sessions but does neither leave any files nor need any special settings. This options take a string in the form I=I and can be specified multiple times. The value of the key I define which storage backend to load, all other paramters are passed the the object constructor as hash reference. For example: ./bot --store type=Deep --store file=foo.deep That command will create an L object and pass C 'foo.deep'> to its constructor. =item --charset Charset to use for the bot. Defaults to I, but you can use any encoding listed in L. The IRC protocol doesn't define a specific character-set to use. This presents a big problem, because if you do not use the same as everybody else in the channel you just receive garbage. =item --port Port to connect to on target host. This defaults to the irc standard port 6667. You won't need to define this in most cases. =item --command-line The bot does not connect to any irc server, but will wait on stdin on commands from the user. This mode won't actually work with a lot of irc related modules like ChanOp. =back =head1 CONFIGFILE The bot read a configfile either found by L (usually named ~/.bot-basicbot-pluggable.yaml) or specified on the comamnd line via I<--configfile> on startup. The file should be a synatctical correct yaml file with a hash as its first level element. It understands every option listed above and the special settings paramter, which is a hash, where the keys are module names and the value is a hash of configurable module settings. Easier to show than to explain: --- server: host nick: bot settings: Karma: self_ignore: 0 store: type: Deep file: foo.deep All modules listed under settings are also loaded on startup. Please remember that you have to escape hash (or pound) signs in YAML: --- channel: - '#botzone' =head1 AUTHOR Mario Domgoergen =head1 SEE ALSO L =head1 COPYRIGHT & LICENSE Copyright 2005-2009 Mario Domgoergen. This program is free software; you can redistribute it and/or modify it under the terms of either: =over 4 =item * the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or =item * the Artistic License version 2.0. =back =cut BasicBot000755001750001750 012727613416 20355 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/BotPluggable.pm100644001750001750 4536212727613416 23007 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBotpackage Bot::BasicBot::Pluggable; $Bot::BasicBot::Pluggable::VERSION = '1.00'; use warnings; use strict; use 5.8.0; use POE; use Bot::BasicBot 0.60; use Log::Log4perl; use Log::Log4perl::Level; use base qw( Bot::BasicBot ); use Data::Dumper; $Data::Dumper::Terse = 1; $Data::Dumper::Indent = 0; use Module::Pluggable sub_name => '_available', search_path => 'Bot::BasicBot::Pluggable::Module', except => 'Bot::BasicBot::Pluggable::Module::Base'; use Bot::BasicBot::Pluggable::Module; use Bot::BasicBot::Pluggable::Store; use File::Spec; use Try::Tiny; sub init { my $self = shift; $self->init_logging(); my $logger = Log::Log4perl->get_logger( ref $self ); $logger->info( 'Starting initialization of ' . ref $self ); if ( !$self->store ) { $logger->debug('Store not set, trying to load a store backend'); my $store; for my $type (qw( DBI Deep Storable Memory )) { $store = try { $logger->debug("Trying to load store backend $type"); Bot::BasicBot::Pluggable::Store->new( { type => $type } ); }; if ($store) { $logger->info("Loaded store backend $type"); last; } } if ( !UNIVERSAL::isa( $store, 'Bot::BasicBot::Pluggable::Store' ) ) { $logger->logdie("Couldn't load any default store type"); } $self->store($store); } elsif ( !UNIVERSAL::isa( $self->store, "Bot::BasicBot::Pluggable::Store" ) ) { $self->store( Bot::BasicBot::Pluggable::Store->new( $self->store ) ); } return 1; } sub init_logging { my $self = shift; my $logger = Log::Log4perl->get_logger( ref $self ); if ( $self->logconfig ) { Log::Log4perl->init( $self->logconfig ); } else { my $loglevel = $self->loglevel; Log::Log4perl::init( \ <get_logger( ref $self ); for my $log_entry (@_) { chomp $log_entry; $logger->warn($log_entry); } return; } sub load { my $self = shift; my $module = shift; my $logger = Log::Log4perl->get_logger( ref $self ); # it's safe to die here, mostly this call is eval'd. $logger->logdie("Cannot load module without a name") unless $module; $logger->logdie("Module $module already loaded") if $self->handler($module); # This is possible a leeeetle bit evil. $logger->info("Loading module $module"); my $filename = $module; $filename =~ s{::}{/}g; my $file = "Bot/BasicBot/Pluggable/Module/$filename.pm"; $file = "./$filename.pm" if ( -e "./$filename.pm" ); $file = "./modules/$filename.pm" if ( -e "./modules/$filename.pm" ); $logger->debug("Loading module $module from file $file"); warn "Loading $module from $file"; # force a reload of the file (in the event that we've already loaded it). no warnings 'redefine'; delete $INC{$file}; try { require $file } catch { die "Can't load $module: $_"; }; # Ok, it's very evil. Don't bother me, I'm working. my $m = "Bot::BasicBot::Pluggable::Module::$module"->new( Bot => $self, Param => \@_ ); $logger->logdie("->new didn't return an object") unless ( $m and ref($m) ); $logger->logdie( ref($m) . " isn't a $module" ) unless ref($m) =~ /\Q$module/; $self->add_handler( $m, $module ); return $m; } sub reload { my $self = shift; my $module = shift; my $logger = Log::Log4perl->get_logger( ref $self ); $logger->logdie("Cannot reload module with a name") unless $module; $self->remove_handler($module) if $self->handler($module); return $self->load($module); } sub unload { my $self = shift; my $module = shift; my $logger = Log::Log4perl->get_logger( ref $self ); $logger->logdie("Need name") unless $module; $logger->logdie("Not loaded") unless $self->handler($module); $logger->info("Unloading module $module"); $self->remove_handler($module); } sub module { my $self = shift; return $self->handler(@_); } sub modules { my $self = shift; return $self->handlers(@_); } sub available_modules { my $self = shift; my @local_modules = map { substr( ( File::Spec->splitpath($_) )[2], 0, -3 ) } glob('./*.pm'), glob('./modules/*.pm'); my @central_modules = map { my $mod = $_; $mod =~ s/^Bot::BasicBot::Pluggable::Module:://; $mod; } $self->_available(); my @modules = sort @local_modules, @central_modules; return @modules; } # deprecated methods sub handler { my ( $self, $name ) = @_; return $self->{handlers}{ lc($name) }; } sub handlers { my $self = shift; my @keys = keys( %{ $self->{handlers} } ); return @keys if wantarray; return \@keys; } sub add_handler { my ( $self, $handler, $name ) = @_; my $logger = Log::Log4perl->get_logger( ref $self ); $logger->logdie("Need a name for adding a handler") unless $name; $logger->logdie("Can't load a handler with a duplicate name $name") if $self->{handlers}{ lc($name) }; $self->{handlers}{ lc($name) } = $handler; } sub remove_handler { my ( $self, $name ) = @_; my $logger = Log::Log4perl->get_logger( ref $self ); $logger->logdie("Need a name for removing a handler") unless $name; $logger->logdie("Hander $name not defined") unless $self->{handlers}{ lc($name) }; $self->{handlers}{ lc($name) }->stop(); delete $self->{handlers}{ lc($name) }; } sub store { my $self = shift; $self->{store_object} = shift if @_; return $self->{store_object}; } sub loglevel { my $self = shift; $self->{loglevel} = shift if @_; return ($self->{loglevel} and uc $self->{loglevel}) || 'WARN'; } sub logconfig { my $self = shift; $self->{logconfig} = shift if @_; return $self->{logconfig}; } sub dispatch { my ( $self, $method, @args ) = @_; my $logger = Log::Log4perl->get_logger( ref $self ); $logger->info("Dispatching $method"); for my $who ( $self->handlers ) { ## Otherwise we would see tick every five seconds if ( $method eq 'tick' ) { $logger->trace("Trying to dispatch $method to $who"); } else { $logger->debug("Trying to dispatch $method to $who"); } $logger->trace( "... with " . Dumper(@args) ) if $logger->is_trace && @args; next unless $self->handler($who)->can($method); try { $logger->trace( "Dispatching $method to $who with " . Dumper(@args) ) if $logger->is_trace; $self->handler($who)->$method(@args); } catch { $logger->warn($_); } } return; } sub help { my $self = shift; my $mess = shift; $mess->{body} =~ s/^help\s*//i; my $logger = Log::Log4perl->get_logger( ref $self ); unless ( $mess->{body} ) { return "Ask me for help about: " . join( ", ", $self->handlers() ) . " (say 'help ')."; } elsif ( $mess->{body} eq 'modules' ) { return "These modules are available for loading: " . join( ", ", $self->available_modules ); } else { if ( my $handler = $self->handler( $mess->{body} ) ) { try { return $handler->help($mess); } catch { $logger->warn( "Error calling help for handler $mess->{body}: $_"); } } else { return "I don't know anything about '$mess->{body}'."; } } } ######################################################### # the following routines are lifted from Bot::BasicBot: # ######################################################### sub tick { my $self = shift; $self->dispatch('tick'); return 5; } sub dispatch_priorities { my ( $self, $event, $mess ) = @_; my $response; my $who; my $logger = Log::Log4perl->get_logger( ref $self ); $logger->info('Dispatching said event'); for my $priority ( 0 .. 3 ) { for my $handler ( $self->handlers ) { my $response; $logger->debug( "Trying to dispatch said to $handler on priority $priority"); $logger->trace( '... with arguments ' . Dumper($mess) ) if $logger->is_trace and $mess; try { $response = $self->handler($handler)->$event( $mess, $priority ); } catch { $logger->warn($_); }; if ( $priority and $response ) { $logger->debug("Response by $handler on $priority"); $logger->trace( 'Response is ' . Dumper($response) ) if $logger->is_trace; return if $response eq '1'; $self->reply( $mess, $response ); return; } } } return; } sub reply { my ( $self, $mess, @other ) = @_; $self->dispatch( 'replied', {%$mess}, @other ); if ( $mess->{reply_hook} ) { return $mess->{reply_hook}->( $mess, @other ); } else { return $self->SUPER::reply( $mess, @other ); } } BEGIN { my @dispatchable_events = ( qw/ connected chanjoin chanpart userquit nick_change topic kicked / ); my @priority_events = (qw/ said emoted /); { ## no critic qw(ProhibitNoStrict) no strict 'refs'; for my $event (@dispatchable_events) { *$event = sub { shift->dispatch( $event, @_ ); }; } for my $event (@priority_events) { *$event = sub { shift->dispatch_priorities( $event, @_ ); }; } } } 1; # sigh. __END__ =head1 NAME Bot::BasicBot::Pluggable - extended simple IRC bot for pluggable modules =head1 VERSION version 1.00 =head1 SYNOPSIS =head2 Creating the bot module # with all defaults. my $bot = Bot::BasicBot->new(); # with useful options. pass any option # that's valid for Bot::BasicBot. my $bot = Bot::BasicBot::Pluggable->new( channels => ["#bottest"], server => "irc.example.com", port => "6667", nick => "pluggabot", altnicks => ["pbot", "pluggable"], username => "bot", name => "Yet Another Pluggable Bot", ignore_list => [qw(hitherto blech muttley)], ); =head2 Running the bot (simple) There's a shell script installed to run the bot. $ bot-basicbot-pluggable --nick MyBot --server irc.perl.org Then connect to the IRC server, /query the bot, and set a password. See L for further details. =head2 Running the bot (advanced) There are two useful ways to create a Pluggable bot. The simple way is: # Load some useful modules. my $infobot_module = $bot->load("Infobot"); my $google_module = $bot->load("Google"); my $seen_module = $bot->load("Seen"); # Set the Google key (see http://www.google.com/apis/). $google_module->set("google_key", "some google key"); $bot->run(); The above lets you run a bot with a few modules, but not change those modules during the run of the bot. The complex, but more flexible, way is as follows: # Load the Loader module. $bot->load('Loader'); # run the bot. $bot->run(); This is simpler but needs further setup once the bot is joined to a server. The Loader module lets you talk to the bot in-channel and tell it to load and unload other modules. The first one you'll want to load is the 'Auth' module, so that other people can't load and unload modules without permission. Then you'll need to log in as an admin and change the default password, per the following /query: !load Auth !auth admin julia !password julia new_password !auth admin new_password Once you've done this, your bot is safe from other IRC users, and you can tell it to load and unload other installed modules at any time. Further information on module loading is in L. !load Seen !load Google !load Join The Join module lets you tell the bot to join and leave channels: , join #mychannel , leave #someotherchannel The perldoc pages for the various modules will list other commands. =head1 DESCRIPTION Bot::BasicBot::Pluggable started as Yet Another Infobot replacement, but now is a generalised framework for writing infobot-type bots that lets you keep each specific function seperate. You can have seperate modules for factoid tracking, 'seen' status, karma, googling, etc. Included default modules are below. Use C> for help on their individual terminology. Auth - user authentication and admin access. DNS - host lookup (e.g. nslookup and dns). Google - search Google for things. Infobot - handles infobot-style factoids. Join - joins and leaves channels. Karma - tracks the popularity of things. Loader - loads and unloads modules as bot commands. Seen - tells you when people were last seen. Title - gets the title of URLs mentioned in channel. Vars - changes module variables. The way the Pluggable bot works is very simple. You create a new bot object and tell it to load various modules (or, alternatively, load just the Loader module and then interactively load modules via an IRC /query). The modules receive events when the bot sees things happen and can, in turn, respond. See C for the details of the module API. =head1 METHODS =over 4 =item new(key => value, ...) Create a new Bot. Except of the additional attributes loglevel and logconfig identical to the C method in L. Please refer to their accessor for documentation. =item load($module) Load a module for the bot by name from C<./ModuleName.pm> or C<./modules/ModuleName.pm> in that order if one of these files exist, and falling back to C if not. =item reload($module) Reload the module C<$module> - equivalent to unloading it (if it's already loaded) and reloading it. Will stomp the old module's namespace - warnings are expected here. Not toally clean - if you're experiencing odd bugs, restart the bot if possible. Works for minor bug fixes, etc. =item unload($module) Removes a module from the bot. It won't get events any more. =item module($module) Returns the handler object for the loaded module C<$module>. Used, e.g., to get the 'Auth' hander to check if a given user is authenticated. =item modules Returns a list of the names of all loaded modules as an array. =item available_modules Returns a list of all available modules whether loaded or not =item add_handler($handler_object, $handler_name) Adds a handler object with the given name to the queue of modules. There is no order specified internally, so adding a module earlier does not guarantee it'll get called first. Names must be unique. =item remove_handler($handler_name) Remove a handler with the given name. =item store Returns the bot's object store; see L. =item log Logs all of its argument to loglevel info. Please do not use this function in new code, it's simple provided as fallback for old modules. =item loglevel Returns the bots loglevel or sets it if an argument is supplied. It expects trace, debug, info, warn, error or fatal as value. =item logconfig Returns the bot configuration file for logging. Please refer to L for the configurations files format. Setting this to a differant file after calling init() has no effect. Returns or set =item dispatch($method_name, $method_params) Call the named C<$method> on every loaded module with that method name. =item help Returns help for the ModuleName of message 'help ModuleName'. If no message has been passed, return a list of all possible handlers to return help for. =item run Runs the bot. POE core gets control at this point; you're unlikely to get it back. =back =head1 BUGS During the C, C, C process, POE will moan about its kernel not being run. This is a C, apparently. Reloading a module causes warnings as the old module gets its namespace stomped. Not a lot you can do about that. All modules must be in Bot::Pluggable::Module:: namespace. Well, that's not really a bug. =head1 REQUIREMENTS Bot::BasicBot::Pluggable is based on POE, and really needs the latest version. Because POE is like that sometimes. You also need L. Oh, and L. Some of the modules will need more modules, e.g. Google.pm needs L. See the module docs for more details. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR David Precious (BIGPRESH) I am merely the current maintainer; however, the AUTHOR heading is traditional. =head1 CONTRIBUTORS =over 2 =item * Mario Domgoergen =item * Tom Insam =item * David Precious =item * Mike Eldridge =back =head1 CREDITS Bot::BasicBot was written initially by Mark Fowler, and worked on heavily by Simon Kent, who was kind enough to apply some patches we needed for Pluggable. Eventually. Oh, yeah, and I stole huge chunks of docs from the Bot::BasicBot source too. I spent a lot of time in the mozbot code, and that has influenced my ideas for Pluggable. Mostly to get round its awfulness. Various people helped with modules. Convert was almost ported from the infobot code by blech. But not quite. Thanks for trying... blech has also put a lot of effort into the chump.cgi & chump.tem files in the examples/ folder, including some /inspired/ calendar evilness. And thanks to the rest of #2lmc who were my unwilling guinea pigs during development. And who kept suggesting totally stupid ideas for modules that I then felt compelled to go implement. Shout.pm owes its existence to #2lmc. Thanks to Mike Eldridge (DIZ), maintainer until 2016, for kindly transferring maintainership to me, BIGPRESH, so I can keep this useful bot framework alive. =head1 SEE ALSO =over 2 =item * L =item * L =item * L =item * Infobot: http://www.infobot.org/ =item * Mozbot: http://www.mozilla.org/projects/mozbot/ =back =cut bot-basicbot-pluggable-cli100755001750001750 26612727613416 23274 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/bin#!/usr/bin/perl use warnings; use strict; use App::Bot::BasicBot::Pluggable::Terminal; my $app = App::Bot::BasicBot::Pluggable::Terminal->new_with_options(); $app->run(); __END__ bot-basicbot-pluggable-cgi100755001750001750 561512727613416 23312 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/bin#!/usr/local/bin/perl -w use lib qw(lib); =head1 NAME bot-basicbot-pluggable.pl - A standard Bot::BasicBot::Pluggable script =head1 VERSION version 1.00 =head1 DESCRIPTION A standard Bot::BasicBot::Pluggable interface. You can /query the bot to load in more modules. Change the admin password ASAP - See perldoc L for details of this. =head1 USAGE bot-basicbot-pluggable.pl --nick MyBot --server irc.perl.org =head2 SEE ALSO Bot::BasicBot::Pluggable =cut use warnings; use strict; use CGI; use Template; my $q = CGI->new; print $q->header; my $tt = Template->new || die $Template::ERROR."\n"; my $template = join "", ; my $nick = "dipsy"; my $bot = Bot::BasicBot::Pluggable::CLI->new( channels => [ ], server => "", nick => $nick, charset => "utf8", store => { type => 'Storable' }, ); # Loader lets you tell the bot to load other modules. $bot->load("Loader"); my @dunno = split /\|/, $bot->store->get('Infobot',"user_unknown_responses"); my $in = $q->param("q"); my $ret; goto VARS unless defined $in; # strip off whitespace before and after the message $in =~ s!(^\s*|\s*$)!!g; my $mess = { address => 1, channel => "#$nick", body => $in, who => $ENV{USER}, }; if ($mess->{body} =~ /^help/i) { $ret = $bot->help($mess); } else { $bot->said($mess); $ret = $bot->{_tmp_reply}->{body} if ($bot->{_tmp_reply}); $bot->{_tmp_reply} = undef; } VARS: $ret = $dunno[rand $#dunno] unless defined $ret and $ret ne ""; my $vars = { nick => $nick, question => $in, response => $ret, }; $tt->process(\$template, $vars) || die $tt->error(), "\n"; package Bot::BasicBot::Pluggable::CLI; $Bot::BasicBot::Pluggable::CLI::VERSION = '1.00'; use base qw(Bot::BasicBot::Pluggable); sub reply { my $self = shift; my ($mess, $body) = @_; $mess->{body} = $body; $self->{_tmp_reply} = $mess; } package main; $main::VERSION = '1.00'; __DATA__ Web Dipsy [% IF question %] - [% question | html %] [% END %]

[% IF question %] you: [% question | html %]
[% nick | html %]: [% response | html %]
[% ELSE %] [% nick %]:Hello!
[% END %]

You:  
BasicBot000755001750001750 012727613416 21075 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/App/BotPluggable.pm100644001750001750 1322012727613416 23513 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/App/Bot/BasicBotpackage App::Bot::BasicBot::Pluggable; $App::Bot::BasicBot::Pluggable::VERSION = '1.00'; use Moose; use Config::Find; use Bot::BasicBot::Pluggable; use Bot::BasicBot::Pluggable::Store; use Moose::Util::TypeConstraints; use List::MoreUtils qw(any uniq); use Try::Tiny; use Log::Log4perl; with 'MooseX::Getopt::Dashes'; with 'MooseX::SimpleConfig'; use Module::Pluggable sub_name => '_available_stores', search_path => 'Bot::BasicBot::Pluggable::Store'; subtype 'App::Bot::BasicBot::Pluggable::Channels' => as 'ArrayRef' ## Either it's an empty ArrayRef or all channels start with # => where { @{$_} ? any { /^#/ } @{$_} : 1 }; coerce 'App::Bot::BasicBot::Pluggable::Channels' => from 'ArrayRef' => via { [ map { /^#/ ? $_ : "#$_" } @{$_} ] }; subtype 'App::Bot::BasicBot::Pluggable::Store' => as 'Bot::BasicBot::Pluggable::Store'; MooseX::Getopt::OptionTypeMap->add_option_type_to_map( 'App::Bot::BasicBot::Pluggable::Store' => '=s%' ); coerce 'App::Bot::BasicBot::Pluggable::Store' => from 'Str' => via { Bot::BasicBot::Pluggable::Store->new_from_hashref({ type => 'Str' }) }; coerce 'App::Bot::BasicBot::Pluggable::Store' => from 'HashRef' => via { Bot::BasicBot::Pluggable::Store->new_from_hashref( shift ) }; has server => ( is => 'rw', isa => 'Str', default => 'localhost' ); has nick => ( is => 'rw', isa => 'Str', default => 'basicbot' ); has charset => ( is => 'rw', isa => 'Str', default => 'utf8' ); has channel => ( is => 'rw', isa => 'App::Bot::BasicBot::Pluggable::Channels', coerce => 1, default => sub { [] } ); has password => ( is => 'rw', isa => 'Str' ); has port => ( is => 'rw', isa => 'Int', default => 6667 ); has bot_class => ( is => 'rw', isa => 'Str', default => 'Bot::BasicBot::Pluggable' ); has list_modules => ( is => 'rw', isa => 'Bool', default => 0 ); has list_stores => ( is => 'rw', isa => 'Bool', default => 0 ); has store => ( is => 'rw', isa => 'App::Bot::BasicBot::Pluggable::Store', coerce => 1, builder => '_create_store' ); has settings => ( metaclass => 'NoGetopt', is => 'rw', isa => 'HashRef', default => sub { {} } ); has loglevel => ( is => 'rw', isa => 'Str', default => 'warn' ); has logconfig => ( is => 'rw', isa => 'Str' ); has configfile => ( is => 'rw', isa => 'Str|Undef', default => Config::Find->find( name => 'bot-basicbot-pluggable.yaml' ), ); has bot => ( metaclass => 'NoGetopt', is => 'rw', isa => 'Bot::BasicBot::Pluggable', builder => '_create_bot', lazy => 1, ); has module => ( is => 'rw', isa => 'ArrayRef', default => sub { return [qw( Auth Loader )] } ); sub BUILD { my ($self) = @_; if ( $self->password() ) { $self->module( [ uniq @{ $self->module }, 'Auth' ] ); } $self->_load_modules(); } sub _load_modules { my ($self) = @_; my %settings = %{ $self->settings() }; my $logger = Log::Log4perl->get_logger( ref $self ); # Implicit loading of modules via $self->settings my @modules = uniq @{ $self->module() }, keys %settings; $self->module( [@modules] ); for my $module_name (@modules) { my $module = try { $self->bot->load($module_name); } catch { $logger->error("$_"); }; next if !$module; if ( exists( $settings{$module_name} ) ) { for my $key ( keys %{ $settings{$module_name} } ) { $module->set( $key, $settings{$module_name}->{$key} ); } } if ( $module_name eq 'Auth' and $self->password() ) { $module->set( 'password_admin', $self->password() ); } } } sub _create_store { return Bot::BasicBot::Pluggable::Store->new_from_hashref( { type => 'Memory' } ); } sub _create_bot { my ($self) = @_; my $class = $self->bot_class(); return $class->new( channels => $self->channel(), server => $self->server(), nick => $self->nick(), charset => $self->charset(), port => $self->port(), store => $self->store(), loglevel => $self->loglevel(), logconfig => $self->logconfig(), ); } sub run { my ($self) = @_; if ( $self->list_modules() ) { print "$_\n" for $self->bot->available_modules; exit 0; } if ( $self->list_stores() ) { for ( $self->_available_stores ) { s/Bot::BasicBot::Pluggable::Store:://; print "$_\n"; } exit 0; } $self->bot->run(); } 1; __END__ =head1 NAME App::Bot::BasicBot::Pluggable - Base class for bot applications =head1 VERSION version 1.00 =head1 SYNOPSIS my bot = App::Bot::BasicBot::Pluggable( modules => [ 'Karma' ] ) $bot->run(); =head1 DESCRIPTION This module is basically intended as base class for L frontends. It's attributes can be set by command line options or a configuration file. =head1 ATTRIBUTES All subsequently listed attributes are documented in the manpage of L. Just replace all dashes with underscores. =over 4 =item server =item nick =item charset =item password =item port =item list_modules =item list_stores =item loglevel =item logconfig =item configfile =item module =back =head1 METHODS =head2 run If list_modules or list_stores are set to a true value, the according list is printed to stdout. Otherwise the run method of the bot specified by the bot_class method is called. =head1 AUTHOR Mario Domgoergen =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself BasicBot000755001750001750 012727613416 21274 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Test/BotPluggable.pm100644001750001750 676412727613416 23711 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Test/Bot/BasicBotpackage Test::Bot::BasicBot::Pluggable; $Test::Bot::BasicBot::Pluggable::VERSION = '1.00'; use warnings; use strict; use base qw( Bot::BasicBot::Pluggable ); sub new { my ( $class, %args ) = @_; my $bot = $class->SUPER::new( store => 'Memory', nick => 'test_bot', %args ); return bless $bot, $class; } sub tell_private { return shift->tell( shift, 1, 1 ); } # tell the module something privately sub tell_direct { return shift->tell( shift, 0, 1 ) } sub tell_indirect { return shift->tell( shift, 0, 0 ); } # the module has seen something sub tell { my ( $bot, $body, $private, $addressed, $who ) = @_; my @reply; my $message = { body => $body, who => $who || 'test_user', channel => $private ? 'msg' : '#test', address => $addressed, reply_hook => sub { push @reply, $_[1]; }, # $_[1] is the reply text }; if ( $body =~ /^help/ and $addressed ) { push @reply, $bot->help($message); } else { $bot->said($message); } return join "\n", @reply; } sub connect { my $self = shift; $self->dispatch('connected'); } # otherwise AUTOLOAD in Bot::BasicBot will be called sub DESTROY { } 1; __END__ =head1 NAME Test::Bot::BasicBot::Pluggable - utilities to aid in testing of Bot::BasicBot::Pluggable modules =head1 VERSION version 1.00 =head1 SYNOPSIS use Test::More; use Test::Bot::BasicBot::Pluggable; my $bot = Test::Bot::BasicBot->new(); $bot->load('MyModule'); is ( $bot->tell_direct('foo'), 'bar'); is ( $bot->tell_indirect('foo'), 'bar'); is ( $bot->tell_private('foo'), 'bar'); =head1 DESCRIPTION Test::Bot::BasicBot::Pluggable was written to provide a minimalistic testing bot in order to write cleaner unit tests for Bot::BasicBot::Pluggable modules. =head1 SUBROUTINES/METHODS =head2 new Creates a new Test::Bot::BasicBot::Pluggable object, which is basically just a subclass of Bot::BasicBot::Pluggable with a few special methods. The default nickname is 'test_bot' and it contains a in-memory store instead of sqlite. It takes the same arguments as Bot::BasicBot::Pluggable. =head1 INSTANCE METHODS =head2 tell_direct Sends the provided string to the bot like it was send directly to the bot in a public channel. The channel is called '#test' and the sending user 'test_user'. test_user@#test> test_bot: foo =head2 tell_indirect Sends the provided string to the bot like it was send to a public channel without addressing. The channel is called '#test' and the sending user 'test_user'. test_user@#test> foo =head2 tell_private Sends the provided string to the bot like it was send in a private channel. The sending user 'test_user'. test_user@test_bot> foo =head2 tell This is the working horse of Test::Bot::BasicBot::Pluggable. It basically builds a message hash as argument to the bots said() function. You should never have to call it directly. =head2 connect Dispatch the connected event to all loaded modules without actually connecting to anything. =head2 DESTROY The special subrouting is explicitly overriden with an empty subroutine as otherwise AUTOLOAD in Bot::BasicBot will be called for it. =head1 BUGS AND LIMITATIONS There are no methods to test join, part and emote. =head1 AUTHOR Mario Domgoergen =head1 LICENSE AND COPYRIGHT Copyright 2009 Mario Domgoergen, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Pluggable000755001750001750 012727613416 22257 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBotStore.pm100644001750001750 1465712727613416 24106 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggablepackage Bot::BasicBot::Pluggable::Store; $Bot::BasicBot::Pluggable::Store::VERSION = '1.00'; use strict; use warnings; use Carp qw( croak ); use Data::Dumper; use Storable qw( nfreeze thaw ); use Try::Tiny; use Module::Load qw(); use Log::Log4perl; use base qw( ); sub new { my $class = shift; my $self; my $logger = Log::Log4perl->get_logger($class); if ( @_ % 2 == 0 ) { $self = bless {@_} => $class; } elsif ( @_ == 1 and ref $_[0] eq 'HASH' ) { $self = $class->new_from_hashref( $_[0] ); } elsif ( @_ == 1 and !ref $_[0] ) { $self = $class->new_from_hashref( { type => $_[0] } ); } elsif ( !@_ ) { $self = bless {} => $class; } else { $logger->warn( "Argument to new() is neither an argument list, a hashref, a string nor empty" ); } $self->init(); $self->load(); return $self; } sub new_from_hashref { my ( $class, $args ) = @_; my $logger = Log::Log4perl->get_logger($class); if ( ref($args) ne 'HASH' ) { $logger->warn('Argument to store_from_hashref must be a hashref'); } my $store_class = delete $args->{type} || 'Memory'; $store_class = "Bot::BasicBot::Pluggable::Store::$store_class" unless $store_class =~ /::/; # load the store class try { Module::Load::load $store_class; } catch { $logger->warn("Couldn't load $store_class - $_"); }; my $store = $store_class->new( %{$args} ); croak "Couldn't init a $store_class store\n" unless $store; return $store; } sub init { undef } sub load { undef } sub save { } sub keys { my ( $self, $namespace, %opts ) = @_; my $mod = $self->{store}{$namespace} || {}; return $self->_keys_aux( $mod, $namespace, %opts ); } sub count_keys { my ( $self, $namespace, %opts ) = @_; $opts{_count_only} = 1; $self->keys( $namespace, %opts ); } sub _keys_aux { my ( $self, $mod, $namespace, %opts ) = @_; my @res = ( exists $opts{res} ) ? @{ $opts{res} } : (); return CORE::keys %$mod unless @res; my @return; my $count = 0; OUTER: while ( my ($key) = each %$mod ) { for my $re (@res) { # limit matches $re = "^" . lc($namespace) . "_.*${re}.*" if $re =~ m!^[^\^].*[^\$]$!; next OUTER unless $key =~ m!$re!; } push @return, $key if ( !$opts{_count_only} ); last if $opts{limit} && ++$count >= $opts{limit}; } return ( $opts{_count_only} ) ? $count : @return; } sub get { my ( $self, $namespace, $key ) = @_; return $self->{store}{$namespace}{$key}; } sub set { my ( $self, $namespace, $key, $value ) = @_; $self->{store}{$namespace}{$key} = $value; $self->save($namespace); return $self; } sub unset { my ( $self, $namespace, $key ) = @_; delete $self->{store}{$namespace}{$key}; $self->save($namespace); return $self; } sub namespaces { my $self = shift; return CORE::keys( %{ $self->{store} } ); } sub dump { my $self = shift; my $data = {}; for my $n ( $self->namespaces ) { warn "Dumping namespace '$n'.\n"; for my $k ( $self->keys($n) ) { $data->{$n}{$k} = $self->get( $n, $k ); } } return nfreeze($data); } sub restore { my ( $self, $dump ) = @_; my $data = thaw($dump); for my $n ( CORE::keys(%$data) ) { warn "Restoring namespace '$n'.\n"; for my $k ( CORE::keys( %{ $data->{$n} } ) ) { $self->set( $n, $k, $data->{$n}{$k} ); } } warn "Complete.\n"; } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Store - base class for the back-end pluggable store =head1 VERSION version 1.00 =head1 SYNOPSIS my $store = Bot::BasicBot::Pluggable::Store->new( option => "value" ); my $namespace = "MyModule"; for ( $store->keys($namespace) ) { my $value = $store->get($namespace, $_); $store->set( $namespace, $_, "$value and your momma." ); } Store classes should subclass this and provide some persistent way of storing things. =head1 METHODS =over 4 =item new() Standard C method, blesses a hash into the right class and puts any key/value pairs passed to it into the blessed hash. If called with an hash argument as its first argument, new_from_hashref will be run with the hash as its only argument. See L for the possible keys and values. You can also pass a string and it will try to call new_from_hashref with a hash reference { type => $string }. Calls C to load any internal variables, then C, which you can also override in your module. =item new_from_hashref( $hashref ) Intended to be called as class method to dynamically create a store object. It expects a hash reference as its only argument. The only required hash element is a string specified by I. This should be either a fully qualified classname or a colonless string that is appended to I. All other arguments are passed down to the real object constructor. =item init() Called as part of new class construction, before C. =item load() Called as part of new class construction, after C. =item save() Subclass me. But, only if you want to. See ...Store::Storable.pm as an example. =item keys($namespace,[$regex]) Returns a list of all store keys for the passed C<$namespace>. If you pass C<$regex> then it will only pass the keys matching C<$regex> =item get($namespace, $variable) Returns the stored value of the C<$variable> from C<$namespace>. =item set($namespace, $variable, $value) Sets stored value for C<$variable> to C<$value> in C<$namespace>. Returns store object. =item unset($namespace, $variable) Removes the C<$variable> from the store. Returns store object. =item namespaces() Returns a list of all namespaces in the store. =item dump() Dumps the complete store to a huge Storable scalar. This is mostly so you can convert from one store to another easily, i.e.: my $from = Bot::BasicBot::Pluggable::Store::Storable->new(); my $to = Bot::BasicBot::Pluggable::Store::DBI->new( ... ); $to->restore( $from->dump ); C is written generally so you don't have to re-implement it in subclasses. =item restore($data) Restores the store from a L. =back =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L L Module.pm100644001750001750 2350712727613416 24231 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggablepackage Bot::BasicBot::Pluggable::Module; $Bot::BasicBot::Pluggable::Module::VERSION = '1.00'; use warnings; use strict; sub new { my $class = shift; my %param = @_; my $name = ref($class) || $class; $name =~ s/^.*:://; $param{Name} ||= $name; my $self = \%param; bless $self, $class; $self->init(); return $self; } sub config { my ( $self, $config ) = @_; for my $var ( keys %{$config} ) { $self->set( $var, $config->{$var} ) unless defined( $self->get($var) ); } } sub bot { my $self = shift; return $self->{Bot}; } sub store { my $self = shift; die "module has no bot" unless $self->bot; return $self->bot->store; } sub get { my $self = shift; $self->store->get( $self->{Name}, @_ ); } sub set { my $self = shift; $self->store->set( $self->{Name}, @_ ); } sub unset { my $self = shift; $self->store->unset( $self->{Name}, @_ ); } sub var { my $self = shift; my $name = shift; if (@_) { return $self->set( $name, shift ); } else { return $self->get($name); } } sub store_keys { my $self = shift; my $store = $self->store; die "No store set up" unless defined $store; die "Store isn't a ref" unless ref($store); $store->keys( $self->{Name}, @_ ); } sub help { my ( $self, $mess ) = @_; return "No help for module '$self->{Name}'. This is a bug."; } sub say { my $self = shift; return $self->bot->say(@_); } sub reply { my $self = shift; return $self->bot->reply(@_); } sub tell { my ( $self, $target, $body ) = @_; if ( $target =~ /^#/ ) { $self->say( { channel => $target, body => $body } ); } else { $self->say( { channel => 'msg', body => $body, who => $target } ); } } sub said { my ( $self, $mess, $pri ) = @_; $mess->{body} =~ s/(^\s*|\s*$)//g if defined $mess->{body}; my $handler = (qw/ seen admin told fallback /)[$pri]; return $self->$handler($mess); } sub authed { my ( $self, $who ) = @_; if ( $self->bot->module('Auth') ) { return $self->bot->module('Auth')->authed($who); } return 0; } sub init { undef } sub connected { undef } sub chanjoin { undef } sub chanpart { undef } sub seen { undef } sub admin { undef } sub told { undef } sub fallback { undef } sub emoted { undef } sub tick { undef } sub stop { undef } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module - base module for all BasicBot plugins =head1 VERSION version 1.00 =head1 SYNOPSIS You MUST override C, which MUST return help text for the module. You MUST override at least C, though it is preferred that you override the more specific C, C, C and C for cleaner code without relying on checks against C<$pri>. You MAY override C, C, C, C, C, C and C. You MAY return a response from C to the event. =head1 DESCRIPTION =head2 Object Store Every pluggable module gets an object store to save variables in. Access this store using the C and C accessors. Do not access the store through any other means - the location of the store, and its method of storage, may change at any time: my $count = $self->get("count"); $self->set( count => $count + 1 ); Keys that begin "user_" are considered _USER_ variables, and can be changed by administrators in the IRC channel using L. Don't use them as unchecked input data. =head1 METHODS =over 4 =item new() Standard C method, blesses a hash into the right class and puts any key/value pairs passed to it into the blessed hash. Calls C to load any internal or user variables you may have set in your module. =item init() Called as part of new class construction. May or may not be after server connection. Override this to do things when your module is added to the bot. =item config($config) Set every key in the hash reference $config to its default value if it is not already defined in the module store. In that case the value from the store is used to initialise the variable. Typically called in the module's init functions. =item start() Indicates that the module is added to the bot, and that the bot is connected to the IRC server. Do things here that need to be done after you're connected. TODO - this method not yet implemented. =item stop() Called just before your module is removed from the bot. Do cleanup here. =item bot() Returns the L bot we're running under. =item store Returns L subclass used to store variables. =item get($name) Returns the value of a local variable from the object store. =item set($name => $value) Set a local variable into the object store. =item unset($name) Unsets a local variable - removes it from the store, not just Cs it. =item var($name, [$value]) C or C a local variable from the module store. =item store_keys Returns a list of all keys in the object store. =item connected Called when the bot connects to the server. The return value is meaningless. =item chanjoin($message) Called when a user joins a channel. =item userquit($message) Called when a user client quits. See L for a description of the arguments. =item chanpart($message) Called when a user leaves a channel. =item topic($message) Called when the topic of a channel is changed. See L for a description of the arguments. =item kicked($message) Called when a user is kicked from a channel. See L for a description of the arguments. =item nick_change($message) When a user changes nicks, this will be called. See L for a description of the arguments. =item help Called when a user asks for help on a topic and thus should return some useful help text. For L, when a user asks the bot 'help', the bot will return a list of modules. Asking the bot 'help ' will call the C function of that module, passing in the first parameter the message object that represents the question. =item say($message) Passing through L, send messages without replying to a C: $self->say({ who => 'tom', body => 'boo', channel => 'msg' }); =item reply($message, $body) Replies to the given message with the given text. Another passthrough to C. The message is used to pre-populate the reply, so it'll be in the same channel as the question, directed to the right user, etc. =item tell($nick | $channel, $message) Convenience method to send message to nick (privmsg) or channel (public): $self->tell('tom', "hello there, fool"); $self->tell('#sailors', "hello there, sailor"); =item said($message, $priority) This method is called whenever the bot sees something said. The first parameter is a L 'message' object, as passed to it's 'said' function - see those docs for further details. The second parameter is the priority of the message - all modules will have the 'said' function called up to 4 times, with priorities of 0, 1, 2, and 3. The first module to return a non-null value 'claims' the message, and the bot will reply to it with the value returned - unless the value is "1", in which case the message is considered claimed (no other module will see it) but no reply will be issued. The exception to this is the 0 priority, which a module MUST NOT respond to (any response will be ignored). This is so that all modules will at least see all messages. I suggest: sub said { my ($self, $mess, $pri) = @_; my $body = $mess->{body}; return unless ($pri == 2); # most common my ($command, $param) = split(/\s+/, $body, 2); $command = lc($command); # do something here return; # allows other modules to see this message, or: return 1; # "eat" the message, no other module sees it, no reply, or: return "OK!"; # "eat" the message and send a reply back to the user } The preferred way, however, is to override one of the seperate C, C, C and C methods, corresponding to priorities 0, 1, 2 and 3 in order - this will lead to nicer code. This approach is new, though, which is why it's not yet used in most of the shipped modules yet. It will eventually become the only thing to do, and I will deprecate C. =item replied($message,$reply) This method is called every time a module returns an reply. The first argument is the original message and the second is the returned string. The return value of this method is actually discarded, so you can't do anything to prevent the message from being sent. This is mainly meant to log the bots activity. =item seen($message) Like C; called if you don't override C, but only for priority 0. As it is called at priority 0, you cannot return a reply from this method. =item admin($message) Like C; called if you don't override C, but only for priority 1. =item told($message) Like C; called if you don't override C, but only for priority 2. =item fallback($message) Like C; called if you don't override C, but only for priority 3. =item emoted($message, $priority) Called when a user emotes something in channel. =item tick Called every five seconds. It is probably worth having a counter and not responding to every single one, assuming you want to respond at all. The return value is ignored. =item authed($who) This is a convinient method that trys to check for the users authentication level via Auth.pm. It is exactly equivalent to $self->bot->module('Auth') and $self->bot->module('Auth')->authed($who); =back =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Terminal.pm100755001750001750 174712727613416 24544 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggablepackage Bot::BasicBot::Pluggable::Terminal; $Bot::BasicBot::Pluggable::Terminal::VERSION = '1.00'; use warnings; use strict; use base qw(Test::Bot::BasicBot::Pluggable); # Loader lets you tell the bot to load other modules. sub run { my $self = shift; while (1) { last if eof STDIN; my $in = ; chomp $in; # strip off whitespace before and after the message $in =~ s!(^\s*|\s*$)!!g; last if $in eq 'quit'; my $ret = $self->tell( $in, 1, 1, $ENV{USER} ); print "$ret\n" if $ret; } } 1; __END__ =head1 NAME bot-basicbot-pluggable.pl - A standard Bot::BasicBot::Pluggable script =head1 VERSION version 1.00 =head1 DESCRIPTION A standard Bot::BasicBot::Pluggable interface. You can /query the bot to load in more modules. Change the admin password ASAP - See perldoc L for details of this. =head1 USAGE bot-basicbot-pluggable-cli =head2 SEE ALSO Bot::BasicBot::Pluggable Store000755001750001750 012727613416 23353 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/PluggableDBI.pm100644001750001750 1211512727613416 24467 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Storepackage Bot::BasicBot::Pluggable::Store::DBI; $Bot::BasicBot::Pluggable::Store::DBI::VERSION = '1.00'; use warnings; use strict; use Carp qw( croak ); use Data::Dumper; use DBI; use Storable qw( nfreeze thaw ); use Try::Tiny; use base qw( Bot::BasicBot::Pluggable::Store ); sub init { my $self = shift; $self->{dsn} ||= 'dbi:SQLite:bot-basicbot.sqlite'; $self->{table} ||= 'basicbot'; $self->create_table; } sub dbh { my $self = shift; my $dsn = $self->{dsn} or die "I need a DSN"; my $user = $self->{user}; my $password = $self->{password}; return DBI->connect_cached( $dsn, $user, $password ); } sub create_table { my $self = shift; my $table = $self->{table} or die "Need DB table"; my $sth = $self->dbh->table_info( '', '', $table, "TABLE" ); $table = $self->dbh->quote_identifier($table); if ( !$sth->fetch ) { $self->dbh->do( "CREATE TABLE $table ( id INT PRIMARY KEY, namespace TEXT, store_key TEXT, store_value LONGBLOB )" ); if ( $self->{create_index} ) { try { $self->dbh->do( "CREATE INDEX lookup ON $table ( namespace(10), store_key(10) )" ); }; } } } sub get { my ( $self, $namespace, $key ) = @_; my $table = $self->{table} or die "Need DB table"; $table = $self->dbh->quote_identifier($table); my $sth = $self->dbh->prepare_cached( "SELECT store_value FROM $table WHERE namespace=? and store_key=?"); $sth->execute( $namespace, $key ); my $row = $sth->fetchrow_arrayref; $sth->finish; return unless $row and @$row; return try { thaw( $row->[0] ) } catch { $row->[0] }; } sub set { my ( $self, $namespace, $key, $value ) = @_; my $table = $self->{table} or die "Need DB table"; $table = $self->dbh->quote_identifier($table); $value = nfreeze($value) if ref($value); if ( defined( $self->get( $namespace, $key ) ) ) { my $sth = $self->dbh->prepare_cached( "UPDATE $table SET store_value=? WHERE namespace=? AND store_key=?" ); $sth->execute( $value, $namespace, $key ); $sth->finish; } else { my $sth = $self->dbh->prepare_cached( "INSERT INTO $table (id, store_value, namespace, store_key) VALUES (?, ?, ?, ?)" ); $sth->execute( $self->new_id($table), $value, $namespace, $key ); $sth->finish; } return $self; } sub unset { my ( $self, $namespace, $key ) = @_; my $table = $self->{table} or die "Need DB table"; $table = $self->dbh->quote_identifier($table); my $sth = $self->dbh->prepare_cached( "DELETE FROM $table WHERE namespace=? and store_key=?"); $sth->execute( $namespace, $key ); $sth->finish; } sub new_id { my $self = shift; my $table = shift; my $sth = $self->dbh->prepare_cached("SELECT MAX(id) FROM $table"); $sth->execute(); my $id = $sth->fetchrow_arrayref->[0] || "0"; $sth->finish(); return $id + 1; } sub keys { my ( $self, $namespace, %opts ) = @_; my $table = $self->{table} or die "Need DB table"; $table = $self->dbh->quote_identifier($table); my @res = ( exists $opts{res} ) ? @{ $opts{res} } : (); my $sql = "SELECT store_key FROM $table WHERE namespace=?"; my @args = ($namespace); foreach my $re (@res) { my $orig = $re; # h-h-h-hack .... convert to SQL and limit terms if too general $re = "%$re" if $re !~ s!^\^!!; $re = "$re%" if $re !~ s!\$$!!; $re = "${namespace}_${re}" if $orig =~ m!^[^\^].*[^\$]$!; $sql .= " AND store_key LIKE ?"; push @args, $re; } if ( exists $opts{limit} ) { $sql .= " LIMIT ?"; push @args, $opts{limit}; } my $sth = $self->dbh->prepare_cached($sql); $sth->execute(@args); return $sth->rows if $opts{_count_only}; my @keys = map { $_->[0] } @{ $sth->fetchall_arrayref }; $sth->finish; return @keys; } sub namespaces { my ($self) = @_; my $table = $self->{table} or die "Need DB table"; $table = $self->dbh->quote_identifier($table); my $sth = $self->dbh->prepare_cached("SELECT DISTINCT namespace FROM $table"); $sth->execute(); my @keys = map { $_->[0] } @{ $sth->fetchall_arrayref }; $sth->finish; return @keys; } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Store::DBI - use DBI to provide a storage backend =head1 VERSION version 1.00 =head1 SYNOPSIS my $store = Bot::BasicBot::Pluggable::Store::DBI->new( dsn => "dbi:mysql:bot", user => "user", password => "password", table => "brane", # create indexes on key/values? create_index => 1, ); $store->set( "namespace", "key", "value" ); =head1 DESCRIPTION This is a L that uses a database to store the values set by modules. Complex values are stored using Storable. =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Pluggable000755001750001750 012727613416 23176 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Test/Bot/BasicBotStore.pm100644001750001750 453012727613416 24772 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Test/Bot/BasicBot/Pluggablepackage Test::Bot::BasicBot::Pluggable::Store; $Test::Bot::BasicBot::Pluggable::Store::VERSION = '1.00'; use base qw(Test::Builder::Module); use strict; use warnings; our @EXPORT = qw(store_ok); sub store_ok { my ( $store_class, $store_args ) = @_; my $test = __PACKAGE__->builder; $test->plan( tests => 12 ); $test->ok( eval "require Bot::BasicBot::Pluggable::Store::$store_class", 'loading store class' ); $test->ok( my $store = "Bot::BasicBot::Pluggable::Store::$store_class"->new( %{$store_args} ), 'creating store object' ); $test->is_num( scalar $store->keys('test'), 0, 'no keys set initially' ); $test->ok( $store->set( "test", "foo", "bar" ), "set foo to bar" ); $test->is_num( scalar $store->keys('test'), 1, "storage namespace has 1 key" ); $test->is_eq( $store->get( "test", "foo" ), "bar", "foo is set to bar" ); $test->ok( $store->set( "test", "user_foo", "bar" ), "set user_foo also to bar" ); $test->is_num( scalar $store->keys('test'), 2, "storage namespace has 2 keys" ); $test->is_num( scalar $store->keys( 'test', res => ['^user'] ), 1, "storage namespace has one key matching ^user" ); $test->ok( $store->unset( "test", "foo" ), "unset key" ); $test->ok( !$store->get( 'test', 'foo' ), "unset has worked, no key namned foo left" ); $test->is_eq( $store->namespaces(), 'test', "return namespaces" ); } 1; __END__ =head1 NAME Test::Bot::BasicBot::Pluggable::Store - basics tests for Bot::BasicBot::Pluggable storage classes =head1 VERSION version 1.00 =head1 SYNOPSIS store_ok( 'Memory' ); store_ok( 'Deep', { file => 'deep.db' }); =head1 DESCRIPTION This modules collects some general functions to test storage module sfor Bot::BasicBot::Pluggable. In the moment we just export the basic store_ok. =head1 FUNCTIONS =head2 store_ok This functions justs tests some basic behaviour every storage module should provide, like store creation, get and set. You can't use it directly with Test::More as we harcode the number of tests to nine in the moment. (Man, i'm so excited about nested tap streams in the newest development release of Test::Simple) =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Deep.pm100644001750001750 330512727613416 24727 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Storepackage Bot::BasicBot::Pluggable::Store::Deep; $Bot::BasicBot::Pluggable::Store::Deep::VERSION = '1.00'; use warnings; use strict; use DBM::Deep; use base qw( Bot::BasicBot::Pluggable::Store ); sub init { my $self = shift; delete $self->{type}; $self->{file} ||= 'bot-basicbot.deep'; $self->{_db} = DBM::Deep->new(%$self) || die "Couldn't connect to DB '$self->{file}'"; } sub set { my ( $self, $namespace, $key, $value ) = @_; $self->{_db}->{$namespace}->{$key} = $value; return $self; } sub get { my ( $self, $namespace, $key ) = @_; return $self->{_db}->{$namespace}->{$key}; } sub unset { my ( $self, $namespace, $key ) = @_; delete $self->{_db}->{$namespace}->{$key}; } sub keys { my ( $self, $namespace, %opts ) = @_; # no idea why this works return CORE::keys %{ $self->{_db}->{$namespace} } unless exists $opts{res} && @{ $opts{res} }; my $mod = $self->{_db}->{$namespace} || {}; return $self->_keys_aux( $mod, $namespace, %opts ); } sub namespaces { my ($self) = @_; return CORE::keys %{ $self->{_db} }; } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Store::Deep - use DBM::Deep to provide a storage backend =head1 VERSION version 1.00 =head1 SYNOPSIS my $store = Bot::BasicBot::Pluggable::Store::Deep->new( file => "filename" ); $store->set( "namespace", "key", "value" ); =head1 DESCRIPTION This is a C that uses C to store the values set by modules. =head1 AUTHOR Simon Wistow =head1 COPYRIGHT Copyright 2005, Simon Wistow This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Module000755001750001750 012727613416 23504 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/PluggableDNS.pm100644001750001750 242312727613416 24627 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::DNS; $Bot::BasicBot::Pluggable::Module::DNS::VERSION = '1.00'; use base qw(Bot::BasicBot::Pluggable::Module); use warnings; use strict; use Socket; sub help { return "DNS lookups for hosts or IPs. Usage: 'dns ' for the hostname, 'nslookup ' for the IP address."; } sub told { my ( $self, $mess ) = @_; my $body = $mess->{body}; my ( $command, $param ) = split( /\s+/, $body, 2 ); $command = lc($command); if ( $command eq "dns" ) { my $addr = inet_aton($param); my @addr = gethostbyaddr( $addr, AF_INET ); return "$param is $addr[0]."; } elsif ( $command eq "nslookup" ) { my @addr = gethostbyname($param); my $straddr = inet_ntoa( $addr[4] ); return "$param is $straddr."; } } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::DNS - DNS lookups for hostnames or IP addresses =head1 VERSION version 1.00 =head1 IRC USAGE =over 4 =item dns Returns the hostname of that IP address =item nslookup Returns the IP address of the hostname. =back =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. bot-basicbot-pluggable.yaml100644001750001750 31512727613416 25443 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/t/configfiles--- server: irc.example.com port: 6668 nick: botbot channel: - baz - quux store: type: Memory charset: ascii module: - Loader - Karma settings: Auth: password_admin: truhe loglevel: fatal Seen.pm100644001750001750 1154512727613416 25122 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Seen; use base qw(Bot::BasicBot::Pluggable::Module); use warnings; use strict; our $VERSION = '0.86'; sub init { my $self = shift; $self->config( { user_allow_hiding => 1 } ); } sub help { return "Tracks when and where people were last seen. Usage: seen (find out where 'nick' was last seen) hide (Start hiding yourself from 'seen' reporting) unhide (Stop hiding yourself from 'seen' reporting) hidechan #chan (Hide a private channel from seen reporting) unhidechan #chan (Stop hiding a private channel from seen reporting) "; } sub seen { my ( $self, $mess ) = @_; my $what = 'saying "' . $mess->{body} . '"'; $self->update_seen( $mess->{who}, $mess->{channel}, $what ); return; } sub chanpart { my ( $self, $mess ) = @_; my $what = 'leaving the channel'; $self->update_seen( $mess->{who}, $mess->{channel}, $what ); return; } sub chanjoin { my ( $self, $mess ) = @_; my $what = 'joining the channel'; $self->update_seen( $mess->{who}, $mess->{channel}, $what ); return; } sub update_seen { my ( $self, $who, $channel, $what ) = @_; my $nick = lc $who; my $ignore_channels = $self->get('user_ignore_channels') || {}; return if exists $ignore_channels->{$channel}; $self->set( "seen_$nick" => { time => time, channel => $channel, what => $channel ne 'msg' ? $what : '', } ); } sub told { my ( $self, $mess ) = @_; my $body = $mess->{body}; return unless defined $body; my ( $command, $param ) = split( /\s+/, $body, 2 ); $command = lc($command); if ( $command eq "seen" and $param =~ /^(\S+)\??$/ ) { my $who = lc($1); my $seen = $self->get("seen_$who"); my $ignore_channels = $self->get('user_ignore_channels') || {}; my $hidden_channel = $seen && exists $ignore_channels->{ $seen->{channel} }; if (!$seen || $hidden_channel || ( $self->get("user_allow_hiding") and $self->get("hide_$who") ) ) { return "Sorry, I haven't seen $1."; } my $diff = time - $seen->{time}; my $time_string = secs_to_string($diff); return "$1 was last seen in $seen->{channel} $time_string " . $seen->{what} . "."; } elsif ( $command eq "hide" and $mess->{address} ) { my $nick = lc( $mess->{who} ); if ( !$self->get("user_allow_hiding") ) { return "Hiding has been disabled by the administrator."; } $self->set( "hide_$nick" => 1 ); return "Ok, you're hiding from seen status."; } elsif ( $command eq "unhide" and $mess->{address} ) { my $nick = lc( $mess->{who} ); $self->unset("hide_$nick"); return "Ok, you're visible to seen status."; } elsif ( my ($chanhideaction) = $command =~ /^(hide|unhide)chan$/ ) { my $response; if ($self->authed($mess->{who})) { my $ignore_channels = $self->get('user_ignore_channels') || {}; if ($chanhideaction eq 'hide') { $ignore_channels->{$param}++; $response = "OK, not tracking users in $param"; } else { delete $ignore_channels->{$param}; $response = "OK, tracking users in $param"; } $self->set('user_ignore_channels', $ignore_channels); return $response; } else { return "You need to be authenticated to do that."; } } } sub secs_to_string { my $secs = shift; # Hopefully never used. But if the seen time is in the future, catch it. my $weird = 0; if ( $secs < 0 ) { $secs = -$secs; $weird = 1; } my $days = int( $secs / 86400 ); $secs = $secs % 86400; my $hours = int( $secs / 3600 ); $secs = $secs % 3600; my $mins = int( $secs / 60 ); $secs = $secs % 60; my $string = ""; $string .= "$days days " if $days; $string .= "$hours hours " if $hours; $string .= "$mins mins " if ( $mins and !$days ); $string .= "$secs seconds " if ( !$days and !$hours ); return $string . ( $weird ? "in the FUTURE!!!" : "ago" ); } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::Seen - track when and where people were seen =head1 VERSION version 1.00 =head1 IRC USAGE =over 4 =item seen Find out when the last time a nick was seen and where. =item hide Hide yourself from the seen reporting. =item unhide Stops hiding yourself from the seen reporting. =back =head1 VARS =over 4 =item allow_hiding Defaults to 1; whether or not a nick can hide themselves from seen status. =back =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Auth.pm100644001750001750 1716612727613416 25136 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Auth; $Bot::BasicBot::Pluggable::Module::Auth::VERSION = '1.00'; use base qw(Bot::BasicBot::Pluggable::Module); use warnings; use strict; use Crypt::SaltedHash; sub init { my $self = shift; $self->config( { password_admin => "julia", allow_anonymous => 0, } ); # A list of admin commands handled by this module and their usage $self->{_admin_commands} = { auth => ' ', adduser => ' ', deluser => '', password => ' ', users => '', }; } sub help { my $self = shift; return "Authenticator for admin-level commands. Usage: " . join ", ", map { "!$_ $self->{_admin_commands}{$_}" } keys %{ $self->{_admin_commands} }; } sub admin { my ( $self, $mess ) = @_; my $body = $mess->{body}; return unless ( $body and length($body) > 4 ); # we don't care about commands that don't start with '!'. return 0 unless $body =~ /^!/; # Find out what the command is: my ($command, $params) = split '\s+', $mess->{body}, 2; $command =~ s/^!//; $command = lc $command; my @params; @params = split /\s+/, $params if defined $params; # If it's not a command we handle, go no further: return 0 unless exists $self->{_admin_commands}{$command}; # Basic usage check: the usage message declares which params are taken, so # check we have the right number: my $usage_message = $self->{_admin_commands}{$command}; # Count how many params we want (assignment to empty list gets us list # context, then assigning to scalar results in the count): my $want_params = () = $usage_message =~ m{<.+?>}g; if (scalar @params != $want_params) { return "Usage: !$command $usage_message"; } # system commands have to be directly addressed... return 1 unless $mess->{address}; # ...and in a privmsg. return "Admin commands in privmsg only, please." unless !defined $mess->{channel} || $mess->{channel} eq 'msg'; if ($command eq 'auth') { my ( $user, $pass ) = @params; my $stored = $self->get( "password_" . $user ); if ( _check_password($pass, $stored) ) { $self->{auth}{ $mess->{who} }{time} = time(); $self->{auth}{ $mess->{who} }{username} = $user; if ( $user eq "admin" and $pass eq "julia" ) { return "Authenticated. But change the password - you're using the default."; } return "Authenticated."; } else { delete $self->{auth}{ $mess->{who} }; return "Wrong password."; } } elsif ( $command eq 'adduser' ) { my ( $user, $pass ) = @params; if ( $self->authed( $mess->{who} ) ) { $self->set( "password_" . $user, _hash_password($pass) ); return "Added user $user."; } else { return "You need to authenticate."; } } elsif ( $command eq 'deluser' ) { my ($user) = @params; if ( $self->authed( $mess->{who} ) ) { $self->unset( "password_" . $user ); return "Deleted user $user."; } else { return "You need to authenticate."; } } elsif ( $command eq 'password' ) { my ( $old_pass, $pass ) = @params; if ( $self->authed( $mess->{who} ) ) { my $username = $self->{auth}{ $mess->{who} }{username}; if (_check_password($old_pass, $self->get("password_$username")) ) { $self->set( "password_$username", _hash_password($pass) ); return "Changed password to $pass."; } else { return "Wrong password."; } } else { return "You need to authenticate."; } } elsif ( $command eq 'users' ) { return "Users: " . join( ", ", map { my $user = $_; $user =~ s/^password_// ? $user : () } $self->store_keys( res => ["^password"] ) ) . "."; } } sub authed { my ( $self, $username ) = @_; return 1 if ( $self->{auth}{$username}{time} and $self->{auth}{$username}{time} + 7200 > time() ); return 0; } # Given a password provided by the user and the password stored in the database, # see if they match. Older versions stored plaintext passwords, newer versions # use salted hashed passwords. sub _check_password { my ($entered_pw, $stored_pw) = @_; return unless defined $entered_pw && defined $stored_pw; if ($stored_pw =~ /^\{SSHA\}/) { return Crypt::SaltedHash->validate($stored_pw, $entered_pw); } else { return $entered_pw eq $stored_pw; } } # Given a plain-text password, return a salted hashed version to store sub _hash_password { my $plain_pw = shift; my $csh = Crypt::SaltedHash->new(algorithm => 'SHA-1'); $csh->add($plain_pw); return $csh->generate; } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::Auth - authentication for Bot::BasicBot::Pluggable modules =head1 VERSION version 1.00 =head1 SYNOPSIS This module catches messages at priority 1 and stops anything starting with '!' unless the user is authed. Most admin modules, e.g. Loader, can merely sit at priority 2 and assume the user is authed if the !command reaches them. If you want to use modules that can change bot state, like Loader or Vars, you almost certainly want this module. =head1 IRC USAGE The default user is 'admin' with password 'julia'. Change this. =over 4 =item !auth Authenticate as an administrators. Logins timeout after an hour. =item !adduser Adds a user with the given password. =item !deluser Deletes a user. Don't delete yourself, that's probably not a good idea. =item !password Change your current password (must be logged in first). =item !users List all the users the bot knows about. =back =head1 VARIABLES =over 4 =item password_admin This variable specifies the admin password. Its normally set via the !password directive and defaults to 'julia'. Please change this as soon as possible. =item allow_anonymous If this variable is true, the implicit authentication handling is disabled. Every module will have to check for authentication via the authed method, otherwise access is just granted. This is only usefull to allow modules to handle directives starting with an exclamation mark without needing any authentication. And to make things even more interesting, you won't be warned that you have't authenticated, so modules needing authentication will fail without any warning. It defaults to false and should probably never be changed. You've been warned. =back =head1 METHODS The only useful method is C: =over 4 =item authed($username) Returns 1 if the given username is logged in, 0 otherwise: if ($bot->module("Auth")->authed("jerakeen")) { ... } =back =head1 BUGS All users are admins. This is fine at the moment, as the only things that need you to be logged in are admin functions. Passwords are stored in plaintext, and are trivial to extract for any module on the system. I don't consider this a bug, because I assume you trust the modules you're loading. If Auth is I loaded, all users effectively have admin permissions. This may not be a good idea, but is also not an Auth bug, it's an architecture bug. =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Join.pm100644001750001750 565212727613416 25111 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Join; $Bot::BasicBot::Pluggable::Module::Join::VERSION = '1.00'; use base qw(Bot::BasicBot::Pluggable::Module); use warnings; use strict; sub connected { my $self = shift; my $channels = $self->get("channels") || []; ## If we are not a array reference, we are problably the old ## string format ... trying to convert if ( not ref($channels) eq 'ARRAY' ) { $channels = [ split( /\s+/, $channels ) ]; } for ( @{$channels} ) { print "Joining $_.\n"; $self->bot->join($_); } } sub help { return "Join and leave channels. Usage: join , leave/part , channels. Requires direct addressing."; } sub told { my ( $self, $mess ) = @_; my $body = $mess->{body}; return unless defined $body; return unless $mess->{address}; my ( $command, $param ) = split( /\s+/, $body, 2 ); $command = lc($command); return unless $command =~ /^(join|leave|part|channels)$/; if (!$self->authed($mess->{who})) { return "Sorry, you must be authenticated to do that."; } if ( $command eq "join" ) { $self->add_channel($param); return "Ok."; } elsif ( $command eq "leave" or $command eq "part" ) { $self->remove_channel( $param || $mess->{channel} ); return "Ok."; } elsif ( $command eq "channels" ) { my @channels = $self->bot->channels; my $channel_num = scalar @channels; if ( $channel_num == 0 ) { return "I'm not in any channel."; } elsif ( $channel_num == 1 ) { return "I'm in " . $channels[0] . "."; } elsif ( $channel_num == 2 ) { return "I'm in " . $channels[0] . " and " . $channels[1] . "."; } else { return "I'm in " . join( ', ', @channels[ 0 .. $#channels - 1 ] ) . " and $channels[-1]."; } } } sub chanjoin { my ( $self, $mess ) = @_; if ( $mess->{who} eq $self->bot->nick ) { $self->set( channels => $self->bot->channels ); } } sub chanpart { my ( $self, $mess ) = @_; if ( $mess->{who} eq $self->bot->nick ) { $self->set( channels => $self->bot->channels ); } } sub add_channel { my ( $self, $channel ) = @_; $self->bot->join($channel); } sub remove_channel { my ( $self, $channel ) = @_; $self->bot->part($channel); } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::Join - join and leave channels; remembers state =head1 VERSION version 1.00 =head1 IRC USAGE =over 4 =item join =item part =item channels List the channels the bot is in. =back =head1 METHODS =over 4 =item add_channel($channel) =item remove_channel($channel) =back =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Vars.pm100644001750001750 522612727613416 25122 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Vars; $Bot::BasicBot::Pluggable::Module::Vars::VERSION = '1.00'; use base qw(Bot::BasicBot::Pluggable::Module); use warnings; use strict; sub help { return "Change internal module variables. Usage: !set , !unset , !vars ."; } sub told { my ( $self, $mess ) = @_; my $body = $mess->{body}; return 0 unless defined $body; my ( $command, $mod, $var, $value ) = split( /\s+/, $body, 4 ); $command = lc($command); return if !$self->authed( $mess->{who} ); if ( $command eq "!set" ) { my $module = $self->{Bot}->module($mod); return "No such module '$module'." unless $module; $value = defined($value) ? $value : ''; # wipe if no value. $module->set( "user_$var", $value ); return "Set."; } elsif ( $command eq "!unset" ) { return "Usage: !unset ." unless $var; my $module = $self->{Bot}->module($mod); return "No such module '$module'." unless $module; $module->unset("user_$var"); return "Unset."; } elsif ( $command eq "!vars" ) { return "You must pass a module" unless defined $mod; my $module = $self->bot->module($mod); return "No such module '$mod'." unless $module; my @vars = map { my $mod = $_; $mod =~ s/^user_// ? $mod : () } $module->store_keys( res => ["^user"] ); return "$mod has no variables." unless @vars; return "Variables for $mod: " . ( join ", ", map { "'$_' => '" . $module->get("user_$_") . "'" } @vars ) . "."; } } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::Vars - change internal module variables =head1 VERSION version 1.00 =head1 SYNOPSIS Bot modules have variables that they can use to change their behaviour. This module, when loaded, gives people who are logged in and authenticated the ability to change these variables from the IRC interface. The variables that are set are in the object store, and begin "user_", so: !set Module foo bar will set the store key 'user_foo' to 'bar' in the 'Module' module. =head1 IRC USAGE =over 4 =item !set Sets the variable to value in a given module. Module must be loaded. =item !unset Unsets a variable (deletes it entirely) for the current load of the module. =item !vars Lists the variables and their current values in a module. =back =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Base.pm100644001750001750 61312727613416 25034 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Base; $Bot::BasicBot::Pluggable::Module::Base::VERSION = '1.00'; use warnings; use strict; use base qw( Bot::BasicBot::Pluggable::Module ); BEGIN { warn "* Please do not use Bot::BasicBot::Pluggable::Module::Base as base class of your module\n" . "* Its usage is deprecated and the module will be removed in a few releases\n"; } 1; __END__ bot-basicbot-pluggable-infobot-upgrade100644001750001750 147712727613416 25634 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/bin#!/usr/bin/perl use warnings; use strict; use Storable qw(retrieve nstore); use File::Copy qw( cp ); unless (-e "Infobot.storable") { die "I can't see Infobot.storable in ./\n"; } if (-e "Infobot.storable.backup") { die "There's already a backup of Infobot.storable in ./\n"; } cp("Infobot.storable", "Infobot.storable.backup") or die "Can't back up Infobot.storable: $!\n"; unless (-s "Infobot.storable" == -s "Infobot.storable.backup") { die "Infobot.storable backup isn't the same size!\n" } my $data = retrieve("Infobot.storable") or die "Can't load Infobot.storable for some reason\n"; my $new; warn "converting...\n"; for my $factoid (keys %{ $data->{infobot} }) { $new->{ "infobot_$factoid" } = delete $data->{infobot}{$factoid}; } nstore($new, "Infobot.storable"); warn "Saved new Infobot.storable\n"; Memory.pm100644001750001750 323512727613416 25324 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Storepackage Bot::BasicBot::Pluggable::Store::Memory; $Bot::BasicBot::Pluggable::Store::Memory::VERSION = '1.00'; use warnings; use strict; use base qw( Bot::BasicBot::Pluggable::Store ); 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Store::Memory - use memory (RAM) to provide a storage backend =head1 VERSION version 1.00 =head1 SYNOPSIS my $store = Bot::BasicBot::Pluggable::Store::Memory->new(); $store->set( "namespace", "key", "value" ); =head1 DESCRIPTION This is a L that uses memory (RAM) to store the values set by modules. To spell the obvious out, this means that your data won't persist between invocations of your bot. So this is mainly for testing and storing data for a short time. This module is just a bare bone subclass of Bot::BasicBot::Pluggable::Store and does not implement any methods of its own. In a perfect world Bot::BasicBot::Pluggable::Store would just be a abstract base class, but it was implemented as normale in-memory storage class. Due to Bot::BasicBot::Pluggable object creation you can either specify a already created storage object or a string that is simply appended to "Bot::BasicBot::Pluggable::Store::". So if you just want to use memory storage you have to load it this way: my $bot => Bot::BasicBot::Pluggable->new ( store => Bot::BasicBot::Pluggable::Store->new() ); Now you can use load it as any other storage module: my $bot => Bot::BasicBot::Pluggable->new ( store => 'Memory' ); In this way we don't break any existing code. =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Title.pm100644001750001750 426612727613416 25273 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Title; $Bot::BasicBot::Pluggable::Module::Title::VERSION = '1.00'; use base qw(Bot::BasicBot::Pluggable::Module); use warnings; use strict; use Text::Unidecode; use URI::Title qw(title); use URI::Find::Simple qw(list_uris); use URI; sub help { return "Speaks the title of URLs mentioned."; } sub init { my $self = shift; $self->config( { user_asciify => 1, user_ignore_re => '', user_be_rude => 0, } ); } sub admin { # do this in admin so we always get a chance to see titles my ( $self, $mess ) = @_; # If the message was from the bot (for e.g. another module announcing the # title of an URL we just said, etc), go no further, to avoid loops return if $mess->{who} eq $self->bot->nick; my $ignore_regexp = $self->get('user_ignore_re'); my $reply = ""; for ( list_uris( $mess->{body} ) ) { next if $ignore_regexp && /$ignore_regexp/; my $uri = URI->new($_); next unless $uri; if ( $uri->scheme eq "file" ) { next unless $self->get("user_be_rude"); my $who = $mess->{who}; $self->reply( $mess, "Nice try $who, you tosser" ); return; } my $title = title("$_"); next unless defined $title; $title = unidecode($title) if $self->get("user_asciify"); $reply .= "[ $title ] "; } if ($reply) { $self->reply( $mess, $reply ) } return; # Title.pm is passive, and doesn't intercept things. } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::Title - speaks the title of URLs mentioned =head1 VERSION version 1.00 =head1 IRC USAGE None. If the module is loaded, the bot will speak the titles of all URLs mentioned. =head1 VARS =over 4 =item asciify Defaults to 1; whether or not we should convert all titles to ascii from Unicode =item ignore_re If set to a nonempty string, ignore URLs matching this re =back =head1 REQUIREMENTS L L =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Karma.pm100644001750001750 2032312727613416 25255 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Karma; $Bot::BasicBot::Pluggable::Module::Karma::VERSION = '1.00'; use base qw(Bot::BasicBot::Pluggable::Module); use warnings; use strict; sub init { my $self = shift; $self->config( { user_ignore_selfkarma => 1, user_num_comments => 3, user_show_givers => 1, user_randomize_reasons => 1, } ); } sub help { return "Gives karma for or against a particular thing. Usage: ++ # comment, -- # comment, karma , explain ."; } sub told { my ( $self, $mess ) = @_; my $body = $mess->{body}; return 0 unless defined $body; # If someone is trying to change the bot's karma, we'll have our bot nick in # {addressed}, and '++' or '-' in the body ('-' rather than '--' because # Bot::BasicBot removes one of the dashes as it considers it part of the # address) if ( $mess->{address} && ($body eq '++' or $body eq '-') ) { $body = '--' if $body eq '-'; $body = $mess->{address} . $body; } my $op_re = qr{ ( \-\- | \+\+ ) }x; my $comment_re = qr{ (?: \s* \# \s* (.+) )? }x; for my $regex ( qr{^ (\S+) $op_re $comment_re }x, # singleword++ qr{^ \( (.+) \) $op_re $comment_re }x # (more words)++ ) { if (my($thing, $op, $comment) = $body =~ $regex) { my $add = $op eq '++' ? 1 : 0; if ( ( $1 eq $mess->{who} ) and $self->get("user_ignore_selfkarma") ){ return; } my $reply = $self->add_karma( $thing, $add, $comment, $mess->{who} ); if (lc $thing eq lc $self->bot->nick) { $reply .= ' ' . ($add ? '(thanks!)' : '(pffft)'); } return $reply; } } # OK, handle "karma" / "explain" commands my ( $command, $param ) = split( /\s+/, $body, 2 ); $command = lc($command); if ( $command eq "karma" ) { $param =~ s/\?+$//; # handle interrogatives - lop off trailing question marks if ($param && $param eq 'chameleon') { return "Karma karma karma karma karma chameleon, " . "you come and go, you come and go..."; } $param ||= $mess->{who}; return "$param has karma of " . $self->get_karma($param) . "."; } elsif ( $command eq "explain" and $param ) { $param =~ s/^karma\s+//i; my ( $karma, $good, $bad ) = $self->get_karma($param); my $reply = "positive: " . $self->format_reasons($good) . "; "; $reply .= "negative: " . $self->format_reasons($bad) . "; "; $reply .= "overall: $karma."; return $reply; } } sub format_reasons { my ( $self, $reason ) = @_; my $num_comments = $self->get('user_num_comments'); if ( $num_comments == 0 ) { return scalar( $reason->() ); } my @reasons = $reason->(); my $num_reasons = @reasons; if ( $num_reasons == 0 ) { return 'nothing'; } if ( $num_reasons == 1 ) { return ( $self->maybe_add_giver(@reasons) )[0]; } $self->trim_list( \@reasons, $num_comments ); return join( ', ', $self->maybe_add_giver(@reasons) ); } sub maybe_add_giver { my ( $self, @reasons ) = @_; if ( $self->get('user_show_givers') ) { # adding a (user) string to the all reasons return map { $_->{reason} . ' (' . $_->{who} . ')' } @reasons; } else { # just returning the reason string of the reason hash referenes return map { $_->{reason} } @reasons; } } sub get_karma { my ( $self, $thing ) = @_; $thing = lc($thing); $thing =~ s/-/ /g; my @changes = @{ $self->get("karma_$thing") || [] }; my ( @good, @bad ); my $karma = 0; my $positive = 0; my $negative = 0; for my $row (@changes) { # just push non empty reasons on the array my $reason = $row->{reason}; if ( $row->{positive} ) { $positive++; push( @good, $row ) if $reason } else { $negative++; push( @bad, $row ) if $reason } } $karma = $positive - $negative; # The subroutine references return differant values when called. # If they are called in scalar context, they return the overall # positive or negative karma, but when called in list context you # get an array of hash references with all non empty reasons back. return wantarray() ? ( $karma, sub { return wantarray ? @good : $positive }, sub { return wantarray ? @bad : $negative } ) : $karma; } sub add_karma { my ( $self, $thing, $good, $reason, $who ) = @_; $thing = lc($thing); $thing =~ s/-/ /g; my $row = { reason => $reason, who => $who, timestamp => time, positive => $good }; my @changes = @{ $self->get("karma_$thing") || [] }; push @changes, $row; $self->set( "karma_$thing" => \@changes ); my $respond = $self->get('user_karma_change_response'); $respond = 1 if !defined $respond; return $respond ? "Karma for $thing is now " . scalar $self->get_karma($thing) : 1; } sub trim_list { my ( $self, $list, $count ) = @_; # If randomization isn't requested we just return the reasons # in reversed chronological order if ( $self->get('user_randomize_reasons') ) { fisher_yates_shuffle($list); } else { @$list = reverse sort { $b->{timestamp} cmp $a->{timestamp} } @$list; } if ( scalar(@$list) > $count ) { @$list = splice( @$list, 0, $count ); } } sub fisher_yates_shuffle { my $array = shift; my $i = @$array; while ( $i-- ) { my $j = int rand( $i + 1 ); @$array[ $i, $j ] = @$array[ $j, $i ]; } } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::Karma - tracks karma for various concepts =head1 VERSION version 1.00 =head1 IRC USAGE =over 4 =item ++ # Increases the karma for . Responds with the new karma for unless C is set to a false value. =item -- # Decreases the karma for . Responds with the new karma for unless C is set to a false value. =item karma Replies with the karma rating for . =item explain Lists three each good and bad things said about : explain Morbus positive: committing lots of bot documentation; fixing the fisher_yates; negative: filling the dev list. overall: 5 =back =head1 METHODS =over 4 =item get_karma($username) Returns either a string representing the total number of karma points for the passed C<$username> or the total number of karma points and subroutine reference for good and bad karma comments. These references return the according karma levels when called in scalar context or a array of hash reference. Every hash reference has entries for the timestamp (timestamp), the giver (who) and the explanation string (reason) for its karma action. =item add_karma($thing, $good, $reason, $who) Adds or subtracts from the passed C<$thing>'s karma. C<$good> is either 1 (to add a karma point to the C<$thing> or 0 (to subtract). C<$reason> is an optional string commenting on the reason for the change, and C<$who> is the person modifying the karma of C<$thing>. Nothing is returned. =back =head1 VARS =over 4 =item ignore_selfkarma Defaults to 1; determines whether to respect selfkarmaing or not. =item num_comments Defaults to 3; number of good and bad comments to display on explanations. Set this variable to 0 if you do not want to list reasons at all. =item show_givers Defaults to 1; whether to show who gave good or bad comments on explanations. =item randomize_reasons Defaults to 1; whether to randomize the order of reasons. If set to 0, the reasons are sorted in reversed chronological order. =item karma_change_response Defaults to 1; whether to show a response when the karma of a thing is changed. If true, the bot will reply with the new karma. If set to 0, the bot will silently update the karma, without a response. =back =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Pluggable000755001750001750 012727613416 22777 5ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/App/Bot/BasicBotTerminal.pm100644001750001750 142412727613416 25251 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/App/Bot/BasicBot/Pluggablepackage App::Bot::BasicBot::Pluggable::Terminal; $App::Bot::BasicBot::Pluggable::Terminal::VERSION = '1.00'; use Moose; use Bot::BasicBot::Pluggable::Terminal; extends 'App::Bot::BasicBot::Pluggable'; has '+bot_class' => ( default => 'Bot::BasicBot::Pluggable::Terminal' ); 1; __END__ =head1 NAME App::Bot::BasicBot::Pluggable::Terminal =head1 VERSION version 1.00 =head1 SYNOPSIS App::Bot::BasicBot::Pluggable::Terminal->new()->run(); =head1 DESCRIPTION This subclass of L just alters the default bot class to L. Nothing fance here. =head1 AUTHOR Mario Domgoergen =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Google.pm100644001750001750 605212727613416 25421 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Google; $Bot::BasicBot::Pluggable::Module::Google::VERSION = '1.00'; use base qw(Bot::BasicBot::Pluggable::Module); use warnings; use strict; use Net::Google; sub init { my $self = shift; $self->config( { user_google_key => "** SET ME FOR GOOGLE LOOKUPS **", user_languages => "en", user_num_results => 3, user_require_addressing => 1, } ); } sub help { return "Searches Google for terms and spellings. Usage: google , spell ."; } sub told { my ( $self, $mess ) = @_; my $body = $mess->{body}; return if ( $self->get("user_require_addressing") and not $mess->{address} ); my ( $command, $param ) = split( /\s+/, $body, 2 ); $command = lc($command); if ( $command eq "google" ) { return "No Google key has been set! Set it with '!set Google google_key '." unless $self->get("user_google_key"); return "Your configuration has exceeded the maximum number of allowed Google results (10)." if $self->get("user_num_results") > 10; my $google = Net::Google->new( key => $self->get("user_google_key") ); my $search = $google->search( lr => qw($self->get("user_languages")), max_results => $self->get("user_num_results") ); $search->query( split( /\s+/, $param ) ); my $res; # magical concatenation of all results. $res .= $_->title . ": " . $_->URL . "\n" for @{ $search->results() }; $res =~ s/<[^>]+>//g; # remove the bolded search terms. return $res ? $res : "No results for \'$param\'."; } elsif ( $command eq "spell" ) { return "No Google key has been set! Set it with '!set Google google_key '." unless $self->get("user_google_key"); my $google = Net::Google->new( key => $self->get("user_google_key") ); my $res = $google->spelling( phrase => $param )->suggest(); return $res ? $res : "No results for \'$param\'."; } } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::Google - searches Google for terms and spellings =head1 VERSION version 1.00 =head1 IRC USAGE =over 4 =item google Returns Google hits for the terms given. =item spell Returns a Google spelling suggestion for the term given. =back =head1 VARS To set module variables, use L. =over 4 =item google_key A valid Google API key is required for lookups. =item languages Defaults to 'en'; a space-separated list of language restrictions. =item num_results Defaults to 3; the number of Google search results to return (maximum 10). =item require_addressing Defaults to 1; whether you need to address the bot for Google searches. =back =head1 REQUIREMENTS L L =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Loader.pm100644001750001750 467512727613416 25424 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Loader; $Bot::BasicBot::Pluggable::Module::Loader::VERSION = '1.00'; use base qw(Bot::BasicBot::Pluggable::Module); use warnings; use strict; use Try::Tiny; sub init { my $self = shift; my @modules = $self->store_keys; for (@modules) { try { $self->{Bot}->load($_) } catch { warn "Error loading $_: $@." }; } } sub help { return "Module loader and unloader. Usage: !load , !unload , !reload , !list."; } sub maybe_join { my ( $sep, @list ) = @_; return $list[0] if @list == 1; return join( $sep, @list ) if @list > 1; return '' if !@list; return; } sub told { my ( $self, $mess ) = @_; my $body = $mess->{body}; # we don't care about commands that don't start with '!' return 0 unless defined $body; return 0 unless $body =~ /^!/; return if !$self->authed( $mess->{who} ); my ( $command, $param ) = split( /\s+/, $body, 2 ); $command = lc($command); if ( $command eq "!list" ) { my %available = map { lc $_ => $_ } $self->bot->available_modules(); my @loaded = map { delete $available{$_} } @{ $self->bot->handlers() }; my @available = values %available; my $loaded = maybe_join( ', ', sort @loaded ); my $available = maybe_join( ', ', sort @available ); return "Loaded modules: $loaded\nAvailable modules: $available"; } elsif ( $command eq "!load" ) { try { $self->bot->load($param) } catch { return "Failed: $@." }; $self->set( $param => 1 ); return "Success."; } elsif ( $command eq "!reload" ) { try { $self->bot->reload($param) } catch { return "Failed: $@." }; return "Success."; } elsif ( $command eq "!unload" ) { try { $self->bot->unload($param) } catch { return "Failed: $@." }; $self->unset($param); return "Success."; } } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::Loader - loads and unloads bot modules; remembers state =head1 VERSION version 1.00 =head1 IRC USAGE =over 4 =item !load Loads the named module. =item !unload Unloads the named module. =item !reload Reloads a module (combines !unload and !load). =item !list Lists all loaded modules. =back =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. ChanOp.pm100644001750001750 1144512727613416 25377 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::ChanOp; $Bot::BasicBot::Pluggable::Module::ChanOp::VERSION = '1.00'; use base 'Bot::BasicBot::Pluggable::Module'; use strict; use warnings; sub init { my $self = shift; $self->config( { user_auto_op => 0, user_flood_control => 0, user_flood_messages => 6, user_flood_seconds => 4 } ); } sub isop { my ( $self, $channel, $who ) = @_; return unless $channel; $who ||= $self->bot->nick(); my $channel_data = $self->bot->channel_data($channel) or return; return $channel_data->{$who}->{op}; } sub deop_op { my ( $self, $op, $who, @channels ) = @_; for my $channel (@channels) { if ( $self->isop($channel) ) { $self->bot->mode("$channel $op $who"); return "Okay, i $op you in $channel"; } else { return "Sorry, i'm not operator in $channel"; } } } sub op { shift->deop_op( '+o', @_ ); } sub deop { shift->deop_op( '-o', @_ ); } sub help { return 'ChanOp commands need to be adressed in private and after authentication.' . '!op #foo | !deop #foo #bar | !kick #foo user You have been warned '; } sub seen { my ( $self, $message ) = @_; my $who = $message->{who}; my $channel = $message->{channel}; return if !$self->get('user_flood_control'); return if !$self->isop($channel); my $threshold_timestamp = time - $self->get('user_flood_seconds'); my $timestamps = $self->{data}->{$channel}->{$who} = [ grep { $_ > $threshold_timestamp } @{ $self->{data}->{$channel}->{$who} }, time, ]; if ( @$timestamps > $self->get('user_flood_messages') ) { my ( $min, $max ) = ( sort { $a <=> $b } @$timestamps )[ 0, -1 ]; my $seconds = $max - $min; $self->kick( $channel, $who, "Stop flooding the channel (" . @$timestamps . " messages in $seconds seconds)." ); delete $self->{data}->{$channel}->{$who}; } } sub admin { my ( $self, $message ) = @_; my $who = $message->{who}; if ( $self->authed($who) and $self->private($message) ) { my $body = $message->{body}; $body =~ s/(^\s+|\s+$)//g; my ( $command, $rest ) = split(/\s+/, $body, 2 ); if ( $command eq '!op' ) { my @channels = split(/\s+/, $rest ); return $self->op( $who, @channels ); } elsif ( $command eq '!deop' ) { my @channels = split(/\s+/, $rest ); return $self->deop( $who, @channels ); } elsif ( $command eq '!kick' ) { my ( $channel, $user, $reason ) = split(/\s+/, $rest, 3 ); if ( $self->isop($channel) ) { $self->bot->kick( $channel, $who, $reason ); return "Okay, kicked $who from $channel."; } else { return "Sorry, i'm not operator in $channel . "; } } } } sub chanjoin { my ( $self, $message ) = @_; if ( $self->get('user_auto_op') ) { my $who = $message->{who}; if ( $self->authed($who) ) { my $channel = $message->{channel}; $self->op( $who, $channel ); } } } #### ## Helper Functions #### sub private { my ( $self, $message ) = @_; return $message->{address} and $message->{channel} eq ' msg '; } sub kick { my $self = shift; $self->bot->kick(@_); } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::ChanOp - Channel operator =head1 VERSION version 1.00 =head1 SYNOPSIS msg> me: !op #botzone msg> bot: Okay, i +o you in #botzone msg> me: !kick #botzone malice Stay outta here! msg> bot: Okay, i kicked malice from #botzone msg> me: !deop #botzone msg> bot: Okay, i -o you in #botzone =head1 DESCRIPTION This module provides commands to perform basic channel management functions with the help of your bot instance. You can op and deop yourself any time, ask your bot to kick malicious users. It also provides a flood control mechanism, that will kick any user who send more than a specified amount of mesasges in a given time. =head1 VARIABLES =head2 user_auto_op If true, it will op any user who joins a channel and is already authenticated by your bot. Defaults to false. =head2 user_flood_control If true, every user who sends more than C in C will be kicked from the channel. Defaults to false. =head2 user_flood_messages Maximum numbers of messages per user in C. Defaults to 6. =head2 user_flood_seconds C. Defaults to 6. =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Storable.pm100644001750001750 333212727613416 25625 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Storepackage Bot::BasicBot::Pluggable::Store::Storable; $Bot::BasicBot::Pluggable::Store::Storable::VERSION = '1.00'; use warnings; use strict; use Storable qw( nstore retrieve ); use File::Spec; use File::Temp qw(tempfile); use base qw( Bot::BasicBot::Pluggable::Store ); sub init { my $self = shift; if ( !$self->{dir} ) { $self->{dir} = File::Spec->curdir(); } } sub save { my $self = shift; my $namespace = shift; my @modules = $namespace ? ($namespace) : keys( %{ $self->{store} } ); for my $name (@modules) { my $filename = File::Spec->catfile( $self->{dir}, $name . ".storable" ); my ( $fh, $tempfile ) = tempfile( DIR => $self->{dir}, UNLINK => 0 ); nstore( $self->{store}{$name}, $tempfile ) or die "Cannot save to $tempfile\n"; rename $tempfile, $filename or die "Cannot create $filename: $!\n"; } } sub load { my $self = shift; for my $file ( glob File::Spec->catfile( $self->{dir}, '*.storable' ) ) { my (undef, undef, $name) = map {File::Spec->splitpath($_)} $file =~ /^(.*?)\.storable$/; $self->{store}{$name} = retrieve($file); } } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Store::Storable - use Storable to provide a storage backend =head1 VERSION version 1.00 =head1 SYNOPSIS my $store = Bot::BasicBot::Pluggable::Store::Storable->new( dir => "directory" ); $store->set( "namespace", "key", "value" ); =head1 DESCRIPTION This is a L that uses Storable to store the values set by modules. =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Infobot.pm100644001750001750 4503712727613416 25633 0ustar00davidpdavidp000000000000Bot-BasicBot-Pluggable-1.00/lib/Bot/BasicBot/Pluggable/Modulepackage Bot::BasicBot::Pluggable::Module::Infobot; $Bot::BasicBot::Pluggable::Module::Infobot::VERSION = '1.00'; use strict; use warnings; use base qw(Bot::BasicBot::Pluggable::Module); use Data::Dumper; use LWP::UserAgent (); use URI; # this one is a complete bugger to build eval { require XML::Feed }; our $HAS_XML_FEED = $@ ? 0 : 1; sub init { my $self = shift; $self->config( { user_allow_searching => 0, user_min_length => 3, user_max_length => 25, user_num_results => 20, user_passive_answer => 0, user_passive_learn => 0, user_require_question => 1, user_http_timeout => 10, user_rss_items => 5, user_stopwords => "here|how|it|something|that|this|what|when|where|which|who|why", user_unknown_responses => "Dunno.|I give up.|I have no idea.|No clue. Sorry.|Search me, bub.|Sorry, I don't know.", db_version => "1", } ); # record what we've asked other bots. $self->{remote_infobot} = {}; } sub help { return "An infobot. See http://search.cpan.org/perldoc?Bot::BasicBot::Pluggable::Module::Infobot."; } sub told { my ( $self, $mess ) = @_; my $body = $mess->{body}; return unless defined $body; # looks like an infobot reply. if ( $body =~ s/^:INFOBOT:REPLY (\S+) (.*)$// ) { return $self->infobot_reply( $1, $2, $mess ); } # direct commands must be addressed. return unless $mess->{address}; # forget a particular factoid. if ( $body =~ /^forget\s+(.*)$/i ) { return $self->delete_factoid($1) ? "I forgot about $1." : "I don't know anything about $1."; } # ask another bot for facts. if ( $body =~ /^ask\s+(\S+)\s+about\s+(.*)$/i ) { $self->ask_factoid( $2, $1, $mess ); return "I'll ask $1 about $2."; } # tell someone else about a factoid if ( $body =~ /^tell\s+(\S+)\s+about\s+(.*)$/i ) { $self->tell_factoid( $2, $1, $mess ); return "Told $1 about $2."; } # search for a particular factoid. if ( $body =~ /^search\s+for\s+(.*)$/i ) { return "privmsg only, please" unless ( $mess->{channel} eq "msg" ); return "searching disabled" unless $self->get("user_allow_searching"); my @results = $self->search_factoid( split( /\s+/, $1 ) ); unless (@results) { return "I don't know anything about $1."; } $#results = $self->get("user_num_results") - 1 unless $#results < $self->get("user_num_results"); return "I know about: " . join( ", ", map { "'$_'" } @results ) . "."; } } sub fallback { my ( $self, $mess ) = @_; my $body = $mess->{body} || ""; my $is_priv = !defined $mess->{channel} || $mess->{channel} eq 'msg'; # request starts with "my", so we'll look for # a valid factoid for "$mess->{who}'s $object". $body =~ s/^my /$mess->{who}'s /; my %stopwords = map { lc($_) => 1 } split( /\s*[\s,\|]\s*/, $self->get("user_stopwords") ); # checks to see if something starts # (is|are) # and then removes if if is a stopword # this means that we treat "what is foo?" as "foo?" if ( $body =~ /^(.*?)\s+(is|are)\s+(.*)$/i ) { $body =~ s/^(.*?)\s+(is|are)\s+//i if $stopwords{$1}; } # answer a factoid. this is a crazy check which ensures we will ONLY answer # a factoid if a) there is, or isn't, a question mark, b) we have, or haven't, # been addressed, c) the factoid is bigger and smaller than our requirements, # and d) that it doesn't look like a to-be-learned factoid (which is important # if the user has disabled the requiring of the question mark for answering.) my $body_regexp = $self->get("user_require_question") && !$is_priv ? qr/\?+$/ : qr/[.!?]*$/; if ( $body =~ s/$body_regexp// and ( $mess->{address} or $self->get("user_passive_answer") ) and length($body) >= $self->get("user_min_length") and length($body) <= $self->get("user_max_length") and $body !~ /^(.*?)\s+(is|are)\s+(.*)$/i ) { # get the factoid and type of relationship my ( $is_are, $factoid, $literal ) = $self->get_factoid($body); if ( !$literal && $factoid && $factoid =~ /\|/ ) { my @f = split /\|/, $factoid; $factoid = $f[ int( rand( scalar @f ) ) ]; } # no factoid? unless ($factoid) { my @unknowns = split( /\|/, $self->get("user_unknown_responses") ); my $unknown = $unknowns[ int( rand( scalar(@unknowns) ) ) - 1 ]; return $mess->{address} ? $unknown : undef; } # variable substitution. $factoid =~ s/\$who/$mess->{who}/g; # emote? if ( $factoid =~ s/^\s*//i ) { $self->bot->emote( { who => $mess->{who}, channel => $mess->{channel}, body => $factoid } ); return 1; # replying with, or without a noun? hmMmMmmm?! } elsif ($literal) { $body =~ s!^literal\s+!!; return "$body =${is_are}= $factoid"; } else { return $factoid =~ s/^\s*//i ? $factoid : "$body $is_are $factoid"; } } # the only thing left is learning factoids. are we # addressed or are we willing to learn passively? # does it even look like a factoid? return unless ( $mess->{address} or $self->get("user_passive_learn") ); return unless ( $body =~ /^(.*?)\s+(is)\s+(.*)$/i or $body =~ /^(.*?)\s+(are)\s+(.*)$/i ); my ( $object, $is_are, $description ) = ( $1, $2, $3 ); my $literal = ( $object =~ s!^literal\s+!! ); # allow corrections and additions. my ( $nick, $replace, $also ) = ( $self->bot->nick, 0, 0 ); $replace = 1 if ( $object =~ s/no,?\s+//i ); # no, $object is $fact. $replace = 1 if ( $replace and $object =~ s/^\s*$nick,?\s*//i ) ; # no, $bot, $object is $fact. $also = 1 if ( $description =~ s/^also\s+//i ); # $object is also $fact. # ignore short, long, and stopword'd factoids. return if length($object) < $self->get("user_min_length"); return if length($object) > $self->get("user_max_length"); foreach ( keys %stopwords ) { return if $object =~ /^$_\b/; } # if we're replacing things, remove the factoid first. # $also check supports "no, $bot, $object is also $fact". if ( $replace and !$also ) { $self->delete_factoid($object); } # get any current factoid there might be. my ( $type, $current ) = $self->get_factoid($object); # we can't add without explicit instruction, # but shouldn't warn if this is passive. if ( $current and !$also and $mess->{address} ) { return "... but $object $type $current ..."; } elsif ( $current and !$also and !$mess->{address} ) { return; } # add this factoid. this comment is absolutely useless. excelsior. $self->add_factoid( $object, $is_are, split( /\s+or\s+/, $description ) ); # return an ack if we were addressed only return $mess->{address} ? "Okay." : 1; } sub get_factoid { my ( $self, $object ) = @_; my $literal = ( $object =~ s!^literal\s+!! ); # get a list of factoid hashes my ( $is_are, @factoids ) = $self->get_raw_factoids($object); return unless @factoids; #print STDERR Dumper(@factoids); # simple is a list of the 'simple' factoids, a is b, etc. These are just # joined together. Alternates are factoids that are an alternative to # the simple factoids, they will randomly be displayed _instead_. my ( @simple, @alternatives ); for (@factoids) { next if $_->{text} =~ m!^\s*$!; if ( $_->{alternate} || $_->{alt} ) { push @alternatives, $_->{text}; } else { push @simple, $_->{text}; } } if ($literal) { my $return .= join " =or= ", ( @simple, map { "|$_" } @alternatives ); return ( $is_are, $return, 1 ); } #print STDERR Dumper(@alternatives); # the simple list is one of the alternatives unshift( @alternatives, join( " or ", @simple ) ) if @simple; # pick an option at random srand(); my $factoid = $alternatives[ rand(@alternatives) ]; #print STDERR "$factoid\n"; # if there are any RSS directives, get the feed. # TODO - this could be done in a more general way, with plugins # TODO - this blocks. Bad. you can knock the bot off channel by # giving it an RSS feed that'll take a very long time to return. $factoid =~ s/<(?:rss|atom|feed|xml)\s*=\s*\"?([^>\"]+)\"?>/$self->parseFeed($1)/ieg; return ( $is_are, $factoid, 0 ); } # for a given key, return the raw hashes that are in the store for this # factoid. sub get_raw_factoids { my ( $self, $object ) = @_; my $raw = $self->get( "infobot_" . lc($object) ) or return (); #print STDERR Dumper($raw); my ( $is_are, @factoids ); if ( ref($raw) ) { # it's a deep structure $is_are = $raw->{is_are}; @factoids = @{ $raw->{factoids} || [] }; } else { # old-style tab seperated thing my @strings; ( $is_are, @strings ) = split( /\t/, $raw ); for my $text (@strings) { my $alt = ( $text =~ s/^\|\s*// ? 1 : 0 ); push @factoids, { alternate => $alt, text => $text }; } } return ( $is_are, @factoids ); } sub add_factoid { my ( $self, $object, $is_are, @factoids ) = @_; # get the current list, if any my ( $current_is_are, @current ) = $self->get_raw_factoids($object); # if there's already an is_are set, use it. $is_are = $current_is_are if ($current_is_are); $is_are ||= "is"; # defaults # add these factoids to the list, trimming trailing space after | for (@factoids) { my $alt = s/^\|\s*// ? 1 : 0; push @current, { alternate => $alt, text => $_, }; } my $set = { is_are => $is_are, factoids => \@current, }; # put the list back into the store. $self->set( "infobot_" . lc($object), $set ); return 1; } sub delete_factoid { my ( $self, $object ) = @_; my $key = "infobot_" . lc($object); if ( $self->get($key) ) { $self->unset( "infobot_" . lc($object) ); return 1; } else { return 0; } } sub ask_factoid { my ( $self, $object, $ask, $mess ) = @_; # unique ID to reference this in future my $id = "<" . int( rand(100000) ) . ">"; # store the message, so we can reply in context later $self->{remote_infobot}{$id} = $mess; # ask, using an infobot protocol, the thing we've been told to ask. # this will hopefully result in a reply coming back later. $self->bot->say( who => $ask, channel => 'msg', body => ":INFOBOT:QUERY $id $object" ); } sub tell_factoid { my ( $self, $object, $tell, $mess ) = @_; my ( $is_are, $factoid ) = $self->get_factoid($object); my $from = $mess->{who}; $self->bot->say( who => $tell, channel => 'msg', body => "$from wanted you to know: $object $is_are $factoid" ); } sub search_factoid { my ( $self, @terms ) = @_; my @keys; for (@terms) { push @keys, map { my $term = $_; $term =~ s/^infobot_// ? $term : () } $self->store_keys( limit => $self->get("user_num_results"), res => ["$_"] ); } return @keys; } sub parseFeed { my ( $self, $url ) = @_; my @items; eval { my $ua = LWP::UserAgent->new(); $ua->timeout( $self->get('user_http_timeout') ); $ua->env_proxy; my $feed; my $response = $ua->get($url); if ( $response->is_success ) { $feed = XML::Feed->parse( \$response->content() ) or die XML::Feed->errstr . "\n"; } else { die $response->status_line() . "\n"; } my @entries = $feed->entries(); my $max_items = $self->get('user_rss_items'); if ( $max_items and $max_items < @entries ) { splice( @entries, $max_items ); } @items = map { $_->title } @entries; }; if ($@) { chomp $@; return "<< Error parsing RSS from $url: $@ >>"; } my $ret; foreach my $title (@items) { $title =~ s/\s+/ /; $title =~ s/\n//g; $title =~ s/\s+$//; $title =~ s/^\s+//; $ret .= "${title}; "; } $ret =~ s/\s*;\s*$//; return ( $ret =~ m/^<(reply|action)>/ ? $ret : "$ret" ); } # We've been replied to by an infobot. sub infobot_reply { my ( $self, $id, $return, $mess ) = @_; # get the message that caused the ask initially, so we can reply to it # if there wasn't one, just give up. my $infobot_data = $self->{remote_infobot}{$id} or return 1; # this is the string that the other infobot returned to us. my ( $object, $db, $factoid ) = ( $return =~ /^(.*) =(\w+)=> (.*)$/ ); $self->set_factoid( $mess->{who}, $object, $db, $factoid ); # reply to the original request saying 'we got it' $self->bot->say( channel => $infobot_data->{channel}, who => $infobot_data->{who}, body => "Learnt about $object from $mess->{who}", ); return 1; } 1; __END__ =head1 NAME Bot::BasicBot::Pluggable::Module::Infobot - infobot clone redone in B::B::P. =head1 VERSION version 1.00 =head1 SYNOPSIS Does infobot things - basically remembers and returns factoids. Will ask another infobot about factoids that it doesn't know about, if you want. Due to persistent heckling from the peanut gallery, does things pretty much exactly like the classic infobot, even when they're not necessarily that useful (for example, saying "Okay." rather than "OK, water is wet."). Further infobot backwards compatibility is available through additional packages such as L. =head1 IRC USAGE The following examples assume you're running Infobot with its defaults settings, which require the bot to be addressed before learning factoids or answering queries. Modify these settings with the Vars below. bot: water is wet. user: okay. bot: water? user: water is wet. bot: water is also blue. user: okay. bot: water? user: water is wet or blue. bot: no, water is translucent. user: okay. bot: water? user: water is translucent. bot: forget water. user: I forgot about water. bot: water? user: No clue. Sorry. A fact that begins with "" will have the " is" stripped: bot: what happen is somebody set us up the bomb. user: okay. bot: what happen? user: somebody set us up the bomb. A fact that begins "" will be emoted as a response: bot: be funny is dances silly. user: okay. bot: be funny? * bot dances silly. Pipes ("|") indicate different possible answers, picked at random: bot: dice is one|two|three|four|five|six user: okay. bot: dice? user: two. bot: dice? user: four. You can also use RSS feeds as a response: bot: jerakeen.org is . user: okay. bot: jerakeen.org? user: jerakeen.org is ; ; etc.... You can also ask the bot to learn a factoid from another bot, as follows: bot: ask bot2 about fact. user: asking bot2 about fact... bot: fact? user: fact is very boring. Finally, you can privmsg the bot to search for particular facts: search for options. I know about 'options indexes', 'charsetoptions override', etc.... =head1 METHODS =head1 VARS =over 4 =item min_length Defaults to 3; the minimum length a factoid, or inquiry, must be before recognizing it. =item max_length Defaults to 25; the maximum length a factoid, or inquiry, can be before ignoring it. =item num_results Defaults to 20; the number of facts to return for "search for " privmsg. =item passive_answer Defaults to 0; when enabled, the bot will answer factoids without being addressed. =item passive_learn Defaults to 0; when enabled, the bot will learn factoids without being addressed. =item require_question Defaults to 1; determines whether the bot requires a question mark before responding to a factoid. When enabled, the question mark is required (ie. "water?"). When disabled, the question mark is entirely optional (ie. "water" would also produce a response). =item stopwords A comma-, space-, or pipe- separated list of words the bot should not learn or answer. This prevents such insanity as the learning of "where is the store?" and "how is your mother?" The default list of stopwords contains "here", "how", "it", "something", "that", "this", "what", "when", "where", "which", "who" and "why"). =item unknown_responses A pipe-separated list of responses the bot will randomly choose from when it doesn't know the answer to a question. The default list of response contains "Dunno.", "I give up.", "I have no idea.", "No clue. Sorry.", "Search me, bub.", and "Sorry, I don't know." =item allow_searching Defaults to 0. Searching on large factoid lists is ... problematic. =item http_timeout Time in seconds for an http request to timeout. When this value is set to a very high value, a slow site can disconnect a bot by blocking it. Defaults to 10. =item rss_items Maximal numbers of items returns when using RSS feeds. Defaults to 5. =back =head1 BUGS "is also" doesn't work on s (ie. " cheetahs! or monkies.") "is also" doesn't work on s (same as the previous bug, hobo.) The pipe syntax for random replies doesn't actually work. At all. Um. We should probably make a "choose_random_response" function. "?" fails, due to removal of name from $mess->body. "ask" syntax doesn't work in a private message. The tab stops are set to 2, not 4. OHMYGOD. If a "search" fails, the bot doesn't tell you. "search" is case-sensitive. If Title module is loaded, factoids don't work cos of told/fallback. =head1 REQUIREMENTS URI L L =head1 AUTHOR Mario Domgoergen This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.