Bot-BasicBot-0.93000755001750001750 013234726324 13564 5ustar00davidpdavidp000000000000Changes100644001750001750 1066513234726324 15170 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93Revision history Bot::BasicBot 0.93 Fri Feb 2 00:12:02 GMT 2018 - Support WEBIRC - Typo fixes - Pass just the nick, not full n!u@h, to newly-introduced mode_change() method, for consistency with other methods. 0.92 Thu Feb 1 20:09:43 GMT 2018 - new mode_change() method fired when modes change - More accurate log messages upon connection 0.91 Thu Apr 6 23:39:21 BST 2017 0.90 Wed Apr 5 23:34:09 CEST 2017 - Populate raw_nick for chanjoin (Jeremy Gainsford) - Small documentation improvements - add irc_raw / irc_raw_out for raw IRC events - Maintainership transferred to David Precious 0.89 Mon Nov 21 22:08:39 GMT 2011 - Document the use of STDOUT after calling forkit() - Add accessors for PoCo::IRC's 'localaddr' and 'useipv6' options - Allow specifying a coderef callback for forkit() 0.88 Sat Aug 27 15:29:39 GMT 2011 - Add a DESTROY method so it won't get AUTOLOADed - Fix incorrect documentation of nick_change() return values 0.87 Sat May 14 18:48:55 GMT 2011 - Make charset_decode() use IRC::Utils::decode_irc() internally - Make utf8 the default outgoing message encoding 0.86 Fri Apr 1 20:06:08 GMT 2011 - Add noticed(), which is like said() but for notices - Depend on POE::Component::IRC 6.56 for a notice-related fix 0.85 Fri Apr 1 18:49:45 GMT 2011 - Document the 'no_run' attribute and add a getter/setter for it - Added a pocoirc() method which returns the underlying pocoirc object - Switched the backend from POE::Component::IRC to P::C::I::State - Print a warning and shut down if our session gets an exception - Document the channel_data() method - Depend on POE::Component::IRC 6.55 for a NAMES-related bugfix 0.84 Mon Nov 15 20:05:09 GMT 2010 - Ignore empty strings returned by said() - Adjust the method documentation a bit to avoid confusion - Added the notice() method to send IRC notices. Useful when implementing bots. 0.83 Fri Nov 5 12:40:00 CET 2010 - Applied patch from Mario Domgörgen to use log() for warnings (RT #51804) - Only ignore said() when it returns undef/empty list, not false - got_names was never getting called. Fixed that. - Skip connect.t for now. I should rewrite it to use poco-server-irc... 0.82 Wed Nov 3 02:09:36 GMT 2010 - Maintainership moved from cpan:TOMI to cpan:HINRIK - Use POE::Component::IRC's Connector plugin to handle reconnects. This fixes the endless reconnect loop when trying to shut down the bot - Kill subprocesses (e.g. those created by forkit()) on shutdown - Migrate distribution to Dist::Zilla - Eliminate bogus "NAMES HASH(0x1234567)" queries the bot was making after joining a channel 0.81 2009/01/26 - Implement remove_from_all_channels, you idiot. Sigh. 0.80 2009/01/22 - Understand quit messages - https://rt.cpan.org/Ticket/Display.html?id=42625 - Fix the ->name method on the bot to actually return something sensible - https://rt.cpan.org/Ticket/Display.html?id=27427 - Try to avoid zombie children on forking - https://rt.cpan.org/Public/Bug/Display.html?id=38010 0.70 2006/06/11 - Updates for new PoDo::IRC - No longer do 2 server connects on startup - the connect test doesn't break itself by faking a connection first 0.65 2005/08/11 - Added raw_nick support and a tiny amount of documentation - Support for SSL, contributed by Bradley M. Kuhn 0.61 2005/05/13 - Fix for the odd behaviour of freenode - we ask the server for the time periodically to catch servers that don't send pings. 0.60 2005/03/21 - Charset support - use Text::Wrap to split up really long responses, instead of a nasty regexp, so we split on spaces properly. 0.50 2004/12/01 (revision 1366) - Real (almost) tests - Nick (and op/voice status) tracking - Quiet some warnings 0.31 2004/03/16 (revision 643) - Fixed 'addressing' typo, thanks Earle - Fixed annoying errors for logging - Fixed stupid bug where the return value of said wasn't getting said. How can I not have noticed? - if you don't return true from init, be more helpful. - if help doesn't return true, don't say anything - Made SYNOPSIS clearer 0.30 2003/01/02 - Randomized name so you can run more than one at once in one POE session - Log a lot less. - Be more aggressive about reconnecting to the server - Put reconnect stand-offs into a lot more places, so we get less confused. - Made reconnect timeout changable - Added a NINJA Changes to 0.25 (released 31st August 2003) not available. LICENSE100644001750001750 4403713234726324 14702 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93This software is copyright (c) 2018 by Tom Insam, Hinrik Örn Sigurðsson, David Precious. 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) 2018 by Tom Insam, Hinrik Örn Sigurðsson, David Precious. 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, Fifth Floor, Boston, MA 02110-1301 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) 2018 by Tom Insam, Hinrik Örn Sigurðsson, David Precious. 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 127313234726324 15314 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93name = Bot-BasicBot author = Tom Insam author = Hinrik Örn Sigurðsson author = David Precious copyright_holder = Tom Insam, Hinrik Örn Sigurðsson, David Precious license = Perl_5 [@AVAR] dist = Bot-BasicBot authority = cpan:BIGPRESH bugtracker = rt use_CompileTests = 0 nextrelease_format = %-5v %{ccc MMM d HH:mm:ss V YYYY}d github_user = bigpresh git_tag_message = CPAN release %v no_AutoPrereq = 1 [Prereqs / RuntimeRequires] IRC::Utils = 0 POE = 0 POE::Component::IRC = 6.90 Text::Wrap = 0 META.yml100644001750001750 167713234726324 15131 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93--- abstract: 'simple irc bot baseclass' author: - 'Tom Insam ' - 'Hinrik Örn Sigurðsson ' - 'David Precious ' build_requires: {} configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.143240' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Bot-BasicBot no_index: directory: - examples - t - utils - xt requires: IRC::Utils: '0' POE: '0' POE::Component::IRC: '6.90' Text::Wrap: '0' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Bot-BasicBot homepage: http://metacpan.org/release/Bot-BasicBot license: http://dev.perl.org/licenses/ repository: git://github.com/bigpresh/bot-basicbot.git version: '0.93' x_authority: cpan:BIGPRESH x_serialization_backend: 'YAML::Tiny version 1.69' MANIFEST100644001750001750 50613234726324 14757 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.008. Changes LICENSE MANIFEST MANIFEST.SKIP META.json META.yml Makefile.PL dist.ini examples/countdownbot.pl examples/cpanbot.pl examples/namer.pl examples/tailbot.pl examples/tango.pl lib/Bot/BasicBot.pm t/00bootstrap.t t/connect.t t/lib/TestBot.pm META.json100644001750001750 324613234726324 15273 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93{ "abstract" : "simple irc bot baseclass", "author" : [ "Tom Insam ", "Hinrik \u00d6rn Sigur\u00f0sson ", "David Precious " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.143240", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Bot-BasicBot", "no_index" : { "directory" : [ "examples", "t", "utils", "xt" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "IRC::Utils" : "0", "POE" : "0", "POE::Component::IRC" : "6.90", "Text::Wrap" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Bot-BasicBot@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Bot-BasicBot" }, "homepage" : "http://metacpan.org/release/Bot-BasicBot", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/bigpresh/bot-basicbot.git", "web" : "http://github.com/bigpresh/bot-basicbot" } }, "version" : "0.93", "x_authority" : "cpan:BIGPRESH", "x_serialization_backend" : "JSON::XS version 3.02" } t000755001750001750 013234726324 13750 5ustar00davidpdavidp000000000000Bot-BasicBot-0.93connect.t100644001750001750 101213234726324 15720 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93/t#!/usr/bin/env perl use warnings; use strict; use Test::More; plan skip_all => 'This test should use POE::Component::Server::IRC'; use lib qw(lib t/lib); require IO::Socket; my $s = IO::Socket::INET->new( PeerAddr => "irc.perl.org:80", Timeout => 10, ); if ($s) { close($s); plan tests => 4; } else { plan skip_all => "no net connection available"; exit; } use TestBot; my $bot = TestBot->new( nick => "basicbot_$$", server => "irc.perl.org", channels => ["#bot_basicbot_test"], ); $bot->run; Makefile.PL100644001750001750 217713234726324 15626 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.008. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "simple irc bot baseclass", "AUTHOR" => "Tom Insam , Hinrik \x{d6}rn Sigur\x{f0}sson , David Precious ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Bot-BasicBot", "LICENSE" => "perl", "NAME" => "Bot::BasicBot", "PREREQ_PM" => { "IRC::Utils" => 0, "POE" => 0, "POE::Component::IRC" => "6.90", "Text::Wrap" => 0 }, "VERSION" => "0.93", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "IRC::Utils" => 0, "POE" => 0, "POE::Component::IRC" => "6.90", "Text::Wrap" => 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); MANIFEST.SKIP100644001750001750 10713234726324 15521 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93^Bot-BasicBot- ^cover_db/ ^utils/developer/ ^xt/ ^nytprof ^README.pod$ 00bootstrap.t100644001750001750 123113234726324 16447 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93/t#!/usr/bin/env perl use warnings; use strict; use Test::More tests => 2; BEGIN { use_ok('Bot::BasicBot') }; my @methods = qw( new run init said emoted chanjoin chanpart got_names topic nick_change kicked tick help connected userquit schedule_tick forkit say notice emote reply channel_data server port password ssl nick alt_nicks username name channels quit_message ignore_list charset flood AUTOLOAD log ignore_nick nick_strip charset_decode charset_encode ); can_ok('Bot::BasicBot', @methods); lib000755001750001750 013234726324 14516 5ustar00davidpdavidp000000000000Bot-BasicBot-0.93/tTestBot.pm100644001750001750 101613234726324 16576 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93/t/libpackage TestBot; use warnings; use strict; use base qw( Bot::BasicBot ); use Test::More; sub connected { my $self = shift; ok(1, "connected"); is( $self->nick, "basicbot_$$", "right nick" ); } # ..now wait for the first tick.. sub tick { my $self = shift; my $channel = [ $self->channels ]->[0]; ok(1, "tick"); $self->say( channel => $channel, body => "Hello $$" ); ok(1, "now use a notice from within tick"); $self->notice( channel => $channel, body => "This should be a notice ($$)" ); exit; } 1; examples000755001750001750 013234726324 15323 5ustar00davidpdavidp000000000000Bot-BasicBot-0.93namer.pl100755001750001750 77313234726324 17114 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93/examples#!/usr/bin/perl =head1 NAME namer - read out url titles in the channel =cut package Bot; use base qw(Bot::BasicBot); use warnings; use strict; use URI::Title qw( title ); use URI::Find::Simple qw( list_uris ); sub said { my $self = shift; my $message = shift; my $body = $message->{body}; return unless my @urls = list_uris($message->{body}); $self->reply($message, title($_)) for (@urls); } Bot->new( server => "irc.perl.org", channels => [ '#jerakeen' ], nick => 'namer', )->run(); tango.pl100755001750001750 133213234726324 17132 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93/examples#!/usr/bin/perl =head1 NAME tango - slap people =head1 USAGE ./tango <#channel> [] Slaps someone in #channel. An option nick is the person to slap, otherwise it'll slap leon. Note that the server is hardcoded. =cut package Bot; use base qw(Bot::BasicBot); use warnings; use strict; my $ticked = 0; sub tick { my $self = shift; exit if $ticked; $self->emote( { channel => ( $self->channels )[0], body => "slaps $self->{slapee}" } ); $ticked = 1; return 1; } package main; chomp(my $channel = shift); die "no channel" unless $channel; chomp(my $slapee = shift || "acme"); Bot->new( server => "london.irc.perl.org", channels => [ $channel ], nick => 'tango', slapee => $slapee, )->run(); tailbot.pl100755001750001750 77513234726324 17452 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93/examples#!/usr/bin/perl -w =head1 NAME tailbot =head1 DESCRIPTION from the fbi bot by richardc, tails a file called 'logfile' to the channel #tailbot. =cut use warnings; use strict; package TailBot; use base 'Bot::BasicBot'; my $channel = '#tailbot'; sub connected { my $self = shift; $self->forkit({ channel => $channel, run => [ qw( /usr/bin/tail -f logfile ) ], }); } package main; TailBot->new(nick => 'tailbot', channels => [ $channel ]) ->run; cpanbot.pl100755001750001750 514413234726324 17455 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93/examples#!/usr/bin/perl -w # This bot should not be run by any sane person. Really. The original idea # was to join to a channel a bot for every module in CPAN, and have them # announce when new versions of themselves were released, etc, etc. I can't # remember who had this insane idea, probably sky. Anyway, this is proof of # concept code, and inspired the changes in the source that let you put >1 # BasicBot in a single POE session. # The problem is that with more than 30 or 40 running bots, even on the same # machine as the IRC server, the latencies get insane. You just can't keep # them all alive enough to stay connected and not time-out. So the idea was # a non-starter, because I'm not running a process on the server for every # module on CPAN. But I can think of some cases where you'd want to run 2 or # 3 bots in a single session, to bridge networks, say, that sort of thing, # and so heere's how I'd do it... # Probably, this does not work. # The bot moudle itself. package CPANBot; use Bot::BasicBot; use strict; use warnings::register; use base 'Bot::BasicBot'; sub create { my $class = shift; my $nick = shift; print STDERR "Creating $nick\n"; my $self = bless Bot::BasicBot->new( nick => $nick, server => 'london.irc.perl.org', no_run => 1, # don't run the bot automatically ), $class; $self->{_delay} = shift || 1; return $self; } sub connected { my $self = shift; print STDERR $self->nick." connected\n"; $self->join('#jerakeen'); $self->say(channel => '#jerakeen', body => 'lo, I am '.$self->nick); } sub said { my $self = shift; my $mess = shift; print STDERR $self->nick." : ".$mess->{body}."\n"; my $nick = $self->nick; if ($mess->{body} =~ /$nick/i) { $self->say(channel => $mess->{channel}, body => 'I 0wnz0r you'); } if ($nick =~ /$mess->{body}/i) { $self->say(channel => $mess->{channel}, body => 'you 0wnz0r me'); } } package main; use POE; use CPANPLUS::Backend; use Data::Dumper; my $cp = new CPANPLUS::Backend; #$cp->reload_indices(update_source => 1); my $modules = $cp->module_tree; #print Dumper($modules); my @names = keys(%$modules); my @bots; for (@names) { s/:+/_/g; s/\W//g; # next unless length($_) < 19; next unless /^Bot/; push @bots, $_; print STDERR "$_!\n"; } my $bot = {}; my $i = 0; for (@bots) { # this next line needs a code change to Bot::Basicbot - take the # $poe_kernel->run line out of the run method, we don't want the bots to # run themselves. $bot->{$_} = CPANBot->create($_, $i)->run; $i+= 11; } $poe_kernel->run(); Bot000755001750001750 013234726324 14777 5ustar00davidpdavidp000000000000Bot-BasicBot-0.93/libBasicBot.pm100644001750001750 12157513234726324 17236 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93/lib/Botpackage Bot::BasicBot; our $AUTHORITY = 'cpan:BIGPRESH'; $Bot::BasicBot::VERSION = '0.93'; use strict; use warnings; use Carp; use Encode qw(encode); use Exporter; use IRC::Utils qw(decode_irc); use POE::Kernel; use POE::Session; use POE::Wheel::Run; use POE::Filter::Line; use POE::Component::IRC::State; use POE::Component::IRC::Plugin::Connector; use Text::Wrap (); use base 'Exporter'; our @EXPORT = qw(say emote); sub new { my $class = shift; my $self = bless {}, $class; $self->{IRCNAME} = 'wanna'.int(rand(100000)); $self->{ALIASNAME} = 'pony'.int(rand(100000)); # call the set methods my %args = @_; for my $method (keys %args) { if ($self->can($method)) { $self->$method($args{$method}); } else { $self->{$method} = $args{$method}; #croak "Invalid argument '$method'"; } } $self->{charset} = 'utf8' if !defined $self->{charset}; $self->init or die "init did not return a true value - dying"; return $self; } sub run { my $self = shift; # create the callbacks to the object states POE::Session->create( object_states => [ $self => { _start => "start_state", die => "die_state", irc_001 => "irc_001_state", irc_msg => "irc_said_state", irc_public => "irc_said_state", irc_ctcp_action => "irc_emoted_state", irc_notice => "irc_noticed_state", irc_disconnected => "irc_disconnected_state", irc_error => "irc_error_state", irc_join => "irc_chanjoin_state", irc_part => "irc_chanpart_state", irc_kick => "irc_kicked_state", irc_nick => "irc_nick_state", irc_quit => "irc_quit_state", irc_mode => "irc_mode_state", fork_close => "fork_close_state", fork_error => "fork_error_state", irc_366 => "names_done_state", irc_332 => "topic_raw_state", irc_topic => "topic_state", irc_shutdown => "shutdown_state", irc_raw => "irc_raw_state", irc_raw_out => "irc_raw_out_state", tick => "tick_state", } ] ); # and say that we want to recive said messages $poe_kernel->post($self->{IRCNAME}, 'register', 'all'); # run $poe_kernel->run() if !$self->{no_run}; return; } sub init { return 1; } sub said { return } sub emoted { return shift->said(@_); } sub noticed { return shift->said(@_); } sub chanjoin { return } sub chanpart { return } sub got_names { return } sub topic { return } sub nick_change { return } sub mode_change { return } sub kicked { return } sub tick { return 0; } sub help { return "Sorry, this bot has no interactive help." } sub connected { return } sub raw_in { return } sub raw_out { return } sub userquit { my ($self, $mess) = @_; return; } sub schedule_tick { my $self = shift; my $time = shift || 5; $poe_kernel->delay('tick', $time); return; } sub forkit { my $self = shift; my $args; if (ref($_[0])) { $args = shift; } else { my %args = @_; $args = \%args; } return if !$args->{run}; $args->{handler} = $args->{handler} || "_fork_said"; $args->{arguments} = $args->{arguments} || []; #install a new handler in the POE kernel pointing to # $self->{$args{handler}} $poe_kernel->state( $args->{handler}, $args->{callback} || $self ); my $run; if (ref($args->{run}) =~ /^CODE/) { $run = sub { $args->{run}->($args->{body}, @{ $args->{arguments} }) }; } else { $run = $args->{run}; } my $wheel = POE::Wheel::Run->new( Program => $run, StdoutFilter => POE::Filter::Line->new(), StderrFilter => POE::Filter::Line->new(), StdoutEvent => "$args->{handler}", StderrEvent => "fork_error", CloseEvent => "fork_close" ); # Use a signal handler to reap dead processes $poe_kernel->sig_child($wheel->PID, "got_sigchld"); # store the wheel object in our bot, so we can retrieve/delete easily $self->{forks}{ $wheel->ID } = { wheel => $wheel, args => { channel => $args->{channel}, who => $args->{who}, address => $args->{address} } }; return; } sub _fork_said { my ($self, $body, $wheel_id) = @_[OBJECT, ARG0, ARG1]; chomp $body; # remove newline necessary to move data; # pick up the default arguments we squirreled away earlier my $args = $self->{forks}{$wheel_id}{args}; $args->{body} = $body; $self->say($args); return; } sub say { # If we're called without an object ref, then we're handling saying # stuff from inside a forked subroutine, so we'll freeze it, and toss # it out on STDOUT so that POE::Wheel::Run's handler can pick it up. if (!ref $_[0]) { print $_[0], "\n"; return 1; } # Otherwise, this is a standard object method my $self = shift; my $args; if (ref $_[0]) { $args = shift; } else { my %args = @_; $args = \%args; } my $body = $args->{body}; # add the "Foo: bar" at the start if ($args->{channel} ne "msg" && defined $args->{address}) { $body = "$args->{who}: $body"; } # work out who we're going to send the message to my $who = $args->{channel} eq "msg" ? $args->{who} : $args->{channel}; if (!defined $who || !defined $body) { $self->log("Can't send a message without target and body\n" . " called from " . ( [caller]->[0] ) . " line " . ( [caller]->[2] ) . "\n" . " who = '$who'\n body = '$body'\n"); return; } # if we have a long body, split it up.. local $Text::Wrap::columns = 300; local $Text::Wrap::unexpand = 0; # no tabs my $wrapped = Text::Wrap::wrap('', '..', $body); # =~ m!(.{1,300})!g; # I think the Text::Wrap docs lie - it doesn't do anything special # in list context my @bodies = split /\n+/, $wrapped; # Allows to override the default "PRIVMSG". Used by notice() my $irc_command = defined $args->{irc_command} && $args->{irc_command} eq 'notice' ? 'notice' : 'privmsg'; # post an event that will send the message for my $body (@bodies) { my ($enc_who, $enc_body) = $self->charset_encode($who, $body); #warn "$enc_who => $enc_body\n"; $poe_kernel->post( $self->{IRCNAME}, $irc_command, $enc_who, $enc_body, ); } return; } sub emote { # If we're called without an object ref, then we're handling emoting # stuff from inside a forked subroutine, so we'll freeze it, and # toss it out on STDOUT so that POE::Wheel::Run's handler can pick # it up. if (!ref $_[0]) { print $_[0], "\n"; return 1; } # Otherwise, this is a standard object method my $self = shift; my $args; if (ref $_[0]) { $args = shift; } else { my %args = @_; $args = \%args; } my $body = $args->{body}; # Work out who we're going to send the message to my $who = $args->{channel} eq "msg" ? $args->{who} : $args->{channel}; # post an event that will send the message # if there's a better way of sending actions i'd love to know - jw # me too; i'll look at it in v0.5 - sb $poe_kernel->post( $self->{IRCNAME}, 'ctcp', $self->charset_encode($who, "ACTION $body"), ); return; } sub notice { if (!ref $_[0]) { print $_[0], "\n"; return 1; } my $self = shift; my $args; if (ref $_[0]) { $args = shift; } else { my %args = @_; $args = \%args; } # Don't modify '$args' hashref in-place, or we might # make all subsequent calls into notices return $self->say( %{ $args }, irc_command => 'notice' ); } sub pocoirc { my $self = shift; return $self->{IRCOBJ}; } sub reply { my $self = shift; my ($mess, $body) = @_; my %hash = %$mess; $hash{body} = $body; return $self->say(%hash); } sub channel_data { my $self = shift; my $channel = shift or return; my $irc = $self->{IRCOBJ}; my $channels = $irc->channels(); return if !exists $channels->{$channel}; return { map { $_ => { op => $irc->is_channel_operator($channel, $_) || 0, voice => $irc->has_channel_voice($channel, $_) || 0, } } $irc->channel_list($channel) }; } sub server { my $self = shift; $self->{server} = shift if @_; return $self->{server} || "irc.perl.org"; } sub port { my $self = shift; $self->{port} = shift if @_; return $self->{port} || "6667"; } sub password { my $self = shift; $self->{password} = shift if @_; return $self->{password} || undef; } sub ssl { my $self = shift; $self->{ssl} = shift if @_; return $self->{ssl} || 0; } sub localaddr { my $self = shift; $self->{localaddr} = shift if @_; return $self->{localaddr} || 0; } sub useipv6 { my $self = shift; $self->{useipv6} = shift if @_; return $self->{useipv6} || 0; } sub nick { my $self = shift; $self->{nick} = shift if @_; return $self->{nick} if defined $self->{nick}; return _random_nick(); } sub _random_nick { my @things = ( 'a' .. 'z' ); return join '', ( map { @things[ rand @things ] } 0 .. 4 ), "bot"; } sub alt_nicks { my $self = shift; if (@_) { # make sure we copy my @args = ( ref $_[0] eq "ARRAY" ) ? @{ $_[0] } : @_; $self->{alt_nicks} = \@args; } return @{ $self->{alt_nicks} || [] }; } sub username { my $self = shift; $self->{username} = shift if @_; return defined $self->{username} ? $self->{username} : $self->nick; } sub name { my $self = shift; $self->{name} = shift if @_; return defined $self->{name} ? $self->{name} : $self->nick . " bot"; } sub channels { my $self = shift; if (@_) { # make sure we copy my @args = ( ref $_[0] eq "ARRAY" ) ? @{ $_[0] } : @_; $self->{channels} = \@args; } return @{ $self->{channels} || [] }; } sub quit_message { my $self = shift; $self->{quit_message} = shift if @_; return defined $self->{quit_message} ? $self->{quit_message} : "Bye"; } sub ignore_list { my $self = shift; if (@_) { # make sure we copy my @args = ( ref $_[0] eq "ARRAY" ) ? @{ $_[0] } : @_; $self->{ignore_list} = \@args; } return @{ $self->{ignore_list} || [] }; } sub charset { my $self = shift; if (@_) { $self->{charset} = shift; } return $self->{charset}; } sub flood { my $self = shift; $self->{flood} = shift if @_; return $self->{flood}; } sub no_run { my $self = shift; $self->{no_run} = shift if @_; return $self->{no_run}; } sub webirc { my $self = shift; $self->{webirc} = shift if @_; return $self->{webirc}; } sub start_state { my ($self, $kernel, $session) = @_[OBJECT, KERNEL, SESSION]; $kernel->sig('DIE', 'die'); $self->{session} = $session; # Make an alias for our session, to keep it from getting GC'ed. $kernel->alias_set($self->{ALIASNAME}); $kernel->delay('tick', 30); $self->{IRCOBJ} = POE::Component::IRC::State->spawn( alias => $self->{IRCNAME}, ); $self->{IRCOBJ}->plugin_add( 'Connector', POE::Component::IRC::Plugin::Connector->new(), ); $kernel->post($self->{IRCNAME}, 'register', 'all'); $kernel->post( $self->{IRCNAME}, 'connect', { Nick => $self->nick, Server => $self->server, Port => $self->port, Password => $self->password, UseSSL => $self->ssl, Flood => $self->flood, LocalAddr => $self->localaddr, useipv6 => $self->useipv6, webirc => $self->webirc, $self->charset_encode( Nick => $self->nick, Username => $self->username, Ircname => $self->name, ), }, ); return; } sub die_state { my ($kernel, $self, $ex) = @_[KERNEL, OBJECT, ARG1]; warn $ex->{error_str}; $self->{IRCOBJ}->yield('shutdown'); $kernel->sig_handled(); return; } sub irc_001_state { my ($self, $kernel) = @_[OBJECT, KERNEL]; # ignore all messages from ourselves $kernel->post( $self->{IRCNAME}, 'ignore', $self->charset_encode($self->nick), ); $self->log("Connected to " . $self->server); # connect to the channel for my $channel ($self->channels) { $self->log("Trying to join '$channel'\n"); $kernel->post( $self->{IRCNAME}, 'join', $self->charset_encode($channel), ); } $self->schedule_tick(5); $self->connected(); return; } sub irc_disconnected_state { my ($self, $kernel, $server) = @_[OBJECT, KERNEL, ARG0]; $self->log("Lost connection to server $server.\n"); return; } sub irc_error_state { my ($self, $err, $kernel) = @_[OBJECT, ARG0, KERNEL]; $self->log("Server error occurred! $err\n"); return; } sub irc_kicked_state { my ($self, $kernel, $heap, $session) = @_[OBJECT, KERNEL, HEAP, SESSION]; my ($nickstring, $channel, $kicked, $reason) = @_[ARG0..$#_]; my $nick = $self->nick_strip($nickstring); $_[OBJECT]->_remove_from_channel( $channel, $kicked ); $self->kicked( { channel => $channel, who => $nick, kicked => $kicked, reason => $reason, } ); return; } sub irc_join_state { my ($self, $nick) = @_[OBJECT, ARG0]; return; } sub irc_nick_state { my ($self, $nick, $newnick) = @_[OBJECT, ARG0, ARG1]; $nick = $self->nick_strip($nick); $self->nick_change($nick, $newnick); return; } sub irc_mode_state { my ($self, $nick, $channel, $mode_changes) = @_[OBJECT, ARG0, ARG1, ARG2]; my @mode_operands = @_[ARG3..$#_]; $self->mode_change( { channel => $channel, who => $self->nick_strip($nick), mode_changes => $mode_changes, mode_operands => \@mode_operands, } ); return; } sub irc_quit_state { my ($self, $kernel, $session) = @_[OBJECT, KERNEL, SESSION]; my ($nick, $message) = @_[ARG0..$#_]; $nick = $self->nick_strip($nick); $self->userquit({ who => $nick, body => $message }); return; } sub irc_said_state { irc_received_state( 'said', 'say', @_ ); return; } sub irc_emoted_state { irc_received_state( 'emoted', 'emote', @_ ); return; } sub irc_noticed_state { irc_received_state( 'noticed', 'emote', @_ ); return; } sub irc_received_state { my $received = shift; my $respond = shift; my ($self, $nick, $to, $body) = @_[OBJECT, ARG0, ARG1, ARG2]; ($nick, $to, $body) = $self->charset_decode($nick, $to, $body); my $return; my $mess = {}; # pass the raw body through $mess->{raw_body} = $body; # work out who it was from $mess->{who} = $self->nick_strip($nick); $mess->{raw_nick} = $nick; # right, get the list of places this message was # sent to and work out the first one that we're # either a memeber of is is our nick. # The IRC protocol allows messages to be sent to multiple # targets, which is pretty clever. However, noone actually # /does/ this, so we can get away with this: my $channel = $to->[0]; if (lc($channel) eq lc($self->nick)) { $mess->{channel} = "msg"; $mess->{address} = "msg"; } else { $mess->{channel} = $channel; } # okay, work out if we're addressed or not $mess->{body} = $body; if ($mess->{channel} ne "msg") { my $own_nick = $self->nick; if ($mess->{body} =~ s/^(\Q$own_nick\E)\s*[:,-]?\s*//i) { $mess->{address} = $1; } for my $alt_nick ($self->alt_nicks) { last if $mess->{address}; if ($mess->{body} =~ s/^(\Q$alt_nick\E)\s*[:,-]?\s*//i) { $mess->{address} = $1; } } } # strip off whitespace before and after the message $mess->{body} =~ s/^\s+//; $mess->{body} =~ s/\s+$//; # check if someone was asking for help if ($mess->{address} && $mess->{body} =~ /^help/i) { $mess->{body} = $self->help($mess) or return; $self->say($mess); return; } # okay, call the said/emoted method $return = $self->$received($mess); ### what did we get back? # nothing? Say nothing then return if !defined $return; # a string? Say it how we were addressed then if (!ref $return && length $return) { $mess->{body} = $return; $self->$respond($mess); return; } } sub irc_chanjoin_state { my $self = $_[OBJECT]; my ($channel, $nick) = @_[ ARG1, ARG0 ]; $nick = $_[OBJECT]->nick_strip($nick); if ($self->nick eq $nick) { my @channels = $self->channels; push @channels, $channel unless grep { $_ eq $channel } @channels; $self->channels(\@channels); } irc_chan_received_state('chanjoin', 'say', @_); return; } sub irc_chanpart_state { my $self = $_[OBJECT]; my ($channel, $nick) = @_[ ARG1, ARG0 ]; $nick = $_[OBJECT]->nick_strip($nick); if ($self->nick eq $nick) { my @channels = $self->channels; @channels = grep { $_ ne $channel } @channels; $self->channels(\@channels); } irc_chan_received_state('chanpart', 'say', @_); return; } sub irc_chan_received_state { my $received = shift; my $respond = shift; my ($self, $nick, $channel) = @_[OBJECT, ARG0, ARG1]; my $return; my $mess = {}; $mess->{who} = $self->nick_strip($nick); $mess->{raw_nick} = $nick; $mess->{channel} = $channel; $mess->{body} = $received; #chanjoin or chanpart $mess->{address} = "chan"; # okay, call the chanjoin/chanpart method $return = $self->$received($mess); ### what did we get back? # nothing? Say nothing then return if !defined $return; # a string? Say it how we were addressed then if (!ref $return) { $mess->{body} = $return; $self->$respond($mess); return; } } sub fork_close_state { my ($self, $wheel_id) = @_[OBJECT, ARG0]; delete $self->{forks}{$wheel_id}; return; } sub fork_error_state { } sub tick_state { my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; my $delay = $self->tick(); $self->schedule_tick($delay) if $delay; return; } sub names_done_state { my ($self, $kernel, $server, $message) = @_[OBJECT, KERNEL, ARG0, ARG1]; my ($channel) = split /\s/, $message; $self->got_names( { channel => $channel, names => $self->channel_data($channel), } ); return; } sub topic_raw_state { my ($self, $kernel, $server, $raw) = @_[OBJECT, KERNEL, ARG0, ARG1]; my ($channel, $topic) = split / :/, $raw, 2; $self->topic( { channel => $channel, who => undef, topic => $topic, } ); return; } sub topic_state { my ($self, $kernel, $nickraw, $channel, $topic) = @_[OBJECT, KERNEL, ARG0, ARG1, ARG2]; my $nick = $self->nick_strip($nickraw); $self->topic( { channel => $channel, who => $nick, topic => $topic, } ); return; } sub shutdown_state { my ($kernel, $self) = @_[KERNEL, OBJECT]; $kernel->delay('tick'); $kernel->alias_remove($self->{ALIASNAME}); for my $fork (values %{ $self->{forks} }) { $fork->{wheel}->kill(); } return; } sub irc_raw_state { my ($self, $kernel, $raw_line) = @_[OBJECT, KERNEL, ARG0]; $self->raw_in($raw_line); } sub irc_raw_out_state { my ($self, $kernel, $raw_line) = @_[OBJECT, KERNEL, ARG0]; $self->raw_out($raw_line); } sub AUTOLOAD { my $self = shift; our $AUTOLOAD; $AUTOLOAD =~ s/.*:://; $poe_kernel->post( $self->{IRCNAME}, $AUTOLOAD, $self->charset_encode(@_), ); return; } # so it won't get AUTOLOADed sub DESTROY { return } sub log { my $self = shift; for (@_) { my $log_entry = $_; chomp $log_entry; print STDERR "$log_entry\n"; } return; } sub ignore_nick { local $_ = undef; my $self = shift; my $nick = shift; return grep { $nick eq $_ } @{ $self->{ignore_list} }; } sub nick_strip { my $self = shift; my $combined = shift || ""; my ($nick) = $combined =~ m/(.*?)!/; return $nick; } sub charset_decode { my $self = shift; my @r; for (@_) { if (ref($_) eq 'ARRAY') { push @r, [ $self->charset_decode(@$_) ]; } elsif (ref($_) eq "HASH") { push @r, { $self->charset_decode(%$_) }; } elsif (ref($_)) { die "Can't decode object $_\n"; } else { push @r, decode_irc($_); } } #warn Dumper({ decoded => \@r }); return @r; } sub charset_encode { my $self = shift; my @r; for (@_) { if (ref($_) eq 'ARRAY') { push @r, [ $self->charset_encode(@$_) ]; } elsif (ref($_) eq "HASH") { push @r, { $self->charset_encode(%$_) }; } elsif (ref($_)) { die "Can't encode object $_\n"; } else { push @r, encode($self->charset, $_); } } #warn Dumper({ encoded => \@r }); return @r; } 1; =head1 NAME Bot::BasicBot - simple irc bot baseclass =head1 SYNOPSIS #!/usr/bin/perl use strict; use warnings; # Subclass Bot::BasicBot to provide event-handling methods. package UppercaseBot; use base qw(Bot::BasicBot); sub said { my $self = shift; my $arguments = shift; # Contains the message that the bot heard. # The bot will respond by uppercasing the message and echoing it back. $self->say( channel => $arguments->{channel}, body => uc $arguments->{body}, ); # The bot will shut down after responding to a message. $self->shutdown('I have done my job here.'); } # Create an object of your Bot::BasicBot subclass and call its run method. package main; my $bot = UppercaseBot->new( server => 'irc.example.com', port => '6667', channels => ['#bottest'], nick => 'UppercaseBot', name => 'John Doe', ignore_list => [ 'laotse', 'georgeburdell' ], ); $bot->run(); =head1 DESCRIPTION Basic bot system designed to make it easy to do simple bots, optionally forking longer processes (like searches) concurrently in the background. There are several examples of bots using Bot::BasicBot in the examples/ folder in the Bot::BasicBot tarball. A quick summary, though - You want to define your own package that subclasses Bot::BasicBot, override various methods (documented below), then call L|/new> and L|/run> on it. =head1 STARTING THE BOT =head2 C Creates a new instance of the class. Key/value pairs may be passed which will have the same effect as calling the method of that name with the value supplied. Returns a Bot::BasicBot object, that you can call 'run' on later. eg: my $bot = Bot::BasicBot->new( nick => 'superbot', channels => [ '#superheroes' ] ); =head2 C Runs the bot. Hands the control over to the POE core. =head1 STOPPING THE BOT To shut down the bot cleanly, use the L|/shutdown> method, which will (through L|/AUTOLOAD>) send an L of the same name to POE::Component::IRC, so it takes the same arguments: $bot->shutdown( $bot->quit_message() ); =head1 METHODS TO OVERRIDE In your Bot::BasicBot subclass, you want to override some of the following methods to define how your bot works. These are all object methods - the (implicit) first parameter to all of them will be the bot object. =head2 C called when the bot is created, as part of new(). Override to provide your own init. Return a true value for a successful init, or undef if you failed, in which case new() will die. =head2 C This is the main method that you'll want to override in your subclass - it's the one called by default whenever someone says anything that we can hear, either in a public channel or to us in private that we shouldn't ignore. You'll be passed a hashref that contains the arguments described below. Feel free to alter the values of this hash - it won't be used later on. =over 4 =item who Who said it (the nick that said it) =item raw_nick The raw IRC nick string of the person who said it. Only really useful if you want more security for some reason. =item channel The channel in which they said it. Has special value "msg" if it was in a message. Actually, you can send a message to many channels at once in the IRC spec, but no-one actually does this so this is just the first one in the list. =item body The body of the message (i.e. the actual text) =item address The text that indicates how we were addressed. Contains the string "msg" for private messages, otherwise contains the string off the text that was stripped off the front of the message if we were addressed, e.g. "Nick: ". Obviously this can be simply checked for truth if you just want to know if you were addressed or not. =back You should return what you want to say. This can either be a simple string (which will be sent back to whoever was talking to you as a message or in public depending on how they were talking) or a hashref that contains values that are compatible with say (just changing the body and returning the structure you were passed works very well.) Returning undef will cause nothing to be said. =head2 C This is a secondary method that you may wish to override. It gets called when someone in channel 'emotes', instead of talking. In its default configuration, it will simply pass anything emoted on channel through to the C handler. C receives the same data hash as C. =head2 C This is like C, except for notices instead of normal messages. =head2 C Called when someone joins a channel. It receives a hashref argument similar to the one received by said(). The key 'who' is the nick of the user who joined, while 'channel' is the channel they joined. This is a do-nothing implementation, override this in your subclass. =head2 C Called when someone parts a channel. It receives a hashref argument similar to the one received by said(). The key 'who' is the nick of the user who parted, while 'channel' is the channel they parted. This is a do-nothing implementation, override this in your subclass. =head2 C Whenever we have been given a definitive list of 'who is in the channel', this function will be called. It receives a hash reference as an argument. The key 'channel' will be the channel we have information for, 'names' is a hashref where the keys are the nicks of the users, and the values are more hashes, containing the two keys 'op' and 'voice', indicating if the user is a chanop or voiced respectively. The reply value is ignored. Normally, I wouldn't override this method - instead, just use the L call when you want to know who's in the channel. Override this only if you want to be able to do something as soon as possible. Also be aware that the names list can be changed by other events - kicks, joins, etc, and this method won't be called when that happens. =head2 C Called when the topic of the channel changes. It receives a hashref argument. The key 'channel' is the channel the topic was set in, and 'who' is the nick of the user who changed the channel, 'topic' will be the new topic of the channel. =head2 C When a user changes nicks, this will be called. It receives two arguments: the old nickname and the new nickname. =head2 C When a user sets channel modes, or the bot (or someone sharing its bouncer connection?) sets user modes, this will be called. It receives a hashref which will look like the following: { channel => "#channel", who => "nick!user@host", mode_changes => "+o+v", mode_operands => ["bigpresh", "somedude"], } =head2 C Called when a user is kicked from the channel. It receives a hashref which will look like this: { channel => "#channel", who => "nick", kicked => "kicked", reason => "reason", } The reply value is ignored. =head2 C This is an event called every regularly. The function should return the amount of time until the tick event should next be called. The default tick is called 5 seconds after the bot starts, and the default implementation returns '0', which disables the tick. Override this and return non-zero values to have an ongoing tick event. Use this function if you want the bot to do something periodically, and don't want to mess with 'real' POE things. Call the L event to schedule a tick event without waiting for the next tick. =head2 C This is the other method that you should override. This is the text that the bot will respond to if someone simply says help to it. This should be considered a special case which you should not attempt to process yourself. Saying help to a bot should have no side effects whatsoever apart from returning this text. =head2 C An optional method to override, gets called after we have connected to the server =head2 C Receives a hashref which will look like: { who => "nick that quit", body => "quit message", } =head2 C Receives a line of raw IRC input. Intended for cases where you're trying to do something clever which the normal methods and parsing supplied can't handle. =head2 C Receives a line of raw IRC output being sent to the IRC server. =head1 BOT METHODS There are a few methods you can call on the bot object to do things. These are as follows: =head2 C Takes an integer as an argument. Causes the L event to be called after that many seconds (or 5 seconds if no argument is provided). Note that if the tick event is due to be called already, this will override it. You can't schedule multiple future events with this funtction. =head2 C This method allows you to fork arbitrary background processes. They will run concurrently with the main bot, returning their output to a handler routine. You should call C in response to specific events in your C routine, particularly for longer running processes like searches, which will block the bot from receiving or sending on channel whilst they take place if you don't fork them. Inside the subroutine called by forkit, you can send output back to the channel by printing lines (followd by C<\n>) to STDOUT. This has the same effect as calling Lsay >>|say>. C takes the following arguments: =over 4 =item run A coderef to the routine which you want to run. Bear in mind that the routine doesn't automatically get the text of the query - you'll need to pass it in C (see below) if you want to use it at all. Apart from that, your C routine just needs to print its output to C, and it will be passed on to your designated handler. =item handler Optional. A method name within your current package which we can return the routine's data to. Defaults to the built-in method C (which simply sends data to channel). =item callback Optional. A coderef to execute in place of the handler. If used, the value of the handler argument is used to name the POE event. This allows using closures and/or having multiple simultanious calls to forkit with unique handler for each call. =item body Optional. Use this to pass on the body of the incoming message that triggered you to fork this process. Useful for interactive processes such as searches, so that you can act on specific terms in the user's instructions. =item who The nick of who you want any response to reach (optional inside a channel.) =item channel Where you want to say it to them in. This may be the special channel "msg" if you want to speak to them directly =item address Optional. Setting this to a true value causes the person to be addressed (i.e. to have "Nick: " prepended to the front of returned message text if the response is going to a public forum. =item arguments Optional. This should be an anonymous array of values, which will be passed to your C routine. Bear in mind that this is not intelligent - it will blindly spew arguments at C in the order that you specify them, and it is the responsibility of your C routine to pick them up and make sense of them. =back =head2 C Say something to someone. Takes a list of key/value pairs as arguments. You should pass the following arguments: =over 4 =item who The nick of who you are saying this to (optional inside a channel.) =item channel Where you want to say it to them in. This may be the special channel "msg" if you want to speak to them directly =item body The body of the message. I.e. what you want to say. =item address Optional. Setting this to a true value causes the person to be addressed (i.e. to have "Nick: " prepended to the front of the message text if this message is going to a pulbic forum. =back You can also make non-OO calls to C, which will be interpreted as coming from a process spawned by C. The routine will serialise any data it is sent, and throw it to STDOUT, where L can pass it on to a handler. =head2 C C will return data to channel, but emoted (as if you'd said "/me writes a spiffy new bot" in most clients). It takes the same arguments as C, listed above. =head2 C C will send a IRC notice to the channel. This is typically used by bots to not break the IRC conversations flow. The message will appear as: -nick- message here It takes the same arguments as C, listed above. Example: $bot->notice( channel => '#bot_basicbot_test', body => 'This is a notice' ); =head2 C Takes two arguments, a hashref containing information about an incoming message, and a reply message. It will reply in a privmsg if the incoming one was a privmsg, in channel if not, and with prefixes if the incoming one was prefixed. Mostly a shortcut method - it's roughly equivalent to $mess->{body} = $body; $self->say($mess); =head2 C Takes no arguments. Returns the underlying L object used by Bot::BasicBot. Useful for accessing various state methods and for posting commands to the component. For example: # get the list of nicks in the channel #someplace my @nicks = $bot->pocoirc->channel_list("#someplace"); # join the channel #otherplace $bot->pocoirc->yield('join', '#otherplace'); =head2 C Takes a channel names as a parameter, and returns a hash of hashes. The keys are the nicknames in the channel, the values are hashes containing the keys "voice" and "op", indicating whether these users are voiced or opped in the channel. This method is only here for backwards compatibility. You'll probably get more use out of L's methods (which this method is merely a wrapper for). You can access the POE::Component::IRC::State object through Bot::BasicBot's C method. =head1 ATTRIBUTES Get or set methods. Changing most of these values when connected won't cause sideffects. e.g. changing the server will not cause a disconnect and a reconnect to another server. Attributes that accept multiple values always return lists and either accept an arrayref or a complete list as an argument. The usual way of calling these is as keys to the hash passed to the 'new' method. =head2 C The server we're going to connect to. Defaults to "irc.perl.org". =head2 C The port we're going to use. Defaults to "6667" =head2 C The server password for the server we're going to connect to. Defaults to undef. =head2 C A boolean to indicate whether or not the server we're going to connect to is an SSL server. Defaults to 0. =head2 C The local address to use, for multihomed boxes. Defaults to undef (use whatever source IP address the system deigns is appropriate). =head2 C A boolean to indicate whether IPv6 should be used. Defaults to undef (use IPv4). =head2 C The nick we're going to use. Defaults to five random letters and numbers followed by the word "bot" =head2 C Alternate nicks that this bot will be known by. These are not nicks that the bot will try if it's main nick is taken, but rather other nicks that the bot will recognise if it is addressed in a public channel as the nick. This is useful for bots that are replacements for other bots...e.g, your bot can answer to the name "infobot: " even though it isn't really. =head2 C The username we'll claim to have at our ip/domain. By default this will be the same as our nick. =head2 C The name that the bot will identify itself as. Defaults to "$nick bot" where $nick is the nick that the bot uses. =head2 C The channels we're going to connect to. =head2 C The quit message. Defaults to "Bye". =head2 C The list of irc nicks to ignore B messages from (normally other bots.) Useful for stopping bot cascades. =head2 C IRC has no defined character set for putting high-bit chars into channel. This attribute sets the encoding to be used for outgoing messages. Defaults to 'utf8'. =head2 C Set to '1' to disable the built-in flood protection of POE::Compoent::IRC =head2 C Tells Bot::BasicBot to B run the L at the end of L|/run>, in case you want to do that yourself. =head2 C A hashref of WEBIRC params - keys C, C, C and C. Unless the network you are connecting to trusts you enough to give you a WEBIRC config block & password, this won't be of any use to you. =head1 OTHER METHODS =head2 C Bot::BasicBot implements AUTOLOAD for sending arbitrary states to the underlying L component. So for a C<$bot> object, sending $bot->foo("bar"); is equivalent to $poe_kernel->post(BASICBOT_ALIAS, "foo", "bar"); =head2 C Logs the message. This method merely prints to STDERR - If you want smarter logging, override this method - it will have simple text strings passed in @_. =head2 C Takes a nick name as an argument. Return true if this nick should be ignored. Ignores anything in the ignore list =head2 C Takes a nick and hostname (of the form "nick!hostname") and returns just the nick =head2 C Converts a string of bytes from IRC (uses L|IRC::Utils/decode_irc> from L internally) and returns a Perl string. It can also takes a list (or arrayref or hashref) of strings, and return a list of strings =head2 C Converts a list of perl strings into a list of byte sequences, using the bot's charset. See L|/charset_decode>. =head1 HELP AND SUPPORT If you have any questions or issues, you can drop by in #poe or #bot-basicbot @ irc.perl.org, where I (Hinrik) am usually around. =head1 AUTHOR David Precious (BIGPRESH) C<< >> is the current maintainer. Tom Insam Etom@jerakeen.orgE was the original author. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 CREDITS The initial version of Bot::BasicBot was written by Mark Fowler, and many thanks are due to him. Nice code for dealing with emotes thanks to Jo Walsh. Various patches from Tom Insam, including much improved rejoining, AUTOLOAD stuff, better interactive help, and a few API tidies. Maintainership for a while was in the hands of Simon Kent Esimon@hitherto.netE. Don't know what he did. :-) I (Tom Insam) received patches for tracking joins and parts from Silver, sat on them for two months, and have finally applied them. Thanks, dude. He also sent me changes for the tick event API, which made sense. In November 2010, maintainership moved to Hinrik Ern SigurEsson (L). In April 2017, maintainership moved to David Precious (L). =head1 SEE ALSO If you want to write/run a more flexible bot which supports module loading, authentication, data storage etc, consider the subclass L. Also see L, L Possibly Infobot, at http://www.infobot.org =cut countdownbot.pl100755001750001750 257013234726324 20554 0ustar00davidpdavidp000000000000Bot-BasicBot-0.93/examples#!/usr/bin/perl =head1 NAME countdownbot - a bot that will announce the time till an event =head1 DESCRIPTION This bot is incredibly annoying. Give it a date, and it'll periodically announce how long until that date. I wrote this to annoy Arthur. =cut use warnings; use strict; # Create and run the bot Bot->new( channels => [ '#2lmc' ], nick => 'countdownbot', server => 'irc.london.pm.org', date => 'Tue Jan 6 17:00:00 2004', # apple keynote Jan 2004 )->run; # Here's the definition of the bot package Bot; use base qw(Bot::BasicBot); use Date::Parse qw(str2time); use Time::Duration; # Called 5 seconds after bot startup, and then called again 'x' seconds # later, where 'x' is whatever the function returns. sub tick { my $self = shift; # How long till the event? my $secs = Date::Parse::str2time($self->{date}) - time; # What will we say? my $body = ($secs > 0) ? from_now($secs) : "Why are you still here?"; # Say this thing in all our channels. $self->say( channel => $_, body => $body ) for (@{$self->{channels}}); # Now, depending on how long is left, wait a different amount of # time. if ($secs > 60 * 30) { return 60 * 10 } elsif ( $secs > 60 * 10 ) { return 60 * 5 } elsif ( $secs > 60 ) { return 60 } elsif ( $secs > 10 ) { return 10 } elsif ( $secs > 0 ) { return 1 } else { exit; # done. } }