Author: dylan
Date: 2005-06-20 03:48:44 -0400 (Mon, 20 Jun 2005)
New Revision: 779
Added:
trunk/perl/
trunk/perl/client/
trunk/perl/client/Build.PL
trunk/perl/client/COPYING
trunk/perl/client/MANIFEST.SKIP
trunk/perl/client/README
trunk/perl/client/bin/
trunk/perl/client/examples/
trunk/perl/client/examples/cmod.pl
trunk/perl/client/lib/
trunk/perl/client/lib/Haver/
trunk/perl/client/lib/Haver/Client.pm
trunk/perl/client/lib/Haver/Client/
trunk/perl/client/lib/Haver/Client/POE.pm
trunk/perl/client/t/
trunk/perl/client/t/basic.t
trunk/perl/core/
trunk/perl/core/Build.PL
trunk/perl/core/COPYING
trunk/perl/core/MANIFEST.SKIP
trunk/perl/core/README
trunk/perl/core/lib/
trunk/perl/core/lib/Haver/
trunk/perl/core/lib/Haver/Base.pm
trunk/perl/core/lib/Haver/Config.pm
trunk/perl/core/lib/Haver/Logger.pm
trunk/perl/core/lib/Haver/Protocol.pm
trunk/perl/core/lib/Haver/Protocol/
trunk/perl/core/lib/Haver/Protocol/Filter.pm
trunk/perl/core/lib/Haver/Session.pm
trunk/perl/core/lib/Haver/Util.pm
trunk/perl/core/lib/Haver/Wheel.pm
trunk/perl/core/lib/Haver/Wheel/
trunk/perl/core/lib/Haver/Wheel/Loader.pm
trunk/perl/core/t/
trunk/perl/core/t/001_config.t
trunk/perl/core/t/002_protocol.t
trunk/perl/core/t/003_wheel.t
trunk/perl/core/t/004_loader.t
trunk/perl/core/t/005_wheel_run.t
trunk/perl/server/
trunk/perl/server/Build.PL
trunk/perl/server/COPYING
trunk/perl/server/MANIFEST.SKIP
trunk/perl/server/NEWS
trunk/perl/server/README
trunk/perl/server/TODO
trunk/perl/server/bin/
trunk/perl/server/bin/haver-new-user.pl
trunk/perl/server/bin/haver-passwd.pl
trunk/perl/server/bin/haverd.pl
trunk/perl/server/lib/
trunk/perl/server/lib/Haver/
trunk/perl/server/lib/Haver/Server.pm
trunk/perl/server/lib/Haver/Server/
trunk/perl/server/lib/Haver/Server/Avatar.pm
trunk/perl/server/lib/Haver/Server/Entity.pm
trunk/perl/server/lib/Haver/Server/Entity/
trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
trunk/perl/server/lib/Haver/Server/Entity/Lobby.pm
trunk/perl/server/lib/Haver/Server/Entity/Service.pm
trunk/perl/server/lib/Haver/Server/Entity/User.pm
trunk/perl/server/lib/Haver/Server/Listener.pm
trunk/perl/server/lib/Haver/Server/Talker.pm
trunk/perl/server/lib/Haver/Server/Wheel.pm
trunk/perl/server/lib/Haver/Server/Wheel/
trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
trunk/perl/server/lib/Haver/Server/Wheel/Main.pm
trunk/perl/server/t/
trunk/perl/server/t/00_use.t
trunk/perl/server/t/01_entity.t
Removed:
trunk/main/
trunk/misc/
Modified:
trunk/
Log:
[EMAIL PROTECTED]: dylan | 2005-06-20 03:48:34 -0400
main -> perl, to match with the java directory. :)
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43050
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1111
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43050
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1112
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Property changes on: trunk/perl/client
___________________________________________________________________
Name: svn:ignore
+ _build
Build
Makefile.PL
MANIFEST
META.yml
*.bak
*~
Added: trunk/perl/client/Build.PL
===================================================================
--- trunk/perl/client/Build.PL 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/client/Build.PL 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+use Module::Build;
+my $build = Module::Build->new(
+ module_name => 'Haver::Client',
+ dist_name => 'haver-client',
+ dist_version_from => 'lib/Haver/Client.pm',
+ dist_author => 'Bryan Donlan <[EMAIL PROTECTED]>',
+ license => 'gpl',
+ requires => {
+ 'perl' => '5.8.0',
+ Haver => 0.06,
+ 'Digest::SHA1' => 2.01,
+ 'Data::Dumper' => 2.121,
+
+ },
+ create_makefile_pl => 'passthrough',
+ script_files => [ glob ('bin/*.pl') ],
+);
+
+$build->create_build_script;
Property changes on: trunk/perl/client/Build.PL
___________________________________________________________________
Name: svn:executable
+
Name: svn:eol-style
+ native
Added: trunk/perl/client/COPYING
===================================================================
--- trunk/perl/client/COPYING 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/client/COPYING 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,326 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your freedom to
+share and change it. By contrast, the GNU 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. This General Public License applies to
+most of the Free Software Foundation's software and to any other program whose
+authors commit to using it. (Some other Free Software Foundation software is
+covered by the GNU Library General Public License instead.) You can apply it
+to your programs, too.
+
+ When we speak of free software, we are referring to freedom, not price. Our
+General Public Licenses are designed to make sure that you have the freedom to
+distribute copies of free software (and charge for this service if you wish),
+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 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 show them these terms so they know 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.
+
+ Finally, any free program is threatened constantly by software patents. We
+wish to avoid the danger that redistributors of a free program will
+individually obtain patent licenses, in effect making the program proprietary.
+To prevent this, we have made it clear that any patent must be licensed for
+everyone's free use or not licensed at all.
+
+ 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 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
+derivative work under copyright law: that is to say, a work containing the
+Program or a portion of it, either verbatim or with modifications and/or
+translated into another language. (Hereinafter, translation is included
+without limitation in the term "modification".) Each licensee is addressed as
+"you".
+
+Activities other than copying, distribution and modification are not covered
+by this License; they are outside its scope. The act of running the Program
+is not restricted, and the output from the Program is covered only if its
+contents constitute a work based on the Program (independent of having been
+made by running the Program). Whether that is true depends on what the
+Program does.
+
+ 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 License
+and to the absence of any warranty; and give any other recipients of the
+Program a copy of this License along with the Program.
+
+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.
+
+ 2. You may modify your copy or copies of the Program or any portion of it,
+thus forming a work based on the Program, and copy and distribute such
+modifications or work under the terms of Section 1 above, provided that you
+also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary 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
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If identifiable
+sections of that work are not derived from the Program, and can be reasonably
+considered independent and separate works in themselves, then this License,
+and its terms, do not apply to those sections when you distribute them as
+separate works. But when you distribute the same sections as part of a whole
+which is a work based on the Program, the distribution of the whole must be on
+the terms of this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest your
+rights to work written entirely by you; rather, the intent is to exercise the
+right to control the distribution of derivative or collective works based on
+the Program.
+
+In addition, mere aggregation of another work not based on the Program with
+the Program (or with a work based on the Program) on a volume of a storage or
+distribution medium does not bring the other work under the scope of this
+License.
+
+ 3. You may copy and distribute the Program (or a work based on it, under
+Section 2) in object code or executable form under the terms of Sections 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 Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for making
+modifications to it. For an executable work, complete source code means all
+the source code for all modules it contains, plus any associated interface
+definition files, plus the scripts used to control compilation and
+installation of the executable. However, as a special exception, the source
+code distributed need not include anything that is normally distributed (in
+either source or binary form) with the major components (compiler, kernel, and
+so on) of the operating system on which the executable runs, unless that
+component itself accompanies the executable.
+
+If distribution of executable or object code is made by offering access to
+copy from a designated place, then offering equivalent access to copy the
+source code from the same place counts as distribution of the source code,
+even though third parties are not compelled to copy the source along with the
+object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program except as
+expressly provided under this License. Any attempt otherwise to copy, modify,
+sublicense or distribute the Program is void, and will automatically terminate
+your rights under this License. However, parties who have received copies, or
+rights, from you under this License will not have their licenses terminated so
+long as such parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not signed
+it. However, nothing else grants you permission to modify or distribute the
+Program or its derivative works. These actions are prohibited by law if you
+do not accept this License. Therefore, by modifying or distributing 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 for copying,
+distributing or modifying the Program or works based on it.
+
+ 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. You are not responsible for enforcing
+compliance by third parties to this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or otherwise)
+that contradict the conditions of this License, they do not excuse you from
+the conditions of this License. If you cannot distribute so as to satisfy
+simultaneously your obligations under this License and any other pertinent
+obligations, then as a consequence you may not distribute the Program at all.
+For example, if a patent license would not permit royalty-free redistribution
+of the Program by all those who receive copies directly or indirectly through
+you, then the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply and
+the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any patents or
+other property right claims or to contest validity of any such claims; this
+section has the sole purpose of protecting the integrity of the free software
+distribution system, which is implemented by public license practices. Many
+people have made generous contributions to the wide range of software
+distributed through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing to
+distribute software through any other system and a licensee cannot impose that
+choice.
+
+This section is intended to make thoroughly clear what is believed to be a
+consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in certain
+countries either by patents or by copyrighted interfaces, the original
+copyright holder who places the Program under this License may add an explicit
+geographical distribution limitation excluding those countries, so that
+distribution is permitted only in or among countries not thus excluded. In
+such case, this License incorporates the limitation as if written in the body
+of this License.
+
+ 9. 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 this 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 this License,
+you may choose any version ever published by the Free Software Foundation.
+
+ 10. 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
+
+ 11. 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.
+
+ 12. 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
+
+ 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 the public, 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ 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 2 of the License, 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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) 19yy 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 is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General Public
+License instead of this License.
Property changes on: trunk/perl/client/COPYING
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/client/MANIFEST.SKIP
===================================================================
--- trunk/perl/client/MANIFEST.SKIP 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/client/MANIFEST.SKIP 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,8 @@
+\.old$
+\.bak
+store
+blib
+_build
+^Build$
+^\.#
+\.svn
Property changes on: trunk/perl/client/MANIFEST.SKIP
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/client/README
===================================================================
--- trunk/perl/client/README 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/client/README 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,59 @@
+Haver-Client version 0.04 ("Vinegar")
+=========================
+
+Haver's a new chat system similar to IRC,
+but hopefully it is both more simple and more
+flexible.
+
+Haver will never replace IRC, rather it
+is intended for a different niche: Fairly
+small servers. Haver doesn't make any attempts
+at doing multi-server stuff.
+
+Why was haver written?
+Because IRC is really... disorganized.
+Having to user agents for keeping rooms registered
+is just plain icky, in my opinion.
+
+Also, writing the server, the clients,
+devising a protocol that is simple, is
+terribly fun stuff.
+
+This is a collection of various client libraries.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Build.PL
+ perl Build
+ perl Build test
+ perl Build install
+
+
+
+DEPENDENCIES
+
+Haver => 0.04
+POE => 0.26
+Data::Dumper => 2.121
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2004 by Bryan Donlan, Dylan William Hardison
+
+This library 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 2 of the License, or
+(at your option) any later version.
+
+This library 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Property changes on: trunk/perl/client/README
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/client/examples/cmod.pl
===================================================================
--- trunk/perl/client/examples/cmod.pl 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/client/examples/cmod.pl 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,354 @@
+#!/usr/bin/perl
+# vim: set ft=perl ts=4 sw=4:
+# cmod.pl - Conspiracy game engine for Haver
+# Rules: http://norinel.aftran.com/stuff/usingcmod.html
+#
+# Copyright (C) 2004 Bryan Donlan, Dylan William Hardison.
+#
+# This module 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 2 of the License, or
+# (at your option) any later version.
+#
+# This module 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 module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use warnings;
+use constant {
+ STATE_IDLE => 0,
+ STATE_REGISTER => 1,
+ STATE_MAIN => 2,
+ STATE_VOTE => 3,
+};
+
+
+#sub POE::Kernel::ASSERT_DEFAULT { 1 }
+
+use Haver::Config;
+use Haver::OS;
+use POE qw(Component::Client::Haver);
+use Getopt::Mixed;
+use Data::Dumper;
+
+my $conf;
+my $debug = 0;
+my $PACKAGE = __PACKAGE__;
+
+sub _dprint {
+ my ($thresh, @stuff) = @_;
+ return unless $thresh <= $debug;
+ print STDERR @stuff, "\n";
+}
+
+sub _dprintf {
+ my ($thresh, $fmt, @stuff) = @_;
+ return unless $thresh <= $debug;
+ printf STDERR "$fmt\n", @stuff;
+}
+
+sub _msg ($) {
+ my $message = $_[0];
+ POE::Kernel->post('haver', 'msg', q{"}, $conf->{Channel}, $message);
+}
+
+sub _pmsg ($$) {
+ my ($rcpt, $msg) = @_;
+ POE::Kernel->post('haver', 'pmsg', q{"}, $rcpt, $msg);
+}
+{
+ my $file;
+ my ($option, $value);
+ $file = Haver::OS->config_find(scope => 'user', name => 'haver-cmod',
type => 'file');
+ Getopt::Mixed::init(qw(h c=s d:i));
+ while(($option, $value) = Getopt::Mixed::nextOption()) {
+ if($option eq 'h') {
+ print STDERR "Usage: $0 [-h] [-c file] [-d [level]]\n",
+ "A conspiracy moderator bot for Haver\n",
+ "\n",
+ "-h\tShow this help\n",
+ "-c file\tUse configuration file specified
instead of the default.\n",
+ "-d [level]\tActivate debugging, default
level is 1\n";
+ exit 0;
+ } elsif ($option eq 'c') {
+ $file = $value;
+ } elsif ($option eq 'd') {
+ $debug = (defined($value) ? $value : 1);
+ }
+ }
+ Getopt::Mixed::cleanup();
+ $conf = new Haver::Config(
+ file => $file,
+ default => {
+ Host => 'hardison.net',
+ Port => 7070,
+ Channel => 'lobby',
+ UID => 'cmod',
+ Register_wait => 30,
+ Discuss_wait => 600,
+ Reconnect_delay => 30,
+ }
+ ) || die "Can't load configuration file: $!";
+ _dprint 1, "Loaded configuration file $file.";
+}
+
+POE::Component::Client::Haver->new('haver');
+POE::Session->create(package_states => [$PACKAGE => [qw{
+ _start
+ haver_login
+ haver_connect_fail
+ haver_login_fail
+ haver_disconnected
+ haver_part
+ haver_joined
+ haver_msg
+ haver_pmsg
+ haver_raw_in
+ haver_raw_out
+ cmd_start
+ cmd_register
+ cmd_abort
+ cmd_hurry
+ cmd_snoop
+ end_registration
+ abort
+ start_vote
+ finish_vote
+ reset
+ }]]);
+
+POE::Kernel->run();
+
+sub _start {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ _dprint 1, "Kernel running, doing connect";
+ $kernel->post('haver', 'register', 'all');
+ $kernel->post('haver', 'connect',
+ Host => $conf->{Host},
+ Port => $conf->{Port},
+ UID => $conf->{UID},
+ (defined($conf->{Password}) ? (Password => $conf->{Password}) :
())
+ );
+ $heap->{state} = STATE_IDLE;
+}
+
+sub haver_login {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ _dprint 1, "Logged in, joining $conf->{Channel}";
+ $kernel->post('haver', 'join', $conf->{Channel});
+}
+
+sub haver_connect_fail {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ _dprint 0, "Connect failure, error $args->[1]";
+ # XXX: Reconnection logic here
+ exit 1;
+}
+
+sub haver_login_fail {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ _dprint 0, "Login failure, error $args->[2]";
+ # XXX: Reconnection logic here
+ exit 1;
+}
+
+sub haver_disconnected {
+ _dprint 0, "Disconnected";
+ # XXX: Reconnection logic here
+ exit 1;
+}
+
+sub haver_joined {
+ _dprint 1, "Joined channel.";
+}
+
+sub haver_part {
+ # ...
+}
+
+sub haver_msg {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my $line = $args->[2];
+ _dprint 3, "got msg type $args->[0] line $line source $args->[1]";
+ $args->[0] eq q{"} or return;
+ $line =~ /^!(\S+)\s*(.*)$/ or return;
+ _dprint 3, "got msg type $1 arg $2 source $args->[1]";
+ $kernel->yield("cmd_$1", $args->[1], $2);
+}
+
+
+sub haver_raw_in {
+ _dprint 3, "S: ", join "\t", @{$_[ARG0]};
+}
+
+sub haver_raw_out {
+ _dprint 3, "C: ", join "\t", @{$_[ARG0]};
+}
+
+sub cmd_start {
+ my ($kernel, $heap, $who) = @_[KERNEL,HEAP,ARG0];
+ if($heap->{state} != STATE_IDLE) {
+ $kernel->post("haver", "pmsg", q{"}, $who, "A game is already
running, sorry.");
+ }
+ _dprint 1, "Game start by $who";
+ $heap->{players} = {};
+ $kernel->delay(end_registration => $conf->{Register_wait});
+ $kernel->post("haver", "msg", q{"}, $conf->{Channel}, "A game of
conspiracy has begun. Type !register within the next $conf->{Register_wait}
seconds to register.");
+ $heap->{state} = STATE_REGISTER;
+}
+
+sub end_registration {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ if(keys(%{$heap->{players}}) < 3) {
+ $kernel->post("haver", "msg", q{"}, $conf->{Channel}, "Not
enough players.");
+ $kernel->yield("abort");
+ return;
+ }
+ _dprint 1, "Game start.";
+ $heap->{state} = STATE_MAIN;
+ my $conspiracy = int rand 2;
+ if($conspiracy) {
+ $heap->{innocent} = (keys %{$heap->{players}})[int rand scalar
keys %{$heap->{players}}];
+ }
+ for(keys %{$heap->{players}}) {
+ if($conspiracy && $_ ne $heap->{innocent}) {
+ _pmsg($_, "You are a conspirator, and the innocent is
$heap->{innocent}");
+ } else {
+ _pmsg($_, "You are an innocent in this game");
+ }
+ }
+ _msg("A game of conspiracy has begun! Game ends in
$conf->{Discuss_wait} seconds");
+ $kernel->delay(start_vote => $conf->{Discuss_wait});
+}
+
+sub cmd_abort {
+ $_[KERNEL]->yield('abort');
+}
+
+sub cmd_register {
+ my ($kernel, $heap, $who) = @_[KERNEL,HEAP,ARG0];
+ if($heap->{state} == STATE_IDLE) {
+ $kernel->post("haver", "msg", q{"}, $conf->{Channel}, "A game
is not running. Type !start to start one.");
+ return;
+ } elsif ($heap->{state} == STATE_REGISTER) {
+ if(exists $heap->{players}->{$who}) {
+ $kernel->post("haver", "pmsg", q{"}, $who, "You have
already joined.");
+ return;
+ }
+ $heap->{players}->{$who} = -1;
+ $kernel->post("haver", "msg", q{"}, $conf->{Channel}, "$who has
joined the game.");
+ } else {
+ $kernel->post("haver", "pmsg", q{"}, $who, "A game is already
running, wait until it's finished.");
+ }
+}
+
+sub cmd_snoop {
+# ?
+}
+sub cmd_hurry {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ if($heap->{state} == STATE_REGISTER) {
+ $kernel->yield('end_registration');
+ $kernel->delay('end_registration' => undef);
+ }
+ if($heap->{state} == STATE_MAIN) {
+ $kernel->yield('start_vote');
+ $kernel->delay('start_vote' => undef);
+ }
+}
+
+sub abort {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ $kernel->delay('start_vote' => undef);
+ $kernel->delay('end_registration' => undef);
+ $kernel->yield('reset');
+ _msg("Game aborted.");
+}
+
+sub start_vote {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ _msg("Pencils down, please. Discussion ends. If you think there's a
conspiracy, private message me with 'yes'. Otherwise, 'no'.");
+ _msg("This goes for you conspirators, too.");
+ _msg("That is, if there were any.");
+ _msg("Which there aren't.");
+ _msg("Maybe.");
+ $heap->{state} = STATE_VOTE;
+ $heap->{tally} = 0;
+}
+
+sub haver_pmsg {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my ($type, $who, $text) = @$args;
+ return unless $type eq q{"};
+ return unless $heap->{state} == STATE_VOTE;
+ return unless exists $heap->{players}->{$who};
+ if($heap->{players}->{$who} != -1) {
+ _pmsg($who, "You've already had your say.");
+ return;
+ }
+ $text = lc $text;
+ unless($text =~ /^\s*(y|yes|n|no)\s*$/){
+ _pmsg($who, "Please use 'yes' or 'no'");
+ return;
+ }
+ if($1 =~ /^y/) {
+ $heap->{players}->{$who} = 1;
+ } else {
+ $heap->{players}->{$who} = 0;
+ }
+ _pmsg($who, "Okay.");
+ $heap->{tally}++;
+ _dprint 3, "tally = $heap->{tally}, pcnt=", scalar keys
%{$heap->{players}};
+ if($heap->{tally} == scalar keys %{$heap->{players}}) {
+ $kernel->yield('finish_vote');
+ }
+}
+
+sub finish_vote {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ _msg("All responses received.");
+ _dprint 3, Dumper $heap;
+# if(grep { $_ eq 'innocent' } keys %$heap) {
+ if($heap->{innocent}) {
+ _msg("There was a conspiracy, and the innocent was
$heap->{innocent}.");
+ } else {
+ _msg("There was no conspiracy.");
+ }
+ my $fstr = "%-16s|%2s|%-4s";
+ my $header = sprintf $fstr, "UID", "R", "WIN";
+ my $sep = '-'x(length $header);
+ _msg($header);
+ _msg($sep);
+ my $iv = $heap->{innocent} && $heap->{players}->{$heap->{innocent}};
+ for(keys %{$heap->{players}}) {
+ my $win;
+ if(!$heap->{innocent}) {
+ $win = !$heap->{players}->{$_};
+ } else {
+ if($_ eq $heap->{innocent}) {
+ $win = $iv;
+ } else {
+ $win = !$iv;
+ }
+ }
+ my $line = sprintf $fstr, $_,
+ ($heap->{players}->{$_} ? 'Y' : 'N'),
+ ($win ? 'Y' : 'N');
+ _msg($line);
+ }
+ _msg($sep);
+ _msg('Thanks for playing!');
+ $kernel->yield('reset');
+}
+
+sub reset {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ %$heap = ( state => STATE_IDLE );
+}
+
Property changes on: trunk/perl/client/examples/cmod.pl
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/client/lib/Haver/Client/POE.pm
===================================================================
--- trunk/perl/client/lib/Haver/Client/POE.pm 2005-06-20 07:48:42 UTC (rev
778)
+++ trunk/perl/client/lib/Haver/Client/POE.pm 2005-06-20 07:48:44 UTC (rev
779)
@@ -0,0 +1,700 @@
+# vim: set ft=perl ts=4 sw=4:
+# Haver::Client::POE - POE component haver client.
+#
+# Copyright (C) 2004 Bryan Donlan, Dylan William Hardison.
+#
+# This module 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 2 of the License, or
+# (at your option) any later version.
+#
+# This module 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 module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# object fields:
+# self => {
+# [persistent data]
+# options => { key => value },
+# handlers => {
+# type => {
+# event name => {
+# reverse => {
+# stringified $subref => index
+# },
+# forward => [
+# $subref,
+# ...
+# ]
+# } # event name =>
+# } # type =>
+# }, # handlers =>
+# connection => {
+# [connection data]
+# UID => $uid,
+# authmethods => [ acceptable auth methods ],
+# state => STATE_NAME,
+# want => 'CURRENTLY_WANTED',
+# pending => [
+# ['WAITING', 'FOR', 'WANT'],
+# ],
+# POE => {
+# connwheel => POE::Wheel::ConnectionFactory,
+# sockwheel => POE::Wheel::ReadWrite
+# },
+# } # connection =>
+# }
+
+=head1 NAME
+
+Haver::Client::POE - POE Component for Haver clients.
+
+=head1 SYNOPSIS
+
+ use Haver::Client::POE;
+
+ my $conn = new Haver::Client::POE('haver');
+ $conn->register(connected => \&on_connect);
+ $conn->connect( Host => 'example.com',
+ Port => 7070,
+ UID => 'example');
+
+=head1 DESCRIPTION
+
+Haver::Client::POE is a POE component for writing Haver clients.
+Generally one will create a session with new(), register for all events with
+register(), and then send commands and receive events from the session.
+
+=head1 METHODS
+
+=cut
+
+package Haver::Client::POE;
+use strict;
+use warnings;
+
+use constant {
+ TRUE => 1,
+ FALSE => 0,
+ STATE_IDLE => 0, # not connected or connecting
+ STATE_CONNECT => 1, # establishing connection
+ STATE_AUTH => 2, # authenticating
+ STATE_READY => 3, # ready for user control
+ STATE_DISCON => 4, # disconnecting
+};
+
+use Carp;
+
+use POE qw(Wheel::ReadWrite
+ Wheel::SocketFactory);
+
+use POE::Filter::Haver;
+use Haver::Preprocessor;
+use Haver::Formats::Error;
+
+our $VERSION = 0.06;
+
+sub _call {
+ return POE::Kernel->call(POE::Kernel->get_active_session(), @_);
+}
+
+sub _dprint {
+ my ($level, @text) = @_;
+ return unless
POE::Kernel->get_active_session()->get_heap()->{object}{debug} >= $level;
+ print STDERR @text;
+}
+
+sub _dprintf {
+ my ($level, $fmt, @text) = @_;
+ return unless
POE::Kernel->get_active_session()->get_heap()->{object}{debug} >= $level;
+ printf STDERR $fmt, @text;
+}
+
+sub _object_states {
+ my ($self, $ehash) = @_;
+ $ehash = {qw{
+ _start _start
+ _default _default
+ }, %$ehash};
+ return $self->SUPER::_object_states($ehash);
+}
+
+### SETUP
+
+=head2 new([option => value ...])
+
+Creates a new Haver::Client::POE session, and optionally sets one or more
+options (see C<setoptions>)
+
+=cut
+
+sub new {
+ my ($class, %options) = @_;
+ $class = ref $class || $class;
+
+ my $self = {
+ options => {
+ version => "Haver::Client::POE/$VERSION",
+ },
+ handlers => {
+ },
+ };
+ bless $self, $class;
+ $self->_init_wants;
+ $self->_init_msgs;
+}
+
+sub _start {
+ die "STUB";
+}
+
+# Internal: _init_event_type($type)
+# Prepares to register events of type $type
+
+sub _init_event_type {
+ my $self = shift;
+ $self->{handlers}{shift} = {
+ hhash => {},
+ byname => {},
+ }
+}
+
+# Internal: _init_wants
+# Sets up default handlers for wants
+
+sub _init_wants {
+ my $self = shift;
+ my %wants = {
+ # TODO ...
+ };
+ $self->_init_event_type('wants');
+ for (my ($event, $handler) = each %wants) {
+ $self->register_handler($self, 'want', $event, $handler);
+ }
+ $self->register_handler($self, 'want', '_default',
+ sub {
+ my ($handled, $type, $evname, $args) = @_;
+ my $name = $args->[0];
+ $self->send_raw('CANT', $name);
+ $handled = 1;
+ }
+ );
+}
+
+# Internal: _init_smsg
+# Sets up default handlers for server messages
+
+sub _init_smsg {
+ my $self = shift;
+ my %smsgs = {
+ # TODO ...
+ };
+ $self->_init_event_type('smsg');
+ for (my ($event, $handler) = each %smsgs) {
+ $self->register_handler($self, 'smsg', $event, $handler);
+ }
+}
+
+
+
+=head2 setoptions(option => value [, ...])
+
+Sets one or more options to the given value. The following options are
available:
+
+=head3 debug => level
+
+Sets debugging to the given level. 0 will disable debugging.
+
+=head3 autorespond => [ ... ]
+
+Enables autoresponding to certain types of messages. Currently only PING? and
TIME? are supported.
+
+=head3 version => "foobar/0.1"
+
+Sets the string sent in response to S: WANT VERSION
+
+=cut
+
+sub setoptions {
+ die "STUB";
+}
+
+### SESSION MANAGEMENT
+
+=head2 connect(Host => $Z<>host, [Port => $Z<>port])
+
+Connects to the haver server. The Host option is mandatory, all others are
optional.
+If it is already connected, it will disconnect, then connect with the new
parameters.
+
+=cut
+
+sub connect {
+ die "STUB";
+}
+
+=head2 disconnect(Z<>)
+
+Disconnects from the Haver server. If not already connected, does nothing.
This event
+may not complete immediately.
+
+=cut
+
+sub disconnect {
+ die "STUB";
+}
+
+=head2 send_raw(@args)
+
+Sends the arguments specified to the haver server. No checking is performed,
though escaping may occur.
+
+=cut
+
+sub send_raw {
+ die "STUB";
+}
+
+=head2 send(@args)
+
+Sends the arguments specified to the Haver server. If authentication is not
+yet completed, it will be queued until authentication is completed.
+
+=cut
+
+sub send {
+ die "STUB"
+}
+
+### CLIENT EVENTS
+
+=head2 login(UID => $Z<>uid)
+
+Specifies the UID to use to log in. If authentication is already complete,
+this has no effect.
+
+=cut
+
+sub login {
+ die "STUB";
+}
+
+=head2 authenticate($Z<>method, @Z<>args)
+
+Authenticates to the server. $method must be an object of type
+Haver::Client::POE::Auth capable of handling an authentication
+type listed in the auth_request() message.
+
+=cut
+
+sub authenticate {
+ die "STUB";
+}
+
+=head2 join($Z<>channel)
+
+Attempts to join $channel
+
+=cut
+
+sub join {
+ die "STUB";
+}
+
+=head2 part($Z<>channel)
+
+Parts $Z<>channel
+
+=cut
+
+sub part {
+ die "STUB";
+}
+
+=head2 make($Z<>channel)
+
+Ask the server to create a channel $channel.
+
+=cut
+
+sub make {
+ die "STUB";
+}
+
+=head2 msg($Z<>channel, $Z<>type, $Z<>text)
+
+Sends a message with specified type and text to $channel.
+
+=cut
+
+sub msg {
+ die "STUB";
+}
+
+=head2 pmsg($Z<>uid, $Z<>type, $Z<>text)
+
+Sends a private message with specified type and text to $uid.
+
+=cut
+
+sub pmsg {
+ die "STUB";
+}
+
+=head2 users($Z<>channel)
+
+Ask the server which users are on $channel.
+
+=cut
+
+sub users {
+ die "STUB";
+}
+
+=head2 chans(Z<>)
+
+Ask the server for a list of all channels
+
+=cut
+
+sub chans {
+ die "STUB";
+}
+
+=head2 destroy(Z<>)
+
+Disconnects from the Haver server, and destroys the session. This event may
not complete
+immediately, so you should not attempt to create another session with the same
alias
+until it finishes.
+
+=cut
+
+sub destroy {
+ die "STUB";
+}
+
+sub _default {
+ my ( $kernel, $state, $event, $args, $self ) = @_[ KERNEL, STATE, ARG0,
ARG1, OBJECT ];
+ $args ||= []; # Prevents uninitialized-value warnings.
+ # DEBUG: "default: $state = $event. Args:\n", Dumper $args;
+ return 0;
+}
+
+=head1 HANDLERS
+
+Handlers are subroutines called to handle some event from the server. Any
+number of handlers may be registered to an event, and they will be called
+in reverse order of registration until one indicates that it has handled the
+event.
+
+The handler prototype is as follows:
+
+ sub handler {
+ my ($handled, $type, $name, $args) = @_;
+ # ...
+ $handled = 1; # To handle the event
+ }
+
+$type is the type of event, $name is the event name, and $args is an array ref
+of arguments for the event.
+
+If $$handled is 0 when the handler returns, the next handler in the chain will
+be called. Any changes to the contents of $args will be passed on.
+
+If no handler in a chain handles the event, an event with the same type and
+a name of '_default' will be generated, with the old event name prepended
+to @args. If no handler in the _default chain handles the event, it will be
+discarded.
+
+=head2 METHODS FOR HANDLER MANIPULATION
+
+=head3 register_handler($Z<>type, $Z<>event, $Z<>handler)
+
+Register a handler $handler for an event of type $type, name $event. If such
+a handler already exists, does nothing.
+
+=cut
+
+sub register_handler {
+ my ($self, $type, $event, $handler) = @_;
+ my $htype = $self->{handlers}{$type}
+ or croak "Unknown event type $type";
+ my $hevent = $htype->{$event};
+ if (!$hevent) {
+ $hevent = $htype->{$event} = {
+ forward => {},
+ reverse => {},
+ };
+ }
+ return if (exists $hevent->{reverse}{$handler});
+ my $index = @{$hevent->{forward}};
+ push @{$hevent->{forward}}, $handler;
+ $hevent->{reverse}{$handler} = $index;
+}
+
+=head3 unregister_handler($Z<>type, $Z<>event, $Z<>handler)
+
+Unregisters a handler previously registered by passing the same arguments
+to register_handler. If such a handler does not exist, does nothing.
+
+=cut
+
+sub unregister_handler {
+ my ($self, $type, $event, $handler) = @_;
+ my $htype = $self->{handlers}{$type}
+ or croak "Unknown event type $type";
+ my $hevent = $self->{handlers}{$type}{$event} or return;
+ my $index = $hevent->{reverse}{$handler} or return;
+ # Remove the item
+ splice @{$hevent->{forward}}, $index, 1;
+ # and renumber the ones afterward
+ my $len = @{$hevent->{forward}};
+ for (; $index < $len; $index++) {
+ my $handler = $hevent->{forward}[$index];
+ $hevent->{reverse}{$handler} = $index;
+ }
+ # and delete the reverse mapping
+ delete $hevent->{reverse}{$handler};
+}
+
+# Internal: _event_dispatch($type, $event, @args)
+# dispatches event $event
+
+sub _event_dispatch {
+ my ($self, $type, $event, @args) = @_;
+ my $etype = $self->{handlers}{$type}
+ or croak "Unknown event type $etype";
+ my $ev = $etype->{$event};
+ if (!$ev) {
+ if ($event eq '_default') {
+ return; # Nobody seems to be interested.
+ }
+ $self->_event_dispatch($type, '_default', $event, @args);
+ }
+ for my $handler (@{$ev->{forward}}) {
+ my $handled = 0;
+ $handler->(\$handled, $type, $event, [EMAIL PROTECTED]);
+ return if $handled;
+ }
+ if ($event ne '_default') {
+ $self->_event_dispatch($type, '_default', $event, @args);
+ }
+}
+
+
+
+1;
+__END__
+
+=head2 TYPES OF HANDLERS
+
+=head3 want
+
+Handlers of type 'want' are invoked when the server sends a S: WANT message.
The
+first argument of the S: WANT is the event name, the rest are used as
+arguments for the first handler.
+
+The default action, should all handlers pass the event, is to send a
+C: CANT $event to the server.
+
+=head3 smsg
+
+Handlers of type 'smsg' are invoked whenever a command is received from the
server.
+The command name is used for the event name, and the arguments are passed for
+the first handler's @args.
+
+Note that adding a handler with $type of smsg, and $event of 'WANT' may
+prevent handlers of $type want from being called.
+
+=head1 EVENTS
+
+Events are sent to inform multiple handlers of some happening on the server.
+Any number of event callbacks may be registered to an event, and they will all
+be invoked in an undefined order when the event is dispatched.
+
+=cut
+
+# implementation notes:
+# events are implemented with handlers, with type 'event'
+# register and unregister create an anonymous wrapper closure to hide the
+# details. These subs are stored in %{$self->{evwrap}}
+# TODO: expire evwrap entries
+
+=head2 EVENT MANIPULATION FUNCTIONS
+
+=head3 register(event => handler)
+
+Registers to receive a specified event with the specified handler function.
+The special event 'all' may be used to receive all events.
+
+=cut
+
+sub register {
+ my ($self, @events) = @_;
+ while (@events) {
+ my ($ev, $handler) = splice @events, 0, 2;
+ my $wrap = $self->{evwrap}{$handler} || sub {
+ my ($handled, $type, $name, $args) = @_[1..3];
+ if ($type ne 'event') {
+ die "Impossible: event handler on non-event
type!";
+ }
+ $handler->($name, @$args);
+ };
+ $self->{evwrap}{$handler} = $wrap;
+ $self->register_handler('event', $ev, $wrap);
+ }
+}
+
+=head3 unregister(event => handler)
+
+Unregisters the given handler for the specified event.
+
+=cut
+
+sub unregister {
+ my ($self, @events) = @_;
+ while (@events) {
+ my ($ev, $handler) = splice @events, 0, 2;
+ my $wrap = $self->{evwrap}{$handler} or next;
+ $self->unregister_handler('event', $ev, $wrap);
+ }
+}
+
+
+=head2 TYPES OF EVENTS
+
+Client events have the following prototype:
+
+ sub event {
+ my ($type, $event, @args) = @_;
+ # ...
+ }
+
+The contents of @args vary depending on the event name, and are documented
+below.
+
+=head4 connected(Z<>)
+
+This event is sent when a connection is established (but before it is logged
in)
+
+=head4 connect_fail($Z<>enum, $Z<>estr)
+
+The connection could not be established. An error code is in $enum, and the
human-readable
+version is in $estr
+
+=head4 disconnected($Z<>enum, $Z<>estr)
+
+The connection has been lost. If the server closed the connection, $enum will
be 0 and $estr will
+be meaningless. If the user closed the connection, and the server failed to
respond, $enum will be -1.
+Otherwise, $enum will contain an error code, and $estr the human-readable
version.
+
+=head4 raw_in(@data)
+
+The client has received @data from the Haver server. Mostly useful for
debugging.
+
+=head4 raw_out(@data)
+
+The client has sent @data to the Haver server. Mostly useful for debugging.
+
+=head4 login_request(Z<>)
+
+The server is asking for a UID, and one was not provided in connect().
+The authentication will not proceed until login() is invoked with the UID.
+
+=head4 auth_request(@Z<>methods)
+
+The server requests authentication using one of the listed methods. The
+authentication will not proceed until authenticate() is invoked with a
+suitable authentication handler.
+
+=head4 login(Z<>)
+
+The client has successfully logged in.
+
+=head4 close($Z<>etyp, $Z<>estr)
+Z<XXX: Describe args>
+
+Server is closing connection, and sent $etyp and $estr
+
+=head4 join(Z<>)
+
+$uid has joined $cid
+
+=head4 joined(Z<>)
+
+The client has joined $cid.
+
+=head4 part(Z<>)
+
+$uid has left $cid.
+
+=head4 parted(Z<>)
+
+The client has left $Z<>cid.
+
+=head4 msg($Z<>type, @Z<>msg)
+
+A public message with type $type and contents @msg was sent on channel $cid by
user $uid.
+
+=head4 pmsg($Z<>type, @Z<>text)
+
+A private message with type $type and contents @msg was sent to you by user
$uid.
+
+=head4 users(@Z<>who)
+
+Channel $cid has the users listed in @who in it. Sent in response to message
users().
+
+=head4 bye($Z<>why)
+
+The server is disconnecting you due to the reason in $why
+
+=head4 chans(@Z<>channels)
+
+The server has the channels listed in @channels. Sent in response to message
chans()
+
+=head4 warn($Z<>err, $Z<>short, $Z<>long, @Z<>args)
+
+The server has sent a non-fatal error message with code $err and arguments
@args. $short and $long have the
+short and long human-readable forms, respectively.
+
+=head4 die($Z<>err, $Z<>short, $Z<>long, @Z<>args)
+
+The server has sent a fatal error message with code $err and arguments @args.
$short and $long have the
+short and long human-readable forms, respectively. The connection will be
closed shortly.
+
+=head4 quit($Z<>why)
+
+UID $uid has disconnected due to the reason in $why.
+
+=head1 SEE ALSO
+
+L<http://wiki.chani3.com/wiki/ProjectHaver/>
+
+=head1 AUTHOR
+
+Bryan Donlan, E<lt>[EMAIL PROTECTED]<gt> and
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2004 by Bryan Donlan, Dylan William Hardison
+
+This library 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 2 of the License, or
+(at your option) any later version.
+
+This library 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+=cut
Property changes on: trunk/perl/client/lib/Haver/Client/POE.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/client/lib/Haver/Client.pm
===================================================================
--- trunk/perl/client/lib/Haver/Client.pm 2005-06-20 07:48:42 UTC (rev
778)
+++ trunk/perl/client/lib/Haver/Client.pm 2005-06-20 07:48:44 UTC (rev
779)
@@ -0,0 +1,68 @@
+# Haver::Client - POE Component for Haver clients.
+#
+# Copyright (C) 2004 Bryan Donlan, Dylan William Hardison.
+#
+# This module 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 2 of the License, or
+# (at your option) any later version.
+#
+# This module 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 module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package Haver::Client;
+use strict;
+use warnings;
+
+our $VERSION = 0.06;
+
+
+1;
+__END__
+
+=head1 NAME
+
+Haver::Client - Namespace for client stuff.
+
+=head1 SYNOPSIS
+
+ use Haver::Client;
+
+=head1 DESCRIPTION
+
+This module is nought but a place holder.
+
+=head1 SEE ALSO
+
+L<http://wiki.chani3.com/wiki/ProjectHaver/>
+
+=head1 AUTHOR
+
+Bryan Donlan, E<lt>[EMAIL PROTECTED]<gt> and
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2004 by Bryan Donlan, Dylan William Hardison
+
+This library 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 2 of the License, or
+(at your option) any later version.
+
+This library 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+=cut
Property changes on: trunk/perl/client/lib/Haver/Client.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/client/t/basic.t
===================================================================
--- trunk/perl/client/t/basic.t 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/client/t/basic.t 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,19 @@
+# vim: set syn=perl:
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Haver-Client.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 2;
+BEGIN {
+ use_ok('Haver::Client');
+ use_ok('Haver::Client::Commands');
+};
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
Property changes on: trunk/perl/client/t/basic.t
___________________________________________________________________
Name: svn:eol-style
+ native
Property changes on: trunk/perl/core
___________________________________________________________________
Name: svn:ignore
+ _build
Build
Makefile.PL
MANIFEST
META.yml
*.bak
*~
Added: trunk/perl/core/Build.PL
===================================================================
--- trunk/perl/core/Build.PL 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/Build.PL 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+use Module::Build;
+my $build = Module::Build->new(
+ module_name => 'Haver::Core',
+ dist_version_from => 'lib/Haver/Base.pm',
+ dist_author => 'Dylan William Hardison <[EMAIL PROTECTED]>',
+ license => 'gpl',
+ requires => {
+ 'perl' => '5.6.1',
+ YAML => '0.35',
+ 'Filter::Simple' => 0,
+ },
+ recommends => {
+ 'Haver::Server' => 0.06,
+ 'Haver::Client' => 0.06,
+ 'POE' => 0.28,
+ },
+ create_makefile_pl => 'passthrough',
+);
+
+
+$build->create_build_script;
Property changes on: trunk/perl/core/Build.PL
___________________________________________________________________
Name: svn:executable
+
Name: svn:eol-style
+ native
Added: trunk/perl/core/COPYING
===================================================================
--- trunk/perl/core/COPYING 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/COPYING 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,326 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your freedom to
+share and change it. By contrast, the GNU 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. This General Public License applies to
+most of the Free Software Foundation's software and to any other program whose
+authors commit to using it. (Some other Free Software Foundation software is
+covered by the GNU Library General Public License instead.) You can apply it
+to your programs, too.
+
+ When we speak of free software, we are referring to freedom, not price. Our
+General Public Licenses are designed to make sure that you have the freedom to
+distribute copies of free software (and charge for this service if you wish),
+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 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 show them these terms so they know 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.
+
+ Finally, any free program is threatened constantly by software patents. We
+wish to avoid the danger that redistributors of a free program will
+individually obtain patent licenses, in effect making the program proprietary.
+To prevent this, we have made it clear that any patent must be licensed for
+everyone's free use or not licensed at all.
+
+ 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 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
+derivative work under copyright law: that is to say, a work containing the
+Program or a portion of it, either verbatim or with modifications and/or
+translated into another language. (Hereinafter, translation is included
+without limitation in the term "modification".) Each licensee is addressed as
+"you".
+
+Activities other than copying, distribution and modification are not covered
+by this License; they are outside its scope. The act of running the Program
+is not restricted, and the output from the Program is covered only if its
+contents constitute a work based on the Program (independent of having been
+made by running the Program). Whether that is true depends on what the
+Program does.
+
+ 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 License
+and to the absence of any warranty; and give any other recipients of the
+Program a copy of this License along with the Program.
+
+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.
+
+ 2. You may modify your copy or copies of the Program or any portion of it,
+thus forming a work based on the Program, and copy and distribute such
+modifications or work under the terms of Section 1 above, provided that you
+also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary 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
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If identifiable
+sections of that work are not derived from the Program, and can be reasonably
+considered independent and separate works in themselves, then this License,
+and its terms, do not apply to those sections when you distribute them as
+separate works. But when you distribute the same sections as part of a whole
+which is a work based on the Program, the distribution of the whole must be on
+the terms of this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest your
+rights to work written entirely by you; rather, the intent is to exercise the
+right to control the distribution of derivative or collective works based on
+the Program.
+
+In addition, mere aggregation of another work not based on the Program with
+the Program (or with a work based on the Program) on a volume of a storage or
+distribution medium does not bring the other work under the scope of this
+License.
+
+ 3. You may copy and distribute the Program (or a work based on it, under
+Section 2) in object code or executable form under the terms of Sections 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 Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for making
+modifications to it. For an executable work, complete source code means all
+the source code for all modules it contains, plus any associated interface
+definition files, plus the scripts used to control compilation and
+installation of the executable. However, as a special exception, the source
+code distributed need not include anything that is normally distributed (in
+either source or binary form) with the major components (compiler, kernel, and
+so on) of the operating system on which the executable runs, unless that
+component itself accompanies the executable.
+
+If distribution of executable or object code is made by offering access to
+copy from a designated place, then offering equivalent access to copy the
+source code from the same place counts as distribution of the source code,
+even though third parties are not compelled to copy the source along with the
+object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program except as
+expressly provided under this License. Any attempt otherwise to copy, modify,
+sublicense or distribute the Program is void, and will automatically terminate
+your rights under this License. However, parties who have received copies, or
+rights, from you under this License will not have their licenses terminated so
+long as such parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not signed
+it. However, nothing else grants you permission to modify or distribute the
+Program or its derivative works. These actions are prohibited by law if you
+do not accept this License. Therefore, by modifying or distributing 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 for copying,
+distributing or modifying the Program or works based on it.
+
+ 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. You are not responsible for enforcing
+compliance by third parties to this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or otherwise)
+that contradict the conditions of this License, they do not excuse you from
+the conditions of this License. If you cannot distribute so as to satisfy
+simultaneously your obligations under this License and any other pertinent
+obligations, then as a consequence you may not distribute the Program at all.
+For example, if a patent license would not permit royalty-free redistribution
+of the Program by all those who receive copies directly or indirectly through
+you, then the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply and
+the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any patents or
+other property right claims or to contest validity of any such claims; this
+section has the sole purpose of protecting the integrity of the free software
+distribution system, which is implemented by public license practices. Many
+people have made generous contributions to the wide range of software
+distributed through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing to
+distribute software through any other system and a licensee cannot impose that
+choice.
+
+This section is intended to make thoroughly clear what is believed to be a
+consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in certain
+countries either by patents or by copyrighted interfaces, the original
+copyright holder who places the Program under this License may add an explicit
+geographical distribution limitation excluding those countries, so that
+distribution is permitted only in or among countries not thus excluded. In
+such case, this License incorporates the limitation as if written in the body
+of this License.
+
+ 9. 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 this 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 this License,
+you may choose any version ever published by the Free Software Foundation.
+
+ 10. 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
+
+ 11. 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.
+
+ 12. 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
+
+ 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 the public, 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ 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 2 of the License, 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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) 19yy 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 is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General Public
+License instead of this License.
Property changes on: trunk/perl/core/COPYING
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/core/MANIFEST.SKIP
===================================================================
--- trunk/perl/core/MANIFEST.SKIP 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/MANIFEST.SKIP 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,9 @@
+\.old$
+\.bak
+store
+blib
+_build
+^Build$
+^\.#
+\.svn
+\.tar\.gz$
Property changes on: trunk/perl/core/MANIFEST.SKIP
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/core/README
===================================================================
--- trunk/perl/core/README 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/README 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,38 @@
+Haver version 0.06 ('Lamp')
+==================
+
+This is a collection of modules
+used by both haver servers and haver clients.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Build.PL
+ perl Build
+ perl Build test
+ perl Build install
+
+
+
+DEPENDENCIES
+
+YAML
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2004 by Dylan William Hardison
+
+This library 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 2 of the License, or
+(at your option) any later version.
+
+This library 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Property changes on: trunk/perl/core/README
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/core/lib/Haver/Base.pm
===================================================================
--- trunk/perl/core/lib/Haver/Base.pm 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/lib/Haver/Base.pm 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,54 @@
+# vim: set ts=4 sw=4 si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Base;
+use Spiffy qw( -Base );
+use Carp;
+use constant DEBUG => 1;
+
+our @EXPORT_BASE = qw( DEBUG field croak carp confess );
+
+field 'factory';
+
+
+BEGIN {
+no warnings;
+sub field(@) {
+ use warnings;
+ my $package = caller;
+
+ if (DEBUG) {
+ my ($args, @values) = do {
+ no warnings;
+ local *boolean_arguments = sub { (qw( -weak -force )) };
+ local *paired_arguments = sub { (qw( -package -init )) };
+ Haver::Base->parse_arguments(@_);
+ };
+ my ($field, $default) = @values;
+ if (my $sub = $package->can($field) and not $args->{'-force'}) {
+ require B;
+ my $p = B::svref_2object($sub)->START->stashpv;
+ if ($p ne $package) {
+ croak "Warning: redefining field $field in $package (Previously
defined in $p)\n\t";
+ }
+ }
+ }
+ Spiffy::field (-package => $package, @_);}
+}
+
+sub new() {
+ my $this = shift;
+ my $self = super;
+
+ $self->initialize;
+
+ return $self;
+}
+
+sub DESTROY {
+ $self->finalize;
+}
+
+sub initialize { }
+sub finalize { }
+
+
Added: trunk/perl/core/lib/Haver/Config.pm
===================================================================
--- trunk/perl/core/lib/Haver/Config.pm 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/lib/Haver/Config.pm 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,183 @@
+# vim: set ts=4 sw=4 expandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Config;
+use strict;
+use warnings;
+use Haver::Base -base;
+use Scalar::Util 'reftype';
+
+use YAML ();
+our $VERSION = 0.10;
+
+field 'file';
+field 'config' => {};
+field 'default' => {};
+
+
+sub initialize {
+ my $self = shift;
+ my $file = $self->{file};
+ my $config = -e $file ? YAML::LoadFile($file) : {};
+ $self->{config} = merge_hash($config, $self->{default} || {});
+}
+
+
+sub load() {
+ my ($this, $file, $def) = @_;
+ my $self = $this->new(
+ file => $file,
+ default => $def,
+ );
+
+ return $self;
+}
+
+sub save {
+ my $self = shift;
+ YAML::DumpFile($self->{file}, $self->{config});
+}
+
+# Author: bdonlan
+sub merge_struct ($$) {
+ # ASSERT: @_ == 2;
+ my ($left, $right) = @_;
+ my $func = "merge_struct(\$left,\$right):";
+
+ unless (ref $left and ref $right) {
+ return $left;
+ }
+
+ if (reftype $left ne reftype $right) {
+ croak "$func \$left and \$right are not the same!";
+ }
+ if (reftype $left eq 'HASH') {
+ goto &merge_hash;
+ } elsif (reftype $left eq 'ARRAY') {
+ goto &merge_array;
+ } else {
+ croak "$func Can not merge a(n) ", reftype $left, " reference!";
+ }
+}
+
+# Author: bdonlan
+sub merge_hash ($$) {
+ croak 'merge_hash($a,$b): $a and $b must be hashes!'
+ unless reftype($_[0]) eq 'HASH' and reftype($_[1]) eq 'HASH';
+ my ($left, $right) = @_;
+ my %merged = %$left;
+ for (keys %$right) {
+ if (exists $merged{$_}) {
+ $merged{$_} = merge_struct($merged{$_}, $right->{$_});
+ } else {
+ $merged{$_} = $right->{$_};
+ }
+ }
+ return \%merged;
+}
+
+# Author: bdonlan
+sub merge_array ($$) {
+ croak 'merge_array($a, $b): $a and $b must be arrays!'
+ unless reftype($_[0]) eq 'ARRAY' and reftype($_[1]) eq 'ARRAY';
+ my ($left, $right) = @_;
+ return [EMAIL PROTECTED], @$right];
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Haver::Config - Configuration Manager.
+
+=head1 SYNOPSIS
+
+ use Haver::Config;
+ my $ch = new Haver::Config(
+ file => "$ENV{HOME}/.myconfigfile",
+ default => {
+ name => $ENV{USER},
+ stuff => [1,2,3],
+ },
+ );
+ my $config = $ch->config;
+ $config->{name} eq $ENV{USER}; # true.
+ $ch->save;
+
+=head1 DESCRIPTION
+
+This is a simple class to allow the loading and saving of config
+files written in L<YAML> format.
+
+In the future it might provide a way of finding config files in a
cross-platform way
+or even storing the config data in the Registry on Win32 platforms.
+
+=head1 INHERITENCE
+
+Haver::Config extends L<Haver::Base>.
+
+=head1 PARAMETERS
+
+The constructor new() takes the following parameters:
+
+=head2 -file
+
+The name of the config file to use.
+
+=head2 -default
+
+A hash to merge the config file with. This specifies the default values
+for the application.
+
+=head1 METHODS
+
+This class implements the following methods:
+
+=head2 load($file)
+
+This loads the file $file. Note that:
+
+ my $ch = new Haver::Config;
+ $ch->load('foo')
+
+is equivelent to:
+
+ my $ch = new Haver::Config(-file => 'foo');
+
+=head2 save($file)
+
+Save the config hash to $file. If $file is undefined,
+it defaults to the file that the config was loaded from most recently.
+If a file has never been loaded, it will croak.
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 SEE ALSO
+
+L<http://www.haverdev.org/>.
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+
+This module 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 2 of the License, or
+(at your option) any later version.
+
+This module 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Added: trunk/perl/core/lib/Haver/Logger.pm
===================================================================
--- trunk/perl/core/lib/Haver/Logger.pm 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/lib/Haver/Logger.pm 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,26 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Logger;
+use strict;
+use warnings;
+use Carp;
+use Exporter;
+use base 'Exporter';
+
+our $VERSION = 0.02;
+our @EXPORT_OK = qw( Log );
+
+sub Log (@) {
+ if (@_ == 1) {
+ #$POE::Kernel::poe_kernel->post('Logger', 'debug', @_);
+ print "[debug] ", @_, "\n";
+ } elsif (@_ > 1) {
+ #$POE::Kernel::poe_kernel->post('Logger', @_);
+ my $s = shift;
+ print "[$s] ", @_, "\n";
+ } else {
+ croak 'Log() must be called with >= 1 arguments';
+ }
+}
+
+1;
Added: trunk/perl/core/lib/Haver/Protocol/Filter.pm
===================================================================
--- trunk/perl/core/lib/Haver/Protocol/Filter.pm 2005-06-20 07:48:42 UTC
(rev 778)
+++ trunk/perl/core/lib/Haver/Protocol/Filter.pm 2005-06-20 07:48:44 UTC
(rev 779)
@@ -0,0 +1,159 @@
+# vim: set ft=perl ts=4 sw=4 sta si ai tw=100 expandtab:
+# Haver::Protocol::Filter
+# This is a POE filter for the Haver protocol.
+# It subclasses POE::Filter::Line.
+#
+# Copyright (C) 2003-2004 Bryan Donlan
+# Modifications and docs Copyright (C) 2004 Dylan William Hardison
+#
+# This module 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 2 of the License, or
+# (at your option) any later version.
+#
+# This module 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 module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package Haver::Protocol::Filter;
+use warnings;
+use strict;
+use POE;
+use base qw(POE::Filter::Line);
+use Haver::Protocol qw( $CRLF %Escape %Unescape );
+
+our $VERSION = "0.02";
+
+sub new {
+ my ($this) = @_;
+
+ return $this->SUPER::new(
+ OutputLiteral => $CRLF,
+ InputRegexp => qr/\r?\n/,
+ );
+}
+
+# This is not needed any more, so let's not use it.
+#sub get {
+# my ( $self, $arg) = @_;
+# my $lines = $self->SUPER::get($arg);
+#
+# foreach my $line (@{$lines}) {
+# my @f = split("\t", $line);
+#
+# foreach my $item (@f) {
+# $item =~ s/\e([rent])/$Unescape{$1}/g;
+# }
+# $line = [EMAIL PROTECTED];
+# }
+# return $lines;
+#}
+
+sub get_one {
+ my ($self) = @_;
+ my $lines = $self->SUPER::get_one;
+
+ foreach my $line (@{$lines}) {
+ my @f = split("\t", $line);
+
+ foreach my $item (@f) {
+ $item =~ s/\e([rent])/$Unescape{$1}/g;
+ }
+ $line = [EMAIL PROTECTED];
+ }
+ return $lines;
+}
+
+sub put {
+ my ( $self, $arg ) = @_;
+ my @ret;
+ foreach my $msg (@{$arg}) {
+ my @msg;
+ foreach my $item (@$msg) {
+ my $s = $item;
+ if (defined $s) {
+ $s =~ s/([\r\e\n\t])/\e$Escape{$1}/g;
+ } else {
+ $s = '';
+ }
+ push(@msg, $s);
+ }
+ push(@ret, join "\t", @msg);
+ }
+ return $self->SUPER::put([EMAIL PROTECTED]);
+}
+
+1;
+
+
+1;
+__END__
+
+=head1 NAME
+
+Haver::Protocol::Filter - POE::Filter for the Haver protocol.
+
+=head1 SYNOPSIS
+
+ use Haver::Protocol::Filter;
+ my $filter = new Haver::Protocol::Filter; # takes no arguments.
+
+ # See POE::Filter. This is just a standard filter.
+ # it inherits from POE::Filter::Line.
+
+=head1 DESCRIPTION
+
+This POE::Filter translates strings like "MSG\tdylan\tbunnies\xD\xA"
+to and from arrays like ['MSG', 'dylan', 'bunnies'].
+
+=head1 SEE ALSO
+
+L<POE::Filter>, L<POE::Filter::Line>.
+
+L<https://savannah.nongnu.org/projects/haver/>,
L<http://wiki.chani3.com/wiki/ProjectHaver/Protocol>,
+L<http://wiki.chani3.com/wiki/ProjectHaver/ProtocolSyntax>.
+
+=head1 AUTHOR
+
+Bryan Donlan, E<lt>:[EMAIL PROTECTED]<gt>
+with small modifications and documentation by
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2003-2004 by Bryan Donlan.
+Modifications and docs Copyright (C) 2004 Dylan William Hardison.
+
+This library 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 2 of the License, or
+(at your option) any later version.
+
+This library 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+=cut
+
+
+sub new {
+ my ($this) = @_;
+ my $me = bless {}, ref($this) || $this;
+
+ # ...
+
+ return $me;
+}
+
+
+1;
+
Added: trunk/perl/core/lib/Haver/Protocol.pm
===================================================================
--- trunk/perl/core/lib/Haver/Protocol.pm 2005-06-20 07:48:42 UTC (rev
778)
+++ trunk/perl/core/lib/Haver/Protocol.pm 2005-06-20 07:48:44 UTC (rev
779)
@@ -0,0 +1,146 @@
+# Haver::Protocol, Right now this
+# just loads Haver::Protocol::* modules.
+#
+# Copyright (C) 2003 Dylan William Hardison
+#
+# This module 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 2 of the License, or
+# (at your option) any later version.
+#
+# This module 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 module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package Haver::Protocol;
+use strict;
+use warnings;
+
+use Exporter;
+use base 'Exporter';
+
+BEGIN {
+ our @EXPORT = ();
+ our @EXPORT_OK = qw(
+ escape unescape
+ event2line line2event
+ $CRLF $CR $LF
+ %Escape
+ %Unescape
+ );
+ our %EXPORT_TAGS = (
+ all => [EMAIL PROTECTED],
+ escape => [qw( escape unescape )],
+ event => [qw( event2line line2event )],
+ crlf => [qw( $CR $LF $CRLF )],
+ );
+}
+
+our $VERSION = "0.03";
+our $CRLF = "\x0D\x0A";
+our $CR = "\x0D";
+our $LF = "\x0A";
+our %Escape = (
+ $CR => 'r',
+ $LF => 'n',
+ "\e" => 'e',
+ "\t" => 't',
+);
+our %Unescape = reverse %Escape;
+
+my $Chars = join('', keys %Escape);
+my $Codes = join('', keys %Unescape);
+
+sub escape {
+ my ($s) = @_;
+ $s =~ s/([$Chars])/\e$Escape{$1}/g;
+ return $s;
+}
+
+sub unescape {
+ my ($s) = @_;
+ $s =~ s/\e([$Codes])/$Unescape{$1}/g;
+ return $s;
+}
+
+sub line2event {
+ my ($line) = @_;
+ $line =~ s/$CRLF$//g;
+ my @e = split("\t", $line);
+ foreach (@e) {
+ $_ = unescape($_);
+ }
+
+ return wantarray ? @e : [EMAIL PROTECTED];
+}
+
+sub event2line {
+ my @event;
+ if (@_ > 1 or not ref $_[0]) {
+ @event = @_;
+ } else {
+ @event = @{$_[0]};
+ }
+ foreach (@event) {
+ $_ = escape($_);
+ }
+ join("\t", @event) . $CRLF;
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+Haver::Protocol - Routines for parsing the haver protocol.
+
+=head1 SYNOPSIS
+
+ use Haver::Protocol;
+
+=head1 DESCRIPTION
+
+Currently this just loads Haver::Protocol::Filter. In the future,
+when/if there are more protocol-related modules, it'll load them too.
+
+=head2 EXPORT
+
+Nothing to export.
+
+Can export escape(), unescape(),
+event2line(), line2event(), $CRLF, $CR, $LF, %Escape, %Unescape.
+
+=head1 SEE ALSO
+
+L<POE::Filter::Haver>
+
+L<https://gna.org/projects/haver/>
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2004 by Dylan William Hardison
+
+This library 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 2 of the License, or
+(at your option) any later version.
+
+This library 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+=cut
Property changes on: trunk/perl/core/lib/Haver/Protocol.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/core/lib/Haver/Session.pm
===================================================================
--- trunk/perl/core/lib/Haver/Session.pm 2005-06-20 07:48:42 UTC (rev
778)
+++ trunk/perl/core/lib/Haver/Session.pm 2005-06-20 07:48:44 UTC (rev
779)
@@ -0,0 +1,44 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Session;
+use strict;
+use warnings;
+
+use Haver::Base -base;
+use Haver::Logger 'Log';
+use POE::Session;
+
+our $VERSION = 0.08;
+our @EXPORT_BASE = qw(
+ SESSION OBJECT
+ KERNEL HEAP STATE
+ SENDER CALLER_FILE
+ CALLER_LINE ARG0
+ ARG1 ARG2 ARG3
+ ARG4 ARG5 ARG6
+ ARG7 ARG8 ARG9
+ Log
+);
+
+
+sub import (@) {
+ if (grep /^-(Base|selfless)$/, @_) {
+ croak "Haver::Base::Session subclasses may not use -Base or
-selfless!";
+ }
+ my $package = caller();
+ shift->SUPER::import(-package => $package, @_);
+}
+
+sub create () {
+ my $this = shift;
+ my $what = ref $this ? 'object' : 'package';
+
+ create POE::Session (
+ "${what}_states" => [
+ $this => $this->states,
+ ],
+ args => [ { @_ } ],
+ )
+}
+
+1;
Added: trunk/perl/core/lib/Haver/Util.pm
===================================================================
--- trunk/perl/core/lib/Haver/Util.pm 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/lib/Haver/Util.pm 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,88 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Util;
+use strict;
+use warnings;
+
+use base 'Exporter';
+
+our $VERSION = 0.02;
+our @EXPORT = ();
+our @EXPORT_OK = qw( is_valid_name is_reserved_name );
+our %EXPORT_TAGS = (
+ name => [qw( is_valid_name is_reserved_name )],
+);
+
+our $NamePattern = qr/^&?[a-z][a-z0-9_.'@-]+$/i;
+
+sub is_valid_name {
+ my $name = shift;
+ $name =~ $NamePattern;
+}
+
+sub is_reserved_name {
+ my $name = shift;
+ $name =~ /^&/ or $name =~ /@/;
+}
+
+
+1;
+__END__
+=head1 NAME
+
+Haver::Util - description
+
+=head1 SYNOPSIS
+
+ use Haver::Util;
+ # Small code example.
+
+=head1 DESCRIPTION
+
+FIXME
+
+=head1 EXPORTS
+
+This module optionally exports the following functions.
+
+=head2 is_valid_name($name)
+
+Returns true if $name is considered a valid haver name, false otherwise.
+
+=head2 is_reserved_name($name)
+
+Returns true if $name is only available for services and other privledged
entities.
+
+=head1 EXPORT GROUPS
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 SEE ALSO
+
+L<http://www.haverdev.org/>.
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+
+This module 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 2 of the License, or
+(at your option) any later version.
+
+This module 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Added: trunk/perl/core/lib/Haver/Wheel/Loader.pm
===================================================================
--- trunk/perl/core/lib/Haver/Wheel/Loader.pm 2005-06-20 07:48:42 UTC (rev
778)
+++ trunk/perl/core/lib/Haver/Wheel/Loader.pm 2005-06-20 07:48:44 UTC (rev
779)
@@ -0,0 +1,145 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Wheel::Loader;
+use strict;
+use warnings;
+use Carp;
+
+our $VERSION = '0.04';
+
+sub new {
+ my $class = shift;
+ my $self = {
+ wheels => {},
+ };
+ bless $self, $class;
+}
+
+sub load_wheel {
+ my ($self, $class, @args) = @_;
+
+ if (exists $self->{wheels}{$class}) {
+ croak "Plugin $class already loaded!";
+ }
+
+ my $object = $class->new(@args);
+ $object->load;
+ $self->{wheels}{$class} = $object;
+}
+
+sub unload_wheel {
+ my ($self, $class) = @_;
+ my $object = delete $self->{wheels}{$class};
+ $object->unload;
+}
+
+sub wheels {
+ my $self = shift;
+ keys %{ $self->{wheels} };
+}
+
+sub unload_all_wheels {
+ my ($self) = @_;
+ map { $self->unload($_) } $self->wheels
+}
+
+sub fetch_wheel {
+ my ($self, $class) = @_;
+
+ if (exists $self->{wheels}{$class}) {
+ $self->{wheels}{$class};
+ } else {
+ undef;
+ }
+}
+
+
+1;
+__END__
+=head1 NAME
+
+Haver::Wheel::Loader - description
+
+=head1 SYNOPSIS
+
+ use Haver::Wheel::Loader;
+ use MyPlugin;
+
+ # ... In some POE state ...
+ my $loader = Haver::Wheel::Loader;
+ $loader->load_wheel('MyPlugin', 'some', 'args');
+ $_[HEAP]{loader} = $loader;
+
+=head1 DESCRIPTION
+
+This object maintains a list of wheel objects which have states loaded into a
session.
+
+FIXME: Write a better description.
+
+=head1 METHODS
+
+This class implements the following methods:
+
+=head2 new(Z<>)
+
+This returns a new Haver::Wheel::Loader object.
+
+=head2 load_wheel($class, @args)
+
+Creates a new object of class $class, passing @args to its new() class method.
+The newly created object will have its load() method called, which should load
states into the
+currently active L<POE::Session>.
+
+For details on defining wheels, see L<POE::Session::Plugin>.
+
+=head2 unload_wheel($class)
+
+Call unload() on the object associated with $class,
+and then destroy the said object.
+
+=head2 wheels(Z<>)
+
+Returns a list of the currently loaded class names.
+
+=head2 fetch_wheel($class)
+
+Returns the wheel object of type $class.
+Returns undef if $class was never loaded.
+
+=head2 unload_all_wheels(Z<>)
+
+Unload all currently loaded wheels.
+
+This is called when the wheel loader is DESTROY()'d, so you never really need
to call it.
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 SEE ALSO
+
+L<http://www.haverdev.org/>, L<POE>, L<POE::Session>, L<POE::NFA>.
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+
+This module 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 2 of the License, or
+(at your option) any later version.
+
+This module 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Added: trunk/perl/core/lib/Haver/Wheel.pm
===================================================================
--- trunk/perl/core/lib/Haver/Wheel.pm 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/lib/Haver/Wheel.pm 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,243 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Wheel;
+use strict;
+use warnings;
+
+use Haver::Base -base;
+use POE::Session;
+use POE::Wheel;
+
+our $VERSION = 0.08;
+our @EXPORT_BASE = qw(
+ SESSION OBJECT
+ KERNEL HEAP STATE
+ SENDER CALLER_FILE
+ CALLER_LINE ARG0
+ ARG1 ARG2 ARG3
+ ARG4 ARG5 ARG6
+ ARG7 ARG8 ARG9
+);
+
+const kernel => $POE::Kernel::poe_kernel;
+field package => 1;
+
+sub new {
+ my $class = shift;
+ my $self = {
+ # I only prefix these with underscores because I am paranoid of
+ # subclasses clobbering them. :)
+ _provided_states => [],
+ _defined_states => { },
+ _id => POE::Wheel::allocate_wheel_id(),
+ };
+ bless $self, $class;
+ $self->provide("load_$self->{_id}", 'on_load');
+ $self->provide("unload_$self->{_id}", 'on_unload');
+ $self->setup(@_);
+ return $self;
+}
+
+sub setup { }
+
+# POE state called when we load.
+sub on_load {
+
+}
+
+# POE state called when we unload.
+sub on_unload {
+
+}
+
+sub provide {
+ my ($self, $state, $method) = @_;
+ croak "state name undefined!" unless defined $state;
+ push @{ $self->{_provided_states} }, [ $state, $method ];
+}
+
+sub provided_states {
+ my $self = shift;
+ @{ $self->{_provided_states} };
+}
+
+sub defined_states {
+ my $self = shift;
+ keys %{ $self->{_defined_states} };
+}
+
+
+sub invoke {
+ my $self = shift;
+ my $act = shift;
+ my $kernel = $self->kernel;
+ my $session = $kernel->get_active_session();
+ my $class = ref $self;
+ $kernel->call($session, join('_', $act, $self->ID));
+}
+
+sub ID { shift->{_id} }
+
+# Load all provided states.
+sub load {
+ my $self = shift;
+ map {
+ $self->define(@$_)
+ } $self->provided_states;
+ $self->invoke('load');
+}
+
+# Unload all *defined* states.
+sub unload {
+ my $self = shift;
+ $self->invoke('unload');
+ map {
+ $self->undefine($_)
+ } $self->defined_states;
+}
+
+sub define {
+ my ($self, $state, $method) = @_;
+ my $kernel = $self->kernel;
+ $method ||= $state;
+
+ croak "State $state defined; can't redefine"
+ if exists $self->{_defined_states}{$state};
+ $self->{_defined_states}{$state} = $method;
+ $kernel->state($state,
+ $self->{package} ? ref $self : $self,
+ $method
+ );
+}
+
+sub undefine {
+ my ($self, $state) = @_;
+
+ croak "State $state not defined; can't undefine"
+ unless exists $self->{_defined_states}{$state};
+ delete $self->{_defined_states}{$state};
+ $self->kernel->state($state);
+}
+
+
+sub DESTROY {
+ my $self = shift;
+ POE::Wheel::free_wheel_id($self->ID);
+}
+
+1;
+__END__
+=head1 NAME
+
+Haver::Wheel - Base class for modules that extend POE::Session at runtime.
+
+=head1 SYNOPSIS
+
+ package MyPlugin;
+ use POE;
+ use base 'Haver::Wheel';
+
+ sub setup {
+ my $self = shift;
+ $self->provide('foo', 'on_foo');
+ }
+
+ sub on_foo {
+ my ($kernel, $heap, $self) = @_[KERNEL, HEAP, OBJECT];
+ # ...
+ }
+
+=head1 DESCRIPTION
+
+This module allows the loading and unloading of object states into a running
L<POE::Session>.
+
+Plugins are not unlike a L<POE::Wheel>, except instead of producing events,
they respond to them.
+
+This behavior is similar to that of L<POE::NFA>, except it is added to
existing L<POE::Session>
+sessions.
+
+=head1 METHODS
+
+This class implements the following methods:
+
+=head2 new(@args)
+
+This returns a new wheel object.
+Its arguments (@args) are passed to setup()
+
+=head2 setup(Z<>)
+
+B<Do not call this method>. It is called by new().
+
+Subclasses should overload this method and use it call provide()
+to specify which states they define in the current session.
+
+=head2 ID(Z<>)
+
+This returns the unique wheel id of the square wheel.
+
+=head2 define($state [, $method ])
+
+Bind $state in the currently active session to the method $method of $self.
+If $method is omitted, it defaults to the same name as $state.
+
+=head2 undefine($state)
+
+Remove the binding of $state in the current session, if and only if it was
previously
+defined by our $self.
+
+=head2 provide($state [, $method ])
+
+This is like a delayed define(). It will only occurs when load() is called.
+
+=head2 load(Z<>)
+
+Load all C<provide>'d states.
+
+=head2 unload(Z<>)
+
+This undefines (with undefine()) all states that were defined with define()
+or provided() and subsequently loaded with load().
+
+=head2 on_load
+
+This is method is called as a POE state when the plugin is loaded.
+$_[KERNEL], $_[SESSION], etc, should all be correct.
+
+=head2 on_unload
+
+This is method is called as a POE state when the plugin is unloaded.
+$_[KERNEL], $_[SESSION], etc, should all be correct.
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 SEE ALSO
+
+L<http://www.haverdev.org/>, L<Haver::Wheel::Loader>,
+L<POE>, L<POE::Session>, L<POE::NFA>.
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+
+This module 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 2 of the License, or
+(at your option) any later version.
+
+This module 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Added: trunk/perl/core/t/001_config.t
===================================================================
--- trunk/perl/core/t/001_config.t 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/t/001_config.t 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 3;
+BEGIN {
+ use_ok('Haver::Config');
+};
+
+can_ok('Haver::Config', 'new', 'config');
+
+my $d =
+my $ch = new Haver::Config (
+ file => 'foobar',
+ default => {
+ stuff => {
+ monkeys => 2,
+ },
+ foo => 'bar',
+ },
+);
+my $c = $ch->config;
+
+is_deeply($c, { stuff => { monkeys => 2 }, foo => 'bar' }, "Config with
default values");
Added: trunk/perl/core/t/002_protocol.t
===================================================================
--- trunk/perl/core/t/002_protocol.t 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/t/002_protocol.t 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Haver.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 5;
+BEGIN {
+ use_ok('Haver::Protocol', qw(:event :crlf :escape));
+};
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+{
+ my $s = "bunnies\et\eet\er\en";
+ is(escape(unescape($s)), $s, "escape and unescape work properly");
+}
+{
+ my $in = ["This", "is", "a test", "of \r\e\n\t"];
+ my $out = "This\tis\ta test\tof \er\ee\en\et$CRLF";
+ is(event2line($in), $out, "event2line");
+ is_deeply([line2event($out)], $in, "line2event");
+ is(event2line(line2event($out)), $out, "input is output");
+}
+
Property changes on: trunk/perl/core/t/002_protocol.t
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:eol-style
+ native
Added: trunk/perl/core/t/003_wheel.t
===================================================================
--- trunk/perl/core/t/003_wheel.t 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/t/003_wheel.t 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+use strict;
+use Test::More tests => 4;
+
+my $class = 'Haver::Wheel';
+use_ok($class);
+can_ok($class, 'new');
+
+my $plugin = $class->new;
+
+isa_ok($plugin, $class);
+can_ok($plugin,
+ qw(
+ provide
+ load
+ unload
+ define
+ undefine
+ provided_states
+ defined_states
+ setup
+ kernel
+ )
+);
Added: trunk/perl/core/t/004_loader.t
===================================================================
--- trunk/perl/core/t/004_loader.t 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/t/004_loader.t 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+use strict;
+use Test::More tests => 4;
+
+my $class = 'Haver::Wheel::Loader';
+require_ok($class);
+can_ok($class, 'new');
+
+my $loader = $class->new;
+isa_ok($loader, $class);
+can_ok($loader,
+ qw(
+ load_wheel
+ unload_wheel
+ wheels
+ fetch_wheel
+ unload_all_wheels
+ )
+);
Added: trunk/perl/core/t/005_wheel_run.t
===================================================================
--- trunk/perl/core/t/005_wheel_run.t 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/core/t/005_wheel_run.t 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+use strict;
+use Test::More tests => 7;
+use POE;
+use Haver::Wheel;
+use Haver::Wheel::Loader;
+
+BEGIN {
+ package MyWheel;
+ use POE;
+ use base 'Haver::Wheel';
+
+ sub setup {
+ my $self = shift;
+ $self->provide('foo', 'on_foo');
+ $self->provide('bar', 'on_bar');
+ $self->provide('baz', 'on_baz');
+ }
+
+ sub on_load {
+ my $self = $_[OBJECT];
+ $self->{load} = 1;
+ }
+
+ sub on_unload {
+ my $self = $_[OBJECT];
+ $self->{unload} = 1;
+ }
+ sub on_foo {
+ my $self = $_[OBJECT];
+ $self->{foo}++;
+ }
+
+ sub on_bar {
+ my $self = $_[OBJECT];
+ $self->{bar}++;
+ }
+
+ sub on_baz {
+ my $self = $_[OBJECT];
+ $self->{baz}++;
+ if ($self->{baz} == 1) {
+ $_[KERNEL]->yield('bye');
+ }
+ }
+}
+
+POE::Session->create(
+ inline_states => {
+ _start => \&on_start,
+ _stop => \&on_stop,
+ bye => \&on_bye,
+ },
+);
+
+POE::Kernel->run;
+
+sub on_start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my $loader = new Haver::Wheel::Loader;
+ $loader->load_wheel('MyWheel');
+ $heap->{loader} = $loader;
+
+ diag "Starting session";
+ foreach my $state (qw( foo bar baz )) {
+ $kernel->yield($state) for 1 .. 3;
+ }
+}
+
+sub on_stop {
+ diag "Stopping session";
+}
+
+sub on_bye {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my $loader = $heap->{loader};
+ my $p = $loader->fetch_wheel('MyWheel');
+
+ diag "Saying goodbye";
+ is($p->{foo}, 3, "Called foo 3 times");
+ is($p->{bar}, 3, "Called bar 3 times");
+ is($p->{baz}, 3, "Called baz 3 times");
+
+ diag "Calling foo again";
+ $kernel->call($_[SESSION], 'foo');
+ is($p->{foo}, 4, "foo is now 4");
+
+ diag "Unloading MyWheel";
+ $loader->unload_wheel('MyWheel');
+ $kernel->call($_[SESSION], 'foo');
+ isnt($p->{foo}, 5, "foo is not 5");
+ ok($p->{load}, "on_load was called.");
+ ok($p->{unload}, "on_unload was called.");
+}
Property changes on: trunk/perl/server
___________________________________________________________________
Name: svn:ignore
+ _build
Build
Makefile.PL
MANIFEST
META.yml
*.bak
*~
haverd.yml
store
Added: trunk/perl/server/Build.PL
===================================================================
--- trunk/perl/server/Build.PL 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/server/Build.PL 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+require 5.008;
+use Module::Build;
+my $build = Module::Build->new(
+ module_name => 'Haver::Server',
+ dist_version_from => 'lib/Haver/Server.pm',
+ dist_author => 'Dylan William Hardison <[EMAIL PROTECTED]>',
+ dist_abstract => 'POE-based simple chat server',
+ license => 'gpl',
+ requires => {
+ 'perl' => '5.8.0',
+ POE => 0.27,
+ 'Digest::SHA1' => 2.01,
+ Spiffy => 0.22,
+
+ },
+ create_makefile_pl => 'passthrough',
+ script_files => [glob('bin/*.pl')],
+);
+$build->create_build_script();
Property changes on: trunk/perl/server/Build.PL
___________________________________________________________________
Name: svn:executable
+
Name: svn:eol-style
+ native
Added: trunk/perl/server/COPYING
===================================================================
--- trunk/perl/server/COPYING 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/server/COPYING 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,326 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your freedom to
+share and change it. By contrast, the GNU 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. This General Public License applies to
+most of the Free Software Foundation's software and to any other program whose
+authors commit to using it. (Some other Free Software Foundation software is
+covered by the GNU Library General Public License instead.) You can apply it
+to your programs, too.
+
+ When we speak of free software, we are referring to freedom, not price. Our
+General Public Licenses are designed to make sure that you have the freedom to
+distribute copies of free software (and charge for this service if you wish),
+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 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 show them these terms so they know 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.
+
+ Finally, any free program is threatened constantly by software patents. We
+wish to avoid the danger that redistributors of a free program will
+individually obtain patent licenses, in effect making the program proprietary.
+To prevent this, we have made it clear that any patent must be licensed for
+everyone's free use or not licensed at all.
+
+ 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 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
+derivative work under copyright law: that is to say, a work containing the
+Program or a portion of it, either verbatim or with modifications and/or
+translated into another language. (Hereinafter, translation is included
+without limitation in the term "modification".) Each licensee is addressed as
+"you".
+
+Activities other than copying, distribution and modification are not covered
+by this License; they are outside its scope. The act of running the Program
+is not restricted, and the output from the Program is covered only if its
+contents constitute a work based on the Program (independent of having been
+made by running the Program). Whether that is true depends on what the
+Program does.
+
+ 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 License
+and to the absence of any warranty; and give any other recipients of the
+Program a copy of this License along with the Program.
+
+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.
+
+ 2. You may modify your copy or copies of the Program or any portion of it,
+thus forming a work based on the Program, and copy and distribute such
+modifications or work under the terms of Section 1 above, provided that you
+also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary 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
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If identifiable
+sections of that work are not derived from the Program, and can be reasonably
+considered independent and separate works in themselves, then this License,
+and its terms, do not apply to those sections when you distribute them as
+separate works. But when you distribute the same sections as part of a whole
+which is a work based on the Program, the distribution of the whole must be on
+the terms of this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest your
+rights to work written entirely by you; rather, the intent is to exercise the
+right to control the distribution of derivative or collective works based on
+the Program.
+
+In addition, mere aggregation of another work not based on the Program with
+the Program (or with a work based on the Program) on a volume of a storage or
+distribution medium does not bring the other work under the scope of this
+License.
+
+ 3. You may copy and distribute the Program (or a work based on it, under
+Section 2) in object code or executable form under the terms of Sections 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 Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for making
+modifications to it. For an executable work, complete source code means all
+the source code for all modules it contains, plus any associated interface
+definition files, plus the scripts used to control compilation and
+installation of the executable. However, as a special exception, the source
+code distributed need not include anything that is normally distributed (in
+either source or binary form) with the major components (compiler, kernel, and
+so on) of the operating system on which the executable runs, unless that
+component itself accompanies the executable.
+
+If distribution of executable or object code is made by offering access to
+copy from a designated place, then offering equivalent access to copy the
+source code from the same place counts as distribution of the source code,
+even though third parties are not compelled to copy the source along with the
+object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program except as
+expressly provided under this License. Any attempt otherwise to copy, modify,
+sublicense or distribute the Program is void, and will automatically terminate
+your rights under this License. However, parties who have received copies, or
+rights, from you under this License will not have their licenses terminated so
+long as such parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not signed
+it. However, nothing else grants you permission to modify or distribute the
+Program or its derivative works. These actions are prohibited by law if you
+do not accept this License. Therefore, by modifying or distributing 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 for copying,
+distributing or modifying the Program or works based on it.
+
+ 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. You are not responsible for enforcing
+compliance by third parties to this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or otherwise)
+that contradict the conditions of this License, they do not excuse you from
+the conditions of this License. If you cannot distribute so as to satisfy
+simultaneously your obligations under this License and any other pertinent
+obligations, then as a consequence you may not distribute the Program at all.
+For example, if a patent license would not permit royalty-free redistribution
+of the Program by all those who receive copies directly or indirectly through
+you, then the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply and
+the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any patents or
+other property right claims or to contest validity of any such claims; this
+section has the sole purpose of protecting the integrity of the free software
+distribution system, which is implemented by public license practices. Many
+people have made generous contributions to the wide range of software
+distributed through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing to
+distribute software through any other system and a licensee cannot impose that
+choice.
+
+This section is intended to make thoroughly clear what is believed to be a
+consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in certain
+countries either by patents or by copyrighted interfaces, the original
+copyright holder who places the Program under this License may add an explicit
+geographical distribution limitation excluding those countries, so that
+distribution is permitted only in or among countries not thus excluded. In
+such case, this License incorporates the limitation as if written in the body
+of this License.
+
+ 9. 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 this 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 this License,
+you may choose any version ever published by the Free Software Foundation.
+
+ 10. 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
+
+ 11. 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.
+
+ 12. 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
+
+ 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 the public, 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ 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 2 of the License, 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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) 19yy 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 is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General Public
+License instead of this License.
Property changes on: trunk/perl/server/COPYING
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/MANIFEST.SKIP
===================================================================
--- trunk/perl/server/MANIFEST.SKIP 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/server/MANIFEST.SKIP 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,11 @@
+\.old$
+\.bak
+store
+blib
+_build
+^Build$
+^\.#
+\.svn
+\.tar\.gz$
+^data
+^conf
Property changes on: trunk/perl/server/MANIFEST.SKIP
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/NEWS
===================================================================
--- trunk/perl/server/NEWS 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/server/NEWS 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,3 @@
+
+* We're using the fifth version of the protocol...
+* Error names are now saner but we need to work on them.
Property changes on: trunk/perl/server/NEWS
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/README
===================================================================
--- trunk/perl/server/README 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/server/README 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,56 @@
+Haver-Server version 0.08 ("MuffinWillKillMe")
+=========================
+
+Haver's a new chat system similar to IRC,
+but hopefully it is both more simple and more
+flexible.
+
+Haver will never replace IRC, rather it
+is intended for a different niche: Fairly
+small servers. Haver doesn't make any attempts
+at doing multi-server stuff. We try to generalize
+everything, and not have too many special cases.
+
+Why was haver written?
+Because IRC is really... disorganized.
+Having to user agents for keeping rooms registered
+is just plain icky, in my opinion.
+
+Also, writing the server, the clients,
+devising a protocol that is simple, is
+terribly fun stuff.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Build.PL
+ perl Build
+ perl Build test
+ perl Build install
+
+DEPENDENCIES
+
+POE => 0.27
+Haver => 0.07
+YAML => 0.35
+Digest::SHA1 => 2.01
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2004 by Dylan William Hardison
+
+This library 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 2 of the License, or
+(at your option) any later version.
+
+This library 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Property changes on: trunk/perl/server/README
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/TODO
===================================================================
--- trunk/perl/server/TODO 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/server/TODO 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,10 @@
+This is the deep, mysterious Future:
+
+* Add support for SSL.
+ This means we have to get SSLSocketFactory working.
+ Someone in freenode/#poe said he had already done this.
+ * SSL-connected people should have a special (locked)
+ property on them: 'using-ssl' or some such.
+
+* Implement line-length limits.
+
Property changes on: trunk/perl/server/TODO
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/bin/haver-new-user.pl
===================================================================
--- trunk/perl/server/bin/haver-new-user.pl 2005-06-20 07:48:42 UTC (rev
778)
+++ trunk/perl/server/bin/haver-new-user.pl 2005-06-20 07:48:44 UTC (rev
779)
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+# Copyright (C) 2003 Dylan William Hardison
+#
+# 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 2 of the License, 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+use strict;
+use warnings;
+use Haver::Server::Object::User;
+
+
+my $id = shift;
+my $dir = shift;
+
+Haver::Server::Object->store_dir($dir);
+my $u = new Haver::Server::Object::User(id => $id);
+
+
+$u->save;
+
+
Property changes on: trunk/perl/server/bin/haver-new-user.pl
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:eol-style
+ native
Added: trunk/perl/server/bin/haver-passwd.pl
===================================================================
--- trunk/perl/server/bin/haver-passwd.pl 2005-06-20 07:48:42 UTC (rev
778)
+++ trunk/perl/server/bin/haver-passwd.pl 2005-06-20 07:48:44 UTC (rev
779)
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+# Copyright (C) 2003 Dylan William Hardison
+#
+# 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 2 of the License, 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+use strict;
+use warnings;
+use YAML qw(LoadFile DumpFile);
+use Digest::SHA1 qw(sha1_base64);
+
+my $file = shift or die "usage: $0 file";
+my $data = LoadFile($file);
+
+print "Password: ";
+my $pass = readline STDIN;
+chomp $pass;
+
+$data->{password} = sha1_base64($pass);
+
+
+DumpFile($file, $data);
+
+
Property changes on: trunk/perl/server/bin/haver-passwd.pl
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/bin/haverd.pl
===================================================================
--- trunk/perl/server/bin/haverd.pl 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/server/bin/haverd.pl 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+# haverd.pl, This is a haver-compatible server.
+# This really doesn't do much, except load a few modules and start everything.
+# Copyright (C) 2003 Dylan William Hardison
+#
+# 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 2 of the License, 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+use strict;
+use warnings;
+use lib qw( lib ../core/lib );
+use Haver::Server::Entity::User;
+use Haver::Server::Entity::Channel;
+use Haver::Server::Entity::Lobby;
+use Haver::Server::Listener;
+
+
+use POE;
+
+create Haver::Server::Listener (
+ lobby => new Haver::Server::Entity::Lobby,
+);
+
+
+POE::Session->create(
+ inline_states => {
+ _start => sub {
+ $_[KERNEL]->post('Listener', 'listen', {
+ host => 'hardison.net',
+ port => 7070,
+ });
+ },
+ });
+
+
+
+
+POE::Kernel->run;
Property changes on: trunk/perl/server/bin/haverd.pl
___________________________________________________________________
Name: svn:executable
+
Name: svn:eol-style
+ native
Property changes on: trunk/perl/server/lib
___________________________________________________________________
Name: svn:ignore
+ *.foo
Added: trunk/perl/server/lib/Haver/Server/Avatar.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Avatar.pm 2005-06-20 07:48:42 UTC
(rev 778)
+++ trunk/perl/server/lib/Haver/Server/Avatar.pm 2005-06-20 07:48:44 UTC
(rev 779)
@@ -0,0 +1,45 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=104:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Avatar;
+use strict;
+use warnings;
+use Haver::Base -base;
+
+our $VERSION = 0.08;
+
+
+field -weak => 'wheel';
+field _access => {};
+
+
+sub put {
+ my ($self, $msg) = @_;
+
+ if (my $w = $self->wheel) {
+ $w->put($msg);
+ return 1;
+ } else {
+ return undef;
+ }
+}
+
+sub grant {
+ my ($self, $where, $what, $level) = @_;
+
+ $self->{_access}{$where}{$what} = $level || 1;
+}
+
+sub revoke {
+ my ($self, $where, $what) = @_;
+
+ return undef if not exists $self->{_access}{$where};
+ return delete $self->{_access}{$where}{$what};
+}
+
+sub may {
+ my ($self, $where, $what) = @_;
+
+ return undef unless exists $self->{_access}{$where};
+ return undef unless exists $self->{_access}{$where}{$what};
+ return $self->{_access}{$where}{$what};
+}
Property changes on: trunk/perl/server/lib/Haver/Server/Avatar.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2005-06-20
07:48:42 UTC (rev 778)
+++ trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2005-06-20
07:48:44 UTC (rev 779)
@@ -0,0 +1,74 @@
+# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Entity::Channel;
+use strict;
+use warnings;
+use Haver::Server::Entity -base;
+
+our $VERSION = 0.22;
+
+const namespace => 'channel';
+field _contents => {};
+
+sub can_contain {
+ my ($self, $object) = @_;
+ $object->namespace eq 'user';
+}
+
+sub put {
+ my ($self, $msg) = @_;
+
+ foreach my $user ($self->contents('user')) {
+ $user->put($msg);
+ }
+}
+
+sub add {
+ my ($self, $object) = @_;
+
+ my $ns = $object->namespace;
+ my $name = lc $object->name;
+
+ croak ref($self) . " can't contain $object!" unless
$self->can_contain($object);
+
+
+ $self->{_contents}{$ns}{$name} = $object;
+}
+
+sub fetch {
+ my ($self, $ns, $name) = @_;
+ $name = lc $name;
+
+ return undef unless exists $self->{_contents}{$ns};
+ return undef unless exists $self->{_contents}{$ns}{$name};
+ return $self->{_contents}{$ns}{$name};
+}
+
+sub remove {
+ my ($self, $ns, $name) = @_;
+ $name = lc $name;
+
+ return undef unless exists $self->{_contents}{$ns};
+ return undef unless exists $self->{_contents}{$ns}{$name};
+ return delete $self->{_contents}{$ns}{$name};
+}
+
+sub contents {
+ my ($self, $ns) = @_;
+ my @values = ();
+
+ if (exists $self->{_contents}{$ns}) {
+ @values = values %{ $self->{_contents}{$ns} };
+ }
+
+ return wantarray ? @values : [EMAIL PROTECTED];
+}
+
+sub contains {
+ my ($self, $ns, $name) = @_;
+
+ return undef unless exists $self->{_contents}{$ns};
+ return exists $self->{_contents}{$ns}{lc $name};
+}
+
+1;
Property changes on: trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/lib/Haver/Server/Entity/Lobby.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Lobby.pm 2005-06-20 07:48:42 UTC
(rev 778)
+++ trunk/perl/server/lib/Haver/Server/Entity/Lobby.pm 2005-06-20 07:48:44 UTC
(rev 779)
@@ -0,0 +1,37 @@
+# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Entity::Lobby;
+use strict;
+use warnings;
+use Haver::Server::Entity::Channel -base;
+
+our $VERSION = 0.22;
+
+const name => '&lobby';
+
+sub can_contain {
+ my ($self, $object) = @_;
+ $self != $object;
+}
+
+sub fetch {
+ my ($self, $ns, $name) = @_;
+
+ if ($ns eq 'channel' and $name eq '&lobby') {
+ return $self;
+ } else {
+ super ($ns, $name);
+ }
+}
+
+sub contains {
+ my ($self, $ns, $name) = @_;
+
+ if ($ns eq 'channel' and $name eq '&lobby') {
+ return 1;
+ } else {
+ return super ($ns, $name);
+ }
+}
+
+1;
Added: trunk/perl/server/lib/Haver/Server/Entity/Service.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Service.pm 2005-06-20
07:48:42 UTC (rev 778)
+++ trunk/perl/server/lib/Haver/Server/Entity/Service.pm 2005-06-20
07:48:44 UTC (rev 779)
@@ -0,0 +1,12 @@
+# vim: set ts=4 sw=4 expandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Entity::Service;
+use strict;
+use warnings;
+use Haver::Server::Entity -base;
+use Haver::Server::Avatar -mixin;
+
+const namespace => 'service';
+
+
+1;
Added: trunk/perl/server/lib/Haver/Server/Entity/User.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/User.pm 2005-06-20 07:48:42 UTC
(rev 778)
+++ trunk/perl/server/lib/Haver/Server/Entity/User.pm 2005-06-20 07:48:44 UTC
(rev 779)
@@ -0,0 +1,52 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Entity::User;
+use strict;
+use warnings;
+use Haver::Server::Entity -base;
+use Haver::Server::Avatar -mixin;
+
+const namespace => 'user';
+field _channels => {};
+field _friends => {};
+
+
+sub join {
+ my ($self, $chan) = @_;
+ $chan->add($self);
+ $self->add_channel($chan->name);
+}
+
+sub part {
+ my ($self, $chan) = @_;
+ $chan->remove($self->namespace, $self->name);
+ $self->remove_channel($chan->name);
+}
+
+{
+ no strict 'refs';
+ foreach my $word (qw( channel friend )) {
+ my $field = "_$word";
+
+ *{"add_$word"} = sub {
+ my ($self, $name) = @_;
+ $self->{$field}{$name} = 1;
+ };
+ *{"remove_$word"} = sub {
+ my ($self, $name) = @_;
+ delete $self->{$field}{$name};
+ };
+ *{"has_$word"} = sub {
+ my ($self, $name) = @_;
+ exists $self->{$field}{$name};
+ };
+ *{$word.'s'} = sub {
+ my ($self, $name) = @_;
+ my @list = keys %{ $self->{$field} };
+ wantarray ? @list : [EMAIL PROTECTED];
+ };
+ }
+}
+
+
+1;
Added: trunk/perl/server/lib/Haver/Server/Entity.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity.pm 2005-06-20 07:48:42 UTC
(rev 778)
+++ trunk/perl/server/lib/Haver/Server/Entity.pm 2005-06-20 07:48:44 UTC
(rev 779)
@@ -0,0 +1,29 @@
+# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Entity;
+use strict;
+use warnings;
+use Haver::Base -base;
+use Haver::Util;
+
+field _name => '&undef';
+field attr => {};
+stub 'namespace';
+stub 'put';
+
+sub name {
+ my $self = shift;
+ if (@_ == 0) {
+ return $self->_name;
+ } else {
+ my $name = shift;
+ if (Haver::Util::is_valid_name($name)) {
+ return $self->_name($name);
+ } else {
+ croak "Can't set name to invalid value of $name!";
+ }
+ }
+}
+
+
+1;
Property changes on: trunk/perl/server/lib/Haver/Server/Entity.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/lib/Haver/Server/Listener.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Listener.pm 2005-06-20 07:48:42 UTC
(rev 778)
+++ trunk/perl/server/lib/Haver/Server/Listener.pm 2005-06-20 07:48:44 UTC
(rev 779)
@@ -0,0 +1,106 @@
+package Haver::Server::Listener;
+use strict;
+use warnings;
+
+use Haver::Session -base;
+use Haver::Server::Talker;
+use POE::Wheel::SocketFactory;
+
+our $VERSION = 0.03;
+our $Alias = 'Listener';
+
+sub states {
+ return [qw(
+ _start
+ _stop
+ _child
+ socket_birth
+ socket_fail
+ listen
+ shutdown
+ )];
+}
+
+
+sub _start {
+ my ($kernel, $heap, $opt) = @_[KERNEL, HEAP, ARG0];
+
+ $heap->{wheels} = {};
+ $heap->{children} = {};
+ $heap->{lobby} = $opt->{lobby};
+ $kernel->alias_set($Alias);
+
+ Log("$Alias starts.");
+}
+
+sub _stop {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+
+ Log("$Alias stops.");
+}
+
+sub _child {
+ my ($kernel, $heap, $type, $kid) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+ if ($type eq 'create' or $type eq 'gain') {
+ $heap->{children}{$kid->ID} = 1;
+ } elsif ($type eq 'lose') {
+ delete $heap->{children}{$kid->ID};
+ } else {
+ die "I don't know how I got here!\n";
+ }
+}
+
+
+sub listen {
+ my ($kernel, $heap, $hash) = @_[KERNEL, HEAP, ARG0];
+ Log('notice', "Listening on port $hash->{port} with host
$hash->{host}");
+
+ my $wheel = POE::Wheel::SocketFactory->new(
+ #BindAddress => $addr,
+ BindPort => $hash->{port},
+ Reuse => 1,
+ SuccessEvent => 'socket_birth',
+ FailureEvent => 'socket_fail',
+ );
+ $heap->{wheels}{$wheel->ID} = $wheel;
+ $heap->{info}{$wheel->ID} = $hash;
+}
+
+sub socket_birth {
+ my ($kernel, $heap, $socket, $address, $port, $wid) =
+ @_[KERNEL, HEAP, ARG0, ARG1, ARG2, ARG3];
+
+ Log('Socket birth.');
+ create Haver::Server::Talker (
+ sock => $socket,
+ address => Socket::inet_ntoa($address),
+ port => $port,
+ sockinfo => $heap->{info}{$wid},
+ lobby => $heap->{lobby},
+ );
+}
+
+sub socket_fail {
+ my ($kernel, $heap, $operation, $errnum, $errstr, $wid) = @_[KERNEL,
HEAP, ARG0..ARG3];
+ delete $heap->{wheels}{$wid};
+
+ Log("Listener: Operation '$operation' failed: $errstr ($errnum)\n");
+}
+
+sub shutdown {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ Log("Shutting down $Alias.");
+
+ $kernel->alias_remove($Alias);
+
+ foreach my $kid (keys %{ $heap->{children} }) {
+ $kernel->post($kid, 'shutdown', 'die');
+ }
+
+ delete $heap->{wheels};
+}
+
+
+1;
Property changes on: trunk/perl/server/lib/Haver/Server/Listener.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/lib/Haver/Server/Talker.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Talker.pm 2005-06-20 07:48:42 UTC
(rev 778)
+++ trunk/perl/server/lib/Haver/Server/Talker.pm 2005-06-20 07:48:44 UTC
(rev 779)
@@ -0,0 +1,165 @@
+package Haver::Server::Talker;
+use strict;
+use warnings;
+
+use Haver::Session -base;
+use Haver::Protocol::Filter;
+use Haver::Wheel::Loader;
+
+use Haver::Server;
+use Haver::Server::Wheel::Login;
+use Haver::Server::Wheel::Main;
+
+
+use POE::Wheel::ReadWrite;
+use POE::Driver::SysRW;
+
+our $VERSION = '0.08';
+
+sub states {
+ return [qw(
+ _start _stop _default
+ input error flush
+ shutdown fail
+ )];
+}
+
+sub _start {
+ my ($heap, $session, $kernel, $opt) = @_[ HEAP, SESSION, KERNEL,
ARG0];
+ my ($address, $socket, $port) = ($opt->{address}, delete $opt->{sock},
$opt->{port});
+
+ Log('notice', "Talker for $address:$port starts");
+ binmode $socket, ":utf8";
+ my $client = new POE::Wheel::ReadWrite(
+ Handle => $socket,
+ Driver => new POE::Driver::SysRW,
+ Filter => new Haver::Protocol::Filter,
+ InputEvent => 'input',
+ FlushedEvent => 'flush',
+ ErrorEvent => 'error',
+ );
+
+ %$heap = (
+ %$opt,
+ client => $client,
+ loader => new Haver::Wheel::Loader,
+ );
+ croak "no lobby!" unless defined $heap->{lobby};
+ $heap->{loader}->load_wheel('Haver::Server::Wheel::Login');
+}
+
+
+sub _stop {
+ my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
+
+ my ($address, $port) = @$heap{qw(address port)};
+ Log('notice', "Talker for ${address}:$port stops");
+}
+
+
+sub _default {
+ my ($kernel, $heap, $name, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
+ my $cmd = $args->[1];
+ if ($name =~ /^msg_/) {
+ if (not $heap->{version}) {
+ Log('warning', "Client issued unknown command ($cmd)
before HAVER.");
+ Log('warning', 'Probably a search engine...');
+ $heap->{error} = 1;
+ $heap->{client} = undef;
+ $kernel->yield('shutdown');
+ } else {
+ Log('warning', "Client isseud unknown command $cmd");
+ $kernel->yield('fail', 'unknown.cmd');
+ }
+ }
+
+ 0;
+}
+
+sub input {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+
+ my @copy = @$args;
+ return if $heap->{plonk};
+ return if $heap->{shutdown};
+
+ my $cmd = shift @$args;
+ my $event = 'msg_' . $cmd;
+ $event =~ s/:/_/g;
+
+ Log('info', "Command: '$cmd'");
+ $heap->{cmd} = $cmd;
+ $kernel->call($_[SESSION], $event, $args, $cmd);
+}
+
+sub fail {
+ my ($kernel, $heap, $err, @args) = @_[KERNEL, HEAP, ARG0 .. $#_];
+ $heap->{client}->put(['FAIL', $heap->{cmd}, $err, @args]);
+}
+
+
+sub error {
+ my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
+ my @why;
+
+ if ($errnum == 0) {
+ @why = ('closed');
+ } else {
+ Log('error',
+ "Talker for $heap->{address}:$heap->{port}: ",
+ "Socket generated $operation error ${errnum}: $errstr");
+ @why = ('error', $errstr);
+ }
+
+ $heap->{error} = 1;
+ delete $heap->{client};
+ $kernel->yield('shutdown', @why);
+}
+
+
+sub shutdown {
+ my ($kernel, $heap, $session, @why) = @_[KERNEL, HEAP, SESSION, ARG0,
ARG1];
+ my $lobby = $heap->{lobby};
+
+ if ($heap->{shutdown}) {
+ Log('critical', 'Race condition: shutdown called more than
once!');
+ }
+ Log('info', "Shutting down talker for $heap->{address}:$heap->{port}");
+
+ $heap->{shutdown} = 1;
+ if (my $user = $heap->{user}) {
+ $lobby->remove($user->namespace, $user->name);
+ }
+ unless ($heap->{error}) {
+ eval {
+ my $user = delete $heap->{user};
+ my %seen;
+ foreach my $name ($user->channels) {
+ my $chan = $lobby->fetch('channel', $name);
+ $user->part($chan);
+ foreach my $u ($chan->contents('user')) {
+ unless ($seen{ $u->name }++) {
+ $u->put(['QUIT', $user->name,
@why]);
+ }
+ }
+ }
+ $heap->{client}->put(['BYE', @why]);
+ };
+ Log('error', $@) if $@;
+ }
+
+ $kernel->alarm_remove_all();
+}
+
+sub flush {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ Log('warning', "Flush happened after an error") if $heap->{error};
+ if ($heap->{shutdown}) {
+ delete $heap->{client};
+ }
+}
+
+
+
+1;
Property changes on: trunk/perl/server/lib/Haver/Server/Talker.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2005-06-20 07:48:42 UTC
(rev 778)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2005-06-20 07:48:44 UTC
(rev 779)
@@ -0,0 +1,115 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Wheel::Login;
+use strict;
+use warnings;
+
+use Haver::Server::Wheel -base;
+use Haver::Util qw( :name );
+
+our $VERSION = 0.02;
+
+sub setup {
+ my $self = shift;
+ $self->msg('HAVER');
+}
+
+sub msg_HAVER {
+ my ($self, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
+ my ($version) = @$args;
+
+ Log('notice', 'Client is ' . $version);
+ $heap->{client}->put(
+ ['HAVER', $heap->{sockinfo}{host},
"Haver::Server/$Haver::Server::VERSION"]);
+ $heap->{version} = $version;
+ $self->define('msg_IDENT', 'msg_IDENT');
+}
+
+sub msg_IDENT {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($name) = @$args;
+ my $lobby = $_[HEAP]{lobby};
+ my $ns = 'user';
+
+ if ($lobby->contains($ns, $name)) {
+ $kernel->yield('fail', "exists.$ns", $name);
+ } elsif (not is_valid_name($name)) {
+ $kernel->yield('fail', "invalid.$ns", $name);
+ } elsif ($ns eq 'user' and is_reserved_name($name)) {
+ $kernel->yield('fail', "reserved.$ns", $name);
+ } else {
+ my $user = new Haver::Server::Entity::User (
+ name => $name,
+ wheel => $heap->{client}, # weak reference!
+ );
+ $lobby->add($user);
+ $heap->{user} = $user;
+ $heap->{client}->put(['HELLO', $name]);
+ $heap->{loader}->unload_wheel(__PACKAGE__);
+ $heap->{loader}->load_wheel('Haver::Server::Wheel::Main');
+ }
+}
+
+
+1;
+__END__
+=head1 NAME
+
+Haver::Server::Wheel::Login - description
+
+=head1 SYNOPSIS
+
+ use Haver::Server::Wheel::Login;
+ # Small code example.
+
+=head1 DESCRIPTION
+
+FIXME
+
+=head1 INHERITENCE
+
+Haver::Server::Wheel::Login extends blaa blaa blaa
+
+=head1 CONSTRUCTOR
+
+List required parameters for new().
+
+=head1 METHODS
+
+This class implements the following methods:
+
+=head2 method1(Z<>)
+
+...
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 SEE ALSO
+
+L<http://www.haverdev.org/>.
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+
+This module 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 2 of the License, or
+(at your option) any later version.
+
+This module 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Added: trunk/perl/server/lib/Haver/Server/Wheel/Main.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Main.pm 2005-06-20 07:48:42 UTC
(rev 778)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Main.pm 2005-06-20 07:48:44 UTC
(rev 779)
@@ -0,0 +1,276 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Wheel::Main;
+use strict;
+use warnings;
+
+use Haver::Server::Wheel -base;
+use Haver::Util 'is_valid_name';
+use constant PING_TIME => 4 * 60;
+
+sub setup {
+ my $self = shift;
+ $self->msg('TO');
+ $self->msg('IN');
+ $self->msg('JOIN');
+ $self->msg('OPEN');
+ $self->msg('PART');
+ $self->msg('BYE');
+ $self->msg('LIST');
+ $self->msg('POKE');
+ $self->msg('PONG');
+ $self->provide('ping', 'on_ping');
+ $self->provide('schedule_ping', 'on_schedule_ping');
+}
+
+sub on_load {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ $kernel->yield('schedule_ping');
+}
+
+sub on_schedule_ping {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ my $aid = $kernel->alarm_set('ping', time + PING_TIME);
+ if (defined $heap->{alarm_send_ping}) {
+ $kernel->alarm_remove($heap->{alarm_send_ping});
+ }
+ if (defined $heap->{alarm_ping_out}) {
+ $kernel->alarm_remove($heap->{alarm_ping_out});
+ }
+
+ $heap->{alarm_send_ping} = $aid;
+}
+
+sub on_ping {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my $aid = $kernel->alarm_set('shutdown', time + PING_TIME, 'ping');
+ $heap->{client}->put(['PING', $aid]);
+ $heap->{alarm_ping_out} = $aid;
+}
+
+sub msg_JOIN {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $lobby = $heap->{lobby};
+ my ($name) = @$args;
+ my $user = $heap->{user};
+ my $chan = $lobby->fetch('channel', $name);
+
+ unless (is_valid_name($name)) {
+ $kernel->yield('fail', "invalid.name", $name);
+ return;
+ }
+ unless ($chan) {
+ $kernel->yield('fail', 'unknown.channel');
+ return;
+ }
+ if ($chan->contains('user', $user->name)) {
+ $kernel->yield('fail', 'moron');
+ return;
+ }
+
+ $user->join($chan);
+ $chan->put(['JOIN', $chan->name, $user->name]);
+}
+
+sub msg_OPEN {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $lobby = $heap->{lobby};
+ my ($name) = @$args;
+
+ unless (is_valid_name($name)) {
+ $kernel->yield('fail', "invalid.name", $name);
+ return;
+ }
+ if ($lobby->contains('channel', $name)) {
+ $kernel->yield('fail', 'exists.channel');
+ return;
+ }
+
+ $lobby->add(
+ new Haver::Server::Entity::Channel (
+ name => $name
+ )
+ );
+ $heap->{client}->put(['OPEN', $name]);
+ $kernel->yield('msg_JOIN', [$name]);
+
+}
+
+sub msg_PART {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $lobby = $heap->{lobby};
+ my ($name) = @$args;
+ my $user = $heap->{user};
+ my $chan = $lobby->fetch('channel', $name);
+
+ unless (is_valid_name($name)) {
+ $kernel->yield('fail', 'invalid.name', $name);
+ return;
+ }
+ unless ($chan) {
+ $kernel->yield('fail', 'unknown.channel');
+ return;
+ }
+ unless ($chan->contains('user', $user->name)) {
+ $kernel->yield('fail', 'moron');
+ return;
+ }
+
+ $chan->put(['PART', $chan->name, $user->name]);
+ $user->part($chan);
+}
+
+
+sub msg_TO {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $lobby = $heap->{lobby};
+ my ($name, $type) = (shift @$args, shift @$args);
+ my $user = $heap->{user};
+ my $targ = $lobby->fetch('user', $name);
+
+
+ unless (is_valid_name($name)) {
+ $kernel->yield('fail', "invalid.name", $name);
+ return;
+ }
+ unless ($targ) {
+ $kernel->yield('fail', 'unknown.user');
+ return;
+ }
+ unless (defined $type) {
+ $kernel->yield('fail', 'missing.type');
+ return;
+ }
+
+
+ $targ->put(['FROM', $user->name, $type, @$args]);
+}
+
+sub msg_IN {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $lobby = $heap->{lobby};
+ my ($name, $type) = (shift @$args, shift @$args);
+ my $user = $heap->{user};
+ my $chan = $lobby->fetch('channel', $name);
+
+
+ unless (is_valid_name($name)) {
+ $kernel->yield('fail', "invalid.name", $name);
+ return;
+ }
+ unless ($chan) {
+ $kernel->yield('fail', 'unknown.channel');
+ return;
+ }
+ unless (defined $type) {
+ $kernel->yield('fail', 'missing.type');
+ return;
+ }
+
+ $chan->put(['IN', $chan->name, $user->name, $type, @$args]);
+}
+
+sub msg_LIST {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $lobby = $heap->{lobby};
+ my ($name, $ns) = @$args;
+
+ unless (is_valid_name($name)) {
+ $kernel->yield('fail', "invalid.name", $name);
+ return;
+ }
+ unless ($lobby->contains('channel', $name)) {
+ $kernel->yield('fail', 'unknown.channel');
+ return;
+ }
+ unless ($ns and ($ns eq 'user' or $ns eq 'channel' or $ns eq
'service')) {
+ $kernel->yield('fail', 'unknown.namespace', $ns);
+ return;
+ }
+ my $chan = $lobby->fetch('channel', $name);
+ my @items = $chan->contents($ns);
+ $heap->{client}->put(['LIST', $name, $ns, map { $_->name } @items]);
+}
+
+sub msg_POKE {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ $heap->{client}->put(['OUCH', $args->[0]]);
+}
+
+sub msg_PONG {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+
+ $kernel->yield('schedule_ping');
+}
+
+sub msg_BYE {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ $kernel->yield('shutdown', 'bye', $args->[0]);
+}
+
+
+
+
+1;
+__END__
+=head1 NAME
+
+Haver::Server::Wheel::Message - description
+
+=head1 SYNOPSIS
+
+ use Haver::Server::Wheel::Message;
+ # Small code example.
+
+=head1 DESCRIPTION
+
+FIXME
+
+=head1 INHERITENCE
+
+Haver::Server::Wheel::Message extends blaa blaa blaa
+
+=head1 CONSTRUCTOR
+
+List required parameters for new().
+
+=head1 METHODS
+
+This class implements the following methods:
+
+=head2 method1(Z<>)
+
+...
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 SEE ALSO
+
+L<http://www.haverdev.org/>.
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+
+This module 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 2 of the License, or
+(at your option) any later version.
+
+This module 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Added: trunk/perl/server/lib/Haver/Server/Wheel.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel.pm 2005-06-20 07:48:42 UTC (rev
778)
+++ trunk/perl/server/lib/Haver/Server/Wheel.pm 2005-06-20 07:48:44 UTC (rev
779)
@@ -0,0 +1,18 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Wheel;
+use strict;
+use warnings;
+use Haver::Wheel -base;
+use Haver::Logger 'Log';
+
+our $VERSION = 0.04;
+our @EXPORT_BASE = 'Log';
+
+sub msg {
+ my ($self, $word) = @_;
+ $self->provide("msg_$word", "msg_$word");
+}
+
+
+1;
Added: trunk/perl/server/lib/Haver/Server.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server.pm 2005-06-20 07:48:42 UTC (rev
778)
+++ trunk/perl/server/lib/Haver/Server.pm 2005-06-20 07:48:44 UTC (rev
779)
@@ -0,0 +1,28 @@
+# vim: set ft=perl ts=4 sw=4:
+# Haver::Server - description
+#
+# Copyright (C) 2004 Dylan William Hardison.
+#
+# This module 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 2 of the License, or
+# (at your option) any later version.
+#
+# This module 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 module; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package Haver::Server;
+use strict;
+use warnings;
+
+our $VERSION = 0.08;
+
+
+
+
+1;
Added: trunk/perl/server/t/00_use.t
===================================================================
--- trunk/perl/server/t/00_use.t 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/server/t/00_use.t 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,15 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Haver-Server.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 1;
+BEGIN { use_ok('Haver::Server') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
Property changes on: trunk/perl/server/t/00_use.t
___________________________________________________________________
Name: svn:eol-style
+ native
Added: trunk/perl/server/t/01_entity.t
===================================================================
--- trunk/perl/server/t/01_entity.t 2005-06-20 07:48:42 UTC (rev 778)
+++ trunk/perl/server/t/01_entity.t 2005-06-20 07:48:44 UTC (rev 779)
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Haver-Server.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 16;
+BEGIN {
+ use_ok('Haver::Server::Entity');
+ use_ok('Haver::Server::Entity::Room');
+ use_ok('Haver::Server::Entity::Avatar');
+ use_ok('Haver::Server::Entity::User');
+};
+
+my $user = new Haver::Server::Entity::User (
+ -id => 'user1',
+ -wheel => 'this should be a reference, but eh',
+);
+
+$user->set(name => 'User One');
+is($user->get('name'), 'User One', "User->get()");
+ok($user->has('name'), "User->has()");
+is($user->del('name'), 'User One', "User->del()");
+ok(not($user->has('name')), "not User->has()");
+ok( ! defined $user->del('name'), "not User->del()");
+
+$user->set(name => 'User One');
+$user->set(away => 'AFK!');
+is_deeply(scalar $user->get_many('name', 'away'), ['User One', 'AFK!'],
"User->get_many()");
+
+$user->add_room('foobar');
+ok($user->has_room('foobar'), "has_room()");
+ok($user->remove_room('foobar'), "remove_room()");
+
+$user->add_room('foo');
+$user->add_room('bar');
+$user->add_room('baz');
+is(
+ join('--', sort $user->rooms),
+ join('--', sort ('foo', 'bar', 'baz')),
+ 'rooms()'
+);
+
+$user->grant('&lobby', 'kick', 10);
+is($user->may('&lobby', 'kick'), 10, "grant()/may()");
+is($user->revoke('&lobby', 'kick'), 10, "revoke()");
+ok(!defined($user->may('&lobby', 'kick')), "revoke()/may()");
+
