@@ -1,41 +1,20 @@
-use strict;
-use warnings;
-
-use Module::Build;
-
-my $build = Module::Build->new(
- module_name => 'Net::XMPP',
- license => 'lgpl',
- dist_author => 'Darian Anthony Patrick <dapatrick@cpan.org>',
- dist_abstract => 'XMPP Support Library',
-
- configure_requires => {
- 'Module::Build' => '0.360300',
- },
-
- build_requires => {
- 'LWP::Online' => '1.07',
- 'Test::More' => '0.92',
- 'YAML::Tiny' => '1.41',
- },
-
- requires => {
- 'perl' => 'v5.8.0',
- 'Authen::SASL' => '2.12',
- 'Digest::SHA1' => '1.02',
- 'XML::Stream' => '1.23_04',
- 'Scalar::Util' => '0',
- },
-
- sign => 1,
- create_license => 1,
- create_makefile_pl => 'small',
- meta_merge => {
- 'resources' => {
- 'bugtracker' => 'https://rt.cpan.org/Dist/Display.html?Queue=Net-XMPP',
- 'repository' => 'http://github.com/dap/Net-XMPP',
- }
- },
-);
-
-$build->create_build_script();
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+ module_name => 'Net::XMPP',
+ license => 'lgpl',
+ dist_author => 'xmpplar',
+ dist_abstract => 'XMPP Support Library',
+ dist_version_from => 'lib/Net/XMPP.pm',
+ requires => {
+ 'XML::Stream' => 1.22,
+ 'Digest::SHA1' => 1.02,
+ },
+ create_makefile_pl => 'passthrough',
+);
+
+$builder->create_build_script();
+
+
@@ -1,40 +1,3 @@
-1.02_04 2011-07-19
-===
- - Remove outdated Test::More/Test::Builder (szabgab)
- - Address more memory leaks in Net::XMPP::Connection, Net::XMPP::Protocol and Net::XMPP::Roster (szabgab)
- - Fix crash connecting to Google Talk (szabgab)
- - Add Google Talk-specific test (szabgab)
- - Add memory leak tests (szabgab)
- - Correct behavior of Net::XMPP::Debug when level >= 0 (szabgab)
- - Correct documentation with regard to debug settings (szabgab)
- - Correct required version of Perl (szabgab)
- - Removed specific XML::Stream version require (szabgab)
-
-1.02_03 2011-06-23
-===
- - RT#61611 Correct comparison operator
- - Fixed memory leak in Net::XMPP::Connection (szabgab)
- - RT#52549 unindented POD so that it reformats properly (szabgab)
- - Replace indirect object notation with direct invocation notation (szabgab)
-
-1.02_02 2010-09-24
-===
- - Increase XML::Stream dependency to 1.23_04
-
-1.02_01 2010-09-22
-===
- - New maintainer: DAPATRICK
- - RT#15736 Replace print statements to debug logging
- - RT#51156 Correct typo in documentation
- - RT#54521 Note dependency on XML::Stream 1.23
- - RT#37129, RT#18539 Support for virtual domains
- - RT#57887 Use each required module explicitly
- - RT#61453 Pass ssl_verify and ssl_ca_path
- - RT#61453 Improve undef/null ssl param handling
- - RT#61144 Appropriately handle non-object jid
- - RT#37030 Clarify license as LGPL 2.1
- - RT#58333 Check definedness of hash key before use
-
1.0.2 $Id: CHANGES 28 2007-03-29 12:39:48Z hacker $
===
- Fix bug in Stanza::_xpath_defined causing defined to pass when it shouldn't
@@ -1,540 +0,0 @@
-This software is Copyright (c) 2011 by Darian Anthony Patrick <dapatrick@cpan.org>.
-
-This is free software, licensed under:
-
- The GNU Lesser General Public License, Version 2.1, February 1999
-
-The GNU Lesser General Public License (LGPL)
-Version 2.1, February 1999
-
- (The master copy of this license lives on the GNU website.)
-
-Copyright (C) 1991, 1999 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.
-
-[This is the first released version of the Lesser GPL. It also
-counts as the successor of the GNU Library Public License,
-version 2, hence the version number 2.1.]
-
-Preamble
-
-The licenses for most software are designed to take away
-your freedom to share and change it. By contrast, the GNU
-General Public Licenses are intended to guarantee your
-freedom to share and change free software--to make sure the
-software is free for all its users.
-
-This license, the Lesser General Public License, applies to
-some specially designated software packages--typically
-libraries--of the Free Software Foundation and other authors
-who decide to use it. You can use it too, but we suggest you
-first think carefully about whether this license or the ordinary
-General Public License is the better strategy to use in any
-particular case, based on the explanations below.
-
-When we speak of free software, we are referring to freedom
-of use, 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 and use pieces of it in new free
-programs; and that you are informed that you can do these
-things.
-
-To protect your rights, we need to make restrictions that
-forbid distributors to deny you these rights or to ask you to
-surrender these rights. These restrictions translate to certain
-responsibilities for you if you distribute copies of the library
-or if you modify it.
-
-For example, if you distribute copies of the library, whether
-gratis or for a fee, you must give the recipients all the rights
-that we gave you. You must make sure that they, too,
-receive or can get the source code. If you link other code
-with the library, you must provide complete object files to the
-recipients, so that they can relink them with the library after
-making changes to the library and recompiling it. And you
-must show them these terms so they know their rights.
-
-We protect your rights with a two-step method: (1) we
-copyright the library, and (2) we offer you this license, which
-gives you legal permission to copy, distribute and/or modify
-the library.
-
-To protect each distributor, we want to make it very clear
-that there is no warranty for the free library. Also, if the
-library is modified by someone else and passed on, the
-recipients should know that what they have is not the original
-version, so that the original author's reputation will not be
-affected by problems that might be introduced by others.
-
-Finally, software patents pose a constant threat to the
-existence of any free program. We wish to make sure that a
-company cannot effectively restrict the users of a free
-program by obtaining a restrictive license from a patent
-holder. Therefore, we insist that any patent license obtained
-for a version of the library must be consistent with the full
-freedom of use specified in this license.
-
-Most GNU software, including some libraries, is covered by
-the ordinary GNU General Public License. This license, the
-GNU Lesser General Public License, applies to certain
-designated libraries, and is quite different from the ordinary
-General Public License. We use this license for certain
-libraries in order to permit linking those libraries into non-free
-programs.
-
-When a program is linked with a library, whether statically or
-using a shared library, the combination of the two is legally
-speaking a combined work, a derivative of the original library.
-The ordinary General Public License therefore permits such
-linking only if the entire combination fits its criteria of
-freedom. The Lesser General Public License permits more
-lax criteria for linking other code with the library.
-
-We call this license the "Lesser" General Public License
-because it does Less to protect the user's freedom than the
-ordinary General Public License. It also provides other free
-software developers Less of an advantage over competing
-non-free programs. These disadvantages are the reason we
-use the ordinary General Public License for many libraries.
-However, the Lesser license provides advantages in certain
-special circumstances.
-
-For example, on rare occasions, there may be a special
-need to encourage the widest possible use of a certain
-library, so that it becomes a de-facto standard. To achieve
-this, non-free programs must be allowed to use the library. A
-more frequent case is that a free library does the same job
-as widely used non-free libraries. In this case, there is little
-to gain by limiting the free library to free software only, so we
-use the Lesser General Public License.
-
-In other cases, permission to use a particular library in
-non-free programs enables a greater number of people to use
-a large body of free software. For example, permission to
-use the GNU C Library in non-free programs enables many
-more people to use the whole GNU operating system, as
-well as its variant, the GNU/Linux operating system.
-
-Although the Lesser General Public License is Less
-protective of the users' freedom, it does ensure that the user
-of a program that is linked with the Library has the freedom
-and the wherewithal to run that program using a modified
-version of the Library.
-
-The precise terms and conditions for copying, distribution
-and modification follow. Pay close attention to the difference
-between a "work based on the library" and a "work that uses
-the library". The former contains code derived from the
-library, whereas the latter must be combined with the library
-in order to run.
-
-TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION
-AND MODIFICATION
-
-0. This License Agreement applies to any software library or
-other program which contains a notice placed by the
-copyright holder or other authorized party saying it may be
-distributed under the terms of this Lesser General Public
-License (also called "this License"). Each licensee is
-addressed as "you".
-
-A "library" means a collection of software functions and/or
-data prepared so as to be conveniently linked with
-application programs (which use some of those functions
-and data) to form executables.
-
-The "Library", below, refers to any such software library or
-work which has been distributed under these terms. A "work
-based on the Library" means either the Library or any
-derivative work under copyright law: that is to say, a work
-containing the Library or a portion of it, either verbatim or with
-modifications and/or translated straightforwardly into another
-language. (Hereinafter, translation is included without
-limitation in the term "modification".)
-
-"Source code" for a work means the preferred form of the
-work for making modifications to it. For a library, 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
-library.
-
-Activities other than copying, distribution and modification
-are not covered by this License; they are outside its scope.
-The act of running a program using the Library is not
-restricted, and output from such a program is covered only if
-its contents constitute a work based on the Library
-(independent of the use of the Library in a tool for writing it).
-Whether that is true depends on what the Library does and
-what the program that uses the Library does.
-
-1. You may copy and distribute verbatim copies of the
-Library's complete 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
-distribute a copy of this License along with the Library.
-
-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 Library or any
-portion of it, thus forming a work based on the Library, 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) The modified work must itself be a software
- library.
- b) You must cause the files modified to carry
- prominent notices stating that you changed the
- files and the date of any change.
- c) You must cause the whole of the work to be
- licensed at no charge to all third parties under
- the terms of this License.
- d) If a facility in the modified Library refers to a
- function or a table of data to be supplied by an
- application program that uses the facility, other
- than as an argument passed when the facility
- is invoked, then you must make a good faith
- effort to ensure that, in the event an application
- does not supply such function or table, the
- facility still operates, and performs whatever
- part of its purpose remains meaningful.
-
- (For example, a function in a library to
- compute square roots has a purpose that is
- entirely well-defined independent of the
- application. Therefore, Subsection 2d requires
- that any application-supplied function or table
- used by this function must be optional: if the
- application does not supply it, the square root
- function must still compute square roots.)
-
- These requirements apply to the modified work
- as a whole. If identifiable sections of that work
- are not derived from the Library, 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 Library, 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 Library.
-
- In addition, mere aggregation of another work
- not based on the Library with the Library (or
- with a work based on the Library) on a volume
- of a storage or distribution medium does not
- bring the other work under the scope of this
- License.
-
-3. You may opt to apply the terms of the ordinary GNU
-General Public License instead of this License to a given
-copy of the Library. To do this, you must alter all the notices
-that refer to this License, so that they refer to the ordinary
-GNU General Public License, version 2, instead of to this
-License. (If a newer version than version 2 of the ordinary
-GNU General Public License has appeared, then you can
-specify that version instead if you wish.) Do not make any
-other change in these notices.
-
-Once this change is made in a given copy, it is irreversible
-for that copy, so the ordinary GNU General Public License
-applies to all subsequent copies and derivative works made
-from that copy.
-
-This option is useful when you wish to copy part of the code
-of the Library into a program that is not a library.
-
-4. You may copy and distribute the Library (or a portion or
-derivative of it, under Section 2) in object code or executable
-form under the terms of Sections 1 and 2 above provided that
-you 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.
-
-If distribution of 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
-satisfies the requirement to distribute the source code, even
-though third parties are not compelled to copy the source
-along with the object code.
-
-5. A program that contains no derivative of any portion of the
-Library, but is designed to work with the Library by being
-compiled or linked with it, is called a "work that uses the
-Library". Such a work, in isolation, is not a derivative work of
-the Library, and therefore falls outside the scope of this
-License.
-
-However, linking a "work that uses the Library" with the
-Library creates an executable that is a derivative of the
-Library (because it contains portions of the Library), rather
-than a "work that uses the library". The executable is
-therefore covered by this License. Section 6 states terms for
-distribution of such executables.
-
-When a "work that uses the Library" uses material from a
-header file that is part of the Library, the object code for the
-work may be a derivative work of the Library even though the
-source code is not. Whether this is true is especially
-significant if the work can be linked without the Library, or if
-the work is itself a library. The threshold for this to be true is
-not precisely defined by law.
-
-If such an object file uses only numerical parameters, data
-structure layouts and accessors, and small macros and
-small inline functions (ten lines or less in length), then the
-use of the object file is unrestricted, regardless of whether it
-is legally a derivative work. (Executables containing this
-object code plus portions of the Library will still fall under
-Section 6.)
-
-Otherwise, if the work is a derivative of the Library, you may
-distribute the object code for the work under the terms of
-Section 6. Any executables containing that work also fall
-under Section 6, whether or not they are linked directly with
-the Library itself.
-
-6. As an exception to the Sections above, you may also
-combine or link a "work that uses the Library" with the
-Library to produce a work containing portions of the Library,
-and distribute that work under terms of your choice, provided
-that the terms permit modification of the work for the
-customer's own use and reverse engineering for debugging
-such modifications.
-
-You must give prominent notice with each copy of the work
-that the Library is used in it and that the Library and its use
-are covered by this License. You must supply a copy of this
-License. If the work during execution displays copyright
-notices, you must include the copyright notice for the Library
-among them, as well as a reference directing the user to the
-copy of this License. Also, you must do one of these things:
-
- a) Accompany the work with the complete
- corresponding machine-readable source code
- for the Library including whatever changes were
- used in the work (which must be distributed
- under Sections 1 and 2 above); and, if the work
- is an executable linked with the Library, with
- the complete machine-readable "work that
- uses the Library", as object code and/or
- source code, so that the user can modify the
- Library and then relink to produce a modified
- executable containing the modified Library. (It
- is understood that the user who changes the
- contents of definitions files in the Library will
- not necessarily be able to recompile the
- application to use the modified definitions.)
-
- b) Use a suitable shared library mechanism for
- linking with the Library. A suitable mechanism
- is one that (1) uses at run time a copy of the
- library already present on the user's computer
- system, rather than copying library functions
- into the executable, and (2) will operate
- properly with a modified version of the library, if
- the user installs one, as long as the modified
- version is interface-compatible with the version
- that the work was made with.
-
- c) Accompany the work with a written offer,
- valid for at least three years, to give the same
- user the materials specified in Subsection 6a,
- above, for a charge no more than the cost of
- performing this distribution.
-
- d) If distribution of the work is made by offering
- access to copy from a designated place, offer
- equivalent access to copy the above specified
- materials from the same place.
-
- e) Verify that the user has already received a
- copy of these materials or that you have
- already sent this user a copy.
-
-For an executable, the required form of the "work that uses
-the Library" must include any data and utility programs
-needed for reproducing the executable from it. However, as a
-special exception, the materials to be 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.
-
-It may happen that this requirement contradicts the license
-restrictions of other proprietary libraries that do not normally
-accompany the operating system. Such a contradiction
-means you cannot use both them and the Library together in
-an executable that you distribute.
-
-7. You may place library facilities that are a work based on
-the Library side-by-side in a single library together with other
-library facilities not covered by this License, and distribute
-such a combined library, provided that the separate
-distribution of the work based on the Library and of the other
-library facilities is otherwise permitted, and provided that you
-do these two things:
-
- a) Accompany the combined library with a
- copy of the same work based on the Library,
- uncombined with any other library facilities.
- This must be distributed under the terms of the
- Sections above.
-
- b) Give prominent notice with the combined
- library of the fact that part of it is a work based
- on the Library, and explaining where to find the
- accompanying uncombined form of the same
- work.
-
-8. You may not copy, modify, sublicense, link with, or
-distribute the Library except as expressly provided under this
-License. Any attempt otherwise to copy, modify, sublicense,
-link with, or distribute the Library 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.
-
-9. 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 Library or its derivative
-works. These actions are prohibited by law if you do not
-accept this License. Therefore, by modifying or distributing
-the Library (or any work based on the Library), you indicate
-your acceptance of this License to do so, and all its terms
-and conditions for copying, distributing or modifying the
-Library or works based on it.
-
-10. Each time you redistribute the Library (or any work
-based on the Library), the recipient automatically receives a
-license from the original licensor to copy, distribute, link with
-or modify the Library 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 with this
-License.
-
-11. 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 Library at all. For example, if a
-patent license would not permit royalty-free redistribution of
-the Library 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 Library.
-
-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.
-
-12. If the distribution and/or use of the Library is restricted in
-certain countries either by patents or by copyrighted
-interfaces, the original copyright holder who places the
-Library 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.
-
-13. The Free Software Foundation may publish revised
-and/or new versions of the Lesser 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
-Library 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 Library does not specify a license version number, you
-may choose any version ever published by the Free Software
-Foundation.
-
-14. If you wish to incorporate parts of the Library into other
-free programs whose distribution conditions are incompatible
-with these, 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
-
-15. BECAUSE THE LIBRARY IS LICENSED FREE OF
-CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY,
-TO THE EXTENT PERMITTED BY APPLICABLE LAW.
-EXCEPT WHEN OTHERWISE STATED IN WRITING THE
-COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE LIBRARY "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 LIBRARY IS WITH
-YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU
-ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
-16. 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 LIBRARY 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 LIBRARY (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
-LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN
-ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
-
-END OF TERMS AND CONDITIONS
@@ -0,0 +1,482 @@
+ GNU LIBRARY GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 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.
+
+[This is the first released version of the library GPL. It is
+ numbered 2 because it goes with version 2 of the ordinary GPL.]
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+ This license, the Library General Public License, applies to some
+specially designated Free Software Foundation software, and to any
+other libraries whose authors decide to use it. You can use it for
+your libraries, 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 library, or if you modify it.
+
+ For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you. You must make sure that they, too, receive or can get the source
+code. If you link a program with the library, you must provide
+complete object files to the recipients so that they can relink them
+with the library, after making changes to the library and recompiling
+it. And you must show them these terms so they know their rights.
+
+ Our method of protecting your rights has two steps: (1) copyright
+the library, and (2) offer you this license which gives you legal
+permission to copy, distribute and/or modify the library.
+
+ Also, for each distributor's protection, we want to make certain
+that everyone understands that there is no warranty for this free
+library. If the library is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original
+version, 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 companies distributing free
+software will individually obtain patent licenses, thus in effect
+transforming the program into proprietary software. To prevent this,
+we have made it clear that any patent must be licensed for everyone's
+free use or not licensed at all.
+
+ Most GNU software, including some libraries, is covered by the ordinary
+GNU General Public License, which was designed for utility programs. This
+license, the GNU Library General Public License, applies to certain
+designated libraries. This license is quite different from the ordinary
+one; be sure to read it in full, and don't assume that anything in it is
+the same as in the ordinary license.
+
+ The reason we have a separate public license for some libraries is that
+they blur the distinction we usually make between modifying or adding to a
+program and simply using it. Linking a program with a library, without
+changing the library, is in some sense simply using the library, and is
+analogous to running a utility program or application program. However, in
+a textual and legal sense, the linked executable is a combined work, a
+derivative of the original library, and the ordinary General Public License
+treats it as such.
+
+ Because of this blurred distinction, using the ordinary General
+Public License for libraries did not effectively promote software
+sharing, because most developers did not use the libraries. We
+concluded that weaker conditions might promote sharing better.
+
+ However, unrestricted linking of non-free programs would deprive the
+users of those programs of all benefit from the free status of the
+libraries themselves. This Library General Public License is intended to
+permit developers of non-free programs to use free libraries, while
+preserving your freedom as a user of such programs to change the free
+libraries that are incorporated in them. (We have not seen how to achieve
+this as regards changes in header files, but we have achieved it as regards
+changes in the actual functions of the Library.) The hope is that this
+will lead to faster development of free libraries.
+
+ The precise terms and conditions for copying, distribution and
+modification follow. Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library". The
+former contains code derived from the library, while the latter only
+works together with the library.
+
+ Note that it is possible for a library to be covered by the ordinary
+General Public License rather than by this special one.
+
+ GNU LIBRARY GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any software library which
+contains a notice placed by the copyright holder or other authorized
+party saying it may be distributed under the terms of this Library
+General Public License (also called "this License"). Each licensee is
+addressed as "you".
+
+ A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+ The "Library", below, refers to any such software library or work
+which has been distributed under these terms. A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language. (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+ "Source code" for a work means the preferred form of the work for
+making modifications to it. For a library, 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 library.
+
+ Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it). Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+ 1. You may copy and distribute verbatim copies of the Library's
+complete 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 distribute a copy of this License along with the
+Library.
+
+ 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 Library or any portion
+of it, thus forming a work based on the Library, 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) The modified work must itself be a software library.
+
+ b) You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ c) You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+
+ d) If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Library,
+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 Library, 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 Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library. To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License. (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.) Do not make any other change in
+these notices.
+
+ Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+ This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+ 4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you 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.
+
+ If distribution of 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 satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library". Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+ However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library". The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+ When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library. The
+threshold for this to be true is not precisely defined by law.
+
+ If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work. (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+ Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+ 6. As an exception to the Sections above, you may also compile or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+ You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License. You must supply a copy of this License. If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License. Also, you must do one
+of these things:
+
+ a) Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood
+ that the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+
+ b) Accompany the work with a written offer, valid for at
+ least three years, to give the same user the materials
+ specified in Subsection 6a, above, for a charge no more
+ than the cost of performing this distribution.
+
+ c) If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+
+ d) Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+
+ For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it. 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.
+
+ It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system. Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+ 7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+ a) Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+
+ b) Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+
+ 8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License. Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library 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.
+
+ 9. 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 Library or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+ 10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+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.
+
+ 11. 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 Library at all. For example, if a patent
+license would not permit royalty-free redistribution of the Library 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 Library.
+
+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.
+
+ 12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library 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.
+
+ 13. The Free Software Foundation may publish revised and/or new
+versions of the Library 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 Library
+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 Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+ 14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+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
+
+ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "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
+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. 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 LIBRARY 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
+LIBRARY (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 LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), 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 Libraries
+
+ If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change. You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+ To apply these terms, attach the following notices to the library. 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 library's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library 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
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the Free
+ 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.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the
+ library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+ <signature of Ty Coon>, 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
+
@@ -1,45 +1,42 @@
-Build.PL
-CHANGES
-examples/client.pl
-examples/client_xpath.pl
-lib/Net/XMPP.pm
-lib/Net/XMPP/Client.pm
-lib/Net/XMPP/Connection.pm
-lib/Net/XMPP/Debug.pm
-lib/Net/XMPP/IQ.pm
-lib/Net/XMPP/JID.pm
-lib/Net/XMPP/Message.pm
-lib/Net/XMPP/Namespaces.pm
-lib/Net/XMPP/Presence.pm
-lib/Net/XMPP/PrivacyLists.pm
-lib/Net/XMPP/Protocol.pm
-lib/Net/XMPP/Roster.pm
-lib/Net/XMPP/Stanza.pm
-LICENSE
-Makefile.PL
-MANIFEST This list of files
-META.yml
-README
-t/1_load.t
-t/2_client_jabberd1.4.t
-t/3_client_jabberd2.t
-t/config/accounts.yml.copyme
-t/get_time_stamp.test
-t/gtalk.t
-t/iq.t
-t/jid.t
-t/lib/Net/XMPP/Test/Utils.pm
-t/memory_cycle.t
-t/memory_leak.t
-t/message.t
-t/mytestlib.pl
-t/node1.xml
-t/node2.xml
-t/packet_iqauth.t
-t/packet_iqroster.t
-t/presence.t
-t/query_xxxxx.test
-t/rawxml.t
-t/roster.t
-t/srv.t
-SIGNATURE Added here by Module::Build
+Build.PL
+CHANGES
+examples/client.pl
+examples/client_xpath.pl
+lib/Net/XMPP.pm
+lib/Net/XMPP/Client.pm
+lib/Net/XMPP/Connection.pm
+lib/Net/XMPP/Debug.pm
+lib/Net/XMPP/IQ.pm
+lib/Net/XMPP/JID.pm
+lib/Net/XMPP/Message.pm
+lib/Net/XMPP/Namespaces.pm
+lib/Net/XMPP/Presence.pm
+lib/Net/XMPP/PrivacyLists.pm
+lib/Net/XMPP/Protocol.pm
+lib/Net/XMPP/Roster.pm
+lib/Net/XMPP/Stanza.pm
+LICENSE.LGPL
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+stderr
+t/1_load.t
+t/2_client_jabberd1.4.t
+t/3_client_jabberd2.t
+t/get_time_stamp.test
+t/iq.t
+t/jid.t
+t/lib/Test/Builder.pm
+t/lib/Test/More.pm
+t/lib/Test/Simple.pm
+t/message.t
+t/mytestlib.pl
+t/node1.xml
+t/node2.xml
+t/packet_iqauth.t
+t/packet_iqroster.t
+t/presence.t
+t/query_xxxxx.test
+t/rawxml.t
+t/roster.t
@@ -1,55 +1,46 @@
----
-abstract: 'XMPP Support Library'
-author:
- - 'Darian Anthony Patrick <dapatrick@cpan.org>'
-build_requires:
- LWP::Online: 1.07
- Test::More: 0.92
- YAML::Tiny: 1.41
-configure_requires:
- Module::Build: 0.360300
-generated_by: 'Module::Build version 0.3607'
-license: lgpl
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
-name: Net-XMPP
-provides:
- Net::XMPP:
- file: lib/Net/XMPP.pm
- version: 1.02_04
- Net::XMPP::Client:
- file: lib/Net/XMPP/Client.pm
- Net::XMPP::Connection:
- file: lib/Net/XMPP/Connection.pm
- Net::XMPP::Debug:
- file: lib/Net/XMPP/Debug.pm
- Net::XMPP::IQ:
- file: lib/Net/XMPP/IQ.pm
- Net::XMPP::JID:
- file: lib/Net/XMPP/JID.pm
- Net::XMPP::Message:
- file: lib/Net/XMPP/Message.pm
- Net::XMPP::Namespaces:
- file: lib/Net/XMPP/Namespaces.pm
- Net::XMPP::Presence:
- file: lib/Net/XMPP/Presence.pm
- Net::XMPP::PrivacyLists:
- file: lib/Net/XMPP/PrivacyLists.pm
- Net::XMPP::Protocol:
- file: lib/Net/XMPP/Protocol.pm
- Net::XMPP::Roster:
- file: lib/Net/XMPP/Roster.pm
- Net::XMPP::Stanza:
- file: lib/Net/XMPP/Stanza.pm
-requires:
- Authen::SASL: 2.12
- Digest::SHA1: 1.02
- Scalar::Util: 0
- XML::Stream: 1.23_04
- perl: v5.8.0
-resources:
- bugtracker: https://rt.cpan.org/Dist/Display.html?Queue=Net-XMPP
- license: http://www.gnu.org/licenses/old-licenses/lgpl-2.1.txt
- repository: http://github.com/dap/Net-XMPP
-version: 1.02_04
+--- #YAML:1.0
+name: Net-XMPP
+version: 1.02
+author:
+ - xmpplar
+abstract: XMPP Support Library
+license: lgpl
+resources:
+ license: |-
+ http://opensource.org/licenses/artistic-license.php
+requires:
+ Digest::SHA1: 1.02
+ XML::Stream: 1.22
+provides:
+ Net::XMPP:
+ file: lib/Net/XMPP.pm
+ version: 1.02
+ Net::XMPP::Client:
+ file: lib/Net/XMPP/Client.pm
+ Net::XMPP::Connection:
+ file: lib/Net/XMPP/Connection.pm
+ Net::XMPP::Debug:
+ file: lib/Net/XMPP/Debug.pm
+ Net::XMPP::IQ:
+ file: lib/Net/XMPP/IQ.pm
+ Net::XMPP::JID:
+ file: lib/Net/XMPP/JID.pm
+ Net::XMPP::Message:
+ file: lib/Net/XMPP/Message.pm
+ Net::XMPP::Namespaces:
+ file: lib/Net/XMPP/Namespaces.pm
+ Net::XMPP::Presence:
+ file: lib/Net/XMPP/Presence.pm
+ Net::XMPP::PrivacyLists:
+ file: lib/Net/XMPP/PrivacyLists.pm
+ Net::XMPP::Protocol:
+ file: lib/Net/XMPP/Protocol.pm
+ Net::XMPP::Roster:
+ file: lib/Net/XMPP/Roster.pm
+ Net::XMPP::Stanza:
+ file: lib/Net/XMPP/Stanza.pm
+generated_by: Module::Build version 0.2805
+meta-spec:
+ url: |-
+ http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
@@ -1,7 +1,31 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.3607
-require 5.008000;
- use Module::Build::Compat 0.02;
-
- Module::Build::Compat->run_build_pl(args => \@ARGV);
- require Module::Build;
- Module::Build::Compat->write_makefile(build_class => 'Module::Build');
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+
+ unless (eval "use Module::Build::Compat 0.02; 1" ) {
+ print "This module requires Module::Build to install itself.\n";
+
+ require ExtUtils::MakeMaker;
+ my $yn = ExtUtils::MakeMaker::prompt
+ (' Install Module::Build now from CPAN?', 'y');
+
+ unless ($yn =~ /^y/i) {
+ die " *** Cannot install without Module::Build. Exiting ...\n";
+ }
+
+ require Cwd;
+ require File::Spec;
+ require CPAN;
+
+ # Save this 'cause CPAN will chdir all over the place.
+ my $cwd = Cwd::cwd();
+
+ CPAN::Shell->install('Module::Build::Compat');
+ CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
+ or die "Couldn't install Module::Build, giving up.\n";
+
+ chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+ }
+ eval "use Module::Build::Compat 0.02; 1" or die $@;
+
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
+ require Module::Build;
+ Module::Build::Compat->write_makefile(build_class => 'Module::Build');
@@ -1,4 +1,4 @@
-Net::XMPP
+Net::XMPP v1.0
The Extensible Messaging and Presence Protocol (XMPP) is an IETF standard
that provides a complete cross protocol messaging solution. The problem
@@ -12,5 +12,29 @@ access to the XMPP protocol. Using OOP modules we provide a clean
interface to writing anything from a full client to a simple protocol
tester.
-Please report bugs at https://rt.cpan.org/Public/Bug/Report.html?Queue=Net-XMPP.
+
+Ryan Eatmon
+reatmon@jabber.org
+
+
+REQUIREMENTS
+ - XML::Stream - Handles the connection between the Client and the Server.
+ - Digest::SHA1 - Encrypted authorization so that your password is not sent
+ over unsecure XML.
+
+INSTALLATION
+
+ perl Makefile.PL
+ make
+ make install
+
+STATUS
+
+ Beta. There is some more testing and features to add before I'm ready to
+call this 1.0. It should be usable, but I would not put any production code
+using this yet. If you run into problems, downgrade to Net::Jabber 1.29.
+
+Please send any bug reports to reatmon@jabber.org.
+
+2004/08/22
@@ -1,67 +0,0 @@
-This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version 0.61.
-
-To verify the content in this distribution, first make sure you have
-Module::Signature installed, then type:
-
- % cpansign -v
-
-It will check each file's integrity, as well as the signature's
-validity. If "==> Signature verified OK! <==" is not displayed,
-the distribution may already have been compromised, and you should
-not run its Makefile.PL or Build.PL.
-
------BEGIN PGP SIGNED MESSAGE-----
-Hash: SHA1
-
-SHA1 6d952bd3c0f1f7163ebf884001b53e704987fe07 Build.PL
-SHA1 391e0d983d512fd06b14547b42a52f8e9a97c159 CHANGES
-SHA1 03e6c1a092c3e4320194152ecf204f70887c1c22 LICENSE
-SHA1 b33fea4050f983e72b7bb6739574bddaae802270 MANIFEST
-SHA1 a6be4c06ec46f56ce567bac0a508ce3e580c5c69 META.yml
-SHA1 73962f6582eb684416f5c5e9ec4e4e84aa064463 Makefile.PL
-SHA1 8750c73e31da2ccc02eeaa8d1fcf422c6ad4a653 README
-SHA1 56395324555c66964ac300f097d53c7282d3f884 examples/client.pl
-SHA1 4b002e8a47b1bd44d23847d9a2d0e6b1c06b62de examples/client_xpath.pl
-SHA1 07341107488b07ca0c1e26af15072410615e1dfa lib/Net/XMPP.pm
-SHA1 20768db079f852d6161481455e7ccda70f746b7c lib/Net/XMPP/Client.pm
-SHA1 8e7431d2eb112107a3dcd70a2cabf43f7b9e84c8 lib/Net/XMPP/Connection.pm
-SHA1 047479b19cbf74d2ffead46ebdff4ec2e3e35598 lib/Net/XMPP/Debug.pm
-SHA1 ac1c71245bc41fb700c06d49de1bd3358ad7fd55 lib/Net/XMPP/IQ.pm
-SHA1 98db8b388f3340e789abfa59fdf24d771ee60555 lib/Net/XMPP/JID.pm
-SHA1 bdf3c970ef371d735d1271854bee99b12cb74320 lib/Net/XMPP/Message.pm
-SHA1 273fa2cf47a17746b794fdc8addbb1cf2e656197 lib/Net/XMPP/Namespaces.pm
-SHA1 6f4bfbf898a3743cd64ac8db9ec13c368c3d4ef1 lib/Net/XMPP/Presence.pm
-SHA1 c794b060f0e30325c1b3794743078d416b2c5792 lib/Net/XMPP/PrivacyLists.pm
-SHA1 d8713172ab07c78c21097aae5babf7c1ebfe2d59 lib/Net/XMPP/Protocol.pm
-SHA1 347303c860125d6cd3044d6fa6ba93cf4b2f9f3f lib/Net/XMPP/Roster.pm
-SHA1 91bb321744c1b53e7a371968ae732574dd7cfb8c lib/Net/XMPP/Stanza.pm
-SHA1 dadd2326dfff4d22dfc4870c672fd31a40dd86a8 t/1_load.t
-SHA1 b73dea8a5cd1bfbf15e3e8dfc2ea72a6c00bfa70 t/2_client_jabberd1.4.t
-SHA1 272852577847d66285daf113464f8594acea747b t/3_client_jabberd2.t
-SHA1 4dc9cd2d74671e7e256e6b3f8fd29725e1231c10 t/config/accounts.yml.copyme
-SHA1 176c999052912127b3b36cf3ec5b29af4721cb79 t/get_time_stamp.test
-SHA1 89dfece07866a72994f3760755d0c7b40e72f42f t/gtalk.t
-SHA1 132f93f7d927f6d5528cdb36b10e91474e0a02ac t/iq.t
-SHA1 e006af61529ff08cb8056ab114de7714a7e4a2e5 t/jid.t
-SHA1 a2de64e34bcf7eff51de3ef7998ce9710e8464b3 t/lib/Net/XMPP/Test/Utils.pm
-SHA1 e0dc5181e62285604bffb1d927b1c236ec3c92b9 t/memory_cycle.t
-SHA1 c1409d356ef5676ce8a7b2bc07a11f93089d9492 t/memory_leak.t
-SHA1 98e773d39e9c37ac09405e3923c1a97e16ca4ebe t/message.t
-SHA1 98c5a88b61cc930673c10731ab593323a8f2c0bc t/mytestlib.pl
-SHA1 47132a054b2bfd16ee7ca7c06741993bbbaebc88 t/node1.xml
-SHA1 50688b8dbfd86affd8c51e039df302440a89c597 t/node2.xml
-SHA1 f2ce8c701b89f828a042359b1653afe8c36c752b t/packet_iqauth.t
-SHA1 ce91609b363af5b7bdcb7b283d1eec2a43c83e0c t/packet_iqroster.t
-SHA1 12072726e79263ce927989c778bf895b11344641 t/presence.t
-SHA1 697b31cb04c9cac8d2531b2349394fe9090ce9c8 t/query_xxxxx.test
-SHA1 e1c0f8a99820422f6447eae77520656640230083 t/rawxml.t
-SHA1 fa5ed330ecc053f017cc75fc648b51e139b03ff9 t/roster.t
-SHA1 21ab9a1fb1118bc7331bbae053fd479d47838cf2 t/srv.t
------BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.4.10 (GNU/Linux)
-
-iEYEARECAAYFAk4lt8AACgkQjJ7fFJrTQRfGSgCdF+K+YP4ZN36BDDAVxslgCEWc
-bOwAoL8kd8f4bXnMqYoZlFg3x90ATcQY
-=cM/l
------END PGP SIGNATURE-----
@@ -27,229 +27,157 @@ Net::XMPP::Client - XMPP Client Module
=head1 SYNOPSIS
-Net::XMPP::Client is a module that provides a developer easy access
-to the Extensible Messaging and Presence Protocol (XMPP).
+ Net::XMPP::Client is a module that provides a developer easy access
+ to the Extensible Messaging and Presence Protocol (XMPP).
=head1 DESCRIPTION
-Client.pm uses Protocol.pm to provide enough high level APIs and
-automation of the low level APIs that writing an XMPP Client in
-Perl is trivial. For those that wish to work with the low level
-you can do that too, but those functions are covered in the
-documentation for each module.
+ Client.pm uses Protocol.pm to provide enough high level APIs and
+ automation of the low level APIs that writing an XMPP Client in
+ Perl is trivial. For those that wish to work with the low level
+ you can do that too, but those functions are covered in the
+ documentation for each module.
-Net::XMPP::Client provides functions to connect to an XMPP server,
-login, send and receive messages, set personal information, create
-a new user account, manage the roster, and disconnect. You can use
-all or none of the functions, there is no requirement.
+ Net::XMPP::Client provides functions to connect to an XMPP server,
+ login, send and receive messages, set personal information, create
+ a new user account, manage the roster, and disconnect. You can use
+ all or none of the functions, there is no requirement.
-For more information on how the details for how Net::XMPP is written
-please see the help for L<Net::XMPP> itself.
+ For more information on how the details for how Net::XMPP is written
+ please see the help for Net::XMPP itself.
-For a full list of high level functions available please see
-Net::XMPP::Protocol.
+ For a full list of high level functions available please see
+ Net::XMPP::Protocol.
=head2 Basic Functions
use Net::XMPP;
- $Con = Net::XMPP::Client->new();
+ $Con = new Net::XMPP::Client();
$Con->SetCallbacks(...);
$Con->Execute(hostname=>"jabber.org",
username=>"bob",
password=>"XXXX",
- resource=>"Work"
+ resource=>"Work'
);
+ #
+ # For the list of available functions see Net::XMPP::Protocol.
+ #
-For the list of available functions see L<Net::XMPP::Protocol>.
-
- $Con->Disconnect();
+ $Con->Disconnect();
=head1 METHODS
-=head1 Basic Functions
-
-=head2 new
-
- new(debuglevel=>0|1|2,
- debugfile=>string,
- debugtime=>0|1)
-
-creates the Client object. debugfile
-should be set to the path for the debug
-log to be written. If set to "stdout"
-then the debug will go there. debuglevel
-controls the amount of debug. For more
-information about the valid setting for
-debuglevel, debugfile, and debugtime see
-Net::XMPP::Debug.
-
-=head2 Connect
-
- Connect(hostname=>string,
- port=>integer,
- timeout=>int,
- connectiontype=>string,
- tls=>0|1,
- srv=>0|1,
- componentname=>string)
-
-opens a connection to the server
-listed in the hostname (default
-localhost), on the port (default
-5222) listed, using the
-connectiontype listed (default
-tcpip). The two connection types
-available are:
-
- tcpip standard TCP socket
- http TCP socket, but with the
- headers needed to talk
- through a web proxy
-
-If you specify tls, then it TLS
-will be used if it is available
-as a feature.
-
-If srv is specified AND Net::DNS is
-installed and can be loaded, then
-an SRV query is sent to srv.hostname
-and the results processed to replace
-the hostname and port. If the lookup
-fails, or Net::DNS cannot be loaded,
-then hostname and port are left alone
-as the defaults.
-
-
-Alternatively, you may manually specify
-componentname as the domain portion of the
-jid and leave hostname set to the actual
-hostname of the XMPP server.
-
-=head2 Execute
-
- Execute(hostname=>string,
- port=>int,
- tls=>0|1,
- username=>string,
- password=>string,
- resource=>string,
- register=>0|1,
- connectiontype=>string,
- connecttimeout=>string,
- connectattempts=>int,
- connectsleep=>int,
- processtimeout=>int)
-
-
-Generic inner loop to handle
-connecting to the server, calling
-Process, and reconnecting if the
-connection is lost. There are
-five callbacks available that are
-called at various places:
-
- onconnect - when the client has
- made a connection.
-
- onauth - when the connection is
- made and user has been
- authed. Essentially,
- this is when you can
- start doing things
- as a Client. Like
- send presence, get your
- roster, etc...
-
- onprocess - this is the most
- inner loop and so
- gets called the most.
- Be very very careful
- what you put here
- since it can
- *DRASTICALLY* affect
- performance.
-
- ondisconnect - when the client
- disconnects from
- the server.
-
- onexit - when the function gives
- up trying to connect and
- exits.
-
-The arguments are passed straight
-on to the Connect function, except
-for connectattempts and connectsleep.
-connectattempts is the number of
-times that the Component should try
-to connect before giving up. -1
-means try forever. The default is
--1. connectsleep is the number of
-seconds to sleep between each
-connection attempt.
-
-If you specify register=>1, then the
-Client will attempt to register the
-sepecified account for you, if it
-does not exist.
-
-=head2 Process
-
- Process(integer)
-
-takes the timeout period as an argument. If no
-timeout is listed then the function blocks until
-a packet is received. Otherwise it waits that
-number of seconds and then exits so your program
-can continue doing useful things. NOTE: This is
-important for GUIs. You need to leave time to
-process GUI commands even if you are waiting for
-packets. The following are the possible return
-values, and what they mean:
-
- 1 - Status ok, data received.
- 0 - Status ok, no data received.
- undef - Status not ok, stop processing.
-
-IMPORTANT: You need to check the output of every
-Process. If you get an undef then the connection
-died and you should behave accordingly.
-
-=head2 Disconnect
-
- Disconnect()
-
-closes the connection to the server.
-
-=head2 Connected
-
- Connected()
-
-returns 1 if the Transport is connected to the server,
-and 0 if not.
-
-=head1 AUTHOR
+=head2 Basic Functions
-Originally authored by Ryan Eatmon.
+ new(debuglevel=>0|1|2, - creates the Client object. debugfile
+ debugfile=>string, should be set to the path for the debug
+ debugtime=>0|1) log to be written. If set to "stdout"
+ then the debug will go there. debuglevel
+ controls the amount of debug. For more
+ information about the valid setting for
+ debuglevel, debugfile, and debugtime see
+ Net::XMPP::Debug.
+
+ Connect(hostname=>string, - opens a connection to the server
+ port=>integer, listed in the hostname (default
+ timeout=>int localhost), on the port (default
+ connectiontype=>string, 5222) listed, using the
+ tls=>0|1) connectiontype listed (default
+ tcpip). The two connection types
+ available are:
+ tcpip standard TCP socket
+ http TCP socket, but with the
+ headers needed to talk
+ through a web proxy
+ If you specify tls, then it TLS
+ will be used if it is available
+ as a feature.
+
+ Execute(hostname=>string, - Generic inner loop to handle
+ port=>int, connecting to the server, calling
+ tls=>0|1, Process, and reconnecting if the
+ username=>string, connection is lost. There are
+ password=>string, five callbacks available that are
+ resource=>string, called at various places:
+ register=>0|1, onconnect - when the client has
+ connectiontype=>string, made a connection.
+ connecttimeout=>string, onauth - when the connection is
+ connectattempts=>int, made and user has been
+ connectsleep=>int, authed. Essentially,
+ processtimeout=>int) this is when you can
+ start doing things
+ as a Client. Like
+ send presence, get your
+ roster, etc...
+ onprocess - this is the most
+ inner loop and so
+ gets called the most.
+ Be very very careful
+ what you put here
+ since it can
+ *DRASTICALLY* affect
+ performance.
+ ondisconnect - when the client
+ disconnects from
+ the server.
+ onexit - when the function gives
+ up trying to connect and
+ exits.
+ The arguments are passed straight
+ on to the Connect function, except
+ for connectattempts and connectsleep.
+ connectattempts is the number of
+ times that the Component should try
+ to connect before giving up. -1
+ means try forever. The default is
+ -1. connectsleep is the number of
+ seconds to sleep between each
+ connection attempt.
+
+ If you specify register=>1, then the
+ Client will attempt to register the
+ sepecified account for you, if it
+ does not exist.
+
+ Process(integer) - takes the timeout period as an argument. If no
+ timeout is listed then the function blocks until
+ a packet is received. Otherwise it waits that
+ number of seconds and then exits so your program
+ can continue doing useful things. NOTE: This is
+ important for GUIs. You need to leave time to
+ process GUI commands even if you are waiting for
+ packets. The following are the possible return
+ values, and what they mean:
+
+ 1 - Status ok, data received.
+ 0 - Status ok, no data received.
+ undef - Status not ok, stop processing.
+
+ IMPORTANT: You need to check the output of every
+ Process. If you get an undef then the connection
+ died and you should behave accordingly.
+
+ Disconnect() - closes the connection to the server.
+
+ Connected() - returns 1 if the Transport is connected to the server,
+ and 0 if not.
-Previously maintained by Eric Hacker.
+=head1 AUTHOR
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.008;
use strict;
-use warnings;
use Carp;
use Net::XMPP::Connection;
use base qw( Net::XMPP::Connection );
@@ -38,33 +38,20 @@ Net::XMPP::Connection - XMPP Connection Module
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.008;
use strict;
-use warnings;
use Carp;
-
-use Scalar::Util qw(weaken);
-
-use XML::Stream;
-
-use Net::XMPP::Debug;
-use Net::XMPP::Protocol;
-
use base qw( Net::XMPP::Protocol );
+
sub new
{
my $proto = shift;
@@ -93,7 +80,7 @@ sub init
while($#_ >= 0) { $self->{ARGS}->{ lc(pop(@_)) } = pop(@_); }
$self->{DEBUG} =
- Net::XMPP::Debug->new(level => $self->_arg("debuglevel",-1),
+ new Net::XMPP::Debug(level => $self->_arg("debuglevel",-1),
file => $self->_arg("debugfile","stdout"),
time => $self->_arg("debugtime",0),
setdefault => 1,
@@ -110,9 +97,8 @@ sub init
$self->{DISCONNECTED} = 0;
$self->{STREAM} =
- XML::Stream->new(style => "node",
+ new XML::Stream(style => "node",
debugfh => $self->{DEBUG}->GetHandle(),
- #debugfh => weaken $self->{DEBUG}->GetHandle(),
debuglevel => $self->{DEBUG}->GetLevel(),
debugtime => $self->{DEBUG}->GetTime(),
);
@@ -121,9 +107,6 @@ sub init
$self->InitCallbacks();
-# weaken $self->{STREAM};
- weaken $self->{CB} if $self->{CB};
-
return $self;
}
@@ -157,25 +140,10 @@ sub Connect
namespace => $self->{SERVER}->{namespace},
connectiontype => $self->{SERVER}->{connectiontype},
timeout => $self->{SERVER}->{timeout},
- ( defined $self->{SERVER}->{ssl_ca_path}
- && '' ne $self->{SERVER}->{ssl_ca_path}
- ? (ssl_ca_path => $self->{SERVER}->{ssl_ca_path})
- : ()
- ),
- ( defined $self->{SERVER}->{ssl_verify}
- && '' ne $self->{SERVER}->{ssl_verify}
- ? (ssl_verify => $self->{SERVER}->{ssl_verify})
- : ()
- ),
ssl => $self->{SERVER}->{ssl}, #LEGACY
- _tls => $self->{SERVER}->{tls},
- ( defined $self->{SERVER}->{componentname}
- ? (to => $self->{SERVER}->{componentname})
- : ()
- ),
- ( defined $self->{SERVER}->{srv}
- ? (srv => '_xmpp-client._tcp')
- : ()
+ (defined($self->{SERVER}->{componentname}) ?
+ (to => $self->{SERVER}->{componentname}) :
+ ()
),
);
@@ -183,9 +151,7 @@ sub Connect
{
$self->{DEBUG}->Log1("Connect: connection made");
- my $weak = $self;
- weaken $weak;
- $self->{STREAM}->SetCallBacks(node=>sub{ $weak->CallBack(@_) });
+ $self->{STREAM}->SetCallBacks(node=>sub{ $self->CallBack(@_) });
$self->{CONNECTED} = 1;
$self->{RECONNECTING} = 0;
@@ -27,23 +27,22 @@ Net::XMPP::Debug - XMPP Debug Module
=head1 SYNOPSIS
-Net::XMPP::Debug is a module that provides a developer easy access
-to logging debug information.
+ Net::XMPP::Debug is a module that provides a developer easy access
+ to logging debug information.
=head1 DESCRIPTION
-Debug is a helper module for the Net::XMPP modules. It provides
-the Net::XMPP modules with an object to control where, how, and
-what is logged.
+ Debug is a helper module for the Net::XMPP modules. It provides
+ the Net::XMPP modules with an object to control where, how, and
+ what is logged.
=head2 Basic Functions
- $Debug = Net::XMPP::Debug->new();
+ $Debug = new Net::XMPP::Debug();
- $Debug->Init(
- level => 2,
- file => "stdout",
- header =>"MyScript");
+ $Debug->Init(level=>2,
+ file=>"stdout",
+ header=>"MyScript");
$Debug->Log0("Connection established");
@@ -51,110 +50,77 @@ what is logged.
=head2 Basic Functions
-=over 4
-
-=item new
-
- new(hash)
-
-creates the Debug object. The hash argument is passed
-to the Init function. See that function description
-below for the valid settings.
-
-=item Init
-
- Init(
- level => integer,
- file => string,
- header => string,
- setdefault => 0|1,
- usedefault => 0|1,
- time => 0|1)
-
-initializes the debug object.
-
-The B<level> determines the maximum level of debug
-messages to log:
-
- 0 - Base level Output (default)
- 1 - High level API calls
- 2 - Low level API calls
- ...
- N - Whatever you want....
-
-The B<file> determines where the debug log
-goes. You can either specify a path to
-a file, or "stdout" (the default). "stdout"
-tells Debug to send all of the debug info
-sent to this object to go to stdout.
-
-B<header> is a string that will preappended
-to the beginning of all log entries. This
-makes it easier to see what generated the
-log entry (default is "Debug").
-
-B<setdefault> saves the current filehandle
-and makes it available for other Debug
-objects to use. To use the default set
-B<usedefault> to 1.
-
-The B<time> parameter specifies whether or not to add a
-timestamp to the beginning of each logged line.
-
-=item LogN
-
- LogN(array)
-
-Logs the elements of the array at the corresponding
-debug level N. If you pass in a reference to an
-array or hash then they are printed in a readable
-way. (ie... Log0, Log2, Log100, etc...)
-
-=back
+ new(hash) - creates the Debug object. The hash argument is passed
+ to the Init function. See that function description
+ below for the valid settings.
+
+ Init(level=>integer, - initializes the debug object. The level
+ file=>string, determines the maximum level of debug
+ header=>string, messages to log:
+ setdefault=>0|1, 0 - Base level Output (default)
+ usedefault=>0|1, 1 - High level API calls
+ time=>0|1) 2 - Low level API calls
+ ...
+ N - Whatever you want....
+ The file determines where the debug log
+ goes. You can either specify a path to
+ a file, or "stdout" (the default). "stdout"
+ tells Debug to send all of the debug info
+ sent to this object to go to stdout.
+ header is a string that will preappended
+ to the beginning of all log entries. This
+ makes it easier to see what generated the
+ log entry (default is "Debug").
+ setdefault saves the current filehandle
+ and makes it available for other Debug
+ objects to use. To use the default set
+ usedefault to 1. The time parameter
+ specifies whether or not to add a timestamp
+ to the beginning of each logged line.
+
+ LogN(array) - Logs the elements of the array at the corresponding
+ debug level N. If you pass in a reference to an
+ array or hash then they are printed in a readable
+ way. (ie... Log0, Log2, Log100, etc...)
=head1 EXAMPLE
- $Debug = Net::XMPP:Debug->new(level=>2,
+ $Debug = new Net::XMPP:Debug(level=>2,
header=>"Example");
- $Debug->Log0("test");
+ $Debug->Log0("test");
- $Debug->Log2("level 2 test");
+ $Debug->Log2("level 2 test");
- $hash{a} = "atest";
- $hash{b} = "btest";
+ $hash{a} = "atest";
+ $hash{b} = "btest";
- $Debug->Log1("hashtest", \%hash);
+ $Debug->Log1("hashtest",\%hash);
-You would get the following log:
+ You would get the following log:
Example: test
Example: level 2 test
Example: hashtest { a=>"atest" b=>"btest" }
-If you had set the level to 1 instead of 2 you would get:
+ If you had set the level to 1 instead of 2 you would get:
Example: test
Example: hashtest { a=>"atest" b=>"btest" }
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.008;
+require 5.003;
use strict;
-use warnings;
use FileHandle;
use Carp;
use vars qw( %HANDLES $DEFAULT $DEFAULTLEVEL $DEFAULTTIME $AUTOLOAD );
@@ -185,7 +151,7 @@ sub Init
my %args;
while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
- delete($args{file}) if (defined $args{file} && lc($args{file}) eq "stdout");
+ delete($args{file}) if (lc($args{file}) eq "stdout");
$args{time} = 0 if !exists($args{time});
$args{setdefault} = 0 if !exists($args{setdefault});
@@ -202,48 +168,23 @@ sub Init
{
$self->{LEVEL} = 0;
$self->{LEVEL} = $args{level} if exists($args{level});
- if ($self->{LEVEL} >= 0)
- {
- $self->{HANDLE} = FileHandle->new(">&STDERR");
- $self->{HANDLE}->autoflush(1);
- if (exists($args{file}))
+ $self->{HANDLE} = new FileHandle(">&STDERR");
+ $self->{HANDLE}->autoflush(1);
+ if (exists($args{file}))
+ {
+ if (exists($Net::XMPP::Debug::HANDLES{$args{file}}))
{
- if (exists($Net::XMPP::Debug::HANDLES{$args{file}}))
- {
- $self->{HANDLE} = $Net::XMPP::Debug::HANDLES{$args{file}};
- $self->{HANDLE}->autoflush(1);
- }
- else
+ $self->{HANDLE} = $Net::XMPP::Debug::HANDLES{$args{file}};
+ $self->{HANDLE}->autoflush(1);
+ }
+ else
+ {
+ if (-e $args{file})
{
- if (-e $args{file})
- {
- if (-w $args{file})
- {
- $self->{HANDLE} = FileHandle->new(">$args{file}");
- if (defined($self->{HANDLE}))
- {
- $self->{HANDLE}->autoflush(1);
- $Net::XMPP::Debug::HANDLES{$args{file}} = $self->{HANDLE};
- }
- else
- {
- print STDERR "ERROR: Debug filehandle could not be opened.\n";
- print STDERR" Debugging disabled.\n";
- print STDERR " ($!)\n";
- $self->{LEVEL} = -1;
- }
- }
- else
- {
- print STDERR "ERROR: You do not have permission to write to $args{file}.\n";
- print STDERR" Debugging disabled.\n";
- $self->{LEVEL} = -1;
- }
- }
- else
+ if (-w $args{file})
{
- $self->{HANDLE} = FileHandle->new(">$args{file}");
+ $self->{HANDLE} = new FileHandle(">$args{file}");
if (defined($self->{HANDLE}))
{
$self->{HANDLE}->autoflush(1);
@@ -257,6 +198,28 @@ sub Init
$self->{LEVEL} = -1;
}
}
+ else
+ {
+ print STDERR "ERROR: You do not have permission to write to $args{file}.\n";
+ print STDERR" Debugging disabled.\n";
+ $self->{LEVEL} = -1;
+ }
+ }
+ else
+ {
+ $self->{HANDLE} = new FileHandle(">$args{file}");
+ if (defined($self->{HANDLE}))
+ {
+ $self->{HANDLE}->autoflush(1);
+ $Net::XMPP::Debug::HANDLES{$args{file}} = $self->{HANDLE};
+ }
+ else
+ {
+ print STDERR "ERROR: Debug filehandle could not be opened.\n";
+ print STDERR" Debugging disabled.\n";
+ print STDERR " ($!)\n";
+ $self->{LEVEL} = -1;
+ }
}
}
}
@@ -285,7 +248,6 @@ sub Log
my $fh = $self->{HANDLE};
$fh = $Net::XMPP::Debug::DEFAULT if exists($self->{USEDEFAULT});
- return if not $fh;
my $string = "";
@@ -61,7 +61,7 @@ Net::XMPP::IQ - XMPP Info/Query Module
use Net::XMPP;
- $IQ = Net::XMPP::IQ->new();
+ $IQ = new Net::XMPP::IQ();
$IQType = $IQ->NewChild( type );
$IQType->SetXXXXX("yyyyy");
@@ -256,22 +256,17 @@ Net::XMPP::IQ - XMPP Info/Query Module
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.008;
+require 5.003;
use strict;
-use warnings;
use Carp;
use vars qw( %FUNCTIONS );
use Net::XMPP::Stanza;
@@ -295,7 +290,7 @@ sub new
return $self;
}
-sub _iq { my $self = shift; return Net::XMPP::IQ->new(); }
+sub _iq { my $self = shift; return new Net::XMPP::IQ(); }
$FUNCTIONS{Error}->{path} = 'error/text()';
@@ -27,38 +27,38 @@ Net::XMPP::JID - XMPP JID Module
=head1 SYNOPSIS
-Net::XMPP::JID is a companion to the Net::XMPP module.
-It provides the user a simple interface to set and retrieve all
-parts of a Jabber ID (userid on a server).
+ Net::XMPP::JID is a companion to the Net::XMPP module.
+ It provides the user a simple interface to set and retrieve all
+ parts of a Jabber ID (userid on a server).
=head1 DESCRIPTION
-To initialize the JID you must pass it the string that represents the
-jid from the XML packet. Inside the XMPP modules this is done
-automatically and the JID object is returned instead of a string.
-For example, in the callback function for the XMPP object foo:
+ To initialize the JID you must pass it the string that represents the
+ jid from the XML packet. Inside the XMPP modules this is done
+ automatically and the JID object is returned instead of a string.
+ For example, in the callback function for the XMPP object foo:
use Net::XMPP;
sub foo {
- my $foo = Net::XMPP::Foo->new(@_);
+ my $foo = new Net::XMPP::Foo(@_);
my $from = $foo->GetFrom();
- my $JID = Net::XMPP::JID->new($from);
+ my $JID = new Net::XMPP::JID($from);
.
.
.
}
-You now have access to all of the retrieval functions available.
+ You now have access to all of the retrieval functions available.
-To create a new JID to send to the server:
+ To create a new JID to send to the server:
use Net::XMPP;
- $JID = Net::XMPP::JID->new();
+ $JID = new Net::XMPP::JID();
-Now you can call the creation functions below to populate the tag
-before sending it.
+ Now you can call the creation functions below to populate the tag
+ before sending it.
=head2 Retrieval functions
@@ -86,109 +86,60 @@ before sending it.
=head2 Retrieval functions
-=over 4
+ GetUserID() - returns a string with the userid of the JID.
+ If the string is an address (bob%jabber.org) then
+ the function will return it as an address
+ (bob@jabber.org).
-=item GetUserID
+ GetServer() - returns a string with the server of the JID.
- GetUserID()
+ GetResource() - returns a string with the resource of the JID.
-returns a string with the userid of the JID.
-If the string is an address (bob%jabber.org) then
-the function will return it as an address
-(bob@jabber.org).
-
-=item GetServer
-
- GetServer()
-
-returns a string with the server of the JID.
-
-=item GerResource
-
- GetResource()
-
-returns a string with the resource of the JID.
-
-=item GetJID
-
- GetJID()
- GetJID("full")
- GetJID("base")
-returns a string that represents the JID stored
-within. If the "full" string is specified, then
-you get the full JID, including Resource, which
-should be used to send to the server. If the "base",
-string is specified, then you will just get
-user@server, or the base JID.
-
-=back
+ GetJID() - returns a string that represents the JID stored
+ GetJID("full") within. If the "full" string is specified, then
+ GetJID("base") you get the full JID, including Resource, which
+ should be used to send to the server. If the "base",
+ string is specified, then you will just get
+ user@server, or the base JID.
=head2 Creation functions
-=over 4
-
-=item SetJID
-
- SetJID(userid=>string,
- server=>string,
- resource=>string)
- SetJID(string)
-
-set multiple fields in the jid at
-one time. This is a cumulative
-and over writing action. If you set
-the "userid" attribute twice, the second
-setting is what is used. If you set
-the server, and then set the resource
-then both will be in the jid. If all
-you pass is a string, then that string
-is used as the JID. For valid settings
-read the specific Set functions below.
-
-=item SetUserID
-
- SetUserID(string)
-
-sets the userid. Must be a valid userid or the
-server will complain if you try to use this JID
-to talk to the server. If the string is an
-address then it will be converted to the %
-form suitable for using as a User ID.
-
-=item SerServer
-
- SetServer(string)
-
-sets the server. Must be a valid host on the
-network or the server will not be able to talk
-to it.
-
-=item SetResource
-
- SetResource(string)
-
-sets the resource of the userid to talk to.
-
-=back
+ SetJID(userid=>string, - set multiple fields in the jid at
+ server=>string, one time. This is a cumulative
+ resource=>string) and over writing action. If you set
+ SetJID(string) the "userid" attribute twice, the second
+ setting is what is used. If you set
+ the server, and then set the resource
+ then both will be in the jid. If all
+ you pass is a string, then that string
+ is used as the JID. For valid settings
+ read the specific Set functions below.
+
+ SetUserID(string) - sets the userid. Must be a valid userid or the
+ server will complain if you try to use this JID
+ to talk to the server. If the string is an
+ address then it will be converted to the %
+ form suitable for using as a User ID.
+
+ SetServer(string) - sets the server. Must be a valid host on the
+ network or the server will not be able to talk
+ to it.
+
+ SetResource(string) - sets the resource of the userid to talk to.
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.008;
+require 5.003;
use strict;
-use warnings;
use Carp;
sub new
@@ -54,7 +54,7 @@ Net::XMPP::Message - XMPP Message Module
use Net::XMPP;
- $Mess = Net::XMPP::Message->new();
+ $Mess = new Net::XMPP::Message();
Now you can call the creation functions below to populate the tag
before sending it.
@@ -279,22 +279,17 @@ Net::XMPP::Message - XMPP Message Module
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.008;
+require 5.003;
use strict;
-use warnings;
use Carp;
use vars qw( %FUNCTIONS );
use Net::XMPP::Stanza;
@@ -319,7 +314,7 @@ sub new
return $self;
}
-sub _message { my $self = shift; return Net::XMPP::Message->new(); }
+sub _message { my $self = shift; return new Net::XMPP::Message(); }
# Copied from Net::Jabber::Message because GetTimeStamp doesn't work without DefinedX
sub GetX { my $self = shift; $self->GetChild(@_); }
@@ -27,66 +27,66 @@ Net::XMPP::Namespaces - In depth discussion on how namespaces are handled
=head1 SYNOPSIS
-Net::XMPP::Namespaces provides an depth look at how Net::XMPP handles
-namespacs, and how to add your own custom ones. It also serves as the
-storage bin for all of the Namespace information Net::XMPP requires.
+ Net::XMPP::Namespaces provides an depth look at how Net::XMPP handles
+ namespacs, and how to add your own custom ones. It also serves as the
+ storage bin for all of the Namespace information Net::XMPP requires.
=head1 DESCRIPTION
-XMPP as a protocol is very well defined. There are three main top
-level packets (message, iq, and presence). There is also a way to
-extend the protocol in a very clear and strucutred way, via namespaces.
+ XMPP as a protocol is very well defined. There are three main top
+ level packets (message, iq, and presence). There is also a way to
+ extend the protocol in a very clear and strucutred way, via namespaces.
-Two major ways that namespaces are used in Jabber is for making the
-<iq/> a generic wrapper, and as a way for adding data to any packet via
-a child tag <x/>. We will use <x/> to represent the packet, but in
-reality it could be any child tag: <foo/>, <data/>, <error/>, etc.
+ Two major ways that namespaces are used in Jabber is for making the
+ <iq/> a generic wrapper, and as a way for adding data to any packet via
+ a child tag <x/>. We will use <x/> to represent the packet, but in
+ reality it could be any child tag: <foo/>, <data/>, <error/>, etc.
-The Info/Query <iq/> packet uses namespaces to determine the type of
-information to access. Usually there is a <query/> tag in the <iq/>
-that represents the namespace, but in fact it can be any tag. The
-definition of the Query portion, is the first tag that has a namespace.
+ The Info/Query <iq/> packet uses namespaces to determine the type of
+ information to access. Usually there is a <query/> tag in the <iq/>
+ that represents the namespace, but in fact it can be any tag. The
+ definition of the Query portion, is the first tag that has a namespace.
<iq type="get"><query xmlns="..."/></iq>
-or
+ or
<iq type="get"><foo xmlns="..."/></iq>
-After that Query stanza can be any number of other stanzas (<x/> tags)
-you want to include. The Query packet is represented and available by
-calling GetQuery() or GetChild(), and the other namespaces are
-available by calling GetChild().
+ After that Query stanza can be any number of other stanzas (<x/> tags)
+ you want to include. The Query packet is represented and available by
+ calling GetQuery() or GetChild(), and the other namespaces are
+ available by calling GetChild().
-The X tag is just a way to piggy back data on other packets. Like
-embedding the timestamp for a message using jabber:x:delay, or signing
-you presence for encryption using jabber:x:signed.
+ The X tag is just a way to piggy back data on other packets. Like
+ embedding the timestamp for a message using jabber:x:delay, or signing
+ you presence for encryption using jabber:x:signed.
-To this end, Net::XMPP has sought to find a way to easily, and clearly
-define the functions needed to access the XML for a namespace. We will
-go over the full docs, and then show two examples of real namespaces so
-that you can see what we are talking about.
+ To this end, Net::XMPP has sought to find a way to easily, and clearly
+ define the functions needed to access the XML for a namespace. We will
+ go over the full docs, and then show two examples of real namespaces so
+ that you can see what we are talking about.
=head2 Overview
-To avoid a lot of nasty modules populating memory that are not used,
-and to avoid having to change 15 modules when a minor change is
-introduced, the Net::XMPP modules have taken AUTOLOADing to the
-extreme. Namespaces.pm is nothing but a set of function calls that
-generates a big hash of hashes. The hash is accessed by the Stanza.pm
-AUTOLOAD function to do something. (This will make sense, I promise.)
+ To avoid a lot of nasty modules populating memory that are not used,
+ and to avoid having to change 15 modules when a minor change is
+ introduced, the Net::XMPP modules have taken AUTOLOADing to the
+ extreme. Namespaces.pm is nothing but a set of function calls that
+ generates a big hash of hashes. The hash is accessed by the Stanza.pm
+ AUTOLOAD function to do something. (This will make sense, I promise.)
-Before going on, I highly suggest you read a Perl book on AUTOLOAD and
-how it works. From this point on I will assume that you understand it.
+ Before going on, I highly suggest you read a Perl book on AUTOLOAD and
+ how it works. From this point on I will assume that you understand it.
-When you create a Net::XMPP::IQ object and add a Query to it (NewChild)
-several things are happening in the background. The argument to
-NewChild is the namespace you want to add. (custom-namespace)
+ When you create a Net::XMPP::IQ object and add a Query to it (NewChild)
+ several things are happening in the background. The argument to
+ NewChild is the namespace you want to add. (custom-namespace)
-Now that you have a Query object to work with you will call the GetXXX
-functions, and SetXXX functions to set the data. There are no defined
-GetXXX and SetXXXX functions. You cannot look in the Namespaces.pm
-file and find them. Instead you will find something like this:
+ Now that you have a Query object to work with you will call the GetXXX
+ functions, and SetXXX functions to set the data. There are no defined
+ GetXXX and SetXXXX functions. You cannot look in the Namespaces.pm
+ file and find them. Instead you will find something like this:
&add_ns(ns => "mynamespace",
tag => "mytag",
@@ -97,46 +97,46 @@ file and find them. Instead you will find something like this:
}
);
-When the GetUsername() function is called, the AUTOLOAD function looks
-in the Namespaces.pm hash for a "Username" key. Based on the "type" of
-the field (scalar being the default) it will use the "path" as an XPath
-to retrieve the data and call the XPathGet() method in Stanza.pm.
+ When the GetUsername() function is called, the AUTOLOAD function looks
+ in the Namespaces.pm hash for a "Username" key. Based on the "type" of
+ the field (scalar being the default) it will use the "path" as an XPath
+ to retrieve the data and call the XPathGet() method in Stanza.pm.
-Confused yet?
+ Confused yet?
=head2 Net::XMPP private namespaces
-Now this is where this starts to get a little sticky. When you see a
-namespace with __netxmpp__, or __netjabber__ from Net::Jabber, at the
-beginning it is usually something custom to Net::XMPP and NOT part of
-the actual XMPP protocol.
-
-There are some places where the structure of the XML allows for
-multiple children with the same name. The main places you will see
-this behavior is where you have multiple tags with the same name and
-those have children under them (jabber:iq:roster).
-
-In jabber:iq:roster, the <item/> tag can be repeated multiple times,
-and is sort of like a mini-namespace in itself. To that end, we treat
-it like a seperate namespace and defined a __netxmpp__:iq:roster:item
-namespace to hold it. What happens is this, in my code I define that
-the <item/>s tag is "item" and anything with that tag name is to create
-a new Net::XMPP::Stanza object with the namespace
-__netxmpp__:iq:roster:item which then becomes a child of the
-jabber:iq:roster Stanza object. Also, when you want to add a new item
-to a jabber:iq:roster project you call NewQuery with the private
-namespace.
-
-I know this sounds complicated. And if after reading this entire
-document it is still complicated, email me, ask questions, and I will
-monitor it and adjust these docs to answer the questions that people
-ask.
+ Now this is where this starts to get a little sticky. When you see a
+ namespace with __netxmpp__, or __netjabber__ from Net::Jabber, at the
+ beginning it is usually something custom to Net::XMPP and NOT part of
+ the actual XMPP protocol.
+
+ There are some places where the structure of the XML allows for
+ multiple children with the same name. The main places you will see
+ this behavior is where you have multiple tags with the same name and
+ those have children under them (jabber:iq:roster).
+
+ In jabber:iq:roster, the <item/> tag can be repeated multiple times,
+ and is sort of like a mini-namespace in itself. To that end, we treat
+ it like a seperate namespace and defined a __netxmpp__:iq:roster:item
+ namespace to hold it. What happens is this, in my code I define that
+ the <item/>s tag is "item" and anything with that tag name is to create
+ a new Net::XMPP::Stanza object with the namespace
+ __netxmpp__:iq:roster:item which then becomes a child of the
+ jabber:iq:roster Stanza object. Also, when you want to add a new item
+ to a jabber:iq:roster project you call NewQuery with the private
+ namespace.
+
+ I know this sounds complicated. And if after reading this entire
+ document it is still complicated, email me, ask questions, and I will
+ monitor it and adjust these docs to answer the questions that people
+ ask.
=head2 add_ns()
-To repeat, here is an example call to add_ns():
+ To repeat, here is an example call to add_ns():
- add_ns(ns => "mynamespace",
+ &add_ns(ns => "mynamespace",
tag => "mytag",
xpath => {
JID => { type=>'jid', path => '@jid' },
@@ -145,16 +145,17 @@ To repeat, here is an example call to add_ns():
}
);
-ns - This is the new namespace that you are trying to add.
+ ns - This is the new namespace that you are trying to add.
-tag - This is the root tag to use for objects based on this namespace.
+ tag - This is the root tag to use for objects based on this namespace.
-xpath - The hash reference passed in the add_ns call to each name of
-entry tells Net::XMPP how to handle subsequent GetXXXX(), SetXXXX(),
-DefinedXXXX(), RemoveXXXX(), AddXXXX() calls. The basic options you
-can pass in are:
+ xpath - The hash reference passed in the add_ns call to each name of
+ entry tells Net::XMPP how to handle subsequent GetXXXX(), SetXXXX(),
+ DefinedXXXX(), RemoveXXXX(), AddXXXX() calls. The basic options you
+ can pass in are:
-type - This tells Stanza how to handle the call. The possible values are:
+ type - This tells Stanza how to handle the call. The possible
+ values are:
array - The value to set and returned is an an array
reference. For example, <group/> in jabber:iq:roster.
@@ -292,31 +293,23 @@ type - This tells Stanza how to handle the call. The possible values are:
=head2 Wrap Up
-Well. I hope that I have not scared you off from writing a custom
-namespace for you application and use Net::XMPP. Look in the
-Net::XMPP::Protocol manpage for an example on using the add_ns()
-function to register your custom namespace so that Net::XMPP can
-properly handle it.
+ Well. I hope that I have not scared you off from writing a custom
+ namespace for you application and use Net::XMPP. Look in the
+ Net::XMPP::Protocol manpage for an example on using the add_ns()
+ function to register your custom namespace so that Net::XMPP can
+ properly handle it.
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.008;
-use strict;
-use warnings;
-
use vars qw ( %NS %SKIPNS );
$SKIPNS{'__netxmpp__'} = 1;
@@ -27,17 +27,17 @@ Net::XMPP::Presence - XMPP Presence Module
=head1 SYNOPSIS
-Net::XMPP::Presence is a companion to the Net::XMPP module.
-It provides the user a simple interface to set and retrieve all
-parts of an XMPP Presence.
+ Net::XMPP::Presence is a companion to the Net::XMPP module.
+ It provides the user a simple interface to set and retrieve all
+ parts of an XMPP Presence.
=head1 DESCRIPTION
-A Net::XMPP::Presence object is passed to the callback function for
-the message. Also, the first argument to the callback functions is
-the session ID from XML::Streams. There are some cases where you
-might want this information, like if you created a Client that
-connects to two servers at once, or for writing a mini server.
+ A Net::XMPP::Presence object is passed to the callback function for
+ the message. Also, the first argument to the callback functions is
+ the session ID from XML::Streams. There are some cases where you
+ might want this information, like if you created a Client that
+ connects to two servers at once, or for writing a mini server.
use Net::XMPP;
@@ -48,316 +48,204 @@ connects to two servers at once, or for writing a mini server.
.
}
-You now have access to all of the retrieval functions available.
+ You now have access to all of the retrieval functions available.
-To create a new presence to send to the server:
+ To create a new presence to send to the server:
use Net::XMPP;
- $Pres = Net::XMPP::Presence->new();
+ $Pres = new Net::XMPP::Presence();
-Now you can call the creation functions below to populate the tag
-before sending it.
+ Now you can call the creation functions below to populate the tag
+ before sending it.
=head1 METHODS
=head2 Retrieval functions
-=over 4
+ GetTo() - returns the value in the to='' attribute for the
+ GetTo("jid") <presence/>. If you specify "jid" as an argument
+ then a Net::XMPP::JID object is returned and
+ you can easily parse the parts of the JID.
-=item GetTo
+ $to = $Pres->GetTo();
+ $toJID = $Pres->GetTo("jid");
- GetTo()
+ GetFrom() - returns the value in the from='' attribute for the
+ GetFrom("jid") <presence/>. If you specify "jid" as an argument
+ then a Net::XMPP::JID object is returned and
+ you can easily parse the parts of the JID.
-returns the value in the to='' attribute for the <presence/>.
+ $from = $Pres->GetFrom();
+ $fromJID = $Pres->GetFrom("jid");
- GetTo("jid")
+ GetType() - returns the type='' attribute of the <presence/>. Each
+ presence is one of seven types:
+ available available to receive messages; default
+ unavailable unavailable to receive anything
+ subscribe ask the recipient to subscribe you
+ subscribed tell the sender they are subscribed
+ unsubscribe ask the recipient to unsubscribe you
+ unsubscribed tell the sender they are unsubscribed
+ probe probe
-If you specify "jid" as an argument
-then a Net::XMPP::JID object is returned and
-you can easily parse the parts of the JID.
+ $type = $Pres->GetType();
- $to = $Pres->GetTo();
- $toJID = $Pres->GetTo("jid");
+ GetStatus() - returns a string with the current status of the resource.
-=item GetFrom
+ $status = $Pres->GetStatus();
- GetFrom()
+ GetPriority() - returns an integer with the priority of the resource
+ The default is 0 if there is no priority in this
+ presence.
-returns the value in the from='' attribute for the <presence/>.
+ $priority = $Pres->GetPriority();
- GetFrom("jid")
+ GetShow() - returns a string with the state the client should show.
-If you specify "jid" as an argument
-then a Net::XMPP::JID object is returned and
-you can easily parse the parts of the JID.
-
- $from = $Pres->GetFrom();
- $fromJID = $Pres->GetFrom("jid");
-
-=item GetType
-
- GetType()
-
-returns the type='' attribute of the <presence/>. Each
-presence is one of seven types:
-
- available available to receive messages; default
- unavailable unavailable to receive anything
- subscribe ask the recipient to subscribe you
- subscribed tell the sender they are subscribed
- unsubscribe ask the recipient to unsubscribe you
- unsubscribed tell the sender they are unsubscribed
- probe probe
-
- $type = $Pres->GetType();
-
-=item GetStatus
-
- GetStatus()
-
-returns a string with the current status of the resource.
-
- $status = $Pres->GetStatus();
-
-=item GetPriority
-
- GetPriority()
-
-returns an integer with the priority of the resource
-The default is 0 if there is no priority in this
-presence.
-
- $priority = $Pres->GetPriority();
-
-=item GetShow
-
- GetShow()
-
-Returns a string with the state the client should show.
-
- $show = $Pres->GetShow();
-
-=back
+ $show = $Pres->GetShow();
=head2 Creation functions
-=over 4
-
-=item SetPresence
-
- SetPresence(to=>string|JID
- from=>string|JID,
- type=>string,
- status=>string,
- priority=>integer,
- meta=>string,
- icon=>string,
- show=>string,
- loc=>string)
-
-set multiple fields in the <presence/>
-at one time. This is a cumulative
-and over writing action. If you set
-the "to" attribute twice, the second
-setting is what is used. If you set
-the status, and then set the priority
-then both will be in the <presence/>
-tag. For valid settings read the
-specific Set functions below.
-
- $Pres->SetPresence(TYPE=>"away", StatuS=>"Out for lunch");
-
-=item SetTo
-
- SetTo(string)
- SetTo(JID)
-
-sets the to attribute. You can either pass a string
-or a JID object. They must be valid JIDs or the
-server will return an error message.
-(ie. bob@jabber.org/Silent Bob, etc...)
-
- $Pres->SetTo("bob\@jabber.org");
-
-=item SetFrom
-
- SetFrom(string)
+ SetPresence(to=>string|JID - set multiple fields in the <presence/>
+ from=>string|JID, at one time. This is a cumulative
+ type=>string, and over writing action. If you set
+ status=>string, the "to" attribute twice, the second
+ priority=>integer, setting is what is used. If you set
+ meta=>string, the status, and then set the priority
+ icon=>string, then both will be in the <presence/>
+ show=>string, tag. For valid settings read the
+ loc=>string) specific Set functions below.
-sets the from='' attribute. You can either pass
+ $Pres->SetPresence(TYPE=>"away",
+ StatuS=>"Out for lunch");
- SetFrom(JID)
+ SetTo(string) - sets the to attribute. You can either pass a string
+ SetTo(JID) or a JID object. They must be valid JIDs or the
+ server will return an error message.
+ (ie. bob@jabber.org/Silent Bob, etc...)
-A string or a JID object. They must be valid JIDs
-or the server will return an error message. (ie.
-jabber:bob@jabber.org/Work) This field is not
-required if you are writing a Client since the
-server will put the JID of your connection in there
-to prevent spamming.
+ $Pres->SetTo("bob\@jabber.org");
- $Pres->SetFrom("jojo\@jabber.org");
+ SetFrom(string) - sets the from='' attribute. You can either pass
+ SetFrom(JID) a string or a JID object. They must be valid JIDs
+ or the server will return an error message. (ie.
+ jabber:bob@jabber.org/Work) This field is not
+ required if you are writing a Client since the
+ server will put the JID of your connection in there
+ to prevent spamming.
-=item SetType
+ $Pres->SetFrom("jojo\@jabber.org");
- SetType(string)
+ SetType(string) - sets the type attribute. Valid settings are:
-sets the type attribute. Valid settings are:
+ available available to receive messages; default
+ unavailable unavailable to receive anything
+ subscribe ask the recipient to subscribe you
+ subscribed tell the sender they are subscribed
+ unsubscribe ask the recipient to unsubscribe you
+ unsubscribed tell the sender they are unsubscribed
+ probe probe
- available available to receive messages; default
- unavailable unavailable to receive anything
- subscribe ask the recipient to subscribe you
- subscribed tell the sender they are subscribed
- unsubscribe ask the recipient to unsubscribe you
- unsubscribed tell the sender they are unsubscribed
- probe probe
+ $Pres->SetType("unavailable");
- $Pres->SetType("unavailable");
+ SetStatus(string) - sets the status tag to be whatever string the user
+ wants associated with that resource.
-=item SetStatus
+ $Pres->SetStatus("Taking a nap");
- SetStatus(string)
+ SetPriority(integer) - sets the priority of this resource. The highest
+ resource attached to the xmpp account is the
+ one that receives the messages.
-sets the status tag to be whatever string the user
-wants associated with that resource.
+ $Pres->SetPriority(10);
- $Pres->SetStatus("Taking a nap");
+ SetShow(string) - sets the name of the icon or string to display for
+ this resource.
-=item SetPriority
+ $Pres->SetShow("away");
- SetPriority(integer)
+ Reply(hash) - creates a new Presence object and populates the to/from
+ fields. If you specify a hash the same as with
+ SetPresence then those values will override the Reply
+ values.
-sets the priority of this resource. The highest
-resource attached to the xmpp account is the
-one that receives the messages.
-
- $Pres->SetPriority(10);
-
-=item SetShow
-
- SetShow(string)
-
-Sets the name of the icon or string to display for this resource.
-
- $Pres->SetShow("away");
-
-=item Reply
-
- Reply(hash)
-
-creates a new Presence object and populates the to/from
-fields. If you specify a hash the same as with
-SetPresence then those values will override the Reply
-values.
-
- $Reply = $Pres->Reply();
- $Reply = $Pres->Reply(type=>"subscribed");
-
-=back
+ $Reply = $Pres->Reply();
+ $Reply = $Pres->Reply(type=>"subscribed");
=head2 Removal functions
-=over 4
-
-=item RemoveTo
-
-removes the to attribute from the <presence/>.
-
- $Pres->RemoveTo();
-
-=item RemoveFrom
-
-removes the from attribute from the <presence/>.
+ RemoveTo() - removes the to attribute from the <presence/>.
- $Pres->RemoveFrom();
+ $Pres->RemoveTo();
-=item RemoveType
+ RemoveFrom() - removes the from attribute from the <presence/>.
-removes the type attribute from the <presence/>.
+ $Pres->RemoveFrom();
- $Pres->RemoveType();
+ RemoveType() - removes the type attribute from the <presence/>.
-=item RemoveStatus
+ $Pres->RemoveType();
-removes the <status/> element from the <presence/>.
+ RemoveStatus() - removes the <status/> element from the <presence/>.
- $Pres->RemoveStatus();
+ $Pres->RemoveStatus();
-=item RemovePriority
+ RemovePriority() - removes the <priority/> element from the
+ <presence/>.
-removes the <priority/> element from the <presence/>.
+ $Pres->RemovePriority();
- $Pres->RemovePriority();
+ RemoveShow() - removes the <show/> element from the <presence/>.
-=item RemoveShow
-
-removes the <show/> element from the <presence/>.
-
- $Pres->RemoveShow();
-
-=back
+ $Pres->RemoveShow();
=head2 Test functions
-=over 4
-
-=item DefinedTo
-
-returns 1 if the to attribute is defined in the <presence/>, 0 otherwise.
-
- $test = $Pres->DefinedTo();
-
-=item DefinedFrom
+ DefinedTo() - returns 1 if the to attribute is defined in the
+ <presence/>, 0 otherwise.
-returns 1 if the from attribute is defined in the <presence/>, 0 otherwise.
+ $test = $Pres->DefinedTo();
- $test = $Pres->DefinedFrom();
+ DefinedFrom() - returns 1 if the from attribute is defined in the
+ <presence/>, 0 otherwise.
-=item DefinedType
+ $test = $Pres->DefinedFrom();
-returns 1 if the type attribute is defined in the <presence/>, 0 otherwise.
+ DefinedType() - returns 1 if the type attribute is defined in the
+ <presence/>, 0 otherwise.
- $test = $Pres->DefinedType();
+ $test = $Pres->DefinedType();
-=item DefinedStatus
+ DefinedStatus() - returns 1 if <status/> is defined in the
+ <presence/>, 0 otherwise.
-returns 1 if <status/> is defined in the <presence/>, 0 otherwise.
+ $test = $Pres->DefinedStatus();
- $test = $Pres->DefinedStatus();
+ DefinedPriority() - returns 1 if <priority/> is defined in the
+ <presence/>, 0 otherwise.
-=item DefinedPriority
+ $test = $Pres->DefinedPriority();
-returns 1 if <priority/> is defined in the <presence/>, 0 otherwise.
+ DefinedShow() - returns 1 if <show/> is defined in the <presence/>,
+ 0 otherwise.
- $test = $Pres->DefinedPriority();
-
-=item DefinedShow
-
-returns 1 if <show/> is defined in the <presence/>, 0 otherwise.
-
- $test = $Pres->DefinedShow();
-
-=back
+ $test = $Pres->DefinedShow();
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.008;
+require 5.003;
use strict;
-use warnings;
-
use Carp;
use vars qw( %FUNCTIONS );
use Net::XMPP::Stanza;
@@ -381,7 +269,7 @@ sub new
return $self;
}
-sub _presence { return Net::XMPP::Presence->new(); }
+sub _presence { my $self = shift; return new Net::XMPP::Presence(); }
$FUNCTIONS{Error}->{path} = 'error/text()';
@@ -27,7 +27,7 @@ Net::XMPP::PrivacyLists - XMPP Privacy Lists Object
=head1 SYNOPSIS
-This module is not yet complete. Do not use.
+ This module is not yet complete. Do not use.
=head1 DESCRIPTION
@@ -43,25 +43,17 @@ This module is not yet complete. Do not use.
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.003;
use strict;
-use warnings;
-
use Carp;
-use XML::Stream;
sub new
{
@@ -27,62 +27,53 @@ Net::XMPP::Protocol - XMPP Protocol Module
=head1 SYNOPSIS
-Net::XMPP::Protocol is a module that provides a developer easy
-access to the XMPP Instant Messaging protocol. It provides high
-level functions to the Net::XMPP Client object. These functions are
-inherited by that modules.
+ Net::XMPP::Protocol is a module that provides a developer easy
+ access to the XMPP Instant Messaging protocol. It provides high
+ level functions to the Net::XMPP Client object. These functions are
+ inherited by that modules.
=head1 DESCRIPTION
-Protocol.pm seeks to provide enough high level APIs and automation of
-the low level APIs that writing a XMPP Client in Perl is trivial. For
-those that wish to work with the low level you can do that too, but
-those functions are covered in the documentation for each module.
+ Protocol.pm seeks to provide enough high level APIs and automation of
+ the low level APIs that writing a XMPP Client in Perl is trivial. For
+ those that wish to work with the low level you can do that too, but
+ those functions are covered in the documentation for each module.
-Net::XMPP::Protocol provides functions to login, send and receive
-messages, set personal information, create a new user account, manage
-the roster, and disconnect. You can use all or none of the functions,
-there is no requirement.
+ Net::XMPP::Protocol provides functions to login, send and receive
+ messages, set personal information, create a new user account, manage
+ the roster, and disconnect. You can use all or none of the functions,
+ there is no requirement.
-For more information on how the details for how L<Net::XMPP> is written
-please see the help for Net::XMPP itself.
+ For more information on how the details for how Net::XMPP is written
+ please see the help for Net::XMPP itself.
-For more information on writing a Client see L<Net::XMPP::Client>.
+ For more information on writing a Client see Net::XMPP::Client.
=head2 Modes
-Several of the functions take a mode argument that let you specify how
-the function should behave:
+ Several of the functions take a mode argument that let you specify how
+ the function should behave:
-=over 4
+ block - send the packet with an ID, and then block until an answer
+ comes back. You can optionally specify a timeout so that
+ you do not block forever.
-=item block
+ nonblock - send the packet with an ID, but then return that id and
+ control to the master program. Net::XMPP is still
+ tracking this packet, so you must use the CheckID function
+ to tell when it comes in. (This might not be very
+ useful...)
-send the packet with an ID, and then block until an answer
-comes back. You can optionally specify a timeout so that
-you do not block forever.
+ passthru - send the packet with an ID, but do NOT register it with
+ Net::XMPP, then return the ID. This is useful when
+ combined with the XPath function because you can register
+ a one shot function tied to the id you get back.
-=item nonblock
-
-send the packet with an ID, but then return that id and
-control to the master program. Net::XMPP is still
-tracking this packet, so you must use the CheckID function
-to tell when it comes in. (This might not be very
-useful...)
-
-=item passthru
-
-send the packet with an ID, but do NOT register it with
-Net::XMPP, then return the ID. This is useful when
-combined with the XPath function because you can register
-a one shot function tied to the id you get back.
-
-=back
=head2 Basic Functions
use Net::XMPP qw( Client );
- $Con = Net::XMPP::Client->new(); # From
+ $Con = new Net::XMPP::Client(); # From
$status = $Con->Connect(hostname=>"jabber.org"); # Net::XMPP::Client
$Con->SetCallBacks(send=>\&sendCallBack,
@@ -279,791 +270,505 @@ a one shot function tied to the id you get back.
=head2 Basic Functions
-=over 4
-
-=item GetErrorCode()
-
-returns a string that will hopefully contain some
-useful information about why a function returned
-an undef to you.
-
-=item SetErrorCode
-
- SetErrorCode(string)
-
-set a useful error message before you return
-an undef to the caller.
-
-=item SetCallBacks
-
- SetCallBacks(message=>function,
- presence=>function,
- iq=>function,
- send=>function,
- receive=>function,
- update=>function)
-
-
-sets the callback functions for
-the top level tags listed. The
-available tags to look for are
-<message/>, <presence/>, and
-<iq/>. If a packet is received
-with an ID which is found in the
-registerd ID list (see RegisterID
-below) then it is not sent to
-these functions, instead it
-is inserted into a LIST and can
-be retrieved by some functions
-we will mention later.
-
-send and receive are used to
-log what XML is sent and received.
-update is used as way to update
-your program while waiting for
-a packet with an ID to be
-returned (useful for GUI apps).
-
-A major change that came with
-the last release is that the
-session id is passed to the
-callback as the first argument.
-This was done to facilitate
-the Server module.
-
-The next argument depends on
-which callback you are talking
-about. message, presence, and iq
-all get passed in Net::XMPP
-objects that match those types.
-send and receive get passed in
-strings. update gets passed
-nothing, not even the session id.
-
-If you set the function to undef,
-then the callback is removed from
-the list.
-
-=item SetPresenceCallBacks
-
- SetPresenceCallBacks(type=>function etc...)
-
-sets the callback functions for
-the specified presence type.
-The function takes types as the
-main key, and lets you specify
-a function for each type of
-packet you can get.
-
- "available"
- "unavailable"
- "subscribe"
- "unsubscribe"
- "subscribed"
- "unsubscribed"
- "probe"
- "error"
-
-When it gets a <presence/>
-packet it checks the type=''
-for a defined callback. If
-there is one then it calls the
-function with two arguments:
-
- the session ID, and the
- Net::XMPP::Presence object.
-
-If you set the function to
-undef, then the callback is
-removed from the list.
-
-NOTE: If you use this, which is a cleaner method,
-then you must *NOT* specify a callback for
-presence in the SetCallBacks function.
-
- Net::XMPP defines a few default
- callbacks for various types:
-
- "subscribe" -
- replies with subscribed
-
- "unsubscribe" -
- replies with unsubscribed
-
- "subscribed" -
- replies with subscribed
-
- "unsubscribed" -
- replies with unsubscribed
-
-=item SetMessageCallBacks
-
- SetMessageCallBacks(type=>function, etc...)
-
-sets the callback functions for
-the specified message type. The
-function takes types as the
-main key, and lets you specify
-a function for each type of
-packet you can get.
-
- "normal"
- "chat"
- "groupchat"
- "headline"
- "error"
-
-When it gets a <message/> packet
-it checks the type='' for a
-defined callback. If there is
-one then it calls the function
-with two arguments:
-
- the session ID, and the
- Net::XMPP::Message object.
-
-If you set the function to
-undef, then the callback is
-removed from the list.
-
-NOTE: If you use this, which is a cleaner method,
-then you must *NOT* specify a callback for
-message in the SetCallBacks function.
-
-=item SetIQCallBacks
-
- SetIQCallBacks(namespace=>{
- get=>function,
- set=>function,
- result=>function
- },
- etc...)
-
-
-sets the callback functions for
-the specified namespace. The
-function takes namespaces as the
-main key, and lets you specify a
-function for each type of packet
-you can get.
-
- "get"
- "set"
- "result"
-
-When it gets an <iq/> packet it
-checks the type='' and the
-xmlns='' for a defined callback.
-If there is one then it calls
-the function with two arguments:
-the session ID, and the
-Net::XMPP::xxxx object.
-
-If you set the function to undef,
-then the callback is removed from
-the list.
-
-NOTE: If you use this, which is a cleaner method,
-then you must *NOT* specify a callback for
-iq in the SetCallBacks function.
-
-=item SetXPathCallBacks
-
-
- SetXPathCallBacks(xpath=>function, etc...)
-
-registers a callback function
-for each xpath specified. If
-Net::XMPP matches the xpath,
-then it calls the function with
-two arguments:
-
- the session ID, and the
- Net::XMPP::Message object.
-
-Xpaths are rooted at each
-packet:
-
- /message[@type="chat"]
- /iq/*[xmlns="jabber:iq:roster"][1]
- ...
-
-
-=item RemoveXPathCallBacks
-
- RemoveXPathCallBacks(xpath=>function, etc...)
-
-unregisters a callback
-function for each xpath
-specified.
-
-=item SetDirectXPathCallBacks
-
- SetDirectXPathCallBacks(xpath=>function, etc...)
-
-registers a callback function
-for each xpath specified. If
-Net::XMPP matches the xpath,
-then it calls the function with
-two arguments:
-
- the session ID, and the
- XML::Stream::Node object.
-
-Xpaths are rooted at each
-packet:
-
- /anything
- /anotherthing/foo/[1]
- ...
-
-The big difference between this
-and regular XPathCallBacks is
-the fact that this passes in
-the XML directly and not a
-Net::XMPP based object.
-
-=item RemoveDirectXPathCallBacks
-
- RemoveDirectXPathCallBacks(xpath=>function, etc...)
-
-unregisters a callback
-function for each xpath
-specified.
-
-=item Process
-
- Process(integer)
-takes the timeout period as an argument. If no
-timeout is listed then the function blocks until
-a packet is received. Otherwise it waits that
-number of seconds and then exits so your program
-can continue doing useful things. NOTE: This is
-important for GUIs. You need to leave time to
-process GUI commands even if you are waiting for
-packets. The following are the possible return
-values, and what they mean:
-
- 1 - Status ok, data received.
- 0 - Status ok, no data received.
- undef - Status not ok, stop processing.
-
-IMPORTANT: You need to check the output of every
-Process. If you get an undef then the connection
-died and you should behave accordingly.
-
-=item Send
-
- Send(object, ignoreActivity)
- Send(string, ignoreActivity)
-
-takes either a Net::XMPP::xxxxx object or
-an XML string as an argument and sends it to
-the server. If you set ignoreActivty to 1,
-then the XML::Stream module will not record
-this packet as couting towards user activity.
-
-=back
-
+ GetErrorCode() - returns a string that will hopefully contain some
+ useful information about why a function returned
+ an undef to you.
+
+ SetErrorCode(string) - set a useful error message before you return
+ an undef to the caller.
+
+ SetCallBacks(message=>function, - sets the callback functions for
+ presence=>function, the top level tags listed. The
+ iq=>function, available tags to look for are
+ send=>function, <message/>, <presence/>, and
+ receive=>function, <iq/>. If a packet is received
+ update=>function) with an ID which is found in the
+ registerd ID list (see RegisterID
+ below) then it is not sent to
+ these functions, instead it
+ is inserted into a LIST and can
+ be retrieved by some functions
+ we will mention later.
+
+ send and receive are used to
+ log what XML is sent and received.
+ update is used as way to update
+ your program while waiting for
+ a packet with an ID to be
+ returned (useful for GUI apps).
+
+ A major change that came with
+ the last release is that the
+ session id is passed to the
+ callback as the first argument.
+ This was done to facilitate
+ the Server module.
+
+ The next argument depends on
+ which callback you are talking
+ about. message, presence, and iq
+ all get passed in Net::XMPP
+ objects that match those types.
+ send and receive get passed in
+ strings. update gets passed
+ nothing, not even the session id.
+
+ If you set the function to undef,
+ then the callback is removed from
+ the list.
+
+ SetPresenceCallBacks(type=>function - sets the callback functions for
+ etc...) the specified presence type.
+ The function takes types as the
+ main key, and lets you specify
+ a function for each type of
+ packet you can get.
+ "available"
+ "unavailable"
+ "subscribe"
+ "unsubscribe"
+ "subscribed"
+ "unsubscribed"
+ "probe"
+ "error"
+ When it gets a <presence/>
+ packet it checks the type=''
+ for a defined callback. If
+ there is one then it calls the
+ function with two arguments:
+ the session ID, and the
+ Net::XMPP::Presence object.
+
+ If you set the function to
+ undef, then the callback is
+ removed from the list.
+
+ NOTE: If you use this, which is a cleaner method,
+ then you must *NOT* specify a callback for
+ presence in the SetCallBacks function.
+
+ Net::XMPP defines a few default
+ callbacks for various types:
+
+ "subscribe" -
+ replies with subscribed
+
+ "unsubscribe" -
+ replies with unsubscribed
+
+ "subscribed" -
+ replies with subscribed
+
+ "unsubscribed" -
+ replies with unsubscribed
+
+
+ SetMessageCallBacks(type=>function, - sets the callback functions for
+ etc...) the specified message type. The
+ function takes types as the
+ main key, and lets you specify
+ a function for each type of
+ packet you can get.
+ "normal"
+ "chat"
+ "groupchat"
+ "headline"
+ "error"
+ When it gets a <message/> packet
+ it checks the type='' for a
+ defined callback. If there is
+ one then it calls the function
+ with two arguments:
+ the session ID, and the
+ Net::XMPP::Message object.
+
+ If you set the function to
+ undef, then the callback is
+ removed from the list.
+
+ NOTE: If you use this, which is a cleaner method,
+ then you must *NOT* specify a callback for
+ message in the SetCallBacks function.
+
+
+ SetIQCallBacks(namespace=>{ - sets the callback functions for
+ get=>function, the specified namespace. The
+ set=>function, function takes namespaces as the
+ result=>function main key, and lets you specify a
+ }, function for each type of packet
+ etc...) you can get.
+ "get"
+ "set"
+ "result"
+ When it gets an <iq/> packet it
+ checks the type='' and the
+ xmlns='' for a defined callback.
+ If there is one then it calls
+ the function with two arguments:
+ the session ID, and the
+ Net::XMPP::xxxx object.
+
+ If you set the function to undef,
+ then the callback is removed from
+ the list.
+
+ NOTE: If you use this, which is a cleaner method,
+ then you must *NOT* specify a callback for
+ iq in the SetCallBacks function.
+
+ SetXPathCallBacks(xpath=>function, - registers a callback function
+ etc...) for each xpath specified. If
+ Net::XMPP matches the xpath,
+ then it calls the function with
+ two arguments:
+ the session ID, and the
+ Net::XMPP::Message object.
+
+ Xpaths are rooted at each
+ packet:
+ /message[@type="chat"]
+ /iq/*[xmlns="jabber:iq:roster"][1]
+ ...
+
+ RemoveXPathCallBacks(xpath=>function, - unregisters a callback
+ etc...) function for each xpath
+ specified.
+
+ SetDirectXPathCallBacks(xpath=>function, - registers a callback function
+ etc...) for each xpath specified. If
+ Net::XMPP matches the xpath,
+ then it calls the function with
+ two arguments:
+ the session ID, and the
+ XML::Stream::Node object.
+
+ Xpaths are rooted at each
+ packet:
+ /anything
+ /anotherthing/foo/[1]
+ ...
+
+ The big difference between this
+ and regular XPathCallBacks is
+ the fact that this passes in
+ the XML directly and not a
+ Net::XMPP based object.
+
+ RemoveDirectXPathCallBacks(xpath=>function, - unregisters a callback
+ etc...) function for each xpath
+ specified.
+
+ Process(integer) - takes the timeout period as an argument. If no
+ timeout is listed then the function blocks until
+ a packet is received. Otherwise it waits that
+ number of seconds and then exits so your program
+ can continue doing useful things. NOTE: This is
+ important for GUIs. You need to leave time to
+ process GUI commands even if you are waiting for
+ packets. The following are the possible return
+ values, and what they mean:
+
+ 1 - Status ok, data received.
+ 0 - Status ok, no data received.
+ undef - Status not ok, stop processing.
+
+ IMPORTANT: You need to check the output of every
+ Process. If you get an undef then the connection
+ died and you should behave accordingly.
+
+ Send(object, - takes either a Net::XMPP::xxxxx object or
+ ignoreActivity) an XML string as an argument and sends it to
+ Send(string, the server. If you set ignoreActivty to 1,
+ ignoreActivity) then the XML::Stream module will not record
+ this packet as couting towards user activity.
=head2 ID Functions
-=over
-
-=item SendWithID
-
- SendWithID(object)
- SendWithID(string)
-
-takes either a Net::XMPP::xxxxx object or an
-XML string as an argument, adds the next
-available ID number and sends that packet to
-the server. Returns the ID number assigned.
-
-=item SendAndReceiveWithID
-
- SendAndReceiveWithID(object, timeout)
- SendAndReceiveWithID(string, timeout)
-
-uses SendWithID and WaitForID to
-provide a complete way to send and
-receive packets with IDs. Can take
-either a Net::XMPP::xxxxx object
-or an XML string. Returns the
-proper Net::XMPP::xxxxx object
-based on the type of packet
-received. The timeout is passed
-on to WaitForID, see that function
-for how the timeout works.
-
-=item ReceivedID
-
- ReceivedID(integer)
-
-returns 1 if a packet has been received with
-specified ID, 0 otherwise.
-
-=item GetID
-
- GetID(integer)
-
-returns the proper Net::XMPP::xxxxx object based
-on the type of packet received with the specified
-ID. If the ID has been received the GetID returns 0.
-
-=item WaitForID
-
- WaitForID(integer, timeout)
-
-blocks until a packet with the ID is received.
-Returns the proper Net::XMPP::xxxxx object
-based on the type of packet received. If the
-timeout limit is reached then if the packet
-does come in, it will be discarded.
-
-
-NOTE: Only <iq/> officially support ids, so sending a <message/>, or
-<presence/> with an id is a risk. The server will ignore the
-id tag and pass it through, so both clients must support the
-id tag for these functions to be useful.
-
-=back
+ SendWithID(object) - takes either a Net::XMPP::xxxxx object or an
+ SendWithID(string) XML string as an argument, adds the next
+ available ID number and sends that packet to
+ the server. Returns the ID number assigned.
+
+ SendAndReceiveWithID(object, - uses SendWithID and WaitForID to
+ timeout) provide a complete way to send and
+ SendAndReceiveWithID(string, receive packets with IDs. Can take
+ timeout) either a Net::XMPP::xxxxx object
+ or an XML string. Returns the
+ proper Net::XMPP::xxxxx object
+ based on the type of packet
+ received. The timeout is passed
+ on to WaitForID, see that function
+ for how the timeout works.
+
+ ReceivedID(integer) - returns 1 if a packet has been received with
+ specified ID, 0 otherwise.
+
+ GetID(integer) - returns the proper Net::XMPP::xxxxx object based
+ on the type of packet received with the specified
+ ID. If the ID has been received the GetID returns
+ 0.
+
+ WaitForID(integer, - blocks until a packet with the ID is received.
+ timeout) Returns the proper Net::XMPP::xxxxx object
+ based on the type of packet received. If the
+ timeout limit is reached then if the packet
+ does come in, it will be discarded.
+
+
+ NOTE: Only <iq/> officially support ids, so sending a <message/>, or
+ <presence/> with an id is a risk. The server will ignore the
+ id tag and pass it through, so both clients must support the
+ id tag for these functions to be useful.
=head2 Namespace Functions
-=over 4
-
-=item AddNamespace
-
- AddNamespace(ns=>string,
- tag=>string,
- xpath=>hash)
-
-This function is very complex.
-It is a little too complex to
-discuss within the confines of
-this small paragraph. Please
-refer to the man page for
-Net::XMPP::Namespaces for the
-full documentation on this
-subject.
-
-=back
+ AddNamespace(ns=>string, - This function is very complex.
+ tag=>string, It is a little too complex to
+ xpath=>hash) discuss within the confines of
+ this small paragraph. Please
+ refer to the man page for
+ Net::XMPP::Namespaces for the
+ full documentation on this
+ subject.
=head2 Message Functions
-=over 4
-
-=item MessageSend
-
- MessageSend(hash)
-
-takes the hash and passes it to SetMessage in
-Net::XMPP::Message (refer there for valid
-settings). Then it sends the message to the
-server.
-
-=back
+ MessageSend(hash) - takes the hash and passes it to SetMessage in
+ Net::XMPP::Message (refer there for valid
+ settings). Then it sends the message to the
+ server.
=head2 Presence Functions
-=over 4
-
-=item PresenceSend
-
- PresenceSend()
- PresenceSend(hash, signature=>string)
-
-No arguments will send an empty
-Presence to the server to tell it
-that you are available. If you
-provide a hash, then it will pass
-that hash to the SetPresence()
-function as defined in the
-Net::XMPP::Presence module.
-Optionally, you can specify a
-signature and a jabber:x:signed
-will be placed in the <presence/>.
-
-=back
+ PresenceSend() - no arguments will send an empty
+ PresenceSend(hash, Presence to the server to tell it
+ signature=>string) that you are available. If you
+ provide a hash, then it will pass
+ that hash to the SetPresence()
+ function as defined in the
+ Net::XMPP::Presence module.
+ Optionally, you can specify a
+ signature and a jabber:x:signed
+ will be placed in the <presence/>.
=head2 Subscription Functions
-=over 4
-
-=item Subscription
-
- Subscription(hash)
-
-taks the hash and passes it to SetPresence in
-Net::XMPP::Presence (refer there for valid
-settings). Then it sends the subscription to
-server.
+ Subscription(hash) - taks the hash and passes it to SetPresence in
+ Net::XMPP::Presence (refer there for valid
+ settings). Then it sends the subscription to
+ server.
-The valid types of subscription are:
+ The valid types of subscription are:
- subscribe - subscribe to JID's presence
- unsubscribe - unsubscribe from JID's presence
- subscribed - response to a subscribe
- unsubscribed - response to an unsubscribe
-
-=back
+ subscribe - subscribe to JID's presence
+ unsubscribe - unsubscribe from JID's presence
+ subscribed - response to a subscribe
+ unsubscribed - response to an unsubscribe
=head2 Presence DB Functions
-=over 4
-
-=item PresenceDB
-
- PresenceDB()
-
-Tell the object to initialize the callbacks to
-automatically populate the Presence DB.
-
-=item PresenceDBParse
-
- PresenceDBParse(Net::XMPP::Presence)
-
-for every presence that you
-receive pass the Presence
-object to the DB so that
-it can track the resources
-and priorities for you.
-Returns either the presence
-passed in, if it not able
-to parsed for the DB, or the
-current presence as found by
-the PresenceDBQuery
-function.
-
-=item PresenceDBDelete
-
- PresenceDBDelete(string|Net::XMPP::JID)
-
-delete thes JID entry from the DB.
-
-=item PresenceDBClear
-
- PresenceDBClear()
-
-delete all entries in the database.
-
-=item PresenceDBQuery
-
- PresenceDBQuery(string|Net::XMPP::JID)
-
-returns the NX::Presence
-that was last received for
-the highest priority of
-this JID. You can pass
-it a string or a NX::JID
-object.
-
-=item PresenceDBResources
-
- PresenceDBResources(string|Net::XMPP::JID)
-
-returns an array of
-resources in order
-from highest priority
-to lowest.
-
-=back
+ PresenceDB() - Tell the object to initialize the callbacks to
+ automatically populate the Presence DB.
+
+ PresenceDBParse(Net::XMPP::Presence) - for every presence that you
+ receive pass the Presence
+ object to the DB so that
+ it can track the resources
+ and priorities for you.
+ Returns either the presence
+ passed in, if it not able
+ to parsed for the DB, or the
+ current presence as found by
+ the PresenceDBQuery
+ function.
+
+ PresenceDBDelete(string|Net::XMPP::JID) - delete thes JID entry
+ from the DB.
+
+ PresenceDBClear() - delete all entries in the database.
+
+ PresenceDBQuery(string|Net::XMPP::JID) - returns the NX::Presence
+ that was last received for
+ the highest priority of
+ this JID. You can pass
+ it a string or a NX::JID
+ object.
+
+ PresenceDBResources(string|Net::XMPP::JID) - returns an array of
+ resources in order
+ from highest priority
+ to lowest.
=head2 IQ Functions
=head2 Auth Functions
-=over 4
-
-=item AuthSend
-
- AuthSend(username=>string,
- password=>string,
- resource=>string)
-
-takes all of the information and
-builds a L<Net::XMPP::IQ::Auth> packet.
-It then sends that packet to the
-server with an ID and waits for that
-ID to return. Then it looks in
-resulting packet and determines if
-authentication was successful for not.
-The array returned from AuthSend looks
-like this:
-
- [ type , message ]
-
-If type is "ok" then authentication
-was successful, otherwise message
-contains a little more detail about the
-error.
-
-=back
+ AuthSend(username=>string, - takes all of the information and
+ password=>string, builds a Net::XMPP::IQ::Auth packet.
+ resource=>string) It then sends that packet to the
+ server with an ID and waits for that
+ ID to return. Then it looks in
+ resulting packet and determines if
+ authentication was successful for not.
+ The array returned from AuthSend looks
+ like this:
+ [ type , message ]
+ If type is "ok" then authentication
+ was successful, otherwise message
+ contains a little more detail about the
+ error.
=head2 IQ::Register Functions
-
-=over 4
-
-=item RegisterRequest
-
- RegisterRequest(to=>string, timeout=>int)
- RegisterRequest()
-
-send an <iq/> request to the specified
-server/transport, if not specified it
-sends to the current active server.
-The function returns a hash that
-contains the required fields. Here
-is an example of the hash:
-
-$hash{fields} - The raw fields from
- the iq:register.
- To be used if there
- is no x:data in the
- packet.
-
-$hash{instructions} - How to fill out
- the form.
-
-$hash{form} - The new dynamic forms.
-
-In $hash{form}, the fields that are
-present are the required fields the
-server needs.
-
-=item RegisterSend
-
- RegisterSend(hash)
-
-takes the contents of the hash and passes it
-to the SetRegister function in the module
-Net::XMPP::Query jabber:iq:register namespace.
-This function returns an array that looks like
-this:
-
- [ type , message ]
-
-If type is "ok" then registration was
-successful, otherwise message contains a
-little more detail about the error.
-
-=back
-
+ RegisterRequest(to=>string, - send an <iq/> request to the specified
+ timeout=>int) server/transport, if not specified it
+ RegisterRequest() sends to the current active server.
+ The function returns a hash that
+ contains the required fields. Here
+ is an example of the hash:
+
+ $hash{fields} - The raw fields from
+ the iq:register.
+ To be used if there
+ is no x:data in the
+ packet.
+ $hash{instructions} - How to fill out
+ the form.
+ $hash{form} - The new dynamic forms.
+
+ In $hash{form}, the fields that are
+ present are the required fields the
+ server needs.
+
+ RegisterSend(hash) - takes the contents of the hash and passes it
+ to the SetRegister function in the module
+ Net::XMPP::Query jabber:iq:register namespace.
+ This function returns an array that looks like
+ this:
+
+ [ type , message ]
+
+ If type is "ok" then registration was
+ successful, otherwise message contains a
+ little more detail about the error.
=head2 Roster Functions
-=over 4
-
-=item Roster
-
- Roster()
-
-returns a L<Net::XMPP::Roster> object. This will automatically
-intercept all of the roster and presence packets sent from
-the server and give you an accurate Roster. For more
-information please read the man page for Net::XMPP::Roster.
-
-=item RosterParse
-
- RosterParse(IQ object)
-
-returns a hash that contains the roster
-parsed into the following data structure:
+ Roster() - returns a Net::XMPP::Roster object. This will automatically
+ intercept all of the roster and presence packets sent from
+ the server and give you an accurate Roster. For more
+ information please read the man page for Net::XMPP::Roster.
- $roster{'bob@jabber.org'}->{name}
- - Name you stored in the roster
+ RosterParse(IQ object) - returns a hash that contains the roster
+ parsed into the following data structure:
- $roster{'bob@jabber.org'}->{subscription}
- - Subscription status
- (to, from, both, none)
+ $roster{'bob@jabber.org'}->{name}
+ - Name you stored in the roster
- $roster{'bob@jabber.org'}->{ask}
- - The ask status from this user
- (subscribe, unsubscribe)
+ $roster{'bob@jabber.org'}->{subscription}
+ - Subscription status
+ (to, from, both, none)
- $roster{'bob@jabber.org'}->{groups}
- - Array of groups that
- bob@jabber.org is in
+ $roster{'bob@jabber.org'}->{ask}
+ - The ask status from this user
+ (subscribe, unsubscribe)
-=item RosterGet
+ $roster{'bob@jabber.org'}->{groups}
+ - Array of groups that
+ bob@jabber.org is in
- RosterGet()
+ RosterGet() - sends an empty Net::XMPP::IQ::Roster tag to the
+ server so the server will send the Roster to the
+ client. Returns the above hash from RosterParse.
-sends an empty Net::XMPP::IQ::Roster tag to the
-server so the server will send the Roster to the
-client. Returns the above hash from RosterParse.
+ RosterRequest() - sends an empty Net::XMPP::IQ::Roster tag to the
+ server so the server will send the Roster to the
+ client.
-=item RosterRequest
+ RosterAdd(hash) - sends a packet asking that the jid be
+ added to the roster. The hash format
+ is defined in the SetItem function
+ in the Net::XMPP::Query jabber:iq:roster
+ namespace.
- RosterRequest()
-
-sends an empty Net::XMPP::IQ::Roster tag to the
-server so the server will send the Roster to the
-client.
-
-=item RosterAdd
-
- RosterAdd(hash)
-
-sends a packet asking that the jid be
-added to the roster. The hash format
-is defined in the SetItem function
-in the Net::XMPP::Query jabber:iq:roster
-namespace.
-
-=item RosterRemove
-
- RosterRemove(hash)
-
-sends a packet asking that the jid be
-removed from the roster. The hash
-format is defined in the SetItem function
-in the Net::XMPP::Query jabber:iq:roster
-namespace.
-
-=back
+ RosterRemove(hash) - sends a packet asking that the jid be
+ removed from the roster. The hash
+ format is defined in the SetItem function
+ in the Net::XMPP::Query jabber:iq:roster
+ namespace.
=head2 Roster DB Functions
-=over 4
-
-=item RosterDB
-
- RosterDB()
-
-Tell the object to initialize the callbacks to
-automatically populate the Roster DB. If you do this,
-then make sure that you call RosterRequest() instead of
-RosterGet() so that the callbacks can catch it and
-parse it.
-
-=item RosterDBParse
-
- RosterDBParse(IQ object)
-
-If you want to manually control the
-database, then you can pass in all iq
-packets with jabber:iq:roster queries to
-this function.
-
-=item RosterDBAdd
-
- RosterDBAdd(jid,hash)
-
-Add a new JID into the roster DB. The JID
-is either a string, or a Net::XMPP::JID
-object. The hash must be the same format as
-the has returned by RosterParse above, and
-is the actual hash, not a reference.
-
-=item RosterDBRemove
-
- RosterDBRemove(jid)
-
-Remove a JID from the roster DB. The JID is
-either a string, or a Net::XMPP::JID object.
-
-=item RosterDBClear
+ RosterDB() - Tell the object to initialize the callbacks to
+ automatically populate the Roster DB. If you do this,
+ then make sure that you call RosterRequest() instead of
+ RosterGet() so that the callbacks can catch it and
+ parse it.
-Remove all JIDs from the roster DB.
+ RosterDBParse(IQ object) - If you want to manually control the
+ database, then you can pass in all iq
+ packets with jabber:iq:roster queries to
+ this function.
-=item RosterDBExists
+ RosterDBAdd(jid,hash) - Add a new JID into the roster DB. The JID
+ is either a string, or a Net::XMPP::JID
+ object. The hash must be the same format as
+ the has returned by RosterParse above, and
+ is the actual hash, not a reference.
- RosterDBExists(jid)
+ RosterDBRemove(jid) - Remove a JID from the roster DB. The JID is
+ either a string, or a Net::XMPP::JID object.
-return 1 if the JID exists in the roster DB,
-undef otherwise. The JID is either a string,
-or a Net::XMPP::JID object.
+ RosterDBClear() - Remove all JIDs from the roster DB.
-=item RosterDBJIDs
+ RosterDBExists(jid) - return 1 if the JID exists in the roster DB,
+ undef otherwise. The JID is either a string,
+ or a Net::XMPP::JID object.
- RosterDBJIDs()
+ RosterDBJIDs() - returns a list of Net::XMPP::JID objects that
+ represents all of the JIDs in the DB.
-returns a list of Net::XMPP::JID objects that
-represents all of the JIDs in the DB.
+ RosterDBGroups() - returns the complete list of roster groups in the
+ roster.
-=item RosterDBGroups
+ RosterDBGroupExists(group) - return 1 if the group is a group in the
+ roster DB, undef otherwise.
-returns the complete list of roster groups in the
-roster.
+ RosterDBGroupJIDs(group) - returns a list of Net::XMPP::JID objects
+ that represents all of the JIDs in the
+ specified roster group.
-=item RosterDBGroupExists
+ RosterDBNonGroupJIDs() - returns a list of Net::XMPP::JID objects
+ that represents all of the JIDs not in a
+ roster group.
- RosterDBGroupExists(group)
+ RosterDBQuery(jid) - returns a hash containing the data from the
+ roster DB for the specified JID. The JID is
+ either a string, or a Net::XMPP::JID object.
+ The hash format the same as in RosterParse
+ above.
-return 1 if the group is a group in the
-roster DB, undef otherwise.
+ RosterDBQuery(jid,key) - returns the entry from the above hash for
+ the given key. The available keys are:
+ name, ask, subsrcription and groups
+ The JID is either a string, or a
+ Net::XMPP::JID object.
-=item RosterDBGroupJIDs
-
- RosterDBGroupJIDs(group)
-
-returns a list of Net::XMPP::JID objects
-that represents all of the JIDs in the
-specified roster group.
-
-=item RosterDBNonGroupJIDs
-
-returns a list of Net::XMPP::JID objects
-that represents all of the JIDs not in a
-roster group.
-
-=item RosterDBQuery
-
- RosterDBQuery(jid)
-
-returns a hash containing the data from the
-roster DB for the specified JID. The JID is
-either a string, or a Net::XMPP::JID object.
-The hash format the same as in RosterParse
-above.
-
-=item RosterDBQuery
-
- RosterDBQuery(jid,key)
-
-returns the entry from the above hash for
-the given key. The available keys are:
- name, ask, subsrcription and groups
-The JID is either a string, or a
-L<Net::XMPP::JID> object.
-
-=back
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.003;
-use strict;
-use warnings;
-
-use Carp;
-use Digest::SHA1;
-use MIME::Base64;
-use Authen::SASL;
-
-use XML::Stream;
-
-use Net::XMPP::IQ;
-use Net::XMPP::Message;
-use Net::XMPP::Presence;
-use Net::XMPP::JID;
use Net::XMPP::Roster;
use Net::XMPP::PrivacyLists;
-
+use strict;
+use Carp;
use vars qw( %XMLNS %NEWOBJECT $SASL_CALLBACK $TLS_CALLBACK );
##############################################################################
@@ -1088,10 +793,10 @@ $NEWOBJECT{'presence'} = "Net::XMPP::Presence";
$NEWOBJECT{'jid'} = "Net::XMPP::JID";
##############################################################################
-sub _message { shift; my $o; eval "\$o = $NEWOBJECT{'message'}->new(\@_);"; return $o; }
-sub _presence { shift; my $o; eval "\$o = $NEWOBJECT{'presence'}->new(\@_);"; return $o; }
-sub _iq { shift; my $o; eval "\$o = $NEWOBJECT{'iq'}->new(\@_);"; return $o; }
-sub _jid { shift; my $o; eval "\$o = $NEWOBJECT{'jid'}->new(\@_);"; return $o; }
+sub _message { shift; my $o; eval "\$o = new $NEWOBJECT{'message'}(\@_);"; return $o; }
+sub _presence { shift; my $o; eval "\$o = new $NEWOBJECT{'presence'}(\@_);"; return $o; }
+sub _iq { shift; my $o; eval "\$o = new $NEWOBJECT{'iq'}(\@_);"; return $o; }
+sub _jid { shift; my $o; eval "\$o = new $NEWOBJECT{'jid'}(\@_);"; return $o; }
###############################################################################
#+-----------------------------------------------------------------------------
@@ -1299,7 +1004,7 @@ sub BuildObject
if (exists($NEWOBJECT{$tag}))
{
$self->{DEBUG}->Log1("BuildObject: tag($tag) package($NEWOBJECT{$tag})");
- eval "\$obj = $NEWOBJECT{$tag}->new(\$tree);";
+ eval "\$obj = new $NEWOBJECT{$tag}(\$tree);";
}
return $obj;
@@ -1943,7 +1648,7 @@ sub PresenceDBDelete
my ($jid) = @_;
my $indexJID = $jid;
- $indexJID = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $indexJID = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return if !exists($self->{PRESENCEDB}->{$indexJID});
delete($self->{PRESENCEDB}->{$indexJID});
@@ -1982,7 +1687,7 @@ sub PresenceDBQuery
my ($jid) = @_;
my $indexJID = $jid;
- $indexJID = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $indexJID = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return if !exists($self->{PRESENCEDB}->{$indexJID});
return if (scalar(keys(%{$self->{PRESENCEDB}->{$indexJID}->{priorities}})) == 0);
@@ -2006,7 +1711,7 @@ sub PresenceDBResources
my ($jid) = @_;
my $indexJID = $jid;
- $indexJID = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $indexJID = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
my @resources;
@@ -2375,7 +2080,7 @@ sub PrivacyLists
{
my $self = shift;
- return Net::XMPP::PrivacyLists->new(connection=>$self);
+ return new Net::XMPP::PrivacyLists(connection=>$self);
}
@@ -2698,7 +2403,7 @@ sub Roster
{
my $self = shift;
- return Net::XMPP::Roster->new(connection=>$self);
+ return new Net::XMPP::Roster(connection=>$self);
}
@@ -2763,7 +2468,7 @@ sub RosterDBExists
my $self = shift;
my ($jid) = @_;
- if (ref $jid && $jid->isa('Net::XMPP::JID'))
+ if ($jid->isa("Net::XMPP::JID"))
{
$jid = $jid->GetJID();
}
@@ -2931,7 +2636,7 @@ sub RosterDBQuery
my $jid = shift;
my $key = shift;
- if (ref $jid && $jid->isa('Net::XMPP::JID'))
+ if ($jid->isa("Net::XMPP::JID"))
{
$jid = $jid->GetJID();
}
@@ -3254,7 +2959,7 @@ sub SASLClient
return unless defined($mechanisms);
- my $sasl = Authen::SASL->new(mechanism=>join(" ",@{$mechanisms}),
+ my $sasl = new Authen::SASL(mechanism=>join(" ",@{$mechanisms}),
callback=>{ user => $username,
pass => $password
}
@@ -3433,17 +3138,15 @@ sub xmppCallbackInit
$self->{DEBUG}->Log1("xmppCallbackInit: start");
- my $weak = $self;
- weaken $weak;
- $self->SetCallBacks(iq=>sub{ $weak->callbackIQ(@_) },
- presence=>sub{ $weak->callbackPresence(@_) },
- message=>sub{ $weak->callbackMessage(@_) },
+ $self->SetCallBacks(iq=>sub{ $self->callbackIQ(@_) },
+ presence=>sub{ $self->callbackPresence(@_) },
+ message=>sub{ $self->callbackMessage(@_) },
);
- $self->SetPresenceCallBacks(subscribe=>sub{ $weak->callbackPresenceSubscribe(@_) },
- unsubscribe=>sub{ $weak->callbackPresenceUnsubscribe(@_) },
- subscribed=>sub{ $weak->callbackPresenceSubscribed(@_) },
- unsubscribed=>sub{ $weak->callbackPresenceUnsubscribed(@_) },
+ $self->SetPresenceCallBacks(subscribe=>sub{ $self->callbackPresenceSubscribe(@_) },
+ unsubscribe=>sub{ $self->callbackPresenceUnsubscribe(@_) },
+ subscribed=>sub{ $self->callbackPresenceSubscribed(@_) },
+ unsubscribed=>sub{ $self->callbackPresenceUnsubscribed(@_) },
);
$self->TLSInit();
@@ -3530,7 +3233,7 @@ sub callbackIQ
$self->{DEBUG}->Log1("callbackIQ: type($type) ns($ns)");
if (exists($self->{CB}->{IQns}->{$ns})
- && (ref($self->{CB}->{IQns}->{$ns}) eq 'HASH' )
+ && (ref($self->{CB}->{IQns}->{$ns}) != 'HASH' )
)
{
$self->{DEBUG}->Log1("callbackIQ: goto user function( $self->{CB}->{IQns}->{$ns} )");
@@ -27,22 +27,22 @@ Net::XMPP::Roster - XMPP Roster Object
=head1 SYNOPSIS
-Net::XMPP::Roster is a module that provides a developer an easy
-interface to an XMPP roster. It provides high level functions to
-query, update, and manage a user's roster.
+ Net::XMPP::Roster is a module that provides a developer an easy
+ interface to an XMPP roster. It provides high level functions to
+ query, update, and manage a user's roster.
=head1 DESCRIPTION
-The Roster object seeks to provide an easy to use API for interfacing
-with a user's roster. When you instantiate it, it automatically
-registers with the connection to receivce the correct packets so
-that it can track all roster updates, and presence packets.
+ The Roster object seeks to provide an easy to use API for interfacing
+ with a user's roster. When you instantiate it, it automatically
+ registers with the connection to receivce the correct packets so
+ that it can track all roster updates, and presence packets.
=head2 Basic Functions
- my $Client = Net::XMPP::Client->new(...);
+ my $Client = new Net::XMPP::Client(...);
- my $Roster = Net::XMPP::Roster->new(connection=>$Client);
+ my $Roster = new Net::XMPP::Roster(connection=>$Client);
or
my $Roster = $Client->Roster();
@@ -88,8 +88,8 @@ that it can track all roster updates, and presence packets.
=head2 Advanced Functions
-These functions are only needed if you want to manually control
-the Roster.
+ These functions are only needed if you want to manually control
+ the Roster.
$Roster->add('bob@jabber.org',
name=>"Bob",
@@ -117,121 +117,65 @@ the Roster.
=head2 Basic Functions
-=over 4
-=item new
+ new(connection=>object) - This creates and initializes the Roster
+ object. The connection object is required
+ so that the Roster can interact with the
+ main connection object. It needs to be an
+ object that inherits from
+ Net::XMPP::Connection.
- new(connection=>object)
+ clear() - removes everything from the database.
-This creates and initializes the Roster
-object. The connection object is required
-so that the Roster can interact with the
-main connection object. It needs to be an
-object that inherits from L<Net::XMPP::Connection>.
+ exists(jid) - return 1 if the JID exists in the database, undef
+ otherwise. The jid can either be a string, or a
+ Net::XMPP::JID object.
-=item clear
+ groupExists(group) - return 1 if the group exists in the database,
+ undef otherwise.
- clear()
+ groups() - returns a list of all of the roster groups.
-removes everything from the database.
-
-=item exists
-
- exists(jid)
-
-return 1 if the JID exists in the database, undef
-otherwise. The jid can either be a string, or a L<Net::XMPP::JID> object.
-
-=item groupExists
-
- groupExists(group)
-
-return 1 if the group exists in the database, undef otherwise.
-
-=item groups
-
- groups()
-
-Returns a list of all of the roster groups.
-
-=item jids
-
- jids([type, [group]])
-
-returns a list of all of the matching JIDs. The valid
-types are:
+ jids([type, - returns a list of all of the matching JIDs. The valid
+ [group]]) types are:
all - return all JIDs in the roster. (default)
nogroup - return all JIDs not in a roster group.
group - return all of the JIDs in the specified
roster group.
-=item online
-
- online(jid)
-
-return 1 if the JID is online, undef otherwise. The
-jid can either be a string, or a L<Net::XMPP::JID> object.
-
-=item query
-
- query(jid, [key])
+ online(jid) - return 1 if the JID is online, undef otherwise. The
+ jid can either be a string, or a Net::XMPP::JID object.
-return a hash representing all of the data in the
-DB for this JID. The jid can either be a string,
-or a Net::XMPP::JID object. If you specify a key,
-then only the value for that key is returned.
+ query(jid, - return a hash representing all of the data in the
+ [key]) DB for this JID. The jid can either be a string,
+ or a Net::XMPP::JID object. If you specify a key,
+ then only the value for that key is returned.
-=item resource
+ resource(jid) - return the string representing the resource with the
+ highest priority for the JID. The jid can either be
+ a string, or a Net::XMPP::JID object.
- resource(jid)
+ resourceQuery(jid, - return a hash representing all of the data
+ resource, the DB for the resource for this JID. The
+ [key]) jid can either be a string, or a
+ Net::XMPP::JID object. If you specify a
+ key, then only the value for that key is
+ returned.
-return the string representing the resource with the
-highest priority for the JID. The jid can either be
-a string, or a Net::XMPP::JID object.
+ resources(jid) - returns the list of resources for the JID in order
+ of highest priority to lowest priority. The jid can
+ either be a string, or a Net::XMPP::JID object.
-=item resourceQuery
+ resourceStore(jid, - store the specified value in the DB under
+ resource, the specified key for the resource for this
+ key, JID. The jid can either be a string, or a
+ value) Net::XMPP::JID object.
- resourceQuery(jid,
- resource,
- [key])
+ store(jid, - store the specified value in the DB under the
+ key, specified key for this JID. The jid can either
+ value) be a string, or a Net::XMPP::JID object.
-return a hash representing all of the data
-the DB for the resource for this JID. The
-jid can either be a string, or a
-Net::XMPP::JID object. If you specify a
-key, then only the value for that key is
-returned.
-
-=item resources
-
- resources(jid)
-
-returns the list of resources for the JID in order
-of highest priority to lowest priority. The jid can
-either be a string, or a Net::XMPP::JID object.
-
-=item resourceStore
-
- resourceStore(jid,
- resource,
- key,
- value)
-
-store the specified value in the DB under
-the specified key for the resource for this
-JID. The jid can either be a string, or a
-Net::XMPP::JID object.
-
-=item store
-
- store(jid, key, value)
-
-store the specified value in the DB under the
-specified key for this JID. The jid can either
-be a string, or a Net::XMPP::JID object.
-
-=back
=head2 Advanced Functions
@@ -264,29 +208,18 @@ handler(packet) - Take either a Net::XMPP::IQ or Net::XMPP::Presence
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-use 5.008;
use strict;
-use warnings;
-
use Carp;
-use Net::XMPP::JID;
-
-use Scalar::Util qw(weaken);
-
sub new
{
my $proto = shift;
@@ -320,10 +253,8 @@ sub init
{
my $self = shift;
- my $weak = $self;
- weaken $weak;
- $self->{CONNECTION}-> SetXPathCallBacks('/iq[@type="result" or @type="set"]/query[@xmlns="jabber:iq:roster"]'=>sub{ $weak->handler(@_) });
- $self->{CONNECTION}-> SetXPathCallBacks('/presence'=>sub{ $weak->handler(@_) });
+ $self->{CONNECTION}-> SetXPathCallBacks('/iq[@type="result" or @type="set"]/query[@xmlns="jabber:iq:roster"]'=>sub{ $self->handler(@_) });
+ $self->{CONNECTION}-> SetXPathCallBacks('/presence'=>sub{ $self->handler(@_) });
}
@@ -337,7 +268,7 @@ sub add
my $self = shift;
my ($jid,%item) = @_;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
$self->{JIDS}->{$jid} = \%item;
@@ -364,7 +295,7 @@ sub addResource
my $resource = shift;
my (%item) = @_;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
my $priority = $item{priority};
$priority = 0 unless defined($priority);
@@ -418,7 +349,7 @@ sub exists
my $self = shift;
my ($jid) = @_;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return unless exists($self->{JIDS});
return unless exists($self->{JIDS}->{$jid});
@@ -495,7 +426,7 @@ sub handleIQ
my $self = shift;
my $iq = shift;
- $self->{CONNECTION}->{DEBUG}->Log3('handleIQ: iq(' . $iq->GetXML() . ')');
+ print "handleIQ: iq(",$iq->GetXML(),")\n";
my $type = $iq->GetType();
return unless (($type eq "set") || ($type eq "result"));
@@ -533,7 +464,7 @@ sub handlePresence
my $self = shift;
my $presence = shift;
- $self->{CONNECTION}->{DEBUG}->Log3('handlePresence: presence(' . $presence->GetXML() . ')');
+ print "handlePresence: presence(",$presence->GetXML(),")\n";
my $type = $presence->GetType();
$type = "" unless defined($type);
@@ -600,7 +531,7 @@ sub jids
exists($self->{JIDS}->{$jid}->{groups}) &&
($#{$self->{JIDS}->{$jid}->{groups}} > -1));
- push(@jids, Net::XMPP::JID->new($jid));
+ push(@jids,new Net::XMPP::JID($jid));
}
}
@@ -611,7 +542,7 @@ sub jids
{
foreach my $jid (keys(%{$self->{GROUPS}->{$group}}))
{
- push(@jids, Net::XMPP::JID->new($jid));
+ push(@jids,new Net::XMPP::JID($jid));
}
}
}
@@ -630,7 +561,7 @@ sub online
my $self = shift;
my $jid = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return unless $self->exists($jid);
@@ -652,7 +583,7 @@ sub priority
my $jid = shift;
my $resource = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
if (defined($resource))
{
@@ -678,7 +609,7 @@ sub query
my $jid = shift;
my $key = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return unless $self->exists($jid);
if (defined($key))
@@ -700,7 +631,7 @@ sub remove
my $self = shift;
my $jid = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
if ($self->exists($jid))
{
@@ -735,7 +666,7 @@ sub removeResource
my $jid = shift;
my $resource = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
if ($self->resourceExists($jid,$resource))
{
@@ -776,7 +707,7 @@ sub resource
my $self = shift;
my $jid = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return unless $self->exists($jid);
@@ -799,7 +730,7 @@ sub resourceExists
my $jid = shift;
my $resource = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return unless $self->exists($jid);
return unless exists($self->{JIDS}->{$jid}->{resources});
@@ -820,7 +751,7 @@ sub resourceQuery
my $resource = shift;
my $key = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return unless $self->resourceExists($jid,$resource);
if (defined($key))
@@ -842,7 +773,7 @@ sub resources
my $self = shift;
my $jid = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return () unless $self->exists($jid);
@@ -875,7 +806,7 @@ sub resourceStore
my $key = shift;
my $value = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return unless defined($key);
return unless defined($value);
@@ -899,7 +830,7 @@ sub store
my $key = shift;
my $value = shift;
- $jid = $jid->GetJID() if (ref $jid && $jid->isa('Net::XMPP::JID'));
+ $jid = $jid->GetJID() if $jid->isa("Net::XMPP::JID");
return unless defined($key);
return unless defined($value);
@@ -27,18 +27,18 @@ Net::XMPP::Stanza - XMPP Stanza Module
=head1 SYNOPSIS
-Net::XMPP::Stanza is a private package that serves as a basis for all
-XMPP stanzas generated by L<Net::XMPP>.
+ Net::XMPP::Stanza is a private package that serves as a basis for all
+ XMPP stanzas generated by Net::XMPP.
=head1 DESCRIPTION
-This module is not meant to be used directly. You should be using
-either L<Net::XMPP::IQ>, L<Net::XMPP::Message>, L<Net::XMPP::Presence>, or
-another package that inherits from Net::XMPP::Stanza.
+ This module is not meant to be used directly. You should be using
+ either Net::XMPP::IQ, Net::XMPP::Message, Net::XMPP::Presence, or
+ another package that inherits from Net::XMPP::Stanza.
-That said, this is where all of the namespaced methods are documented.
+ That said, this is where all of the namespaced methods are documented.
-The current supported namespaces are:
+ The current supported namespaces are:
=cut
@@ -59,10 +59,10 @@ The current supported namespaces are:
=pod
-For more information on what these namespaces are for, visit
-L<http://www.jabber.org> and browse the Jabber Programmers Guide.
+ For more information on what these namespaces are for, visit
+ http://www.jabber.org and browse the Jabber Programmers Guide.
-The following tables can be read as follows:
+ The following tables can be read as follows:
ny:private:ns
@@ -73,7 +73,7 @@ The following tables can be read as follows:
Bars child X
Test master X X
-Withing the my:private:ns namespace, there exists the functions:
+ Withing the my:private:ns namespace, there exists the functions:
GetFoo(), SetFoo(), RemoveFoo(), DefinedFoo()
@@ -83,8 +83,8 @@ Withing the my:private:ns namespace, there exists the functions:
GetTest(), SetMaster()
-Hopefully it should be obvious how this all works. If not feel free to
-contact me and I'll work on adding more documentation.
+ Hopefully it should be obvious how this all works. If not feel free to
+ contact me and I'll work on adding more documentation.
=cut
@@ -201,32 +201,22 @@ contact me and I'll work on adding more documentation.
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-use 5.008;
use strict;
-use warnings;
-
use Carp;
-use XML::Stream qw( Node );
-use Net::XMPP::JID;
-use Net::XMPP::Debug;
use Net::XMPP::Namespaces;
use vars qw( $AUTOLOAD %FUNCTIONS $DEBUG );
-$DEBUG = Net::XMPP::Debug->new(usedefault=>1,
- header=>"XMPP");
+$DEBUG = new Net::XMPP::Debug(usedefault=>1,
+ header=>"XMPP");
# XXX need to look at evals and $@
@@ -266,7 +256,7 @@ sub _init
elsif (ref($_[0]) eq "")
{
$self->{TAG} = shift;
- $self->{TREE} = XML::Stream::Node->new($self->{TAG});
+ $self->{TREE} = new XML::Stream::Node($self->{TAG});
}
else
{
@@ -278,7 +268,7 @@ sub _init
}
else
{
- $self->{TREE} = XML::Stream::Node->new($self->{TAG});
+ $self->{TREE} = new XML::Stream::Node($self->{TAG});
}
return;
@@ -398,7 +388,7 @@ sub NewChild
if exists($Net::XMPP::Namespaces::NS{$xmlns});
}
- my $node = XML::Stream::Node->new($tag);
+ my $node = new XML::Stream::Node($tag);
$node->put_attrib(xmlns=>$xmlns);
return $self->AddChild($node);
@@ -464,7 +454,7 @@ sub NewFirstChild
if exists($Net::XMPP::Namespaces::NS{$xmlns});
}
- my $node = XML::Stream::Node->new($tag);
+ my $node = new XML::Stream::Node($tag);
$node->put_attrib(xmlns=>$xmlns);
return $self->AddFirstChild($node);
@@ -1223,7 +1213,7 @@ sub _xpath_add
}
}
- my $node = XML::Stream::Node->new($tag);
+ my $node = new XML::Stream::Node($tag);
$node->put_attrib(xmlns=>$xmlns);
my $obj = $self->AddChild($node);
@@ -1432,7 +1422,7 @@ sub _missing_function
sub _new_jid
{
my $self = shift;
- return Net::XMPP::JID->new(@_);
+ return new Net::XMPP::JID(@_);
}
@@ -1444,7 +1434,7 @@ sub _new_jid
sub _new_packet
{
my $self = shift;
- return Net::XMPP::Stanza->new(@_);
+ return new Net::XMPP::Stanza(@_);
}
@@ -27,256 +27,206 @@ Net::XMPP - XMPP Perl Library
=head1 SYNOPSIS
-Net::XMPP provides a Perl user with access to the Extensible
-Messaging and Presence Protocol (XMPP).
+ Net::XMPP provides a Perl user with access to the Extensible
+ Messaging and Presence Protocol (XMPP).
-For more information about XMPP visit:
+ For more information about XMPP visit:
-L<http://www.xmpp.org>
+ http://www.xmpp.org
=head1 DESCRIPTION
-Net::XMPP is a convenient tool to use for any perl script that would
-like to utilize the XMPP Instant Messaging protocol. While not a
-client in and of itself, it provides all of the necessary back-end
-functions to make a CGI client or command-line perl client feasible
-and easy to use. Net::XMPP is a wrapper around the rest of the
-official Net::XMPP::xxxxxx packages.
+ Net::XMPP is a convenient tool to use for any perl script that would
+ like to utilize the XMPP Instant Messaging protocol. While not a
+ client in and of itself, it provides all of the necessary back-end
+ functions to make a CGI client or command-line perl client feasible
+ and easy to use. Net::XMPP is a wrapper around the rest of the
+ official Net::XMPP::xxxxxx packages.
-There is are example scripts in the example directory that provide you
-with examples of very simple XMPP programs.
+ There is are example scripts in the example directory that provide you
+ with examples of very simple XMPP programs.
-NOTE: The parser that L<XML::Stream::Parser> provides, as are most Perl
-parsers, is synchronous. If you are in the middle of parsing a packet
-and call a user defined callback, the Parser is blocked until your
-callback finishes. This means you cannot be operating on a packet,
-send out another packet and wait for a response to that packet. It
-will never get to you. Threading might solve this, but as of this
-writing threading in Perl is not quite up to par yet. This issue will
-be revisted in the future.
+ NOTE: The parser that XML::Stream::Parser provides, as are most Perl
+ parsers, is synchronous. If you are in the middle of parsing a packet
+ and call a user defined callback, the Parser is blocked until your
+ callback finishes. This means you cannot be operating on a packet,
+ send out another packet and wait for a response to that packet. It
+ will never get to you. Threading might solve this, but as of this
+ writing threading in Perl is not quite up to par yet. This issue will
+ be revisted in the future.
=head1 EXAMPLES
- use Net::XMPP;
- my $client = Net::XMPP::Client->new();
+ use Net::XMPP;
+ my $client = new Net::XMPP::Client();
=head1 METHODS
-The Net::XMPP module does not define any methods that you will call
-directly in your code. Instead you will instantiate objects that call
-functions from this module to do work. The three main objects that
-you will work with are the Message, Presence, and IQ modules. Each one
-corresponds to the Jabber equivilant and allows you get and set all
-parts of those packets.
+ The Net::XMPP module does not define any methods that you will call
+ directly in your code. Instead you will instantiate objects that call
+ functions from this module to do work. The three main objects that
+ you will work with are the Message, Presence, and IQ modules. Each one
+ corresponds to the Jabber equivilant and allows you get and set all
+ parts of those packets.
-There are a few functions that are the same across all of the objects:
+ There are a few functions that are the same across all of the objects:
=head2 Retrieval functions
-=over 4
+ GetXML() - returns the XML string that represents the data contained
+ in the object.
-=item GetXML
+ $xml = $obj->GetXML();
-Returns the XML string that represents the data contained
-in the object.
+ GetChild() - returns an array of Net::XMPP::Stanza objects
+ GetChild(namespace) that represent all of the stanzas in the object
+ that are namespaced. If you specify a namespace
+ then only stanza objects with that XMLNS are
+ returned.
- $xml = $obj->GetXML();
+ @xObj = $obj->GetChild();
+ @xObj = $obj->GetChild("my:namespace");
-=item GetChild
+ GetTag() - return the root tag name of the packet.
-Returns an array of L<Net::XMPP::Stanza> objects
-that represent all of the stanzas in the object
-that are namespaced. If you specify a namespace
-then only stanza objects with that XMLNS are
-returned.
-
- @xObj = $obj->GetChild();
- @xObj = $obj->GetChild("my:namespace");
-
-=item GetTag
-
-Return the root tag name of the packet.
-
-=item GetTree
-
-Return the L<XML::Stream::Node> object that contains the data.
-See XML::Stream::Node for methods you can call on this
-object.
-
-=back
+ GetTree() - return the XML::Stream::Node object that contains the data.
+ See XML::Stream::Node for methods you can call on this
+ object.
=head2 Creation functions
-=over 4
-
-=item NewChild
-
- NewChild(namespace)
- NewChild(namespace,tag)
-
-Creates a new Net::XMPP::Stanza object with
-the specified namespace and root tag of
-whatever the namespace says its root tag
-should be. Optionally you may specify
-another root tag if the default is not
-desired, or the namespace requres you to set
-one.
-
- $xObj = $obj->NewChild("my:namespace");
- $xObj = $obj->NewChild("my:namespace","foo");
-
-ie. <foo xmlns='my:namespace'...></foo>
-
-=item InsertRawXML
-
- InsertRawXML(string)
+ NewChild(namespace) - creates a new Net::XMPP::Stanza object with
+ NewChild(namespace,tag) the specified namespace and root tag of
+ whatever the namespace says its root tag
+ should be. Optionally you may specify
+ another root tag if the default is not
+ desired, or the namespace requres you to set
+ one.
-puts the specified string raw into the XML
-packet that you call this on.
+ $xObj = $obj->NewChild("my:namespace");
+ $xObj = $obj->NewChild("my:namespace","foo");
+ ie. <foo xmlns='my:namespace'...></foo>
- $message->InsertRawXML("<foo></foo>")
- <message...>...<foo></foo></message>
+ InsertRawXML(string) - puts the specified string raw into the XML
+ packet that you call this on.
- $x = $message->NewChild(..);
- $x->InsertRawXML("test");
+ $message->InsertRawXML("<foo></foo>")
+ <message...>...<foo></foo></message>
- $query = $iq->GetChild(..);
- $query->InsertRawXML("test");
+ $x = $message->NewChild(..);
+ $x->InsertRawXML("test");
-=item ClearRawXML
+ $query = $iq->GetChild(..);
+ $query->InsertRawXML("test");
- ClearRawXML()
-
-Removes the raw XML from the packet.
-
-=back
+ ClearRawXML() - removes the raw XML from the packet.
=head2 Removal functions
-=over 4
-
-=item RemoveChild
-
- RemoveChild()
- RemoveChild(namespace)
-
-Removes all of the namespaces child elements
-from the object. If a namespace is provided,
-then only the children with that namespace are
-removed.
-
-=back
+ RemoveChild() - removes all of the namespaces child elements
+ RemoveChild(namespace) from the object. If a namespace is provided,
+ then only the children with that namespace are
+ removed.
=head2 Test functions
-=over 4
-
-=item DefinedChild
+ DefinedChild() - returns 1 if there are any known namespaced
+ DefinedChild(namespace) stanzas in the packet, 0 otherwise.
+ Optionally you can specify a namespace and
+ determine if there are any stanzas with that
+ namespace.
- DefinedChild()
- DefinedChild(namespace)
-
-Returns 1 if there are any known namespaced
-stanzas in the packet, 0 otherwise.
-Optionally you can specify a namespace and
-determine if there are any stanzas with that
-namespace.
-
- $test = $obj->DefinedChild();
- $test = $obj->DefinedChild("my:namespace");
-
-=back
+ $test = $obj->DefinedChild();
+ $test = $obj->DefinedChild("my:namespace");
=head1 PACKAGES
-For more information on each of these packages, please see the man page
-for each one.
+ For more information on each of these packages, please see the man page
+ for each one.
=head2 Net::XMPP::Client
-This package contains the code needed to communicate with an XMPP
-server: login, wait for messages, send messages, and logout. It uses
-XML::Stream to read the stream from the server and based on what kind
-of tag it encounters it calls a function to handle the tag.
+ This package contains the code needed to communicate with an XMPP
+ server: login, wait for messages, send messages, and logout. It uses
+ XML::Stream to read the stream from the server and based on what kind
+ of tag it encounters it calls a function to handle the tag.
=head2 Net::XMPP::Protocol
-A collection of high-level functions that Client uses to make their
-lives easier. These methods are inherited by the Client.
+ A collection of high-level functions that Client uses to make their
+ lives easier. These methods are inherited by the Client.
=head2 Net::XMPP::JID
-The XMPP IDs consist of three parts: user id, server, and resource.
-This module gives you access to those components without having to
-parse the string yourself.
+ The XMPP IDs consist of three parts: user id, server, and resource.
+ This module gives you access to those components without having to
+ parse the string yourself.
=head2 Net::XMPP::Message
-Everything needed to create and read a <message/> received from the
-server.
+ Everything needed to create and read a <message/> received from the
+ server.
=head2 Net::XMPP::Presence
-Everything needed to create and read a <presence/> received from the
-server.
+ Everything needed to create and read a <presence/> received from the
+ server.
=head2 Net::XMPP::IQ
-IQ is a wrapper around a number of modules that provide support for
-the various Info/Query namespaces that XMPP recognizes.
+ IQ is a wrapper around a number of modules that provide support for
+ the various Info/Query namespaces that XMPP recognizes.
=head2 Net::XMPP::Stanza
-This module represents a namespaced stanza that is used to extend a
-<message/>, <presence/>, and <iq/>.
+ This module represents a namespaced stanza that is used to extend a
+ <message/>, <presence/>, and <iq/>.
-The man page for Net::XMPP::Stanza contains a listing of all supported
-namespaces, and the methods that are supported by the objects that
-represent those namespaces.
+ The man page for Net::XMPP::Stanza contains a listing of all supported
+ namespaces, and the methods that are supported by the objects that
+ represent those namespaces.
=head2 Net::XMPP::Namespaces
-XMPP allows for any stanza to be extended by any bit of XML. This
-module contains all of the internals for defining the XMPP based
-extensions defined by the IETF. The documentation for this module
-explains more about how to add your own custom namespace and have it
-be supported.
+ XMPP allows for any stanza to be extended by any bit of XML. This
+ module contains all of the internals for defining the XMPP based
+ extensions defined by the IETF. The documentation for this module
+ explains more about how to add your own custom namespace and have it
+ be supported.
=head1 AUTHOR
-Originally authored by Ryan Eatmon.
-
-Previously maintained by Eric Hacker.
-
-Currently maintained by Darian Anthony Patrick.
+Ryan Eatmon
+Currently maintained by Eric Hacker.
=head1 BUGS
-See unpatched issues at L<https://rt.cpan.org/Dist/Display.html?Queue=Net-XMPP>.
-
-There is at least one issue with L<XML::Stream|XML::Stream> providing different
-node structures depending on how the node is created. Net::XMPP
-should now be able to handle this, but who knows what else lurks.
+Probably. There is at least one issue with XLM::Stream providing different node
+structures depending on how the node is created. Net::XMPP should now be able to
+handle this, but who knows what else lurks.
=head1 COPYRIGHT
This module is free software, you can redistribute it and/or modify it
-under the LGPL 2.1.
+under the LGPL.
=cut
-require 5.008;
+require 5.005;
use strict;
-use warnings;
+use XML::Stream 1.22 qw( Node );
use Time::Local;
+use Carp;
+use Digest::SHA1;
+use Authen::SASL;
+use MIME::Base64;
use POSIX;
use vars qw( $AUTOLOAD $VERSION $PARSING );
-$VERSION = "1.02_04";
+$VERSION = "1.02";
-use XML::Stream;
use Net::XMPP::Debug;
use Net::XMPP::JID;
use Net::XMPP::Namespaces;
@@ -0,0 +1,13 @@
+XML::Stream: new: hostname = (glaucon.vudu.net)
+XML::Stream: SetCallBacks: tag(node) func(CODE(0x354bcc8))
+XMPP::Conn: xmppCallbackInit: start
+XMPP::Conn: SetCallBacks: tag(message) func(CODE(0x354beb4))
+XMPP::Conn: SetCallBacks: tag(presence) func(CODE(0x354be54))
+XMPP::Conn: SetCallBacks: tag(iq) func(CODE(0x354bdf4))
+XMPP::Conn: SetPresenceCallBacks: type(subscribe) func(CODE(0x354be48))
+XMPP::Conn: SetPresenceCallBacks: type(subscribed) func(CODE(0x354c028))
+XMPP::Conn: SetPresenceCallBacks: type(unsubscribe) func(CODE(0x354bfc8))
+XMPP::Conn: SetPresenceCallBacks: type(unsubscribed) func(CODE(0x354c088))
+XMPP::Conn: SetDirectXPathCallBacks: xpath(/[@xmlns="urn:ietf:params:xml:ns:xmpp-tls"]) func(CODE(0x354c148))
+XMPP::Conn: SetDirectXPathCallBacks: xpath(/[@xmlns="urn:ietf:params:xml:ns:xmpp-sasl"]) func(CODE(0x354c25c))
+XMPP::Conn: xmppCallbackInit: stop
@@ -25,7 +25,7 @@ SKIP:
skip "Cannot open connection (maybe a firewall?)",4 unless defined($sock);
$sock->close();
- $Client = Net::XMPP::Client->new();
+ $Client = new Net::XMPP::Client();
$Client->SetCallBacks(onconnect => \&onConnect,
onauth => \&onAuth,
@@ -25,7 +25,7 @@ SKIP:
skip "Cannot open connection (maybe a firewall?)",4 unless defined($sock);
$sock->close();
- $Client = Net::XMPP::Client->new();
+ $Client = new Net::XMPP::Client();
$Client->SetCallBacks(onconnect => \&onConnect,
onauth => \&onAuth,
@@ -1,13 +0,0 @@
-# An account on a server supporting
-# TLS and having an SRV record in DNS
-srv_and_tls:
- bare_jid: you@example.com
- auth:
- password: som3passw0rd
- username: you
- conn:
- hostname: example.com
- port: 5222
- srv: 1
- ssl_ca_path: /path/to/ca/certificates
- tls: 1
@@ -1,232 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-
-######################## XML::Stream mocking starts
-#{
-# package XML::Stream;
-# our $AUTOLOAD;
-# use Data::Dumper;
-#
-# sub new {
-# bless {}, shift;
-# }
-# sub Connect {
-# }
-# sub GetErrorCode {
-# }
-# sub GetStreamFeature {
-# }
-# sub SASLClient {
-# }
-# DESTROY {
-# }
-#
-# AUTOLOAD {
-# print Dumper [$AUTOLOAD, \@_];
-# }
-#
-#}
-#$INC{'XML/Stream.pm'} = 1;
-######################## XML::Stream mocking ends
-
-my @users;
-foreach my $name (qw(GTALK0 GTALK1)) {
- if ($ENV{$name}) {
- my ($user, $pw) = split /:/, $ENV{$name};
- push @users, {
- username => $user,
- password => $pw,
- };
- }
-}
-
-eval "use Test::Memory::Cycle";
-my $memory_cycle = ! $@;
-my $leak_guard;
-
-BEGIN {
- eval "use Devel::LeakGuard::Object qw(leakguard)";
- $leak_guard = ! $@;
-}
-
-my $repeat = 5;
-plan tests => 2 + 6 * $repeat;
-
-# TODO ask user if it is ok to do network tests!
-print_size('before loading Net::XMPP');
-require Net::XMPP;
-print_size('after loading Net::XMPP');
-# see
-# http://blogs.perl.org/users/marco_fontani/2010/03/google-talk-with-perl.html
-{
- # monkey-patch XML::Stream to support the google-added JID
- package XML::Stream;
- no warnings 'redefine';
-
- sub SASLAuth {
- my $self = shift;
- my $sid = shift;
- my $first_step = $self->{SIDS}->{$sid}->{sasl}->{client}->client_start();
- my $first_step64 = MIME::Base64::encode_base64( $first_step, "" );
- $self->Send(
- $sid,
- "<auth xmlns='"
- . &ConstXMLNS('xmpp-sasl')
- . "' mechanism='"
- . $self->{SIDS}->{$sid}->{sasl}->{client}->mechanism() . "' "
- . q{xmlns:ga='http://www.google.com/talk/protocol/auth'
- ga:client-uses-full-bind-result='true'} . # JID
- ">" . $first_step64 . "</auth>"
- );
- }
-}
-
-my $mem1 = run();
-my $mem_last = $mem1;
-for (2..$repeat) {
- $mem_last = run();
-}
-
-# The leakage shown here happens even before Authentication is called
-#SKIP: {
-# skip 'Devel::LeakGuard::Object is needed', 1 if not $leak_guard;
-# my $warn;
-# local $SIG{__WARN__} = sub { $warn = shift };
-# leakguard {
-# run();
-# };
-#
-# ok(!$warn, 'leaking') or diag $warn;
-#}
-
-
-# as I can see setting up the connection leaks in the first 5 attempts
-# and then it stops leaking. I tried it with repeate=25
-# When adding AuthSend to the mix the code keeps leaking even after 20 repeats.
-# Still the total leak is only 130 in 25 repeats
-# After duplicating the connections (having two users),
-# adding the CallBacks and handling the presence messages.
-# the leak after 25 repeats went up to 152.
-#
-# This might need to be added to a test case.
-# For now we only check if it "does not leak too much"
-diag 'Memory change: ' . ($mem_last - $mem1);
-TODO: {
- local $TODO = 'Memory leak or expectations being to high?';
- is $mem_last, $mem1, 'expected 0 memory growth';
-}
-cmp_ok $mem_last, '<', $mem1+160, 'does not leak much' or diag 'Leak: ' . ($mem_last-$mem1);
-
-
-# tools when XML::Stream mocking
-#use Data::Dumper;
-#die Dumper \%INC;
-#foreach my $k (keys %INC) {
-# if ($k =~ m{XML}) {
-# diag $k;
-# }
-#}
-# end tools
-
-exit;
-
-
-
-sub run {
- my @conn;
- for my $i (0,1) {
- $conn[$i] = Net::XMPP::Client->new;
- isa_ok $conn[$i], 'Net::XMPP::Client';
-
- my $status = $conn[$i]->Connect(
- hostname => 'talk.google.com',
- port => 5222,
- componentname => 'gmail.com',
- connectiontype => 'tcpip',
- tls => 1,
- ssl_verify => 0,
- );
-
- SKIP: {
- skip 'Needs Test::Memory::Cycle', 1 if not $memory_cycle;
- memory_cycle_ok($conn[$i], 'after calling Connect');
- }
-
- SKIP: {
- skip "need GTALK$i = username:password", 1 if not $users[$i];
-
- my ( $res, $msg ) = $conn[$i]->AuthSend(
- username => $users[$i]{username},
- password => $users[$i]{password},
- resource => 'notify v1.0',
- );
- is $res, 'ok', 'result is ok';
- if (not defined $res or $res ne 'ok') {
- diag $!;
- }
-
- $conn[$i]->SetCallBacks(
- message => \&on_message,
- presence => \&on_presence,
- receive => \&on_receive,
- );
- $conn[$i]->PresenceSend();
- }
- }
-
- for my $i (0..5) {
- my $status = $conn[$i % 2]->Process(1);
- die if not defined $status;
- }
- # receive presence message
- # send and receive messages
-
- return print_size('after calling Run');
-}
-
-sub print_size {
- my ($msg) = @_;
- return 0 if not -x '/bin/ps';
- my @lines = grep { /^$$\s/ } qx{/bin/ps -e -o pid,rss,command};
- chomp @lines;
- my $RSS;
- foreach my $line (@lines) {
- my ($pid, $rss) = split /\s+/, $line;
- diag "RSS: $rss - $msg";
- $RSS = $rss;
- }
- return $RSS;
-}
-
-sub on_presence {
- my ($sid, $presence) = @_;
- my $to = $presence->GetTo;
- my $from = $presence->GetFrom;
- my $type = $presence->GetType || 'available';
- my $status = $presence->GetStatus || '';
-
- ($to) = split m{/}, $to;
- ($from) = split m{/}, $from;
-
- diag "$to - $from - $type - $status";
-}
-
-sub on_receive {
- # called on every message received
-}
-
-sub on_message {
- my ($message) = @_;
- my $type = $message->GetType;
- my $fromJID = $message->fromJID('jid');
- my $from = $message->GetUserID;
- my $resource = $message->GetResource;
- my $subject = $message->GetSubject;
- my $body = $message->GetBody;
- my $xml = $message->GetXML;
-
- diag "$from - $body";
-}
-
@@ -5,7 +5,7 @@ BEGIN{ use_ok( "Net::XMPP" ); }
require "t/mytestlib.pl";
-my $debug = Net::XMPP::Debug->new(setdefault=>1,
+my $debug = new Net::XMPP::Debug(setdefault=>1,
level=>-1,
file=>"stdout",
header=>"test",
@@ -14,7 +14,7 @@ my $debug = Net::XMPP::Debug->new(setdefault=>1,
#------------------------------------------------------------------------------
# iq
#------------------------------------------------------------------------------
-my $iq = Net::XMPP::IQ->new();
+my $iq = new Net::XMPP::IQ();
ok( defined($iq), "new()");
isa_ok( $iq, "Net::XMPP::IQ");
@@ -85,7 +85,7 @@ is($child, $xoob, "Is the query xoob?");
#------------------------------------------------------------------------------
# iq
#------------------------------------------------------------------------------
-my $iq2 = Net::XMPP::IQ->new();
+my $iq2 = new Net::XMPP::IQ();
ok( defined($iq2), "new()");
isa_ok( $iq2, "Net::XMPP::IQ");
@@ -5,7 +5,7 @@ BEGIN{ use_ok( "Net::XMPP" ); }
require "t/mytestlib.pl";
-my $jid = Net::XMPP::JID->new('host.com/xxx@yyy.com/zzz');
+my $jid = new Net::XMPP::JID('host.com/xxx@yyy.com/zzz');
ok( defined($jid), "new()" );
isa_ok( $jid, "Net::XMPP::JID" );
is( $jid->GetUserID(), '', "GetUserID()" );
@@ -14,7 +14,7 @@ is( $jid->GetResource(), 'xxx@yyy.com/zzz', "GetResource()" );
is( $jid->GetJID("full"), 'host.com/xxx@yyy.com/zzz', "GetJID(\"full\")" );
is( $jid->GetJID("base"), 'host.com', "GetJID(\"base\")" );
-my $jid2 = Net::XMPP::JID->new('user@host.com/xxx@yyy.com/zzz');
+my $jid2 = new Net::XMPP::JID('user@host.com/xxx@yyy.com/zzz');
ok( defined($jid2), "new()" );
isa_ok( $jid2, "Net::XMPP::JID" );
is( $jid2->GetUserID(), 'user', "GetUserID()" );
@@ -1,64 +0,0 @@
-package Net::XMPP::Test::Utils;
-
-use strict;
-use warnings;
-
-use YAML::Tiny;
-use LWP::Online qw/online/;
-
-use Exporter 'import';
-our @EXPORT_OK = (qw/
- can_run_tests
- conn_is_available
- accts_are_configured
- bare_jid
- get_conn_params
- get_auth_params
-/);
-
-$Net::XMPP::Test::Utils::accounts_file = 't/config/accounts.yml';
-
-sub can_run_tests {
- return conn_is_available() && accts_are_configured();
-}
-
-sub conn_is_available {
- return online();
-}
-
-sub accts_are_configured {
- return 1
- if -e $Net::XMPP::Test::Utils::accounts_file
- && -r _ && -s _;
- return 0;
-}
-
-sub get_account {
- my ($wanted_account) = @_;
-
- $Net::XMPP::Test::Utils::accounts
- = YAML::Tiny->read( $Net::XMPP::Test::Utils::accounts_file )
- unless defined $Net::XMPP::Test::Utils::accounts;
-
- return $Net::XMPP::Test::Utils::accounts->[0]->{$wanted_account};
-}
-
-sub bare_jid {
- return get_account( shift )->{'bare_jid'};
-}
-
-sub get_conn_params {
- return get_account( shift )->{'conn'};
-}
-
-sub get_auth_params {
- my $resource = time . int(rand(1000));
- chomp($resource);
-
- my $account = get_account( shift )->{'auth'};
- $account->{'resource'} = $resource;
-
- return $account;
-}
-
-1;
@@ -0,0 +1,1408 @@
+package Test::Builder;
+
+use 5.004;
+
+# $^C was only introduced in 5.005-ish. We do this to prevent
+# use of uninitialized value warnings in older perls.
+$^C ||= 0;
+
+use strict;
+use vars qw($VERSION $CLASS);
+$VERSION = '0.17';
+$CLASS = __PACKAGE__;
+
+my $IsVMS = $^O eq 'VMS';
+
+# Make Test::Builder thread-safe for ithreads.
+BEGIN {
+ use Config;
+ if( $] >= 5.008 && $Config{useithreads} ) {
+ require threads;
+ require threads::shared;
+ threads::shared->import;
+ }
+ else {
+ *share = sub { 0 };
+ *lock = sub { 0 };
+ }
+}
+
+use vars qw($Level);
+my($Test_Died) = 0;
+my($Have_Plan) = 0;
+my $Original_Pid = $$;
+my $Curr_Test = 0; share($Curr_Test);
+my @Test_Results = (); share(@Test_Results);
+my @Test_Details = (); share(@Test_Details);
+
+
+=head1 NAME
+
+Test::Builder - Backend for building test libraries
+
+=head1 SYNOPSIS
+
+ package My::Test::Module;
+ use Test::Builder;
+ require Exporter;
+ @ISA = qw(Exporter);
+ @EXPORT = qw(ok);
+
+ my $Test = Test::Builder->new;
+ $Test->output('my_logfile');
+
+ sub import {
+ my($self) = shift;
+ my $pack = caller;
+
+ $Test->exported_to($pack);
+ $Test->plan(@_);
+
+ $self->export_to_level(1, $self, 'ok');
+ }
+
+ sub ok {
+ my($test, $name) = @_;
+
+ $Test->ok($test, $name);
+ }
+
+
+=head1 DESCRIPTION
+
+Test::Simple and Test::More have proven to be popular testing modules,
+but they're not always flexible enough. Test::Builder provides the a
+building block upon which to write your own test libraries I<which can
+work together>.
+
+=head2 Construction
+
+=over 4
+
+=item B<new>
+
+ my $Test = Test::Builder->new;
+
+Returns a Test::Builder object representing the current state of the
+test.
+
+Since you only run one test per program, there is B<one and only one>
+Test::Builder object. No matter how many times you call new(), you're
+getting the same object. (This is called a singleton).
+
+=cut
+
+my $Test;
+sub new {
+ my($class) = shift;
+ $Test ||= bless ['Move along, nothing to see here'], $class;
+ return $Test;
+}
+
+=back
+
+=head2 Setting up tests
+
+These methods are for setting up tests and declaring how many there
+are. You usually only want to call one of these methods.
+
+=over 4
+
+=item B<exported_to>
+
+ my $pack = $Test->exported_to;
+ $Test->exported_to($pack);
+
+Tells Test::Builder what package you exported your functions to.
+This is important for getting TODO tests right.
+
+=cut
+
+my $Exported_To;
+sub exported_to {
+ my($self, $pack) = @_;
+
+ if( defined $pack ) {
+ $Exported_To = $pack;
+ }
+ return $Exported_To;
+}
+
+=item B<plan>
+
+ $Test->plan('no_plan');
+ $Test->plan( skip_all => $reason );
+ $Test->plan( tests => $num_tests );
+
+A convenient way to set up your tests. Call this and Test::Builder
+will print the appropriate headers and take the appropriate actions.
+
+If you call plan(), don't call any of the other methods below.
+
+=cut
+
+sub plan {
+ my($self, $cmd, $arg) = @_;
+
+ return unless $cmd;
+
+ if( $Have_Plan ) {
+ die sprintf "You tried to plan twice! Second plan at %s line %d\n",
+ ($self->caller)[1,2];
+ }
+
+ if( $cmd eq 'no_plan' ) {
+ $self->no_plan;
+ }
+ elsif( $cmd eq 'skip_all' ) {
+ return $self->skip_all($arg);
+ }
+ elsif( $cmd eq 'tests' ) {
+ if( $arg ) {
+ return $self->expected_tests($arg);
+ }
+ elsif( !defined $arg ) {
+ die "Got an undefined number of tests. Looks like you tried to ".
+ "say how many tests you plan to run but made a mistake.\n";
+ }
+ elsif( !$arg ) {
+ die "You said to run 0 tests! You've got to run something.\n";
+ }
+ }
+ else {
+ require Carp;
+ my @args = grep { defined } ($cmd, $arg);
+ Carp::croak("plan() doesn't understand @args");
+ }
+
+ return 1;
+}
+
+=item B<expected_tests>
+
+ my $max = $Test->expected_tests;
+ $Test->expected_tests($max);
+
+Gets/sets the # of tests we expect this test to run and prints out
+the appropriate headers.
+
+=cut
+
+my $Expected_Tests = 0;
+sub expected_tests {
+ my($self, $max) = @_;
+
+ if( defined $max ) {
+ $Expected_Tests = $max;
+ $Have_Plan = 1;
+
+ $self->_print("1..$max\n") unless $self->no_header;
+ }
+ return $Expected_Tests;
+}
+
+
+=item B<no_plan>
+
+ $Test->no_plan;
+
+Declares that this test will run an indeterminate # of tests.
+
+=cut
+
+my($No_Plan) = 0;
+sub no_plan {
+ $No_Plan = 1;
+ $Have_Plan = 1;
+}
+
+=item B<has_plan>
+
+ $plan = $Test->has_plan
+
+Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests).
+
+=cut
+
+sub has_plan {
+ return($Expected_Tests) if $Expected_Tests;
+ return('no_plan') if $No_Plan;
+ return(undef);
+};
+
+
+=item B<skip_all>
+
+ $Test->skip_all;
+ $Test->skip_all($reason);
+
+Skips all the tests, using the given $reason. Exits immediately with 0.
+
+=cut
+
+my $Skip_All = 0;
+sub skip_all {
+ my($self, $reason) = @_;
+
+ my $out = "1..0";
+ $out .= " # Skip $reason" if $reason;
+ $out .= "\n";
+
+ $Skip_All = 1;
+
+ $self->_print($out) unless $self->no_header;
+ exit(0);
+}
+
+=back
+
+=head2 Running tests
+
+These actually run the tests, analogous to the functions in
+Test::More.
+
+$name is always optional.
+
+=over 4
+
+=item B<ok>
+
+ $Test->ok($test, $name);
+
+Your basic test. Pass if $test is true, fail if $test is false. Just
+like Test::Simple's ok().
+
+=cut
+
+sub ok {
+ my($self, $test, $name) = @_;
+
+ # $test might contain an object which we don't want to accidentally
+ # store, so we turn it into a boolean.
+ $test = $test ? 1 : 0;
+
+ unless( $Have_Plan ) {
+ require Carp;
+ Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
+ }
+
+ lock $Curr_Test;
+ $Curr_Test++;
+
+ $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
+ You named your test '$name'. You shouldn't use numbers for your test names.
+ Very confusing.
+ERR
+
+ my($pack, $file, $line) = $self->caller;
+
+ my $todo = $self->todo($pack);
+
+ my $out;
+ my $result = {};
+ share($result);
+
+ unless( $test ) {
+ $out .= "not ";
+ @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
+ }
+ else {
+ @$result{ 'ok', 'actual_ok' } = ( 1, $test );
+ }
+
+ $out .= "ok";
+ $out .= " $Curr_Test" if $self->use_numbers;
+
+ if( defined $name ) {
+ $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
+ $out .= " - $name";
+ $result->{name} = $name;
+ }
+ else {
+ $result->{name} = '';
+ }
+
+ if( $todo ) {
+ my $what_todo = $todo;
+ $out .= " # TODO $what_todo";
+ $result->{reason} = $what_todo;
+ $result->{type} = 'todo';
+ }
+ else {
+ $result->{reason} = '';
+ $result->{type} = '';
+ }
+
+ $Test_Results[$Curr_Test-1] = $result;
+ $out .= "\n";
+
+ $self->_print($out);
+
+ unless( $test ) {
+ my $msg = $todo ? "Failed (TODO)" : "Failed";
+ $self->diag(" $msg test ($file at line $line)\n");
+ }
+
+ return $test ? 1 : 0;
+}
+
+=item B<is_eq>
+
+ $Test->is_eq($got, $expected, $name);
+
+Like Test::More's is(). Checks if $got eq $expected. This is the
+string version.
+
+=item B<is_num>
+
+ $Test->is_num($got, $expected, $name);
+
+Like Test::More's is(). Checks if $got == $expected. This is the
+numeric version.
+
+=cut
+
+sub is_eq {
+ my($self, $got, $expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+
+ $self->ok($test, $name);
+ $self->_is_diag($got, 'eq', $expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, 'eq', $expect, $name);
+}
+
+sub is_num {
+ my($self, $got, $expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+
+ $self->ok($test, $name);
+ $self->_is_diag($got, '==', $expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, '==', $expect, $name);
+}
+
+sub _is_diag {
+ my($self, $got, $type, $expect) = @_;
+
+ foreach my $val (\$got, \$expect) {
+ if( defined $$val ) {
+ if( $type eq 'eq' ) {
+ # quote and force string context
+ $$val = "'$$val'"
+ }
+ else {
+ # force numeric context
+ $$val = $$val+0;
+ }
+ }
+ else {
+ $$val = 'undef';
+ }
+ }
+
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
+ got: %s
+ expected: %s
+DIAGNOSTIC
+
+}
+
+=item B<isnt_eq>
+
+ $Test->isnt_eq($got, $dont_expect, $name);
+
+Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
+the string version.
+
+=item B<isnt_num>
+
+ $Test->is_num($got, $dont_expect, $name);
+
+Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
+the numeric version.
+
+=cut
+
+sub isnt_eq {
+ my($self, $got, $dont_expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+
+ $self->ok($test, $name);
+ $self->_cmp_diag('ne', $got, $dont_expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, 'ne', $dont_expect, $name);
+}
+
+sub isnt_num {
+ my($self, $got, $dont_expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+
+ $self->ok($test, $name);
+ $self->_cmp_diag('!=', $got, $dont_expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, '!=', $dont_expect, $name);
+}
+
+
+=item B<like>
+
+ $Test->like($this, qr/$regex/, $name);
+ $Test->like($this, '/$regex/', $name);
+
+Like Test::More's like(). Checks if $this matches the given $regex.
+
+You'll want to avoid qr// if you want your tests to work before 5.005.
+
+=item B<unlike>
+
+ $Test->unlike($this, qr/$regex/, $name);
+ $Test->unlike($this, '/$regex/', $name);
+
+Like Test::More's unlike(). Checks if $this B<does not match> the
+given $regex.
+
+=cut
+
+sub like {
+ my($self, $this, $regex, $name) = @_;
+
+ local $Level = $Level + 1;
+ $self->_regex_ok($this, $regex, '=~', $name);
+}
+
+sub unlike {
+ my($self, $this, $regex, $name) = @_;
+
+ local $Level = $Level + 1;
+ $self->_regex_ok($this, $regex, '!~', $name);
+}
+
+=item B<maybe_regex>
+
+ $Test->maybe_regex(qr/$regex/);
+ $Test->maybe_regex('/$regex/');
+
+Convenience method for building testing functions that take regular
+expressions as arguments, but need to work before perl 5.005.
+
+Takes a quoted regular expression produced by qr//, or a string
+representing a regular expression.
+
+Returns a Perl value which may be used instead of the corresponding
+regular expression, or undef if it's argument is not recognised.
+
+For example, a version of like(), sans the useful diagnostic messages,
+could be written as:
+
+ sub laconic_like {
+ my ($self, $this, $regex, $name) = @_;
+ my $usable_regex = $self->maybe_regex($regex);
+ die "expecting regex, found '$regex'\n"
+ unless $usable_regex;
+ $self->ok($this =~ m/$usable_regex/, $name);
+ }
+
+=cut
+
+
+sub maybe_regex {
+ my ($self, $regex) = @_;
+ my $usable_regex = undef;
+ if( ref $regex eq 'Regexp' ) {
+ $usable_regex = $regex;
+ }
+ # Check if it looks like '/foo/'
+ elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
+ $usable_regex = length $opts ? "(?$opts)$re" : $re;
+ };
+ return($usable_regex)
+};
+
+sub _regex_ok {
+ my($self, $this, $regex, $cmp, $name) = @_;
+
+ local $Level = $Level + 1;
+
+ my $ok = 0;
+ my $usable_regex = $self->maybe_regex($regex);
+ unless (defined $usable_regex) {
+ $ok = $self->ok( 0, $name );
+ $self->diag(" '$regex' doesn't look much like a regex to me.");
+ return $ok;
+ }
+
+ {
+ local $^W = 0;
+ my $test = $this =~ /$usable_regex/ ? 1 : 0;
+ $test = !$test if $cmp eq '!~';
+ $ok = $self->ok( $test, $name );
+ }
+
+ unless( $ok ) {
+ $this = defined $this ? "'$this'" : 'undef';
+ my $match = $cmp eq '=~' ? "doesn't match" : "matches";
+ $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
+ %s
+ %13s '%s'
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+=item B<cmp_ok>
+
+ $Test->cmp_ok($this, $type, $that, $name);
+
+Works just like Test::More's cmp_ok().
+
+ $Test->cmp_ok($big_num, '!=', $other_big_num);
+
+=cut
+
+sub cmp_ok {
+ my($self, $got, $type, $expect, $name) = @_;
+
+ my $test;
+ {
+ local $^W = 0;
+ local($@,$!); # don't interfere with $@
+ # eval() sometimes resets $!
+ $test = eval "\$got $type \$expect";
+ }
+ local $Level = $Level + 1;
+ my $ok = $self->ok($test, $name);
+
+ unless( $ok ) {
+ if( $type =~ /^(eq|==)$/ ) {
+ $self->_is_diag($got, $type, $expect);
+ }
+ else {
+ $self->_cmp_diag($got, $type, $expect);
+ }
+ }
+ return $ok;
+}
+
+sub _cmp_diag {
+ my($self, $got, $type, $expect) = @_;
+
+ $got = defined $got ? "'$got'" : 'undef';
+ $expect = defined $expect ? "'$expect'" : 'undef';
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
+ %s
+ %s
+ %s
+DIAGNOSTIC
+}
+
+=item B<BAILOUT>
+
+ $Test->BAILOUT($reason);
+
+Indicates to the Test::Harness that things are going so badly all
+testing should terminate. This includes running any additional test
+scripts.
+
+It will exit with 255.
+
+=cut
+
+sub BAILOUT {
+ my($self, $reason) = @_;
+
+ $self->_print("Bail out! $reason");
+ exit 255;
+}
+
+=item B<skip>
+
+ $Test->skip;
+ $Test->skip($why);
+
+Skips the current test, reporting $why.
+
+=cut
+
+sub skip {
+ my($self, $why) = @_;
+ $why ||= '';
+
+ unless( $Have_Plan ) {
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
+ }
+
+ lock($Curr_Test);
+ $Curr_Test++;
+
+ my %result;
+ share(%result);
+ %result = (
+ 'ok' => 1,
+ actual_ok => 1,
+ name => '',
+ type => 'skip',
+ reason => $why,
+ );
+ $Test_Results[$Curr_Test-1] = \%result;
+
+ my $out = "ok";
+ $out .= " $Curr_Test" if $self->use_numbers;
+ $out .= " # skip $why\n";
+
+ $Test->_print($out);
+
+ return 1;
+}
+
+
+=item B<todo_skip>
+
+ $Test->todo_skip;
+ $Test->todo_skip($why);
+
+Like skip(), only it will declare the test as failing and TODO. Similar
+to
+
+ print "not ok $tnum # TODO $why\n";
+
+=cut
+
+sub todo_skip {
+ my($self, $why) = @_;
+ $why ||= '';
+
+ unless( $Have_Plan ) {
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
+ }
+
+ lock($Curr_Test);
+ $Curr_Test++;
+
+ my %result;
+ share(%result);
+ %result = (
+ 'ok' => 1,
+ actual_ok => 0,
+ name => '',
+ type => 'todo_skip',
+ reason => $why,
+ );
+
+ $Test_Results[$Curr_Test-1] = \%result;
+
+ my $out = "not ok";
+ $out .= " $Curr_Test" if $self->use_numbers;
+ $out .= " # TODO & SKIP $why\n";
+
+ $Test->_print($out);
+
+ return 1;
+}
+
+
+=begin _unimplemented
+
+=item B<skip_rest>
+
+ $Test->skip_rest;
+ $Test->skip_rest($reason);
+
+Like skip(), only it skips all the rest of the tests you plan to run
+and terminates the test.
+
+If you're running under no_plan, it skips once and terminates the
+test.
+
+=end _unimplemented
+
+=back
+
+
+=head2 Test style
+
+=over 4
+
+=item B<level>
+
+ $Test->level($how_high);
+
+How far up the call stack should $Test look when reporting where the
+test failed.
+
+Defaults to 1.
+
+Setting $Test::Builder::Level overrides. This is typically useful
+localized:
+
+ {
+ local $Test::Builder::Level = 2;
+ $Test->ok($test);
+ }
+
+=cut
+
+sub level {
+ my($self, $level) = @_;
+
+ if( defined $level ) {
+ $Level = $level;
+ }
+ return $Level;
+}
+
+$CLASS->level(1);
+
+
+=item B<use_numbers>
+
+ $Test->use_numbers($on_or_off);
+
+Whether or not the test should output numbers. That is, this if true:
+
+ ok 1
+ ok 2
+ ok 3
+
+or this if false
+
+ ok
+ ok
+ ok
+
+Most useful when you can't depend on the test output order, such as
+when threads or forking is involved.
+
+Test::Harness will accept either, but avoid mixing the two styles.
+
+Defaults to on.
+
+=cut
+
+my $Use_Nums = 1;
+sub use_numbers {
+ my($self, $use_nums) = @_;
+
+ if( defined $use_nums ) {
+ $Use_Nums = $use_nums;
+ }
+ return $Use_Nums;
+}
+
+=item B<no_header>
+
+ $Test->no_header($no_header);
+
+If set to true, no "1..N" header will be printed.
+
+=item B<no_ending>
+
+ $Test->no_ending($no_ending);
+
+Normally, Test::Builder does some extra diagnostics when the test
+ends. It also changes the exit code as described in Test::Simple.
+
+If this is true, none of that will be done.
+
+=cut
+
+my($No_Header, $No_Ending) = (0,0);
+sub no_header {
+ my($self, $no_header) = @_;
+
+ if( defined $no_header ) {
+ $No_Header = $no_header;
+ }
+ return $No_Header;
+}
+
+sub no_ending {
+ my($self, $no_ending) = @_;
+
+ if( defined $no_ending ) {
+ $No_Ending = $no_ending;
+ }
+ return $No_Ending;
+}
+
+
+=back
+
+=head2 Output
+
+Controlling where the test output goes.
+
+It's ok for your test to change where STDOUT and STDERR point to,
+Test::Builder's default output settings will not be affected.
+
+=over 4
+
+=item B<diag>
+
+ $Test->diag(@msgs);
+
+Prints out the given $message. Normally, it uses the failure_output()
+handle, but if this is for a TODO test, the todo_output() handle is
+used.
+
+Output will be indented and marked with a # so as not to interfere
+with test output. A newline will be put on the end if there isn't one
+already.
+
+We encourage using this rather than calling print directly.
+
+Returns false. Why? Because diag() is often used in conjunction with
+a failing test (C<ok() || diag()>) it "passes through" the failure.
+
+ return ok(...) || diag(...);
+
+=for blame transfer
+Mark Fowler <mark@twoshortplanks.com>
+
+=cut
+
+sub diag {
+ my($self, @msgs) = @_;
+ return unless @msgs;
+
+ # Prevent printing headers when compiling (i.e. -c)
+ return if $^C;
+
+ # Escape each line with a #.
+ foreach (@msgs) {
+ $_ = 'undef' unless defined;
+ s/^/# /gms;
+ }
+
+ push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+
+ local $Level = $Level + 1;
+ my $fh = $self->todo ? $self->todo_output : $self->failure_output;
+ local($\, $", $,) = (undef, ' ', '');
+ print $fh @msgs;
+
+ return 0;
+}
+
+=begin _private
+
+=item B<_print>
+
+ $Test->_print(@msgs);
+
+Prints to the output() filehandle.
+
+=end _private
+
+=cut
+
+sub _print {
+ my($self, @msgs) = @_;
+
+ # Prevent printing headers when only compiling. Mostly for when
+ # tests are deparsed with B::Deparse
+ return if $^C;
+
+ local($\, $", $,) = (undef, ' ', '');
+ my $fh = $self->output;
+
+ # Escape each line after the first with a # so we don't
+ # confuse Test::Harness.
+ foreach (@msgs) {
+ s/\n(.)/\n# $1/sg;
+ }
+
+ push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+
+ print $fh @msgs;
+}
+
+
+=item B<output>
+
+ $Test->output($fh);
+ $Test->output($file);
+
+Where normal "ok/not ok" test output should go.
+
+Defaults to STDOUT.
+
+=item B<failure_output>
+
+ $Test->failure_output($fh);
+ $Test->failure_output($file);
+
+Where diagnostic output on test failures and diag() should go.
+
+Defaults to STDERR.
+
+=item B<todo_output>
+
+ $Test->todo_output($fh);
+ $Test->todo_output($file);
+
+Where diagnostics about todo test failures and diag() should go.
+
+Defaults to STDOUT.
+
+=cut
+
+my($Out_FH, $Fail_FH, $Todo_FH);
+sub output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $Out_FH = _new_fh($fh);
+ }
+ return $Out_FH;
+}
+
+sub failure_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $Fail_FH = _new_fh($fh);
+ }
+ return $Fail_FH;
+}
+
+sub todo_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $Todo_FH = _new_fh($fh);
+ }
+ return $Todo_FH;
+}
+
+sub _new_fh {
+ my($file_or_fh) = shift;
+
+ my $fh;
+ unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
+ $fh = do { local *FH };
+ open $fh, ">$file_or_fh" or
+ die "Can't open test output log $file_or_fh: $!";
+ }
+ else {
+ $fh = $file_or_fh;
+ }
+
+ return $fh;
+}
+
+unless( $^C ) {
+ # We dup STDOUT and STDERR so people can change them in their
+ # test suites while still getting normal test output.
+ open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
+ open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
+
+ # Set everything to unbuffered else plain prints to STDOUT will
+ # come out in the wrong order from our own prints.
+ _autoflush(\*TESTOUT);
+ _autoflush(\*STDOUT);
+ _autoflush(\*TESTERR);
+ _autoflush(\*STDERR);
+
+ $CLASS->output(\*TESTOUT);
+ $CLASS->failure_output(\*TESTERR);
+ $CLASS->todo_output(\*TESTOUT);
+}
+
+sub _autoflush {
+ my($fh) = shift;
+ my $old_fh = select $fh;
+ $| = 1;
+ select $old_fh;
+}
+
+
+=back
+
+
+=head2 Test Status and Info
+
+=over 4
+
+=item B<current_test>
+
+ my $curr_test = $Test->current_test;
+ $Test->current_test($num);
+
+Gets/sets the current test # we're on.
+
+You usually shouldn't have to set this.
+
+=cut
+
+sub current_test {
+ my($self, $num) = @_;
+
+ lock($Curr_Test);
+ if( defined $num ) {
+ unless( $Have_Plan ) {
+ require Carp;
+ Carp::croak("Can't change the current test number without a plan!");
+ }
+
+ $Curr_Test = $num;
+ if( $num > @Test_Results ) {
+ my $start = @Test_Results ? $#Test_Results + 1 : 0;
+ for ($start..$num-1) {
+ my %result;
+ share(%result);
+ %result = ( ok => 1,
+ actual_ok => undef,
+ reason => 'incrementing test number',
+ type => 'unknown',
+ name => undef
+ );
+ $Test_Results[$_] = \%result;
+ }
+ }
+ }
+ return $Curr_Test;
+}
+
+
+=item B<summary>
+
+ my @tests = $Test->summary;
+
+A simple summary of the tests so far. True for pass, false for fail.
+This is a logical pass/fail, so todos are passes.
+
+Of course, test #1 is $tests[0], etc...
+
+=cut
+
+sub summary {
+ my($self) = shift;
+
+ return map { $_->{'ok'} } @Test_Results;
+}
+
+=item B<details>
+
+ my @tests = $Test->details;
+
+Like summary(), but with a lot more detail.
+
+ $tests[$test_num - 1] =
+ { 'ok' => is the test considered a pass?
+ actual_ok => did it literally say 'ok'?
+ name => name of the test (if any)
+ type => type of test (if any, see below).
+ reason => reason for the above (if any)
+ };
+
+'ok' is true if Test::Harness will consider the test to be a pass.
+
+'actual_ok' is a reflection of whether or not the test literally
+printed 'ok' or 'not ok'. This is for examining the result of 'todo'
+tests.
+
+'name' is the name of the test.
+
+'type' indicates if it was a special test. Normal tests have a type
+of ''. Type can be one of the following:
+
+ skip see skip()
+ todo see todo()
+ todo_skip see todo_skip()
+ unknown see below
+
+Sometimes the Test::Builder test counter is incremented without it
+printing any test output, for example, when current_test() is changed.
+In these cases, Test::Builder doesn't know the result of the test, so
+it's type is 'unkown'. These details for these tests are filled in.
+They are considered ok, but the name and actual_ok is left undef.
+
+For example "not ok 23 - hole count # TODO insufficient donuts" would
+result in this structure:
+
+ $tests[22] = # 23 - 1, since arrays start from 0.
+ { ok => 1, # logically, the test passed since it's todo
+ actual_ok => 0, # in absolute terms, it failed
+ name => 'hole count',
+ type => 'todo',
+ reason => 'insufficient donuts'
+ };
+
+=cut
+
+sub details {
+ return @Test_Results;
+}
+
+=item B<todo>
+
+ my $todo_reason = $Test->todo;
+ my $todo_reason = $Test->todo($pack);
+
+todo() looks for a $TODO variable in your tests. If set, all tests
+will be considered 'todo' (see Test::More and Test::Harness for
+details). Returns the reason (ie. the value of $TODO) if running as
+todo tests, false otherwise.
+
+todo() is pretty part about finding the right package to look for
+$TODO in. It uses the exported_to() package to find it. If that's
+not set, it's pretty good at guessing the right package to look at.
+
+Sometimes there is some confusion about where todo() should be looking
+for the $TODO variable. If you want to be sure, tell it explicitly
+what $pack to use.
+
+=cut
+
+sub todo {
+ my($self, $pack) = @_;
+
+ $pack = $pack || $self->exported_to || $self->caller(1);
+
+ no strict 'refs';
+ return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
+ : 0;
+}
+
+=item B<caller>
+
+ my $package = $Test->caller;
+ my($pack, $file, $line) = $Test->caller;
+ my($pack, $file, $line) = $Test->caller($height);
+
+Like the normal caller(), except it reports according to your level().
+
+=cut
+
+sub caller {
+ my($self, $height) = @_;
+ $height ||= 0;
+
+ my @caller = CORE::caller($self->level + $height + 1);
+ return wantarray ? @caller : $caller[0];
+}
+
+=back
+
+=cut
+
+=begin _private
+
+=over 4
+
+=item B<_sanity_check>
+
+ _sanity_check();
+
+Runs a bunch of end of test sanity checks to make sure reality came
+through ok. If anything is wrong it will die with a fairly friendly
+error message.
+
+=cut
+
+#'#
+sub _sanity_check {
+ _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
+ _whoa(!$Have_Plan and $Curr_Test,
+ 'Somehow your tests ran without a plan!');
+ _whoa($Curr_Test != @Test_Results,
+ 'Somehow you got a different number of results than tests ran!');
+}
+
+=item B<_whoa>
+
+ _whoa($check, $description);
+
+A sanity check, similar to assert(). If the $check is true, something
+has gone horribly wrong. It will die with the given $description and
+a note to contact the author.
+
+=cut
+
+sub _whoa {
+ my($check, $desc) = @_;
+ if( $check ) {
+ die <<WHOA;
+WHOA! $desc
+This should never happen! Please contact the author immediately!
+WHOA
+ }
+}
+
+=item B<_my_exit>
+
+ _my_exit($exit_num);
+
+Perl seems to have some trouble with exiting inside an END block. 5.005_03
+and 5.6.1 both seem to do odd things. Instead, this function edits $?
+directly. It should ONLY be called from inside an END block. It
+doesn't actually exit, that's your job.
+
+=cut
+
+sub _my_exit {
+ $? = $_[0];
+
+ return 1;
+}
+
+
+=back
+
+=end _private
+
+=cut
+
+$SIG{__DIE__} = sub {
+ # We don't want to muck with death in an eval, but $^S isn't
+ # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
+ # with it. Instead, we use caller. This also means it runs under
+ # 5.004!
+ my $in_eval = 0;
+ for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
+ $in_eval = 1 if $sub =~ /^\(eval\)/;
+ }
+ $Test_Died = 1 unless $in_eval;
+};
+
+sub _ending {
+ my $self = shift;
+
+ _sanity_check();
+
+ # Don't bother with an ending if this is a forked copy. Only the parent
+ # should do the ending.
+ do{ _my_exit($?) && return } if $Original_Pid != $$;
+
+ # Bailout if plan() was never called. This is so
+ # "require Test::Simple" doesn't puke.
+ do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
+
+ # Figure out if we passed or failed and print helpful messages.
+ if( @Test_Results ) {
+ # The plan? We have no plan.
+ if( $No_Plan ) {
+ $self->_print("1..$Curr_Test\n") unless $self->no_header;
+ $Expected_Tests = $Curr_Test;
+ }
+
+ # 5.8.0 threads bug. Shared arrays will not be auto-extended
+ # by a slice. Worse, we have to fill in every entry else
+ # we'll get an "Invalid value for shared scalar" error
+ for my $idx ($#Test_Results..$Expected_Tests-1) {
+ my %empty_result = ();
+ share(%empty_result);
+ $Test_Results[$idx] = \%empty_result
+ unless defined $Test_Results[$idx];
+ }
+
+ my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
+ $num_failed += abs($Expected_Tests - @Test_Results);
+
+ if( $Curr_Test < $Expected_Tests ) {
+ $self->diag(<<"FAIL");
+Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
+FAIL
+ }
+ elsif( $Curr_Test > $Expected_Tests ) {
+ my $num_extra = $Curr_Test - $Expected_Tests;
+ $self->diag(<<"FAIL");
+Looks like you planned $Expected_Tests tests but ran $num_extra extra.
+FAIL
+ }
+ elsif ( $num_failed ) {
+ $self->diag(<<"FAIL");
+Looks like you failed $num_failed tests of $Expected_Tests.
+FAIL
+ }
+
+ if( $Test_Died ) {
+ $self->diag(<<"FAIL");
+Looks like your test died just after $Curr_Test.
+FAIL
+
+ _my_exit( 255 ) && return;
+ }
+
+ _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
+ }
+ elsif ( $Skip_All ) {
+ _my_exit( 0 ) && return;
+ }
+ elsif ( $Test_Died ) {
+ $self->diag(<<'FAIL');
+Looks like your test died before it could output anything.
+FAIL
+ }
+ else {
+ $self->diag("No tests run!\n");
+ _my_exit( 255 ) && return;
+ }
+}
+
+END {
+ $Test->_ending if defined $Test and !$Test->no_ending;
+}
+
+=head1 THREADS
+
+In perl 5.8.0 and later, Test::Builder is thread-safe. The test
+number is shared amongst all threads. This means if one thread sets
+the test number using current_test() they will all be effected.
+
+=head1 EXAMPLES
+
+CPAN can provide the best examples. Test::Simple, Test::More,
+Test::Exception and Test::Differences all use Test::Builder.
+
+=head1 SEE ALSO
+
+Test::Simple, Test::More, Test::Harness
+
+=head1 AUTHORS
+
+Original code by chromatic, maintained by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002 by chromatic E<lt>chromatic@wgz.orgE<gt>,
+ Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
@@ -0,0 +1,1248 @@
+package Test::More;
+
+use 5.004;
+
+use strict;
+use Test::Builder;
+
+
+# Can't use Carp because it might cause use_ok() to accidentally succeed
+# even though the module being used forgot to use Carp. Yes, this
+# actually happened.
+sub _carp {
+ my($file, $line) = (caller(1))[1,2];
+ warn @_, " at $file line $line\n";
+}
+
+
+
+require Exporter;
+use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
+$VERSION = '0.47';
+@ISA = qw(Exporter);
+@EXPORT = qw(ok use_ok require_ok
+ is isnt like unlike is_deeply
+ cmp_ok
+ skip todo todo_skip
+ pass fail
+ eq_array eq_hash eq_set
+ $TODO
+ plan
+ can_ok isa_ok
+ diag
+ );
+
+my $Test = Test::Builder->new;
+
+
+# 5.004's Exporter doesn't have export_to_level.
+sub _export_to_level
+{
+ my $pkg = shift;
+ my $level = shift;
+ (undef) = shift; # redundant arg
+ my $callpkg = caller($level);
+ $pkg->export($callpkg, @_);
+}
+
+
+=head1 NAME
+
+Test::More - yet another framework for writing test scripts
+
+=head1 SYNOPSIS
+
+ use Test::More tests => $Num_Tests;
+ # or
+ use Test::More qw(no_plan);
+ # or
+ use Test::More skip_all => $reason;
+
+ BEGIN { use_ok( 'Some::Module' ); }
+ require_ok( 'Some::Module' );
+
+ # Various ways to say "ok"
+ ok($this eq $that, $test_name);
+
+ is ($this, $that, $test_name);
+ isnt($this, $that, $test_name);
+
+ # Rather than print STDERR "# here's what went wrong\n"
+ diag("here's what went wrong");
+
+ like ($this, qr/that/, $test_name);
+ unlike($this, qr/that/, $test_name);
+
+ cmp_ok($this, '==', $that, $test_name);
+
+ is_deeply($complex_structure1, $complex_structure2, $test_name);
+
+ SKIP: {
+ skip $why, $how_many unless $have_some_feature;
+
+ ok( foo(), $test_name );
+ is( foo(42), 23, $test_name );
+ };
+
+ TODO: {
+ local $TODO = $why;
+
+ ok( foo(), $test_name );
+ is( foo(42), 23, $test_name );
+ };
+
+ can_ok($module, @methods);
+ isa_ok($object, $class);
+
+ pass($test_name);
+ fail($test_name);
+
+ # Utility comparison functions.
+ eq_array(\@this, \@that);
+ eq_hash(\%this, \%that);
+ eq_set(\@this, \@that);
+
+ # UNIMPLEMENTED!!!
+ my @status = Test::More::status;
+
+ # UNIMPLEMENTED!!!
+ BAIL_OUT($why);
+
+
+=head1 DESCRIPTION
+
+B<STOP!> If you're just getting started writing tests, have a look at
+Test::Simple first. This is a drop in replacement for Test::Simple
+which you can switch to once you get the hang of basic testing.
+
+The purpose of this module is to provide a wide range of testing
+utilities. Various ways to say "ok" with better diagnostics,
+facilities to skip tests, test future features and compare complicated
+data structures. While you can do almost anything with a simple
+C<ok()> function, it doesn't provide good diagnostic output.
+
+
+=head2 I love it when a plan comes together
+
+Before anything else, you need a testing plan. This basically declares
+how many tests your script is going to run to protect against premature
+failure.
+
+The preferred way to do this is to declare a plan when you C<use Test::More>.
+
+ use Test::More tests => $Num_Tests;
+
+There are rare cases when you will not know beforehand how many tests
+your script is going to run. In this case, you can declare that you
+have no plan. (Try to avoid using this as it weakens your test.)
+
+ use Test::More qw(no_plan);
+
+In some cases, you'll want to completely skip an entire testing script.
+
+ use Test::More skip_all => $skip_reason;
+
+Your script will declare a skip with the reason why you skipped and
+exit immediately with a zero (success). See L<Test::Harness> for
+details.
+
+If you want to control what functions Test::More will export, you
+have to use the 'import' option. For example, to import everything
+but 'fail', you'd do:
+
+ use Test::More tests => 23, import => ['!fail'];
+
+Alternatively, you can use the plan() function. Useful for when you
+have to calculate the number of tests.
+
+ use Test::More;
+ plan tests => keys %Stuff * 3;
+
+or for deciding between running the tests at all:
+
+ use Test::More;
+ if( $^O eq 'MacOS' ) {
+ plan skip_all => 'Test irrelevant on MacOS';
+ }
+ else {
+ plan tests => 42;
+ }
+
+=cut
+
+sub plan {
+ my(@plan) = @_;
+
+ my $caller = caller;
+
+ $Test->exported_to($caller);
+
+ my @imports = ();
+ foreach my $idx (0..$#plan) {
+ if( $plan[$idx] eq 'import' ) {
+ my($tag, $imports) = splice @plan, $idx, 2;
+ @imports = @$imports;
+ last;
+ }
+ }
+
+ $Test->plan(@plan);
+
+ __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
+}
+
+sub import {
+ my($class) = shift;
+ goto &plan;
+}
+
+
+=head2 Test names
+
+By convention, each test is assigned a number in order. This is
+largely done automatically for you. However, it's often very useful to
+assign a name to each test. Which would you rather see:
+
+ ok 4
+ not ok 5
+ ok 6
+
+or
+
+ ok 4 - basic multi-variable
+ not ok 5 - simple exponential
+ ok 6 - force == mass * acceleration
+
+The later gives you some idea of what failed. It also makes it easier
+to find the test in your script, simply search for "simple
+exponential".
+
+All test functions take a name argument. It's optional, but highly
+suggested that you use it.
+
+
+=head2 I'm ok, you're not ok.
+
+The basic purpose of this module is to print out either "ok #" or "not
+ok #" depending on if a given test succeeded or failed. Everything
+else is just gravy.
+
+All of the following print "ok" or "not ok" depending on if the test
+succeeded or failed. They all also return true or false,
+respectively.
+
+=over 4
+
+=item B<ok>
+
+ ok($this eq $that, $test_name);
+
+This simply evaluates any expression (C<$this eq $that> is just a
+simple example) and uses that to determine if the test succeeded or
+failed. A true expression passes, a false one fails. Very simple.
+
+For example:
+
+ ok( $exp{9} == 81, 'simple exponential' );
+ ok( Film->can('db_Main'), 'set_db()' );
+ ok( $p->tests == 4, 'saw tests' );
+ ok( !grep !defined $_, @items, 'items populated' );
+
+(Mnemonic: "This is ok.")
+
+$test_name is a very short description of the test that will be printed
+out. It makes it very easy to find a test in your script when it fails
+and gives others an idea of your intentions. $test_name is optional,
+but we B<very> strongly encourage its use.
+
+Should an ok() fail, it will produce some diagnostics:
+
+ not ok 18 - sufficient mucus
+ # Failed test 18 (foo.t at line 42)
+
+This is actually Test::Simple's ok() routine.
+
+=cut
+
+sub ok ($;$) {
+ my($test, $name) = @_;
+ $Test->ok($test, $name);
+}
+
+=item B<is>
+
+=item B<isnt>
+
+ is ( $this, $that, $test_name );
+ isnt( $this, $that, $test_name );
+
+Similar to ok(), is() and isnt() compare their two arguments
+with C<eq> and C<ne> respectively and use the result of that to
+determine if the test succeeded or failed. So these:
+
+ # Is the ultimate answer 42?
+ is( ultimate_answer(), 42, "Meaning of Life" );
+
+ # $foo isn't empty
+ isnt( $foo, '', "Got some foo" );
+
+are similar to these:
+
+ ok( ultimate_answer() eq 42, "Meaning of Life" );
+ ok( $foo ne '', "Got some foo" );
+
+(Mnemonic: "This is that." "This isn't that.")
+
+So why use these? They produce better diagnostics on failure. ok()
+cannot know what you are testing for (beyond the name), but is() and
+isnt() know what the test was and why it failed. For example this
+test:
+
+ my $foo = 'waffle'; my $bar = 'yarblokos';
+ is( $foo, $bar, 'Is foo the same as bar?' );
+
+Will produce something like this:
+
+ not ok 17 - Is foo the same as bar?
+ # Failed test (foo.t at line 139)
+ # got: 'waffle'
+ # expected: 'yarblokos'
+
+So you can figure out what went wrong without rerunning the test.
+
+You are encouraged to use is() and isnt() over ok() where possible,
+however do not be tempted to use them to find out if something is
+true or false!
+
+ # XXX BAD! $pope->isa('Catholic') eq 1
+ is( $pope->isa('Catholic'), 1, 'Is the Pope Catholic?' );
+
+This does not check if C<$pope->isa('Catholic')> is true, it checks if
+it returns 1. Very different. Similar caveats exist for false and 0.
+In these cases, use ok().
+
+ ok( $pope->isa('Catholic') ), 'Is the Pope Catholic?' );
+
+For those grammatical pedants out there, there's an C<isn't()>
+function which is an alias of isnt().
+
+=cut
+
+sub is ($$;$) {
+ $Test->is_eq(@_);
+}
+
+sub isnt ($$;$) {
+ $Test->isnt_eq(@_);
+}
+
+*isn't = \&isnt;
+
+
+=item B<like>
+
+ like( $this, qr/that/, $test_name );
+
+Similar to ok(), like() matches $this against the regex C<qr/that/>.
+
+So this:
+
+ like($this, qr/that/, 'this is like that');
+
+is similar to:
+
+ ok( $this =~ /that/, 'this is like that');
+
+(Mnemonic "This is like that".)
+
+The second argument is a regular expression. It may be given as a
+regex reference (i.e. C<qr//>) or (for better compatibility with older
+perls) as a string that looks like a regex (alternative delimiters are
+currently not supported):
+
+ like( $this, '/that/', 'this is like that' );
+
+Regex options may be placed on the end (C<'/that/i'>).
+
+Its advantages over ok() are similar to that of is() and isnt(). Better
+diagnostics on failure.
+
+=cut
+
+sub like ($$;$) {
+ $Test->like(@_);
+}
+
+
+=item B<unlike>
+
+ unlike( $this, qr/that/, $test_name );
+
+Works exactly as like(), only it checks if $this B<does not> match the
+given pattern.
+
+=cut
+
+sub unlike {
+ $Test->unlike(@_);
+}
+
+
+=item B<cmp_ok>
+
+ cmp_ok( $this, $op, $that, $test_name );
+
+Halfway between ok() and is() lies cmp_ok(). This allows you to
+compare two arguments using any binary perl operator.
+
+ # ok( $this eq $that );
+ cmp_ok( $this, 'eq', $that, 'this eq that' );
+
+ # ok( $this == $that );
+ cmp_ok( $this, '==', $that, 'this == that' );
+
+ # ok( $this && $that );
+ cmp_ok( $this, '&&', $that, 'this || that' );
+ ...etc...
+
+Its advantage over ok() is when the test fails you'll know what $this
+and $that were:
+
+ not ok 1
+ # Failed test (foo.t at line 12)
+ # '23'
+ # &&
+ # undef
+
+It's also useful in those cases where you are comparing numbers and
+is()'s use of C<eq> will interfere:
+
+ cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
+
+=cut
+
+sub cmp_ok($$$;$) {
+ $Test->cmp_ok(@_);
+}
+
+
+=item B<can_ok>
+
+ can_ok($module, @methods);
+ can_ok($object, @methods);
+
+Checks to make sure the $module or $object can do these @methods
+(works with functions, too).
+
+ can_ok('Foo', qw(this that whatever));
+
+is almost exactly like saying:
+
+ ok( Foo->can('this') &&
+ Foo->can('that') &&
+ Foo->can('whatever')
+ );
+
+only without all the typing and with a better interface. Handy for
+quickly testing an interface.
+
+No matter how many @methods you check, a single can_ok() call counts
+as one test. If you desire otherwise, use:
+
+ foreach my $meth (@methods) {
+ can_ok('Foo', $meth);
+ }
+
+=cut
+
+sub can_ok ($@) {
+ my($proto, @methods) = @_;
+ my $class = ref $proto || $proto;
+
+ unless( @methods ) {
+ my $ok = $Test->ok( 0, "$class->can(...)" );
+ $Test->diag(' can_ok() called with no methods');
+ return $ok;
+ }
+
+ my @nok = ();
+ foreach my $method (@methods) {
+ local($!, $@); # don't interfere with caller's $@
+ # eval sometimes resets $!
+ eval { $proto->can($method) } || push @nok, $method;
+ }
+
+ my $name;
+ $name = @methods == 1 ? "$class->can('$methods[0]')"
+ : "$class->can(...)";
+
+ my $ok = $Test->ok( !@nok, $name );
+
+ $Test->diag(map " $class->can('$_') failed\n", @nok);
+
+ return $ok;
+}
+
+=item B<isa_ok>
+
+ isa_ok($object, $class, $object_name);
+ isa_ok($ref, $type, $ref_name);
+
+Checks to see if the given $object->isa($class). Also checks to make
+sure the object was defined in the first place. Handy for this sort
+of thing:
+
+ my $obj = Some::Module->new;
+ isa_ok( $obj, 'Some::Module' );
+
+where you'd otherwise have to write
+
+ my $obj = Some::Module->new;
+ ok( defined $obj && $obj->isa('Some::Module') );
+
+to safeguard against your test script blowing up.
+
+It works on references, too:
+
+ isa_ok( $array_ref, 'ARRAY' );
+
+The diagnostics of this test normally just refer to 'the object'. If
+you'd like them to be more specific, you can supply an $object_name
+(for example 'Test customer').
+
+=cut
+
+sub isa_ok ($$;$) {
+ my($object, $class, $obj_name) = @_;
+
+ my $diag;
+ $obj_name = 'The object' unless defined $obj_name;
+ my $name = "$obj_name isa $class";
+ if( !defined $object ) {
+ $diag = "$obj_name isn't defined";
+ }
+ elsif( !ref $object ) {
+ $diag = "$obj_name isn't a reference";
+ }
+ else {
+ # We can't use UNIVERSAL::isa because we want to honor isa() overrides
+ local($@, $!); # eval sometimes resets $!
+ my $rslt = eval { $object->isa($class) };
+ if( $@ ) {
+ if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
+ if( !UNIVERSAL::isa($object, $class) ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ } else {
+ die <<WHOA;
+WHOA! I tried to call ->isa on your object and got some weird error.
+This should never happen. Please contact the author immediately.
+Here's the error.
+$@
+WHOA
+ }
+ }
+ elsif( !$rslt ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ }
+
+
+
+ my $ok;
+ if( $diag ) {
+ $ok = $Test->ok( 0, $name );
+ $Test->diag(" $diag\n");
+ }
+ else {
+ $ok = $Test->ok( 1, $name );
+ }
+
+ return $ok;
+}
+
+
+=item B<pass>
+
+=item B<fail>
+
+ pass($test_name);
+ fail($test_name);
+
+Sometimes you just want to say that the tests have passed. Usually
+the case is you've got some complicated condition that is difficult to
+wedge into an ok(). In this case, you can simply use pass() (to
+declare the test ok) or fail (for not ok). They are synonyms for
+ok(1) and ok(0).
+
+Use these very, very, very sparingly.
+
+=cut
+
+sub pass (;$) {
+ $Test->ok(1, @_);
+}
+
+sub fail (;$) {
+ $Test->ok(0, @_);
+}
+
+=back
+
+=head2 Diagnostics
+
+If you pick the right test function, you'll usually get a good idea of
+what went wrong when it failed. But sometimes it doesn't work out
+that way. So here we have ways for you to write your own diagnostic
+messages which are safer than just C<print STDERR>.
+
+=over 4
+
+=item B<diag>
+
+ diag(@diagnostic_message);
+
+Prints a diagnostic message which is guaranteed not to interfere with
+test output. Handy for this sort of thing:
+
+ ok( grep(/foo/, @users), "There's a foo user" ) or
+ diag("Since there's no foo, check that /etc/bar is set up right");
+
+which would produce:
+
+ not ok 42 - There's a foo user
+ # Failed test (foo.t at line 52)
+ # Since there's no foo, check that /etc/bar is set up right.
+
+You might remember C<ok() or diag()> with the mnemonic C<open() or
+die()>.
+
+B<NOTE> The exact formatting of the diagnostic output is still
+changing, but it is guaranteed that whatever you throw at it it won't
+interfere with the test.
+
+=cut
+
+sub diag {
+ $Test->diag(@_);
+}
+
+
+=back
+
+=head2 Module tests
+
+You usually want to test if the module you're testing loads ok, rather
+than just vomiting if its load fails. For such purposes we have
+C<use_ok> and C<require_ok>.
+
+=over 4
+
+=item B<use_ok>
+
+ BEGIN { use_ok($module); }
+ BEGIN { use_ok($module, @imports); }
+
+These simply use the given $module and test to make sure the load
+happened ok. It's recommended that you run use_ok() inside a BEGIN
+block so its functions are exported at compile-time and prototypes are
+properly honored.
+
+If @imports are given, they are passed through to the use. So this:
+
+ BEGIN { use_ok('Some::Module', qw(foo bar)) }
+
+is like doing this:
+
+ use Some::Module qw(foo bar);
+
+don't try to do this:
+
+ BEGIN {
+ use_ok('Some::Module');
+
+ ...some code that depends on the use...
+ ...happening at compile time...
+ }
+
+instead, you want:
+
+ BEGIN { use_ok('Some::Module') }
+ BEGIN { ...some code that depends on the use... }
+
+
+=cut
+
+sub use_ok ($;@) {
+ my($module, @imports) = @_;
+ @imports = () unless @imports;
+
+ my $pack = caller;
+
+ local($@,$!); # eval sometimes interferes with $!
+ eval <<USE;
+package $pack;
+require $module;
+'$module'->import(\@imports);
+USE
+
+ my $ok = $Test->ok( !$@, "use $module;" );
+
+ unless( $ok ) {
+ chomp $@;
+ $Test->diag(<<DIAGNOSTIC);
+ Tried to use '$module'.
+ Error: $@
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+=item B<require_ok>
+
+ require_ok($module);
+
+Like use_ok(), except it requires the $module.
+
+=cut
+
+sub require_ok ($) {
+ my($module) = shift;
+
+ my $pack = caller;
+
+ local($!, $@); # eval sometimes interferes with $!
+ eval <<REQUIRE;
+package $pack;
+require $module;
+REQUIRE
+
+ my $ok = $Test->ok( !$@, "require $module;" );
+
+ unless( $ok ) {
+ chomp $@;
+ $Test->diag(<<DIAGNOSTIC);
+ Tried to require '$module'.
+ Error: $@
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+=back
+
+=head2 Conditional tests
+
+Sometimes running a test under certain conditions will cause the
+test script to die. A certain function or method isn't implemented
+(such as fork() on MacOS), some resource isn't available (like a
+net connection) or a module isn't available. In these cases it's
+necessary to skip tests, or declare that they are supposed to fail
+but will work in the future (a todo test).
+
+For more details on the mechanics of skip and todo tests see
+L<Test::Harness>.
+
+The way Test::More handles this is with a named block. Basically, a
+block of tests which can be skipped over or made todo. It's best if I
+just show you...
+
+=over 4
+
+=item B<SKIP: BLOCK>
+
+ SKIP: {
+ skip $why, $how_many if $condition;
+
+ ...normal testing code goes here...
+ }
+
+This declares a block of tests that might be skipped, $how_many tests
+there are, $why and under what $condition to skip them. An example is
+the easiest way to illustrate:
+
+ SKIP: {
+ eval { require HTML::Lint };
+
+ skip "HTML::Lint not installed", 2 if $@;
+
+ my $lint = new HTML::Lint;
+ isa_ok( $lint, "HTML::Lint" );
+
+ $lint->parse( $html );
+ is( $lint->errors, 0, "No errors found in HTML" );
+ }
+
+If the user does not have HTML::Lint installed, the whole block of
+code I<won't be run at all>. Test::More will output special ok's
+which Test::Harness interprets as skipped, but passing, tests.
+It's important that $how_many accurately reflects the number of tests
+in the SKIP block so the # of tests run will match up with your plan.
+
+It's perfectly safe to nest SKIP blocks. Each SKIP block must have
+the label C<SKIP>, or Test::More can't work its magic.
+
+You don't skip tests which are failing because there's a bug in your
+program, or for which you don't yet have code written. For that you
+use TODO. Read on.
+
+=cut
+
+#'#
+sub skip {
+ my($why, $how_many) = @_;
+
+ unless( defined $how_many ) {
+ # $how_many can only be avoided when no_plan is in use.
+ _carp "skip() needs to know \$how_many tests are in the block"
+ unless $Test::Builder::No_Plan;
+ $how_many = 1;
+ }
+
+ for( 1..$how_many ) {
+ $Test->skip($why);
+ }
+
+ local $^W = 0;
+ last SKIP;
+}
+
+
+=item B<TODO: BLOCK>
+
+ TODO: {
+ local $TODO = $why if $condition;
+
+ ...normal testing code goes here...
+ }
+
+Declares a block of tests you expect to fail and $why. Perhaps it's
+because you haven't fixed a bug or haven't finished a new feature:
+
+ TODO: {
+ local $TODO = "URI::Geller not finished";
+
+ my $card = "Eight of clubs";
+ is( URI::Geller->your_card, $card, 'Is THIS your card?' );
+
+ my $spoon;
+ URI::Geller->bend_spoon;
+ is( $spoon, 'bent', "Spoon bending, that's original" );
+ }
+
+With a todo block, the tests inside are expected to fail. Test::More
+will run the tests normally, but print out special flags indicating
+they are "todo". Test::Harness will interpret failures as being ok.
+Should anything succeed, it will report it as an unexpected success.
+You then know the thing you had todo is done and can remove the
+TODO flag.
+
+The nice part about todo tests, as opposed to simply commenting out a
+block of tests, is it's like having a programmatic todo list. You know
+how much work is left to be done, you're aware of what bugs there are,
+and you'll know immediately when they're fixed.
+
+Once a todo test starts succeeding, simply move it outside the block.
+When the block is empty, delete it.
+
+
+=item B<todo_skip>
+
+ TODO: {
+ todo_skip $why, $how_many if $condition;
+
+ ...normal testing code...
+ }
+
+With todo tests, it's best to have the tests actually run. That way
+you'll know when they start passing. Sometimes this isn't possible.
+Often a failing test will cause the whole program to die or hang, even
+inside an C<eval BLOCK> with and using C<alarm>. In these extreme
+cases you have no choice but to skip over the broken tests entirely.
+
+The syntax and behavior is similar to a C<SKIP: BLOCK> except the
+tests will be marked as failing but todo. Test::Harness will
+interpret them as passing.
+
+=cut
+
+sub todo_skip {
+ my($why, $how_many) = @_;
+
+ unless( defined $how_many ) {
+ # $how_many can only be avoided when no_plan is in use.
+ _carp "todo_skip() needs to know \$how_many tests are in the block"
+ unless $Test::Builder::No_Plan;
+ $how_many = 1;
+ }
+
+ for( 1..$how_many ) {
+ $Test->todo_skip($why);
+ }
+
+ local $^W = 0;
+ last TODO;
+}
+
+=item When do I use SKIP vs. TODO?
+
+B<If it's something the user might not be able to do>, use SKIP.
+This includes optional modules that aren't installed, running under
+an OS that doesn't have some feature (like fork() or symlinks), or maybe
+you need an Internet connection and one isn't available.
+
+B<If it's something the programmer hasn't done yet>, use TODO. This
+is for any code you haven't written yet, or bugs you have yet to fix,
+but want to put tests in your testing script (always a good idea).
+
+
+=back
+
+=head2 Comparison functions
+
+Not everything is a simple eq check or regex. There are times you
+need to see if two arrays are equivalent, for instance. For these
+instances, Test::More provides a handful of useful functions.
+
+B<NOTE> These are NOT well-tested on circular references. Nor am I
+quite sure what will happen with filehandles.
+
+=over 4
+
+=item B<is_deeply>
+
+ is_deeply( $this, $that, $test_name );
+
+Similar to is(), except that if $this and $that are hash or array
+references, it does a deep comparison walking each data structure to
+see if they are equivalent. If the two structures are different, it
+will display the place where they start differing.
+
+Barrie Slaymaker's Test::Differences module provides more in-depth
+functionality along these lines, and it plays well with Test::More.
+
+B<NOTE> Display of scalar refs is not quite 100%
+
+=cut
+
+use vars qw(@Data_Stack);
+my $DNE = bless [], 'Does::Not::Exist';
+sub is_deeply {
+ my($this, $that, $name) = @_;
+
+ my $ok;
+ if( !ref $this || !ref $that ) {
+ $ok = $Test->is_eq($this, $that, $name);
+ }
+ else {
+ local @Data_Stack = ();
+ if( _deep_check($this, $that) ) {
+ $ok = $Test->ok(1, $name);
+ }
+ else {
+ $ok = $Test->ok(0, $name);
+ $ok = $Test->diag(_format_stack(@Data_Stack));
+ }
+ }
+
+ return $ok;
+}
+
+sub _format_stack {
+ my(@Stack) = @_;
+
+ my $var = '$FOO';
+ my $did_arrow = 0;
+ foreach my $entry (@Stack) {
+ my $type = $entry->{type} || '';
+ my $idx = $entry->{'idx'};
+ if( $type eq 'HASH' ) {
+ $var .= "->" unless $did_arrow++;
+ $var .= "{$idx}";
+ }
+ elsif( $type eq 'ARRAY' ) {
+ $var .= "->" unless $did_arrow++;
+ $var .= "[$idx]";
+ }
+ elsif( $type eq 'REF' ) {
+ $var = "\${$var}";
+ }
+ }
+
+ my @vals = @{$Stack[-1]{vals}}[0,1];
+ my @vars = ();
+ ($vars[0] = $var) =~ s/\$FOO/ \$got/;
+ ($vars[1] = $var) =~ s/\$FOO/\$expected/;
+
+ my $out = "Structures begin differing at:\n";
+ foreach my $idx (0..$#vals) {
+ my $val = $vals[$idx];
+ $vals[$idx] = !defined $val ? 'undef' :
+ $val eq $DNE ? "Does not exist"
+ : "'$val'";
+ }
+
+ $out .= "$vars[0] = $vals[0]\n";
+ $out .= "$vars[1] = $vals[1]\n";
+
+ $out =~ s/^/ /msg;
+ return $out;
+}
+
+
+=item B<eq_array>
+
+ eq_array(\@this, \@that);
+
+Checks if two arrays are equivalent. This is a deep check, so
+multi-level structures are handled correctly.
+
+=cut
+
+#'#
+sub eq_array {
+ my($a1, $a2) = @_;
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
+ for (0..$max) {
+ my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
+ my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
+
+ push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
+ $ok = _deep_check($e1,$e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+ return $ok;
+}
+
+sub _deep_check {
+ my($e1, $e2) = @_;
+ my $ok = 0;
+
+ my $eq;
+ {
+ # Quiet uninitialized value warnings when comparing undefs.
+ local $^W = 0;
+
+ if( $e1 eq $e2 ) {
+ $ok = 1;
+ }
+ else {
+ if( UNIVERSAL::isa($e1, 'ARRAY') and
+ UNIVERSAL::isa($e2, 'ARRAY') )
+ {
+ $ok = eq_array($e1, $e2);
+ }
+ elsif( UNIVERSAL::isa($e1, 'HASH') and
+ UNIVERSAL::isa($e2, 'HASH') )
+ {
+ $ok = eq_hash($e1, $e2);
+ }
+ elsif( UNIVERSAL::isa($e1, 'REF') and
+ UNIVERSAL::isa($e2, 'REF') )
+ {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ pop @Data_Stack if $ok;
+ }
+ elsif( UNIVERSAL::isa($e1, 'SCALAR') and
+ UNIVERSAL::isa($e2, 'SCALAR') )
+ {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ }
+ else {
+ push @Data_Stack, { vals => [$e1, $e2] };
+ $ok = 0;
+ }
+ }
+ }
+
+ return $ok;
+}
+
+
+=item B<eq_hash>
+
+ eq_hash(\%this, \%that);
+
+Determines if the two hashes contain the same keys and values. This
+is a deep check.
+
+=cut
+
+sub eq_hash {
+ my($a1, $a2) = @_;
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
+ foreach my $k (keys %$bigger) {
+ my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
+ my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
+
+ push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
+ $ok = _deep_check($e1, $e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+
+ return $ok;
+}
+
+=item B<eq_set>
+
+ eq_set(\@this, \@that);
+
+Similar to eq_array(), except the order of the elements is B<not>
+important. This is a deep check, but the irrelevancy of order only
+applies to the top level.
+
+B<NOTE> By historical accident, this is not a true set comparision.
+While the order of elements does not matter, duplicate elements do.
+
+=cut
+
+# We must make sure that references are treated neutrally. It really
+# doesn't matter how we sort them, as long as both arrays are sorted
+# with the same algorithm.
+sub _bogus_sort { local $^W = 0; ref $a ? 0 : $a cmp $b }
+
+sub eq_set {
+ my($a1, $a2) = @_;
+ return 0 unless @$a1 == @$a2;
+
+ # There's faster ways to do this, but this is easiest.
+ return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
+}
+
+=back
+
+
+=head2 Extending and Embedding Test::More
+
+Sometimes the Test::More interface isn't quite enough. Fortunately,
+Test::More is built on top of Test::Builder which provides a single,
+unified backend for any test library to use. This means two test
+libraries which both use Test::Builder B<can be used together in the
+same program>.
+
+If you simply want to do a little tweaking of how the tests behave,
+you can access the underlying Test::Builder object like so:
+
+=over 4
+
+=item B<builder>
+
+ my $test_builder = Test::More->builder;
+
+Returns the Test::Builder object underlying Test::More for you to play
+with.
+
+=cut
+
+sub builder {
+ return Test::Builder->new;
+}
+
+=back
+
+
+=head1 NOTES
+
+Test::More is B<explicitly> tested all the way back to perl 5.004.
+
+Test::More is thread-safe for perl 5.8.0 and up.
+
+=head1 BUGS and CAVEATS
+
+=over 4
+
+=item Making your own ok()
+
+If you are trying to extend Test::More, don't. Use Test::Builder
+instead.
+
+=item The eq_* family has some caveats.
+
+=item Test::Harness upgrades
+
+no_plan and todo depend on new Test::Harness features and fixes. If
+you're going to distribute tests that use no_plan or todo your
+end-users will have to upgrade Test::Harness to the latest one on
+CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
+will work fine.
+
+If you simply depend on Test::More, it's own dependencies will cause a
+Test::Harness upgrade.
+
+=back
+
+
+=head1 HISTORY
+
+This is a case of convergent evolution with Joshua Pritikin's Test
+module. I was largely unaware of its existence when I'd first
+written my own ok() routines. This module exists because I can't
+figure out how to easily wedge test names into Test's interface (along
+with a few other problems).
+
+The goal here is to have a testing utility that's simple to learn,
+quick to use and difficult to trip yourself up with while still
+providing more flexibility than the existing Test.pm. As such, the
+names of the most common routines are kept tiny, special cases and
+magic side-effects are kept to a minimum. WYSIWYG.
+
+
+=head1 SEE ALSO
+
+L<Test::Simple> if all this confuses you and you just want to write
+some tests. You can upgrade to Test::More later (it's forward
+compatible).
+
+L<Test::Differences> for more ways to test complex data structures.
+And it plays well with Test::More.
+
+L<Test> is the old testing module. Its main benefit is that it has
+been distributed with Perl since 5.004_05.
+
+L<Test::Harness> for details on how your test results are interpreted
+by Perl.
+
+L<Test::Unit> describes a very featureful unit testing interface.
+
+L<Test::Inline> shows the idea of embedded testing.
+
+L<SelfTest> is another approach to embedded testing.
+
+
+=head1 AUTHORS
+
+Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
+from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, chromatic and the perl-qa gang.
+
+
+=head1 COPYRIGHT
+
+Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
@@ -0,0 +1,235 @@
+package Test::Simple;
+
+use 5.004;
+
+use strict 'vars';
+use vars qw($VERSION);
+$VERSION = '0.47';
+
+
+use Test::Builder;
+my $Test = Test::Builder->new;
+
+sub import {
+ my $self = shift;
+ my $caller = caller;
+ *{$caller.'::ok'} = \&ok;
+
+ $Test->exported_to($caller);
+ $Test->plan(@_);
+}
+
+
+=head1 NAME
+
+Test::Simple - Basic utilities for writing tests.
+
+=head1 SYNOPSIS
+
+ use Test::Simple tests => 1;
+
+ ok( $foo eq $bar, 'foo is bar' );
+
+
+=head1 DESCRIPTION
+
+** If you are unfamiliar with testing B<read Test::Tutorial> first! **
+
+This is an extremely simple, extremely basic module for writing tests
+suitable for CPAN modules and other pursuits. If you wish to do more
+complicated testing, use the Test::More module (a drop-in replacement
+for this one).
+
+The basic unit of Perl testing is the ok. For each thing you want to
+test your program will print out an "ok" or "not ok" to indicate pass
+or fail. You do this with the ok() function (see below).
+
+The only other constraint is you must pre-declare how many tests you
+plan to run. This is in case something goes horribly wrong during the
+test and your test program aborts, or skips a test or whatever. You
+do this like so:
+
+ use Test::Simple tests => 23;
+
+You must have a plan.
+
+
+=over 4
+
+=item B<ok>
+
+ ok( $foo eq $bar, $name );
+ ok( $foo eq $bar );
+
+ok() is given an expression (in this case C<$foo eq $bar>). If it's
+true, the test passed. If it's false, it didn't. That's about it.
+
+ok() prints out either "ok" or "not ok" along with a test number (it
+keeps track of that for you).
+
+ # This produces "ok 1 - Hell not yet frozen over" (or not ok)
+ ok( get_temperature($hell) > 0, 'Hell not yet frozen over' );
+
+If you provide a $name, that will be printed along with the "ok/not
+ok" to make it easier to find your test when if fails (just search for
+the name). It also makes it easier for the next guy to understand
+what your test is for. It's highly recommended you use test names.
+
+All tests are run in scalar context. So this:
+
+ ok( @stuff, 'I have some stuff' );
+
+will do what you mean (fail if stuff is empty)
+
+=cut
+
+sub ok ($;$) {
+ $Test->ok(@_);
+}
+
+
+=back
+
+Test::Simple will start by printing number of tests run in the form
+"1..M" (so "1..5" means you're going to run 5 tests). This strange
+format lets Test::Harness know how many tests you plan on running in
+case something goes horribly wrong.
+
+If all your tests passed, Test::Simple will exit with zero (which is
+normal). If anything failed it will exit with how many failed. If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures. If no tests were ever run Test::Simple
+will throw a warning and exit with 255. If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+ 0 all tests successful
+ 255 test died
+ any other number how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
+
+This module is by no means trying to be a complete testing system.
+It's just to get you started. Once you're off the ground its
+recommended you look at L<Test::More>.
+
+
+=head1 EXAMPLE
+
+Here's an example of a simple .t file for the fictional Film module.
+
+ use Test::Simple tests => 5;
+
+ use Film; # What you're testing.
+
+ my $btaste = Film->new({ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+ NumExplodingSheep => 1
+ });
+ ok( defined($btaste) and ref $btaste eq 'Film', 'new() works' );
+
+ ok( $btaste->Title eq 'Bad Taste', 'Title() get' );
+ ok( $btaste->Director eq 'Peter Jackson', 'Director() get' );
+ ok( $btaste->Rating eq 'R', 'Rating() get' );
+ ok( $btaste->NumExplodingSheep == 1, 'NumExplodingSheep() get' );
+
+It will produce output like this:
+
+ 1..5
+ ok 1 - new() works
+ ok 2 - Title() get
+ ok 3 - Director() get
+ not ok 4 - Rating() get
+ # Failed test (t/film.t at line 14)
+ ok 5 - NumExplodingSheep() get
+ # Looks like you failed 1 tests of 5
+
+Indicating the Film::Rating() method is broken.
+
+
+=head1 CAVEATS
+
+Test::Simple will only report a maximum of 254 failures in its exit
+code. If this is a problem, you probably have a huge test script.
+Split it into multiple files. (Otherwise blame the Unix folks for
+using an unsigned short integer as the exit status).
+
+Because VMS's exit codes are much, much different than the rest of the
+universe, and perl does horrible mangling to them that gets in my way,
+it works like this on VMS.
+
+ 0 SS$_NORMAL all tests successful
+ 4 SS$_ABORT something went wrong
+
+Unfortunately, I can't differentiate any further.
+
+
+=head1 NOTES
+
+Test::Simple is B<explicitly> tested all the way back to perl 5.004.
+
+Test::Simple is thread-safe in perl 5.8.0 and up.
+
+=head1 HISTORY
+
+This module was conceived while talking with Tony Bowden in his
+kitchen one night about the problems I was having writing some really
+complicated feature into the new Testing module. He observed that the
+main problem is not dealing with these edge cases but that people hate
+to write tests B<at all>. What was needed was a dead simple module
+that took all the hard work out of testing and was really, really easy
+to learn. Paul Johnson simultaneously had this idea (unfortunately,
+he wasn't in Tony's kitchen). This is it.
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Test::More>
+
+More testing functions! Once you outgrow Test::Simple, look at
+Test::More. Test::Simple is 100% forward compatible with Test::More
+(i.e. you can just use Test::More instead of Test::Simple in your
+programs and things will still work).
+
+=item L<Test>
+
+The original Perl testing module.
+
+=item L<Test::Unit>
+
+Elaborate unit testing.
+
+=item L<Test::Inline>, L<SelfTest>
+
+Embed tests in your code!
+
+=item L<Test::Harness>
+
+Interprets the output of your test program.
+
+=back
+
+
+=head1 AUTHORS
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+
+=head1 COPYRIGHT
+
+Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
@@ -1,35 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-my $fail;
-BEGIN {
- eval "use Test::Memory::Cycle";
- $fail = $@;
-}
-plan skip_all => 'Need Test::Memory::Cycle' if $fail;
-
-
-plan tests => 2;
-
-use Net::XMPP;
-
-my $conn = Net::XMPP::Client->new;
-
-memory_cycle_ok($conn, 'after creating object');
-
-# TODO the user should be asked if he want to run networking tests!
-SKIP: {
- skip 'Needs AUTHORS_TEST', 1 if not $ENV{AUTHORS_TEST};
- my $status = $conn->Connect(
- hostname => 'talk.google.com',
- port => 5222,
- componentname => 'gmail.com',
- connectiontype => 'tcpip',
- tls => 1,
- ssl_verify => 0,
- );
-
- memory_cycle_ok($conn, 'after calling Connect');
-}
-
@@ -1,71 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-my $fail;
-BEGIN {
- eval "use Devel::LeakGuard::Object qw(leakguard)";
- $fail = $@;
-}
-
-plan skip_all => 'Need Devel::LeakGuard::Object' if $fail;
-
-plan tests => 3;
-
-use Net::XMPP;
-
-
-check_leak(
- sub {
- my $x = bless {}, 'abc';
- },
- 'nothing',
-);
-
-TODO: {
- local $TODO = 'fix leak';
-check_leak(
- sub {
- my $conn = Net::XMPP::Client->new;
- $conn = undef;
- },
- 'new',
-);
-
-check_leak(
- sub {
- my $conn = Net::XMPP::Client->new;
- my $status = $conn->Connect(
- hostname => 'talk.google.com',
- port => 5222,
- componentname => 'gmail.com',
- connectiontype => 'tcpip',
- tls => 1,
- ssl_verify => 0,
- );
- },
- 'connect',
-);
-}
-
-
-sub check_leak{
- my ($sub) = @_;
-
- local $Test::Builder::Level = $Test::Builder::Level + 1;
- for my $c (1..10) {
- $sub->();
- }
-
- my $warn;
- local $SIG{__WARN__} = sub { $warn = shift };
- leakguard {
- for my $c (1..10) {
- $sub->();
- #diag "Called $c";
- }
- };
-
- ok(!$warn, 'leaking') or diag $warn;
-}
-
@@ -5,7 +5,7 @@ BEGIN{ use_ok( "Net::XMPP" ); }
require "t/mytestlib.pl";
-my $debug = Net::XMPP::Debug->new(setdefault=>1,
+my $debug = new Net::XMPP::Debug(setdefault=>1,
level=>-1,
file=>"stdout",
header=>"test",
@@ -14,7 +14,7 @@ my $debug = Net::XMPP::Debug->new(setdefault=>1,
#------------------------------------------------------------------------------
# message
#------------------------------------------------------------------------------
-my $message = Net::XMPP::Message->new();
+my $message = new Net::XMPP::Message();
ok( defined($message), "new()");
isa_ok( $message, "Net::XMPP::Message");
@@ -77,7 +77,7 @@ ok( !$message->DefinedChild("foo:bar"), "DefinedChild - foo:bar - no");
#------------------------------------------------------------------------------
# message
#------------------------------------------------------------------------------
-my $message2 = Net::XMPP::Message->new();
+my $message2 = new Net::XMPP::Message();
ok( defined($message2), "new()");
isa_ok( $message2, "Net::XMPP::Message");
@@ -5,13 +5,13 @@ BEGIN{ use_ok( "Net::XMPP" ); }
require "t/mytestlib.pl";
-my $debug = Net::XMPP::Debug->new(setdefault=>1,
+my $debug = new Net::XMPP::Debug(setdefault=>1,
level=>-1,
file=>"stdout",
header=>"test",
);
-my $query = Net::XMPP::Stanza->new("query");
+my $query = new Net::XMPP::Stanza("query");
ok( defined($query), "new()" );
isa_ok( $query, "Net::XMPP::Stanza" );
@@ -27,7 +27,7 @@ testScalar($query,"Username","username");
is( $query->GetXML(), "<query xmlns='jabber:iq:auth'><digest>digest</digest><hash>hash</hash><password>password</password><resource>resource</resource><sequence>sequence</sequence><token>token</token><username>username</username></query>", "GetXML()" );
-my $query2 = Net::XMPP::Stanza->new("query");
+my $query2 = new Net::XMPP::Stanza("query");
ok( defined($query2), "new()" );
isa_ok( $query2, "Net::XMPP::Stanza" );
@@ -5,13 +5,13 @@ BEGIN{ use_ok( "Net::XMPP" ); }
require "t/mytestlib.pl";
-my $debug = Net::XMPP::Debug->new(setdefault=>1,
+my $debug = new Net::XMPP::Debug(setdefault=>1,
level=>-1,
file=>"stdout",
header=>"test",
);
-my $query = Net::XMPP::Stanza->new("query");
+my $query = new Net::XMPP::Stanza("query");
ok( defined($query), "new()" );
isa_ok( $query, "Net::XMPP::Stanza" );
@@ -5,7 +5,7 @@ BEGIN{ use_ok( "Net::XMPP" ); }
require "t/mytestlib.pl";
-my $debug = Net::XMPP::Debug->new(setdefault=>1,
+my $debug = new Net::XMPP::Debug(setdefault=>1,
level=>-1,
file=>"stdout",
header=>"test",
@@ -14,7 +14,7 @@ my $debug = Net::XMPP::Debug->new(setdefault=>1,
#------------------------------------------------------------------------------
# presence
#------------------------------------------------------------------------------
-my $presence = Net::XMPP::Presence->new();
+my $presence = new Net::XMPP::Presence();
ok( defined($presence), "new()");
isa_ok( $presence, "Net::XMPP::Presence");
@@ -77,7 +77,7 @@ ok( !$presence->DefinedChild("foo:bar"), "DefinedChild - foo:bar - no");
#------------------------------------------------------------------------------
# presence
#------------------------------------------------------------------------------
-my $presence2 = Net::XMPP::Presence->new();
+my $presence2 = new Net::XMPP::Presence();
ok( defined($presence2), "new()");
isa_ok( $presence2, "Net::XMPP::Presence");
@@ -5,7 +5,7 @@ BEGIN{ use_ok( "Net::XMPP" ); }
require "t/mytestlib.pl";
-my $message = Net::XMPP::Message->new();
+my $message = new Net::XMPP::Message();
ok( defined($message), "new()");
isa_ok( $message, "Net::XMPP::Message");
@@ -28,7 +28,7 @@ $message->InsertRawXML("<bar>foo</bar>");
is( $message->GetXML(), "<message from='user1\@server1/resource1' to='user2\@server2/resource2'><body>body</body><subject>subject</subject><bar>foo</bar></message>", "GetXML()" );
-my $iq = Net::XMPP::IQ->new();
+my $iq = new Net::XMPP::IQ();
ok( defined($iq), "new()");
isa_ok( $iq, "Net::XMPP::IQ");
@@ -5,7 +5,7 @@ BEGIN{ use_ok( "Net::XMPP" ); }
require "t/mytestlib.pl";
-my $debug = Net::XMPP::Debug->new(setdefault=>1,
+my $debug = new Net::XMPP::Debug(setdefault=>1,
level=>-1,
file=>"stdout",
header=>"test",
@@ -14,7 +14,7 @@ my $debug = Net::XMPP::Debug->new(setdefault=>1,
#------------------------------------------------------------------------------
# Client
#------------------------------------------------------------------------------
-my $Client = Net::XMPP::Client->new();
+my $Client = new Net::XMPP::Client();
ok( defined($Client), "new()");
isa_ok($Client,"Net::XMPP::Client");
isa_ok($Client,"Net::XMPP::Connection");
@@ -22,11 +22,11 @@ isa_ok($Client,"Net::XMPP::Connection");
#------------------------------------------------------------------------------
# Roster
#------------------------------------------------------------------------------
-my $Roster = Net::XMPP::Roster->new(connection=>$Client);
+my $Roster = new Net::XMPP::Roster(connection=>$Client);
ok( defined($Roster), "new()");
isa_ok($Roster,"Net::XMPP::Roster");
-my $jid1 = '1test1@example.com';
+my $jid1 = 'test1@example.com';
my $res1 = "Work";
my $res2 = "Home";
@@ -1,73 +0,0 @@
-
-use lib 't/lib';
-
-use strict;
-use warnings;
-
-use Test::More tests => '7';
-use Net::XMPP::Test::Utils qw/
- can_run_tests
- get_conn_params
- get_auth_params
- bare_jid
-/;
-
-BEGIN { use_ok('Net::XMPP'); }
-
-SKIP: {
- skip "No accounts configured in $Net::XMPP::Test::Utils::accounts_file", 6
- unless can_run_tests();
-
- my $test_account = 'srv_and_tls';
-
- my $conn_params = get_conn_params( $test_account );
- my $auth_params = get_auth_params( $test_account );
- my $my_full_jid = bare_jid( $test_account ) . '/' . $auth_params->{'resource'};
-
- my $client = Net::XMPP::Client->new(
- debuglevel => 0,
- debug => 'stdout',
- );
-
- isa_ok( $client, 'Net::XMPP::Client');
-
- $client->SetCallBacks(
- onconnect => \&onConnect,
- onauth => \&onAuth,
- message => \&onMessage,
- );
-
- $client->Execute( %{$auth_params}, %{$conn_params} );
-
- sub onConnect {
- ok(1, 'Connected');
- }
-
- # After successful authentication, send a test message to our full JID
- sub onAuth {
- ok( 1, 'Authenticated');
- isa_ok( $client->PresenceSend(), 'Net::XMPP::Presence');
-
- $client->MessageSend(
- to => $my_full_jid,
- subject => 'Test message',
- body => 'This is a test.'
- );
- }
-
- # Check that the contents match what we sent above
- sub onMessage {
- my $sid = shift;
- my $message = shift;
-
- return unless $my_full_jid
- eq $message->GetFrom('jid')->GetJID('full');
-
- is( $message->GetSubject(), 'Test message', 'Subject' );
- is( $message->GetBody(), 'This is a test.', 'Body' );
-
- $client->Disconnect();
-
- exit(0);
- }
-}