Net-Async-IRC-0.11000755001750001750 013056521113 12365 5ustar00leoleo000000000000Net-Async-IRC-0.11/Build.PL000444001750001750 133513056521113 14020 0ustar00leoleo000000000000use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'Net::Async::IRC', requires => { 'IO::Async::Loop' => '0.54', # ->connect Future 'IO::Async::Stream' => '0.59', # Protocol deprecation 'Protocol::IRC::Client' => '0.12', 'Time::HiRes' => 0, 'perl' => '5.010', # //, mro c3 }, test_requires => { 'IO::Async::OS' => 0, 'IO::Async::Test' => 0.14, 'Test::Fatal' => 0, 'Test::More' => '0.88', # done_testing }, auto_configure_requires => 0, # Don't add M::B to configure_requires license => 'perl', create_makefile_pl => 'traditional', create_license => 1, create_readme => 1, ); $build->create_build_script; Net-Async-IRC-0.11/Changes000444001750001750 463613056521113 14026 0ustar00leoleo000000000000Revision history for Net-Async-IRC 0.11 2017/03/04 11:14:11 [CHANGES] * Protocol::IRC is now moved to its own distribution * Expanded documentation, including the start of an introduction tutorial 0.10 2014/06/12 02:02:58 [CHANGES] * Ignore received blank lines * Allow capture of IRC parse errors as custom error handling [BUGFIXES] * Ensure that connection close during login counts as a failure for pending login futures 0.09 2014/01/21 12:21:41 [CHANGES] * Removed now-dead NaIRC::Message subclass [BUGFIXES] * Ensure that handled gated commands don't appear as unhnandled to the default 'on_message' handler * Fix return EXPR and EXPR operator precedence (RT87260) * Correctly set internal nick state when logging in after an ERR_NICKINUSE error (RT90487) * MSWin32 lacks a getpwnam() - use Win32::LoginName() instead 0.08 2014/01/20 01:52:18 [CHANGES] * Directly subclass IO::Async::Stream instead of IO::Async::Protocol * Implement IRCv3.1 CAP negotiation * Much improved handling of command/response gating * Implement 'whois' message gate * Futures-first documentation and testing 0.07 CHANGES: * Much splitting of non-async logic out of NaIRC into Protocol::IRC tree * Added name aliases for server numerics * Dispatch message handler methods for numerics to names first, before raw numbers 0.06 CHANGES: * Renamed Net::Async::IRC::Message to Protocol::IRC::Message, as the first step of the split to Protocol::IRC * Implement IRCv3 message tags 0.05 CHANGES: * Bugfix for ->connect() with service => undef * Some more numerics * New model for storing numerics in source code 0.04 CHANGES: * Split lower-level code into new Net::Async::IRC::Protocol module * Use IO::Async::Protocol->connect from 0.34 0.03 BUGFIXES: * Fix failures due to IO::Async::Test or ::Loop no longer loading IO::Async::Stream; load it explicitly where needed 0.02 CHANGES: * Some more numerics * Capture named args from more WHOIS numerics * base on IO::Async::Protocol::Stream 0.01 First version, released on an unsuspecting world. Net-Async-IRC-0.11/LICENSE000444001750001750 4376213056521113 13563 0ustar00leoleo000000000000This software is copyright (c) 2017 by Paul Evans . 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) 2017 by Paul Evans . 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) 2017 by Paul Evans . 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 Net-Async-IRC-0.11/MANIFEST000444001750001750 70513056521113 13635 0ustar00leoleo000000000000Build.PL Changes examples/client.pl examples/intro-01-helloworld.pl examples/intro-02-whatsyourname.pl examples/SYNOPSIS.pl lib/Net/Async/IRC.pm lib/Net/Async/IRC/Introduction.pod lib/Net/Async/IRC/Protocol.pm LICENSE Makefile.PL MANIFEST This list of files META.json META.yml README t/00use.t t/30client-connect.t t/31client-cap.t t/32client-encoding.t t/33client-nick.t t/40methods-basic.t t/50client-pingpong.t t/99pod.t t/privkey.pem t/server.pem Net-Async-IRC-0.11/META.json000444001750001750 244013056521113 14143 0ustar00leoleo000000000000{ "abstract" : "use IRC with C", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.422", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Async-IRC", "prereqs" : { "runtime" : { "requires" : { "IO::Async::Loop" : "0.54", "IO::Async::Stream" : "0.59", "Protocol::IRC::Client" : "0.12", "Time::HiRes" : "0", "perl" : "5.010" } }, "test" : { "requires" : { "IO::Async::OS" : "0", "IO::Async::Test" : "0.14", "Test::Fatal" : "0", "Test::More" : "0.88" } } }, "provides" : { "Net::Async::IRC" : { "file" : "lib/Net/Async/IRC.pm", "version" : "0.11" }, "Net::Async::IRC::Protocol" : { "file" : "lib/Net/Async/IRC/Protocol.pm", "version" : "0.11" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.11", "x_serialization_backend" : "JSON::PP version 2.27400" } Net-Async-IRC-0.11/META.yml000444001750001750 152013056521113 13771 0ustar00leoleo000000000000--- abstract: 'use IRC with C' author: - 'Paul Evans ' build_requires: IO::Async::OS: '0' IO::Async::Test: '0.14' Test::Fatal: '0' Test::More: '0.88' dynamic_config: 1 generated_by: 'Module::Build version 0.422, 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: Net-Async-IRC provides: Net::Async::IRC: file: lib/Net/Async/IRC.pm version: '0.11' Net::Async::IRC::Protocol: file: lib/Net/Async/IRC/Protocol.pm version: '0.11' requires: IO::Async::Loop: '0.54' IO::Async::Stream: '0.59' Protocol::IRC::Client: '0.12' Time::HiRes: '0' perl: '5.010' resources: license: http://dev.perl.org/licenses/ version: '0.11' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Net-Async-IRC-0.11/Makefile.PL000444001750001750 77413056521113 14464 0ustar00leoleo000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4220 require 5.010; use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Net::Async::IRC', 'VERSION_FROM' => 'lib/Net/Async/IRC.pm', 'PREREQ_PM' => { 'IO::Async::Loop' => '0.54', 'IO::Async::Stream' => '0.59', 'Protocol::IRC::Client' => '0.12', 'Time::HiRes' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Net-Async-IRC-0.11/README000444001750001750 1306513056521113 13427 0ustar00leoleo000000000000NAME Net::Async::IRC - use IRC with IO::Async SYNOPSIS use IO::Async::Loop; use Net::Async::IRC; my $loop = IO::Async::Loop->new; my $irc = Net::Async::IRC->new( on_message_text => sub { my ( $self, $message, $hints ) = @_; print "$hints->{prefix_name} says: $hints->{text}\n"; }, ); $loop->add( $irc ); $irc->login( nick => "MyName", host => "irc.example.org", )->get; $irc->do_PRIVMSG( target => "YourName", text => "Hello world!" ); $loop->run; DESCRIPTION This object class implements an asynchronous IRC client, for use in programs based on IO::Async. Most of the actual IRC message handling behaviour is implemented by the parent class Net::Async::IRC::Protocol. Most of the behaviour related to being an IRC client is implemented by the parent class Protocol::IRC::Client. The following documentation may make mention of these above two parent classes; the reader should make reference to them when required. PARAMETERS The following named parameters may be passed to new or configure: nick => STRING user => STRING realname => STRING Connection details. See also connect, login. If user is not supplied, it will default to either $ENV{LOGNAME} or the current user's name as supplied by getpwuid() or Win32::LoginName(). If unconnected, changing these properties will set the default values to use when logging in. If logged in, changing the nick property is equivalent to calling change_nick. Changing the other properties will not take effect until the next login. use_caps => ARRAY of STRING Attempts to negotiate IRC v3.1 CAP at connect time. The array gives the names of capabilities which will be requested, if the server supports them. METHODS The following methods documented with a trailing call to ->get return Future instances. connect $irc = $irc->connect( %args )->get Connects to the IRC server. This method does not perform the complete IRC login sequence; for that see instead the login method. The returned Future will yield the $irc instance itself, to make chaining easier. host => STRING Hostname of the IRC server. service => STRING or NUMBER Optional. Port number or service name of the IRC server. Defaults to 6667. Any other arguments are passed into the underlying IO::Async::Loop connect method. $irc->connect( %args ) The following additional arguments are used to provide continuations when not returning a Future. on_connected => CODE Continuation to invoke once the connection has been established. Usually used by the login method to perform the actual login sequence. $on_connected->( $irc ) on_error => CODE Continuation to invoke in the case of an error preventing the connection from taking place. $on_error->( $errormsg ) login $irc = $irc->login( %args )->get Logs in to the IRC network, connecting first using the connect method if required. Takes the following named arguments: nick => STRING user => STRING realname => STRING IRC connection details. Defaults can be set with the new or configure methods. pass => STRING Server password to connect with. Any other arguments that are passed, are forwarded to the connect method if it is required; i.e. if login is invoked when not yet connected to the server. $irc->login( %args ) The following additional arguments are used to provide continuations when not returning a Future. on_login => CODE A continuation to invoke once login is successful. $on_login->( $irc ) change_nick $irc->change_nick( $newnick ) Requests to change the nick. If unconnected, the change happens immediately to the stored defaults. If logged in, sends a NICK command to the server, which may suceed or fail at a later point. IRC v3.1 CAPABILITIES The following methods relate to IRC v3.1 capabilities negotiations. caps_supported $caps = $irc->caps_supported Returns a HASH whose keys give the capabilities listed by the server as supported in its CAP LS response. If the server ignored the CAP negotiation then this method returns undef. cap_supported $supported = $irc->cap_supported( $cap ) Returns a boolean indicating if the server supports the named capability. caps_enabled $caps = $irc->caps_enabled Returns a HASH whose keys give the capabilities successfully enabled by the server as part of the CAP REQ login sequence. If the server ignored the CAP negotiation then this method returns undef. cap_enabled $enabled = $irc->cap_enabled( $cap ) Returns a boolean indicating if the client successfully enabled the named capability. MESSAGE-WRAPPING METHODS The following methods are all inherited from Protocol::IRC::Client but are mentioned again for convenient. For further details see the documentation in the parent module. In particular, each method returns a Future instance. do_PRIVMSG do_NOTICE $irc->do_PRIVMSG( target => $target, text => $text )->get $irc->do_NOTICE( target => $target, text => $text )->get Sends a PRIVMSG or NOITICE command. SEE ALSO * http://tools.ietf.org/html/rfc2812 - Internet Relay Chat: Client Protocol AUTHOR Paul Evans Net-Async-IRC-0.11/examples000755001750001750 013056521113 14203 5ustar00leoleo000000000000Net-Async-IRC-0.11/examples/SYNOPSIS.pl000444001750001750 65013056521113 16145 0ustar00leoleo000000000000use IO::Async::Loop; use Net::Async::IRC; my $loop = IO::Async::Loop->new; my $irc = Net::Async::IRC->new( on_message_text => sub { my ( $self, $message, $hints ) = @_; print "$hints->{prefix_name} says: $hints->{text}\n"; }, ); $loop->add( $irc ); $irc->login( nick => "MyName", host => "irc.example.org", )->get; $irc->do_PRIVMSG( target => "YourName", text => "Hello world!" ); $loop->run; Net-Async-IRC-0.11/examples/client.pl000444001750001750 252413056521113 16156 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Data::Dump 'pp'; use Getopt::Long; use Future::Utils qw( repeat ); use IO::Async::Loop; use Net::Async::IRC; GetOptions( 'server|s=s' => \my $SERVER, 'nick|n=s' => \my $NICK, 'port|p=i' => \my $PORT, 'SSL|S' => \my $SSL, ) or exit 1; require IO::Async::SSL if $SSL; my $loop = IO::Async::Loop->new; my $irc = Net::Async::IRC->new( on_message => sub { my ( $self, $command, $message, $hints ) = @_; return if $hints->{handled}; printf "<<%s>>: %s\n", $command, join( " ", $message->args ); print "| $_\n" for split m/\n/, pp( $hints ); return 1; }, ); $loop->add( $irc ); $PORT //= ( $SSL ? 6697 : 6667 ); $irc->connect( host => $SERVER, service => $PORT, ( $SSL ? ( extensions => ['SSL'], SSL_verify_mode => 0 ) : () ), )->get; print "Connected...\n"; $irc->login( nick => $NICK, )->get; print "Now logged in...\n"; my $stdin = IO::Async::Stream->new_for_stdin( on_read => sub {} ); $loop->add( $stdin ); my $eof; ( repeat { $stdin->read_until( "\n" )->on_done( sub { ( my $line, $eof ) = @_; return if $eof; chomp $line; my $message = Protocol::IRC::Message->new_from_line( $line ); $irc->send_message( $message ); }); } while => sub { !$_[0]->failure and !$eof } )->get; Net-Async-IRC-0.11/examples/intro-01-helloworld.pl000444001750001750 61413056521113 20400 0ustar00leoleo000000000000use strict; use warnings; use IO::Async::Loop; use Net::Async::IRC; my $loop = IO::Async::Loop->new; my $irc = Net::Async::IRC->new; $loop->add( $irc ); my $SERVER = "irc.example.net"; my $NICK = "MyNick"; my $TARGET = "TargetNick"; $irc->login( host => $SERVER, nick => $NICK, )->then( sub { $irc->do_PRIVMSG( target => $TARGET, text => "Hello, World" ); })->get; Net-Async-IRC-0.11/examples/intro-02-whatsyourname.pl000444001750001750 154313056521113 21156 0ustar00leoleo000000000000use strict; use warnings; use IO::Async::Loop; use Net::Async::IRC; my $loop = IO::Async::Loop->new; my $irc = Net::Async::IRC->new; $loop->add( $irc ); my $SERVER = "irc.example.net"; my $NICK = "MyNick"; my $TARGET = "TargetNick"; $irc->login( host => $SERVER, nick => $NICK, )->get; my $target_folded = $irc->casefold_name( $TARGET ); $irc->configure( on_message_text => sub { my ( undef, $message, $hints ) = @_; return unless $hints->{prefix_nick_folded} eq $target_folded; print "The user said: $hints->{text}\n"; }, on_message_ctcp_ACTION => sub { my ( undef, $message, $hints ) = @_; return unless $hints->{prefix_nick_folded} eq $target_folded; print "The user acted: $hints->{ctcp_args}\n"; }, ); $irc->do_PRIVMSG( target => $TARGET, text => "Hello, what's your name?" ); $loop->run; Net-Async-IRC-0.11/lib000755001750001750 013056521113 13133 5ustar00leoleo000000000000Net-Async-IRC-0.11/lib/Net000755001750001750 013056521113 13661 5ustar00leoleo000000000000Net-Async-IRC-0.11/lib/Net/Async000755001750001750 013056521113 14736 5ustar00leoleo000000000000Net-Async-IRC-0.11/lib/Net/Async/IRC.pm000444001750001750 2601013056521113 16065 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2008-2017 -- leonerd@leonerd.org.uk package Net::Async::IRC; use strict; use warnings; our $VERSION = '0.11'; # We need to use C3 MRO to make the ->isupport etc.. methods work properly use mro 'c3'; use base qw( Net::Async::IRC::Protocol Protocol::IRC::Client ); use Carp; use Socket qw( SOCK_STREAM ); use constant HAVE_MSWIN32 => ( $^O eq "MSWin32" ); =head1 NAME C - use IRC with C =head1 SYNOPSIS use IO::Async::Loop; use Net::Async::IRC; my $loop = IO::Async::Loop->new; my $irc = Net::Async::IRC->new( on_message_text => sub { my ( $self, $message, $hints ) = @_; print "$hints->{prefix_name} says: $hints->{text}\n"; }, ); $loop->add( $irc ); $irc->login( nick => "MyName", host => "irc.example.org", )->get; $irc->do_PRIVMSG( target => "YourName", text => "Hello world!" ); $loop->run; =head1 DESCRIPTION This object class implements an asynchronous IRC client, for use in programs based on L. Most of the actual IRC message handling behaviour is implemented by the parent class L. Most of the behaviour related to being an IRC client is implemented by the parent class L. The following documentation may make mention of these above two parent classes; the reader should make reference to them when required. =cut sub new { my $class = shift; my %args = @_; my $on_closed = delete $args{on_closed}; return $class->SUPER::new( %args, on_closed => sub { my $self = shift; if( $self->{on_login_f} ) { $_->fail( "Closed" ) for @{ $self->{on_login_f} }; undef $self->{on_login_f}; } $on_closed->( $self ) if $on_closed; }, ); } sub _init { my $self = shift; $self->SUPER::_init( @_ ); $self->{user} = $ENV{LOGNAME} || ( HAVE_MSWIN32 ? Win32::LoginName() : getpwuid($>) ); $self->{realname} = "Net::Async::IRC client $VERSION"; } =head1 PARAMETERS The following named parameters may be passed to C or C: =over 8 =item nick => STRING =item user => STRING =item realname => STRING Connection details. See also C, C. If C is not supplied, it will default to either C<$ENV{LOGNAME}> or the current user's name as supplied by C or C. If unconnected, changing these properties will set the default values to use when logging in. If logged in, changing the C property is equivalent to calling C. Changing the other properties will not take effect until the next login. =item use_caps => ARRAY of STRING Attempts to negotiate IRC v3.1 CAP at connect time. The array gives the names of capabilities which will be requested, if the server supports them. =back =cut sub configure { my $self = shift; my %args = @_; for (qw( user realname use_caps )) { $self->{$_} = delete $args{$_} if exists $args{$_}; } if( exists $args{nick} ) { $self->_set_nick( delete $args{nick} ); } $self->SUPER::configure( %args ); } =head1 METHODS The following methods documented with a trailing call to C<< ->get >> return L instances. =cut =head2 connect $irc = $irc->connect( %args )->get Connects to the IRC server. This method does not perform the complete IRC login sequence; for that see instead the C method. The returned L will yield the C<$irc> instance itself, to make chaining easier. =over 8 =item host => STRING Hostname of the IRC server. =item service => STRING or NUMBER Optional. Port number or service name of the IRC server. Defaults to 6667. =back Any other arguments are passed into the underlying C C method. $irc->connect( %args ) The following additional arguments are used to provide continuations when not returning a Future. =over 8 =item on_connected => CODE Continuation to invoke once the connection has been established. Usually used by the C method to perform the actual login sequence. $on_connected->( $irc ) =item on_error => CODE Continuation to invoke in the case of an error preventing the connection from taking place. $on_error->( $errormsg ) =back =cut # TODO: Most of this needs to be moved into an abstract Net::Async::Connection role sub connect { my $self = shift; my %args = @_; # Largely for unit testing return $self->{connect_f} ||= Future->new->done( $self ) if $self->read_handle; my $on_error = delete $args{on_error}; $args{service} ||= "6667"; return $self->{connect_f} ||= $self->SUPER::connect( %args, on_resolve_error => sub { my ( $msg ) = @_; chomp $msg; if( $args{on_resolve_error} ) { $args{on_resolve_error}->( $msg ); } elsif( $on_error ) { $on_error->( "Cannot resolve - $msg" ); } }, on_connect_error => sub { if( $args{on_connect_error} ) { $args{on_connect_error}->( @_ ); } elsif( $on_error ) { $on_error->( "Cannot connect" ); } }, )->on_fail( sub { undef $self->{connect_f} } ); } =head2 login $irc = $irc->login( %args )->get Logs in to the IRC network, connecting first using the C method if required. Takes the following named arguments: =over 8 =item nick => STRING =item user => STRING =item realname => STRING IRC connection details. Defaults can be set with the C or C methods. =item pass => STRING Server password to connect with. =back Any other arguments that are passed, are forwarded to the C method if it is required; i.e. if C is invoked when not yet connected to the server. $irc->login( %args ) The following additional arguments are used to provide continuations when not returning a Future. =over 8 =item on_login => CODE A continuation to invoke once login is successful. $on_login->( $irc ) =back =cut sub login { my $self = shift; my %args = @_; my $nick = delete $args{nick} || $self->{nick} or croak "Need a login nick"; my $user = delete $args{user} || $self->{user} or croak "Need a login user"; my $realname = delete $args{realname} || $self->{realname}; my $pass = delete $args{pass}; if( !defined $self->{nick} ) { $self->_set_nick( $nick ); } my $on_login = delete $args{on_login}; !defined $on_login or ref $on_login eq "CODE" or croak "Expected 'on_login' to be a CODE reference"; return $self->{login_f} ||= $self->connect( %args )->then( sub { $self->send_message( "CAP", undef, "LS" ) if $self->{use_caps}; $self->send_message( "PASS", undef, $pass ) if defined $pass; $self->send_message( "USER", undef, $user, "0", "*", $realname ); $self->send_message( "NICK", undef, $nick ); my $f = $self->loop->new_future; push @{ $self->{on_login_f} }, $f; $f->on_done( $on_login ) if $on_login; return $f; })->on_fail( sub { undef $self->{login_f} } ); } =head2 change_nick $irc->change_nick( $newnick ) Requests to change the nick. If unconnected, the change happens immediately to the stored defaults. If logged in, sends a C command to the server, which may suceed or fail at a later point. =cut sub change_nick { my $self = shift; my ( $newnick ) = @_; if( !$self->is_connected ) { $self->_set_nick( $newnick ); } else { $self->send_message( "NICK", undef, $newnick ); } } ############################ # Message handling methods # ############################ =head1 IRC v3.1 CAPABILITIES The following methods relate to IRC v3.1 capabilities negotiations. =cut sub on_message_cap_LS { my $self = shift; my ( $message, $hints ) = @_; my $supported = $self->{caps_supported} = $hints->{caps}; my @request = grep { $supported->{$_} } @{$self->{use_caps}}; if( @request ) { $self->{caps_enabled} = { map { $_ => undef } @request }; $self->send_message( "CAP", undef, "REQ", join( " ", @request ) ); } else { $self->send_message( "CAP", undef, "END" ); } return 1; } *on_message_cap_ACK = *on_message_cap_NAK = \&_on_message_cap_reply; sub _on_message_cap_reply { my $self = shift; my ( $message, $hints ) = @_; my $ack = $hints->{verb} eq "ACK"; $self->{caps_enabled}{$_} = $ack for keys %{ $hints->{caps} }; # Are any outstanding !defined and return 1 for values %{ $self->{caps_enabled} }; $self->send_message( "CAP", undef, "END" ); return 1; } =head2 caps_supported $caps = $irc->caps_supported Returns a HASH whose keys give the capabilities listed by the server as supported in its C response. If the server ignored the C negotiation then this method returns C. =cut sub caps_supported { my $self = shift; return $self->{caps_supported}; } =head2 cap_supported $supported = $irc->cap_supported( $cap ) Returns a boolean indicating if the server supports the named capability. =cut sub cap_supported { my $self = shift; my ( $cap ) = @_; return !!$self->{caps_supported}{$cap}; } =head2 caps_enabled $caps = $irc->caps_enabled Returns a HASH whose keys give the capabilities successfully enabled by the server as part of the C login sequence. If the server ignored the C negotiation then this method returns C. =cut sub caps_enabled { my $self = shift; return $self->{caps_enabled}; } =head2 cap_enabled $enabled = $irc->cap_enabled( $cap ) Returns a boolean indicating if the client successfully enabled the named capability. =cut sub cap_enabled { my $self = shift; my ( $cap ) = @_; return !!$self->{caps_enabled}{$cap}; } sub on_message_NICK { my $self = shift; my ( $message, $hints ) = @_; if( $hints->{prefix_is_me} ) { $self->_set_nick( $hints->{new_nick} ); return 1; } return 0; } sub on_message_RPL_WELCOME { my $self = shift; my ( $message ) = @_; # set our nick to be what the server logged us in as $self->_set_nick( $message->{args}[0] ); if( $self->{on_login_f} and @{ $self->{on_login_f} } ) { my @futures = @{ $self->{on_login_f} }; undef $self->{on_login_f}; foreach my $f ( @futures ) { $f->done( $self ); } } # Don't eat it return 0; } =head1 MESSAGE-WRAPPING METHODS The following methods are all inherited from L but are mentioned again for convenient. For further details see the documentation in the parent module. In particular, each method returns a L instance. =cut =head2 do_PRIVMSG =head2 do_NOTICE $irc->do_PRIVMSG( target => $target, text => $text )->get $irc->do_NOTICE( target => $target, text => $text )->get Sends a C or C command. =cut =head1 SEE ALSO =over 4 =item * L - Internet Relay Chat: Client Protocol =back =head1 AUTHOR Paul Evans =cut 0x55AA; Net-Async-IRC-0.11/lib/Net/Async/IRC000755001750001750 013056521113 15353 5ustar00leoleo000000000000Net-Async-IRC-0.11/lib/Net/Async/IRC/Introduction.pod000444001750001750 1513513056521113 20722 0ustar00leoleo000000000000=head1 NAME Net::Async::IRC::Introduction - an introduction =head1 INTRODUCTION =head2 Hello, World This first example is the "hello world" of IRC; a script that connects to the server and immediately sends a hello message to a preconfigured user. This program starts with the usual boilerplate for any L-based program; namely loading the required modules and creating a containing L instance. It then constructs the actual L object and adds it to this containing loop. As these actions are standard to every program, they won't be repeated in later examples; just presumed to have already taken place: use strict; use warnings; use IO::Async::Loop; use Net::Async::IRC; my $loop = IO::Async::Loop->new; my $irc = Net::Async::IRC->new; $loop->add( $irc ); Now this is created, we can move on to the specifics of this example. As it's a tiny example script, we'll just hard-code the parameters for the message. A larger program of course would read these from somewhere better - a config file, commandline arguments, etc... my $SERVER = "irc.example.net"; my $NICK = "MyNick"; my $TARGET = "TargetNick"; Finally we can connect to the IRC server and send the message: $irc->login( host => $SERVER, nick => $NICK, )->then( sub { $irc->do_PRIVMSG( target => $TARGET, text => "Hello, World" ); })->get; The program calls L, which connects the client to the given IRC server and logs in as the given nick. This method returns a L instance to represent its eventual completion, giving us an easy way to sequence further code after it. After login is complete, the next task is simply to send the message. This is done with the C IRC command as wrapped by L. This takes taking the message target name and text string. The trailing call to L makes the script stop here waiting for this chain of futures to actually complete. Without this, the returned future would simply be lost (as the L method appears in void context), and the second stage of code within it would probably never get called. In later examples we'll see other techniques, but for now every constructed future will simply be forced by calling C on it. If either of these stages fails, it will cause the C call to throw an exception instead. Once this is sent, the script terminates, closing its connection to the server. =head2 RECEIVING MESSAGES As a second example, lets now consider also how we handle messages that arrive from IRC. $irc->configure( on_message_PRIVMSG => sub { my ( $irc, $message, $hints ) = @_; return unless $hints->{prefix_nick_folded} eq $irc->casefold_name( $TARGET ); print "The user said: $hints->{text}\n"; } ); $irc->login( host => $SERVER, nick => $NICK, )->then( sub { $irc->do_PRIVMSG( target => $TARGET, text => "Hello, what's your name?" ); })->get; $loop->run; Here we have used the C method to attach an event handler to the C event. This handler code ignores any messages except from the user we are interested in, and simply prints the contents of those we are interested in to the terminal. Having established this event handler, we can then log in and send a message to the target user, similar to the first example. Instead of stopping the script entirely afterwards, we need to ensure that the program keeps running after this initial start so it can continue to receive messages. To do that we enter the main L method, which will wait indefinitely, processing any events that are received. =head2 Case-folded Names The use of the "folded" strings ensures that this code can correctly cope with any odd case-folding rules the IRC server has. By comparison, both of the following lines are incorrect, and may cause missed messages on some servers: return unless $hints->{prefix_name} eq $TARGET; # don't do this return unless lc $hints->{prefix_name} eq lc $TARGET; # don't do this The first does not case-fold the string at all, so will fail in the case of C vs C. The second attempts to solve this, but does not take account of the odd case-folding logic most IRC servers have, in which the characters C<[\]> are "uppercase" versions of C<{|}>. The L method is provided as a server-aware alternative to C, which handles this. A correct implementation could be written: return unless $irc->casefold_name( $hints->{prefix_name} ) eq $irc->casefold_name( $TARGET ); However, since this is a very common pattern, the hints hash conveniently supplies already-folded strings for any name or nick fields it finds. Furthermore, as the case folded version of the target name won't change after startup, we could store that initially to save re-calculating it at every event: $irc->login( host => $SERVER, nick => $NICK, )->get; my $target_folded = $irc->casefold_name( $TARGET ); $irc->configure( on_message_PRIVMSG => sub { my ( undef, $message, $hints ) = @_; return unless $hints->{prefix_nick_folded} eq $target_folded; print "The user said: $hints->{text}\n"; } ); =head2 C vs C and CTCPs This example has used the basic C event. A better version would be to use C instead. This is a synthesized event created on receipt of either C or C, and itself handles details like C parsing, freeing the user code from having to handle it). For example, the plain C event will get quite confused by an incoming C, such as is created by most IRC clients by the C command. Instead, we can handle that by attaching a handler specifically for C: $irc->configure( on_message_text => sub { my ( undef, $message, $hints ) = @_; return unless $hints->{prefix_nick_folded} eq $target_folded; print "The user said: $hints->{text}\n"; }, on_message_ctcp_ACTION => sub { my ( undef, $message, $hints ) = @_; return unless $hints->{prefix_nick_folded} eq $target_folded; print "The user acted: $hints->{ctcp_args}\n"; }, ); This second handlers is invoked on receipt of a C containing a C. The first is only invoked on receipt of a plain C that doesn't contain a C subcommand. =head1 AUTHOR Paul Evans =cut Net-Async-IRC-0.11/lib/Net/Async/IRC/Protocol.pm000444001750001750 2135013056521113 17670 0ustar00leoleo000000000000# You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # # (C) Paul Evans, 2010-2015 -- leonerd@leonerd.org.uk package Net::Async::IRC::Protocol; use strict; use warnings; our $VERSION = '0.11'; use base qw( IO::Async::Stream Protocol::IRC ); use Carp; use Protocol::IRC::Message; use Encode qw( find_encoding ); use Time::HiRes qw( time ); use IO::Async::Timer::Countdown; =head1 NAME C - send and receive IRC messages =head1 DESCRIPTION This subclass of L implements an established IRC connection that has already completed its inital login sequence and is ready to send and receive IRC messages. It handles base message sending and receiving, and implements ping timers. This class provides most of the functionality required for sending and receiving IRC commands and responses by mixing in from L. Objects of this type would not normally be constructed directly. For IRC clients, see L which is a subclass of it. All the events, parameters, and methods documented below are relevant there. =cut =head1 EVENTS The following events are invoked, either using subclass methods or C references in parameters: =head2 $handled = on_message =head2 $handled = on_message_MESSAGE Invoked on receipt of a valid IRC message. See C below. =head2 on_irc_error $err Invoked on receipt of an invalid IRC message if parsing fails. C<$err> is the error message text. If left unhandled, any parse error will result in the connection being immediataely closed, followed by the exception being re-thrown. =head2 on_ping_timeout Invoked if the peer fails to respond to a C message within the given timeout. =head2 on_pong_reply $lag Invoked when the peer successfully sends a C reply response to a C message. C<$lag> is the response time in (fractional) seconds. =cut =head1 PARAMETERS The following named parameters may be passed to C or C: =over 8 =item on_message => CODE =item on_message_MESSAGE => CODE =item on_irc_error => CODE =item on_ping_timeout => CODE =item on_pong_reply => CODE C references for event handlers. =item pingtime => NUM Amount of quiet time, in seconds, after a message is received from the peer, until a C will be sent to check it is still alive. =item pongtime => NUM Timeout, in seconds, after sending a C message, to wait for a C response. =item encoding => STRING If supplied, sets an encoding to use to encode outgoing messages and decode incoming messages. =back =cut =head1 CONSTRUCTOR =cut =head2 new $irc = Net::Async::IRC::Protocol->new( %args ) Returns a new instance of a C object. This object represents a IRC connection to a peer. =cut sub new { my $class = shift; my %args = @_; my $on_closed = delete $args{on_closed}; return $class->SUPER::new( %args, on_closed => sub { my $self = shift; my $loop = $self->get_loop; $self->{pingtimer}->stop; $self->{pongtimer}->stop; $on_closed->( $self ) if $on_closed; undef $self->{connect_f}; undef $self->{login_f}; }, ); } sub _init { my $self = shift; $self->SUPER::_init( @_ ); my $pingtime = 60; my $pongtime = 10; $self->{pingtimer} = IO::Async::Timer::Countdown->new( delay => $pingtime, on_expire => sub { my $now = time(); $self->send_message( "PING", undef, "$now" ); $self->{ping_send_time} = $now; $self->{pongtimer}->start; }, ); $self->add_child( $self->{pingtimer} ); $self->{pongtimer} = IO::Async::Timer::Countdown->new( delay => $pongtime, on_expire => sub { $self->{on_ping_timeout}->( $self ) if $self->{on_ping_timeout}; }, ); $self->add_child( $self->{pongtimer} ); } # for Protocol::IRC sub encoder { my $self = shift; return $self->{encoder}; } sub configure { my $self = shift; my %args = @_; $self->{$_} = delete $args{$_} for grep m/^on_message/, keys %args; for (qw( on_ping_timeout on_pong_reply on_irc_error )) { $self->{$_} = delete $args{$_} if exists $args{$_}; } if( exists $args{pingtime} ) { $self->{pingtimer}->configure( delay => delete $args{pingtime} ); } if( exists $args{pongtime} ) { $self->{pongtimer}->configure( delay => delete $args{pongtime} ); } if( exists $args{encoding} ) { my $encoding = delete $args{encoding}; my $obj = find_encoding( $encoding ); defined $obj or croak "Cannot handle an encoding of '$encoding'"; $self->{encoder} = $obj; } $self->SUPER::configure( %args ); } sub incoming_message { my $self = shift; my ( $message ) = @_; my @shortargs = ( $message->arg( 0 ) ); push @shortargs, $message->arg( 1 ) if $message->command =~ m/^\d+$/; push @shortargs, "..." if $message->args > 1; $self->debug_printf( "COMMAND ${\ $message->command } @shortargs" ); return $self->SUPER::incoming_message( @_ ); } =head1 METHODS =cut =head2 is_connected $connect = $irc->is_connected Returns true if a connection to the peer is established. Note that even after a successful connection, the connection may not yet logged in to. See also the C method. =cut sub is_connected { my $self = shift; return 0 unless my $connect_f = $self->{connect_f}; return $connect_f->is_ready && !$connect_f->failure; } =head2 is_loggedin $loggedin = $irc->is_loggedin Returns true if the full login sequence has been performed on the connection and it is ready to use. =cut sub is_loggedin { my $self = shift; return 0 unless my $login_f = $self->{login_f}; return $login_f->is_ready && !$login_f->failure; } sub on_read { my $self = shift; my ( $buffref, $eof ) = @_; my $pingtimer = $self->{pingtimer}; $pingtimer->is_running ? $pingtimer->reset : $pingtimer->start; eval { $self->Protocol::IRC::on_read( $$buffref ); 1; } and return 0; my $e = "$@"; chomp $e; $self->maybe_invoke_event( on_irc_error => $e ) and return 0; $self->close_now; die "$e\n"; } =head2 nick $nick = $irc->nick Returns the current nick in use by the connection. =cut sub _set_nick { my $self = shift; ( $self->{nick} ) = @_; $self->{nick_folded} = $self->casefold_name( $self->{nick} ); } sub nick { my $self = shift; return $self->{nick}; } =head2 nick_folded $nick_folded = $irc->nick_folded Returns the current nick in use by the connection, folded by C for convenience. =cut sub nick_folded { my $self = shift; return $self->{nick_folded}; } =head1 MESSAGE HANDLING Every incoming message causes a sequence of message handling to occur. First, the message is parsed, and a hash of data about it is created; this is called the hints hash. The message and this hash are then passed down a sequence of potential handlers. Each handler indicates by return value, whether it considers the message to have been handled. Processing of the message is not interrupted the first time a handler declares to have handled a message. Instead, the hints hash is marked to say it has been handled. Later handlers can still inspect the message or its hints, using this information to decide if they wish to take further action. A message with a command of C will try handlers in following places: =over 4 =item 1. A CODE ref in a parameter called C $on_message_COMMAND->( $irc, $message, \%hints ) =item 2. A method called C $irc->on_message_COMMAND( $message, \%hints ) =item 3. A CODE ref in a parameter called C $on_message->( $irc, 'COMMAND', $message, \%hints ) =item 4. A method called C $irc->on_message( 'COMMAND', $message, \%hints ) =back As this message handling ability is provided by C, more details about how it works and how to use it can be found at L. Additionally, some types of messages receive further processing by C and in turn cause new types of events to be invoked. These are further documented by L. =cut sub invoke { my $self = shift; my $retref = $self->maybe_invoke_event( @_ ) or return undef; return $retref->[0]; } sub on_message_PONG { my $self = shift; my ( $message, $hints ) = @_; return 1 unless $self->{pongtimer}->is_running; my $lag = time - $self->{ping_send_time}; $self->{current_lag} = $lag; $self->{on_pong_reply}->( $self, $lag ) if $self->{on_pong_reply}; $self->{pongtimer}->stop; return 1; } =head1 AUTHOR Paul Evans =cut 0x55AA; Net-Async-IRC-0.11/t000755001750001750 013056521113 12630 5ustar00leoleo000000000000Net-Async-IRC-0.11/t/00use.t000444001750001750 22013056521113 14060 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use_ok( "Net::Async::IRC" ); use_ok( "Net::Async::IRC::Protocol" ); done_testing; Net-Async-IRC-0.11/t/30client-connect.t000444001750001750 433013056521113 16222 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use IO::Async::Listener; use Net::Async::IRC; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my $client; my $listener = IO::Async::Listener->new( on_stream => sub { ( undef, $client ) = @_; }, ); $loop->add( $listener ); $listener->listen( addr => { family => "inet" }, )->get; my @errors; my $irc = Net::Async::IRC->new( user => "defaultuser", realname => "Default Real name", on_message => sub { "IGNORE" }, on_irc_error => sub { my $self = shift; my ( $err ) = @_; push @errors, $err; }, ); $loop->add( $irc ); ok( !$irc->is_connected, 'not $irc->is_connected' ); $irc->connect( addr => { family => "inet", ip => $listener->read_handle->sockhost, port => $listener->read_handle->sockport, }, )->get; ok( $irc->is_connected, '$irc->is_connected' ); ok( !$irc->is_loggedin, 'not $irc->is_loggedin' ); wait_for { $client }; $client->configure( on_read => sub { 0 } ); # using read futures $loop->add( $client ); # Now see if we can send a message $irc->send_message( "HELLO", undef, "world" ); my $read_f; $read_f = $client->read_until( $CRLF ); wait_for { $read_f->is_ready }; is( scalar $read_f->get, "HELLO world$CRLF", 'Server stream after initial client message' ); my $logged_in = 0; my $login_f = $irc->login( nick => "MyNick", on_login => sub { $logged_in = 1 }, ); $read_f = $client->read_until( qr/$CRLF.*$CRLF/ ); wait_for { $read_f->is_ready }; is( scalar $read_f->get, "USER defaultuser 0 * :Default Real name$CRLF" . "NICK MyNick$CRLF", 'Server stream after login' ); $client->write( ":irc.example.com 001 MyNick :Welcome to IRC MyNick!defaultuser\@your.host.here$CRLF" ); wait_for { $login_f->is_ready }; ok( !$login_f->failure, 'Client logs in without failure' ); ok( $logged_in, 'Client receives logged in event' ); ok( $irc->is_connected, '$irc->is_connected' ); ok( $irc->is_loggedin, '$irc->is_loggedin' ); $client->write( ":something invalid-here$CRLF" ); wait_for { scalar @errors }; ok( defined shift @errors, 'on_error invoked' ); done_testing; Net-Async-IRC-0.11/t/31client-cap.t000444001750001750 516113056521113 15340 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use IO::Async::Stream; use Net::Async::IRC; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; # Normal CAP login { my $irc = Net::Async::IRC->new( handle => $S1, use_caps => [qw( multi-prefix )], ); $loop->add( $irc ); my $login_f = $irc->login( nick => "MyNick", user => "me", realname => "My real name", ); my $serverstream = ""; wait_for_stream { $serverstream =~ m/(?:.*$CRLF){3}/ } $S2 => $serverstream; is( $serverstream, "CAP LS$CRLF" . "USER me 0 * :My real name$CRLF" . "NICK MyNick$CRLF", 'Server stream negotiates CAP' ); $serverstream = ""; $S2->syswrite( ':irc.example.com CAP * LS :multi-prefix sasl' . $CRLF ); wait_for_stream { $serverstream =~ m/.*$CRLF/ } $S2 => $serverstream; is( $serverstream, "CAP REQ multi-prefix$CRLF", 'Client requests caps' ); $serverstream = ""; is_deeply( $irc->caps_supported, { 'multi-prefix' => 1, 'sasl' => 1 }, '$irc->caps_supported' ); ok( $irc->cap_supported( "multi-prefix" ), '$irc->cap_supported' ); $S2->syswrite( ':irc.example.com CAP * ACK :multi-prefix' . $CRLF ); wait_for_stream { $serverstream =~ m/.*$CRLF/ } $S2 => $serverstream; is( $serverstream, "CAP END$CRLF", 'Client finishes CAP' ); is_deeply( $irc->caps_enabled, { 'multi-prefix' => 1 }, '$irc->caps_enabled' ); ok( $irc->cap_enabled( "multi-prefix" ), '$irc->cap_enabled' ); $S2->syswrite( ':irc.example.com 001 MyNick :Welcome to IRC MyNick!me@your.host' . $CRLF ); wait_for { $login_f->is_ready }; $login_f->get; $loop->remove( $irc ); } # CAP ignored by server { my $irc = Net::Async::IRC->new( handle => $S1, use_caps => [qw( multi-prefix )], ); $loop->add( $irc ); my $login_f = $irc->login( nick => "MyNick", user => "me", realname => "My real name", ); my $serverstream = ""; wait_for_stream { $serverstream =~ m/(?:.*$CRLF){3}/ } $S2 => $serverstream; $S2->syswrite( ':irc.example.com 001 MyNick :Welcome to IRC MyNick!me@your.host' . $CRLF ); wait_for { $login_f->is_ready }; $login_f->get; is( $irc->caps_supported, undef, '$irc->caps_supported undef for CAPless server' ); is( $irc->caps_enabled, undef, '$irc->caps_enabled undef for CAPless server' ); } done_testing; Net-Async-IRC-0.11/t/32client-encoding.t000444001750001750 353413056521113 16366 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use utf8; use Test::More; use IO::Async::Test; use IO::Async::Loop; use IO::Async::Listener; use Encode qw( encode_utf8 ); use Net::Async::IRC; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); SKIP: foreach my $SSL ( 0, 1 ) { if( $SSL ) { eval { require IO::Async::SSL } or skip "No IO::Async::SSL", 1; } my $client; my $listener = IO::Async::Listener->new( on_stream => sub { ( undef, $client ) = @_; }, ); $loop->add( $listener ); $listener->listen( addr => { family => "inet" }, ( $SSL ? ( extensions => [ 'SSL' ], SSL_key_file => "t/privkey.pem", SSL_cert_file => "t/server.pem", ) : () ), )->get; my $irc = Net::Async::IRC->new( user => "defaultuser", realname => "Default Real name", encoding => "UTF-8", on_message => sub { "IGNORE" }, on_irc_error => sub {}, ); $loop->add( $irc ); $irc->connect( addr => { family => "inet", ip => $listener->read_handle->sockhost, port => $listener->read_handle->sockport, }, ( $SSL ? ( extensions => [ 'SSL' ], SSL_verify_mode => 0 ) : () ), )->get; wait_for { $client }; $client->configure( on_read => sub { 0 } ); # using read futures $loop->add( $client ); $irc->send_message( "PRIVMSG", undef, "target", "Ĉu vi ĉi tio vidas?" ); my $read_f = $client->read_until( $CRLF ); wait_for { $read_f->is_ready }; is( scalar $read_f->get, encode_utf8( "PRIVMSG target :Ĉu vi ĉi tio vidas?$CRLF" ), 'Stream is encoded over ' . ( $SSL ? "SSL" : "plaintext" ) ); $loop->remove( $irc ); $loop->remove( $client ); $loop->remove( $listener ); } done_testing; Net-Async-IRC-0.11/t/33client-nick.t000444001750001750 557013056521113 15527 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::OS; use IO::Async::Loop; use IO::Async::Stream; use Net::Async::IRC; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; my $in_use = 0; my $err_nick = 0; my $irc = Net::Async::IRC->new( handle => $S1, user => "defaultuser", realname => "Default Real name", nick => "AlreadyUsedNick", on_message_ERR_NICKNAMEINUSE => sub { shift->change_nick( "1stNick" ); $in_use = 1; }, on_message_ERR_ERRONEUSNICKNAME => sub { shift->change_nick( "FirstNickTOOLONG" ); $err_nick = 1; }, on_message => sub { "IGNORE" }, ); $loop->add( $irc ); is( $irc->nick, "AlreadyUsedNick", 'Initial nick is set' ); ok( $irc->is_nick_me( "AlreadyUsedNick" ), 'Client recognises initial nick' ); ok( !$irc->is_nick_me( "SomeoneElse" ), 'Client does not recognise other nick' ); my $login_f = $irc->login; my $serverstream = ""; wait_for_stream { $serverstream =~ m/$CRLF.*$CRLF/ } $S2 => $serverstream; is( $serverstream, "USER defaultuser 0 * :Default Real name$CRLF" . "NICK AlreadyUsedNick$CRLF", 'Server stream after attempt to login with nick already in use' ); $S2->syswrite( ":irc.example.com 433 * AlreadyUsedNick :Nickname is already in use$CRLF" ); wait_for { $in_use }; ok( $in_use, 'Client recieves ERR_NICKNAMEINUSE error' ); $S2->syswrite( ":irc.example.com 432 * 1stNick :Erroneous nickname$CRLF" ); wait_for { $err_nick }; ok( $err_nick, 'Client recieves ERR_ERRONEUSNICK error' ); $S2->syswrite( ":irc.example.com 001 FirstNick :Welcome to IRC FirstNick!defaultuser\@your.host.here$CRLF" ); wait_for { $login_f->is_ready }; $login_f->get; is( $irc->nick, "FirstNick", 'Nick was updated correctly even after multiple errors' ); $serverstream = ""; wait_for_stream { $serverstream =~ m/$CRLF/ } $S2 => $serverstream; is( $serverstream, "NICK 1stNick$CRLF" . "NICK FirstNickTOOLONG$CRLF", 'Server stream after login' ); $irc->change_nick( "SecondNick" ); is( $irc->nick, "FirstNick", 'Nick still old until server confirms' ); ok( $irc->is_nick_me( "FirstNick" ), 'Client recognises still old nick' ); ok( !$irc->is_nick_me( "SecondNick" ), 'Client does not recognise new nick' ); $serverstream = ""; wait_for_stream { $serverstream =~ m/$CRLF/ } $S2 => $serverstream; is( $serverstream, "NICK SecondNick$CRLF", 'Server stream after NICK command' ); $S2->syswrite( ":FirstNick!defaultuser\@your.host.here NICK SecondNick$CRLF" ); wait_for { not $irc->is_nick_me( "FirstNick" ) }; is( $irc->nick, "SecondNick", 'Object now confirms new nick' ); ok( !$irc->is_nick_me( "FirstNick" ), 'Client no longer recognises old nick' ); ok( $irc->is_nick_me( "SecondNick" ), 'Client now recognises new nick' ); done_testing; Net-Async-IRC-0.11/t/40methods-basic.t000444001750001750 143513056521113 16043 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use IO::Async::Test; use IO::Async::Loop; use IO::Async::Stream; use Net::Async::IRC; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; my $irc = Net::Async::IRC->new( handle => $S1, ); $loop->add( $irc ); # privmsg { my $f = $irc->do_PRIVMSG( target => "#target", text => "Your message here" ); isa_ok( $f, "Future", '$f' ); my $serverstream = ""; wait_for_stream { $serverstream =~ m/(?:.*$CRLF)/ } $S2 => $serverstream; is( $serverstream, "PRIVMSG #target :Your message here$CRLF", '->privmsg' ); ok( $f->is_ready, '$f is ready' ); } done_testing; Net-Async-IRC-0.11/t/50client-pingpong.t000444001750001750 356313056521113 16423 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Time::HiRes qw(); # Empty import, just there to let IO::Async and Net::Async::IRC use it use IO::Async::Test; use IO::Async::OS; use IO::Async::Loop; use IO::Async::Stream; use Net::Async::IRC; my $CRLF = "\x0d\x0a"; # because \r\n isn't portable my $loop = IO::Async::Loop->new(); testing_loop( $loop ); my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; my $lag; my $pingout; my $irc = Net::Async::IRC->new( handle => $S1, on_message => sub { "IGNORE" }, pingtime => 2, pongtime => 1, on_pong_reply => sub { $lag = $_[1] }, on_ping_timeout => sub { $pingout = 1 }, ); $loop->add( $irc ); # This is all tricky timing-related code. Pay attention # First [the server] will send three messages, separated by 1sec, and assert # that the client didn't send a PING my $serverstream = ""; my $msgcount = 0; sub tick { $msgcount++; $S2->syswrite( "HELLO client$CRLF" ); $loop->enqueue_timer( delay => 1, code => \&tick ) if $msgcount < 3; } tick(); wait_for_stream { $msgcount == 3 } $S2 => $serverstream; is( $serverstream, "", 'client quiet after server noise' ); # Now [the server] will be quiet and assert that the client sends a PING wait_for_stream { $serverstream =~ m/$CRLF/ } $S2 => $serverstream; like( $serverstream, qr/^PING .*$CRLF$/, 'client sent PING after server idle' ); # Now lets be a good server and reply to the PING my ( $pingarg ) = $serverstream =~ m/^PING (.*)$CRLF$/; $S2->syswrite( ":irc.example.com PONG $pingarg$CRLF" ); undef $lag; wait_for { defined $lag }; ok( $lag >= 0 && $lag <= 1, 'client acknowledges PONG reply' ); # Now [the server] won't reply to a PING at all, and hope for an event to note # that it failed wait_for { defined $pingout }; ok( $pingout, 'client reports PING timeout' ); done_testing; Net-Async-IRC-0.11/t/99pod.t000444001750001750 25713056521113 14102 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Net-Async-IRC-0.11/t/privkey.pem000444001750001750 156713056521113 15172 0ustar00leoleo000000000000-----BEGIN RSA PRIVATE KEY----- MIICXAIBAAKBgQDddpSdw0V5emmrozEq3LkTiILDUeUk4MiTmoug1bcfgbQwld4r U/Dyl1oT8bonEzIcf7002HAQmhPae+9XdQOxnqyzamRBNwuypO895g5EPswTh9Rr PohJse3qWs4yVP1PVeatBwxIvug+6+0XXAymNBVJmQfcCbLX4i/b27NtmwIDAQAB AoGAcz93XZY1/F6oyQo21wBgS/r5WZ2vqn5TwwRk70DoeDvuQm5rXI7lT8lVthVQ c284373V/782ql0UQdnHFvMtBPT14fPdfysBSFIwjPdAZMG6EqTtYy30o8Hk1N34 CcBTqS4nt+MvxW3xdvQd/hVZgoWRbdCZ6p11Ky9ylmJgt6kCQQD3cRkKNjeF//8j eG/L0OykpTivy0peDCWOZCyRIME45+L/eYaYKMdhQ4YNeaguMC2Z8GrbXf2oRZce t2jxn6tdAkEA5R92e5jC3dT+S1SCCSzdr1+IGF8PF5EnPCGtQMl+pfCleAo/aiPK pM2lmoUaOoMj8j655mq5gdUxxshPFl7lVwJBAJmo2D3pMU27jbt/PR263lnYaH1y pvoEXQYx2yM8zgECr4qq8xRmrnoOLp8Ln48fSBJCpHkZwz3OCWx/xWHXH9kCQEH+ 3wTYyoBVAm42SEJWTwBdtvi2IMW8BJ4YYSwBHd60QyUhZoSvDIaNyX6JijWCYo87 LBbHdOmFvBGyzrz11n8CQCmlyhmF2xe1xUrYnGgnfIj29KPFmJik2qeDTfxACv4Z MzPtOWOEdZjc5h6JTnQTl0fcko35l5FaUeflvw2uBGM= -----END RSA PRIVATE KEY----- Net-Async-IRC-0.11/t/server.pem000444001750001750 174113056521113 15001 0ustar00leoleo000000000000-----BEGIN CERTIFICATE----- MIICsDCCAhmgAwIBAgIJAOLBB28kRrw6MA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNV BAYTAkFVMRMwEQYDVQQIEwpTb21lLVN0YXRlMSEwHwYDVQQKExhJbnRlcm5ldCBX aWRnaXRzIFB0eSBMdGQwHhcNMTAxMTIxMjIwMjM5WhcNMTAxMjIxMjIwMjM5WjBF MQswCQYDVQQGEwJBVTETMBEGA1UECBMKU29tZS1TdGF0ZTEhMB8GA1UEChMYSW50 ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKB gQDddpSdw0V5emmrozEq3LkTiILDUeUk4MiTmoug1bcfgbQwld4rU/Dyl1oT8bon EzIcf7002HAQmhPae+9XdQOxnqyzamRBNwuypO895g5EPswTh9RrPohJse3qWs4y VP1PVeatBwxIvug+6+0XXAymNBVJmQfcCbLX4i/b27NtmwIDAQABo4GnMIGkMB0G A1UdDgQWBBQKCmQV0xTMGtYoalfHFbpDr3kgszB1BgNVHSMEbjBsgBQKCmQV0xTM GtYoalfHFbpDr3kgs6FJpEcwRTELMAkGA1UEBhMCQVUxEzARBgNVBAgTClNvbWUt U3RhdGUxITAfBgNVBAoTGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZIIJAOLBB28k Rrw6MAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADgYEAIjrc8INv1WxIq0kV yDEmcBeot1RRiCQJJxy3xq6eZZcTkT+YvEVrR/hOWPGL0qFInltBKcp0To0w+Esz SQfvieWW1U/aAfcBNJ26HRyzh8N98ZST9k4LlDJbneHB8McF1G5n/D71wmHm1llh cIX3gRpAkOW5gnjXUYpgsviJxUQ= -----END CERTIFICATE-----