COPYRIGHT000664001750001750 530014411570357 14572 0ustar00taitai000000000000Exporter-Tiny-1.006002Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: Exporter-Tiny Upstream-Contact: Toby Inkster (TOBYINK) Source: https://exportertiny.github.io/ Files: NEWS TODO inc/Test/Fatal.pm inc/Test/Requires.pm inc/Try/Tiny.pm inc/archaic/Test/Builder/Module.pm inc/archaic/Test/Builder/Tester.pm inc/archaic/Test/Builder/Tester/Color.pm Copyright: Unknown License: Unknown Files: README lib/Exporter/Shiny.pm lib/Exporter/Tiny.pm lib/Exporter/Tiny/Manual/Etc.pod lib/Exporter/Tiny/Manual/Exporting.pod lib/Exporter/Tiny/Manual/Importing.pod lib/Exporter/Tiny/Manual/QuickStart.pod Copyright: This software is copyright (c) 2013-2014, 2017, 2022-2023 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/05shiny.t t/06notwant.t t/07regexp.t t/08tags.t t/09warnings.t t/10no.t Copyright: This software is copyright (c) 2014, 2017 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: COPYRIGHT CREDITS INSTALL LICENSE Makefile.PL Copyright: Copyright 1970 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/01basic.t t/02renaming.t t/03generators.t t/04into.t Copyright: This software is copyright (c) 2013-2014, 2017 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/14lexical.t t/15nonhashvalue.t t/gh-8.t t/gh-9.t Copyright: This software is copyright (c) 2022 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: Changes META.json META.yml doap.ttl Copyright: Copyright 2023 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/11noncode.t t/12noncodegenerators.t t/13doesntexist.t Copyright: This software is copyright (c) 2018 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: dist.ini examples/Example/Exporter.pm Copyright: Copyright 2013 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/More.pm inc/archaic/Test/Simple.pm Copyright: Copyright 2001-2008 by Michael G Schwern . License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder.pm Copyright: Copyright 2002-2008 by chromatic and. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder/IO/Scalar.pm Copyright: Copyright (c) 1996 by Eryq. All rights reserved. Copyright (c) 1999,2001 by ZeeGee Software Inc. All rights reserved. License: GPL-1.0+ or Artistic-1.0 Files: SIGNATURE Copyright: None License: public-domain License: Artistic-1.0 This software is Copyright (c) 2023 by the copyright holder(s). This is free software, licensed under: The Artistic License 1.0 License: GPL-1.0 This software is Copyright (c) 2023 by the copyright holder(s). This is free software, licensed under: The GNU General Public License, Version 1, February 1989 CREDITS000664001750001750 33514411570357 14302 0ustar00taitai000000000000Exporter-Tiny-1.006002Maintainer: - Toby Inkster (TOBYINK) Thanks: - CHOCOLATEBOY - Diab Jerius (DJERIUS) - Eugen Konkov - Tomohiro Hosaka (BOKUTIN) - ZHUMENGU Changes000664001750001750 1276614411570357 14630 0ustar00taitai000000000000Exporter-Tiny-1.006002Exporter-Tiny ============= Created: 2013-09-05 Home page: Home page: Bug tracker: Maintainer: Toby Inkster (TOBYINK) 1.006002 2023-03-31 [ Documentation ] - Link to Exporter::Almighty in pod. - Update copyright dates. [ Packaging ] - Set homepage in metadata to https://exportertiny.github.io. 1.006001 2023-03-24 [ Documentation ] - Don't mention Alt::Lexical::Var::ButSupportModernPerl in manual. [ Packaging ] - No longer dynamically recommend Alt::Lexical::Var::ButSupportModernPerl. 1.006000 2022-11-21 [ Packaging ] - Stable version number. 1.005_000 2022-10-17 - Introduced lexical exporter support on Perl 5.11.2+ using the Lexical::Var module. - Refactored the Perl 5.37.2+ lexical exporter support. 1.004004 2022-10-15 [ Documentation ] - Minor corrections to QuickStart page in the manual. 1.004003 2022-09-30 [ Bug Fixes ] - If exporting non-CODE items which happen to have the same name as exported CODE items, their export was being quietly blocked. These exports should now work. Diab Jerius++ - Using ! with a tag now works; it was previously documented as working but not implemented. Diab Jerius++ 1.004002 2022-09-16 [ Test Suite ] - Fix for t/15nonhashvalue.t on old versions of Test::More which don't support `done_testing`. 1.004001 2022-09-09 [ Bug Fixes ] - Fix handling of non-hashref references in import list. 1.004000 2022-08-26 [ Documentation ] - Document that the `-lexical` export option is experimental. [ Packaging ] - No functional changes; repackage as stable. 1.003_002 2022-08-18 [ Bug Fixes ] - Quote $1 when passing it as a parameter to a function Eugen Konkov++ 1.003_001 2022-07-21 [ Bug Fixes ] - Correctly check Perl version is at least 5.37.2+ before supporting -lexical option. 1.003_000 2022-07-21 - Updated: Provide a `-lexical` export option on Perl 5.37.2+. 1.002002 2020-04-24 [ Bug Fixes ] - Bug in handling regexps in import lists; Exporter::Tiny allowed regexps like /foo/i but not /foo/. Having trailing flags is now optional! Tomohiro Hosaka++ - Tests would fail if `PERL5OPT=-Mfeature=:5.18` environment variable was set. This is because bareword `-default` was being interpreted as the Perl `default` keyword. zhumengu++ 1.002001 2018-07-17 [ Packaging ] - Fix dates in changelog. 1.002000 2018-07-17 [ Packaging ] - Repackage as 1.002000. 1.001_001 2018-06-29 [ Test Suite ] - Improved test coverage, up from 88.78% on coveralls.io to 96.74%. 1.001_000 2018-06-26 - Added: Support for exporting non-code symbols such as $Foo, @Bar, and %Baz. - Added: Support for generating non-code symbols. 1.000000 2017-05-22 [ Packaging ] - Repackage as 1.000000. 0.044 2017-01-30 [ Packaging ] - Repackage as a stable release. 0.043_02 2017-01-30 [ Packaging ] - Release using newer versions of toolchain stuff. 0.043_01 2014-11-09 [ Documentation ] - Restructure documentation. [ Other ] - Support { -as => CODE } to programatically rename functions. 0.042 2014-10-04 [ Documentation ] - Document the warning emitted when you provide options to a function you are unimporting. [ Other ] - Housekeeping on %TRACKED. 0.041_02 2014-09-19 [ Bug Fixes ] - Option validation needs to happen after expanding tags. 0.041_01 2014-09-18 - Add an `unimport` feature. 0.040 2014-09-17 [ Packaging ] - Repackage as a stable release. 0.039_01 2014-07-20 [ Documentation ] - Document warning and error messages produced by Exporter::Tiny. [ Other ] - Exporter::Tiny would previously cause B.pm to be loaded into memory any time it exported anything. It no longer does. - No longer die when redefining locally defined subs. - Warn when redefining any subs. 0.038 2014-04-04 0.037_03 2014-04-02 [ Bug Fixes ] - Only attempt to merge hashes if we're sure they're both really hashes! 0.037_02 2014-04-02 - Improved handling of hashrefs of options passed to tags, and hashrefs of options found within %EXPORT_TAGS arrayrefs. 0.037_01 2014-03-26 [ Documentation ] - Fix minor error in documentation of generators. [ Other ] - Added: Support Exporter.pm's import negation syntax qw( !foo ). - Added: Support Exporter.pm's regexp import syntax qw( /foo/ ). 0.036 2014-03-11 0.035_02 2014-03-01 [ Documentation ] - Document exactly what Exporter::Shiny is supposed to do. [ Test Suite ] - Make t/02renaming.t less noisy. 0.035_01 2014-03-01 [ Packaging ] - Explicitly list minimum Perl version: 5.6.1. 0.034 2014-01-19 0.033_01 2014-01-19 - Added: Add a new wrapper module called Exporter::Shiny. 0.032 2013-12-30 0.031_01 2013-12-30 [ Test Suite ] - No longer require a recent version of Test::More; the Test::More bundled with Perl 5.6.2 should suffice. 0.030 2013-09-26 [ Test Suite ] - Test for the 'into' option. 0.029_01 2013-09-26 [ Documentation ] - Exporter::TypeTiny is being retired, so modify documentation and distribution metadata for Exporter::Tiny to no longer point there. 0.026 2013-09-05 Initial release [ Packaging ] - Split Exporter::Tiny out from Exporter::TypeTiny. CHOCOLATEBOY++ INSTALL000664001750001750 167714411570357 14345 0ustar00taitai000000000000Exporter-Tiny-1.006002 Installing Exporter-Tiny should be straightforward. INSTALLATION WITH CPANMINUS If you have cpanm, you only need one line: % cpanm Exporter::Tiny If you are installing into a system-wide directory, you may need to pass the "-S" flag to cpanm, which uses sudo to install the module: % cpanm -S Exporter::Tiny INSTALLATION WITH THE CPAN SHELL Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan Exporter::Tiny MANUAL INSTALLATION As a last resort, you can manually install it. Download the tarball and unpack it. Consult the file META.json for a list of pre-requisites. Install these first. To build Exporter-Tiny: % perl Makefile.PL % make && make test Then install it: % make install If you are installing into a system-wide directory, you may need to run: % sudo make install LICENSE000664001750001750 4365014411570357 14336 0ustar00taitai000000000000Exporter-Tiny-1.006002This software is copyright (c) 2023 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2023 by Toby Inkster. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2023 by Toby Inkster. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End MANIFEST000664001750001750 154614411570357 14440 0ustar00taitai000000000000Exporter-Tiny-1.006002COPYRIGHT CREDITS Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL NEWS README SIGNATURE TODO dist.ini doap.ttl examples/Example/Exporter.pm inc/Test/Fatal.pm inc/Test/Requires.pm inc/Try/Tiny.pm inc/archaic/Test/Builder.pm inc/archaic/Test/Builder/IO/Scalar.pm inc/archaic/Test/Builder/Module.pm inc/archaic/Test/Builder/Tester.pm inc/archaic/Test/Builder/Tester/Color.pm inc/archaic/Test/More.pm inc/archaic/Test/Simple.pm lib/Exporter/Shiny.pm lib/Exporter/Tiny.pm lib/Exporter/Tiny/Manual/Etc.pod lib/Exporter/Tiny/Manual/Exporting.pod lib/Exporter/Tiny/Manual/Importing.pod lib/Exporter/Tiny/Manual/QuickStart.pod t/01basic.t t/02renaming.t t/03generators.t t/04into.t t/05shiny.t t/06notwant.t t/07regexp.t t/08tags.t t/09warnings.t t/10no.t t/11noncode.t t/12noncodegenerators.t t/13doesntexist.t t/14lexical.t t/15nonhashvalue.t t/gh-8.t t/gh-9.t META.json000664001750001750 373214411570357 14727 0ustar00taitai000000000000Exporter-Tiny-1.006002{ "abstract" : "an exporter with the features of Sub::Exporter but only core dependencies", "author" : [ "Toby Inkster (TOBYINK) " ], "dynamic_config" : 1, "generated_by" : "Dist::Inkt::Profile::TOBYINK version 0.024, CPAN::Meta::Converter version 2.150010", "keywords" : [], "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Exporter-Tiny", "no_index" : { "directory" : [ "eg", "examples", "inc", "t", "xt" ] }, "optional_features" : {}, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.17" } }, "runtime" : { "requires" : { "perl" : "5.006001" } }, "test" : { "recommends" : { "Test::Fatal" : "0", "Test::Warnings" : "0" }, "requires" : { "Test::More" : "0.47" } } }, "provides" : { "Exporter::Shiny" : { "file" : "lib/Exporter/Shiny.pm", "version" : "1.006002" }, "Exporter::Tiny" : { "file" : "lib/Exporter/Tiny.pm", "version" : "1.006002" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/tobyink/p5-exporter-tiny/issues" }, "homepage" : "https://exportertiny.github.io/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/tobyink/p5-exporter-tiny.git", "web" : "https://github.com/tobyink/p5-exporter-tiny" }, "x_IRC" : "irc://irc.perl.org/#moops", "x_identifier" : "http://purl.org/NET/cpan-uri/dist/Exporter-Tiny/project" }, "version" : "1.006002", "x_serialization_backend" : "JSON::PP version 4.09" } META.yml000664001750001750 222514411570357 14553 0ustar00taitai000000000000Exporter-Tiny-1.006002--- abstract: 'an exporter with the features of Sub::Exporter but only core dependencies' author: - 'Toby Inkster (TOBYINK) ' build_requires: Test::More: '0.47' configure_requires: ExtUtils::MakeMaker: '6.17' dynamic_config: 1 generated_by: 'Dist::Inkt::Profile::TOBYINK version 0.024, CPAN::Meta::Converter version 2.150010' keywords: [] license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Exporter-Tiny no_index: directory: - eg - examples - inc - t - xt optional_features: {} provides: Exporter::Shiny: file: lib/Exporter/Shiny.pm version: '1.006002' Exporter::Tiny: file: lib/Exporter/Tiny.pm version: '1.006002' requires: perl: '5.006001' resources: IRC: irc://irc.perl.org/#moops Identifier: http://purl.org/NET/cpan-uri/dist/Exporter-Tiny/project bugtracker: https://github.com/tobyink/p5-exporter-tiny/issues homepage: https://exportertiny.github.io/ license: http://dev.perl.org/licenses/ repository: git://github.com/tobyink/p5-exporter-tiny.git version: '1.006002' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Makefile.PL000664001750001750 1254214411570357 15277 0ustar00taitai000000000000Exporter-Tiny-1.006002use strict; use ExtUtils::MakeMaker 6.17; my $EUMM = eval( $ExtUtils::MakeMaker::VERSION ); my $meta = { "abstract" => "an exporter with the features of Sub::Exporter but only core dependencies", "author" => ["Toby Inkster (TOBYINK) "], "dynamic_config" => 1, "generated_by" => "Dist::Inkt::Profile::TOBYINK version 0.024, CPAN::Meta::Converter version 2.150010", "keywords" => [], "license" => ["perl_5"], "meta-spec" => { url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec", version => 2, }, "name" => "Exporter-Tiny", "no_index" => { directory => ["eg", "examples", "inc", "t", "xt"] }, "prereqs" => { configure => { requires => { "ExtUtils::MakeMaker" => 6.17 } }, runtime => { requires => { perl => 5.006001 } }, test => { recommends => { "Test::Fatal" => 0, "Test::Warnings" => 0 }, requires => { "Test::More" => 0.47 }, }, }, "provides" => { "Exporter::Shiny" => { file => "lib/Exporter/Shiny.pm", version => 1.006002 }, "Exporter::Tiny" => { file => "lib/Exporter/Tiny.pm", version => 1.006002 }, }, "release_status" => "stable", "resources" => { bugtracker => { web => "https://github.com/tobyink/p5-exporter-tiny/issues" }, homepage => "https://exportertiny.github.io/", license => ["http://dev.perl.org/licenses/"], repository => { type => "git", url => "git://github.com/tobyink/p5-exporter-tiny.git", web => "https://github.com/tobyink/p5-exporter-tiny", }, x_identifier => "http://purl.org/NET/cpan-uri/dist/Exporter-Tiny/project", x_IRC => "irc://irc.perl.org/#moops", }, "version" => 1.006002, }; my %dynamic_config; do { my $prereq_type = 'recommends'; if ( $ENV{CI} and defined $ENV{GITHUB_REPOSITORY} and $ENV{GITHUB_REPOSITORY} eq 'tobyink/p5-exporter-tiny' ) { $prereq_type = 'requires'; } if ( $] ge 5.011002 and $] lt 5.037002 ) { $meta->{prereqs}{runtime}{$prereq_type}{'Lexical::Var'} = '0.010'; } # idk, this should be automatic or summint? put it in explicitly. $meta->{prereqs}{runtime}{requires}{'Test::More'} = '0.47' if $] lt 5.006002; }; my %WriteMakefileArgs = ( ABSTRACT => $meta->{abstract}, AUTHOR => ($EUMM >= 6.5702 ? $meta->{author} : $meta->{author}[0]), DISTNAME => $meta->{name}, VERSION => $meta->{version}, EXE_FILES => [ map $_->{file}, values %{ $meta->{x_provides_scripts} || {} } ], NAME => do { my $n = $meta->{name}; $n =~ s/-/::/g; $n }, test => { TESTS => "t/*.t" }, %dynamic_config, ); $WriteMakefileArgs{LICENSE} = $meta->{license}[0] if $EUMM >= 6.3001; sub deps { my %r; for my $stage (@_) { for my $dep (keys %{$meta->{prereqs}{$stage}{requires}}) { next if $dep eq 'perl'; my $ver = $meta->{prereqs}{$stage}{requires}{$dep}; $r{$dep} = $ver if !exists($r{$dep}) || $ver >= $r{$dep}; } } \%r; } my ($build_requires, $configure_requires, $runtime_requires, $test_requires); if ($EUMM >= 6.6303) { $WriteMakefileArgs{BUILD_REQUIRES} ||= deps('build'); $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{TEST_REQUIRES} ||= deps('test'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime'); } elsif ($EUMM >= 6.5503) { $WriteMakefileArgs{BUILD_REQUIRES} ||= deps('build', 'test'); $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime'); } elsif ($EUMM >= 6.52) { $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime', 'build', 'test'); } else { $WriteMakefileArgs{PREREQ_PM} ||= deps('configure', 'build', 'test', 'runtime'); } { my ($minperl) = reverse sort( grep defined && /^[0-9]+(\.[0-9]+)?$/, map $meta->{prereqs}{$_}{requires}{perl}, qw( configure build runtime ) ); if (defined($minperl)) { die "Installing $meta->{name} requires Perl >= $minperl" unless $] >= $minperl; $WriteMakefileArgs{MIN_PERL_VERSION} ||= $minperl if $EUMM >= 6.48; } } my $mm = WriteMakefile(%WriteMakefileArgs); sub FixMakefile { return unless -d 'inc'; my $file = shift; local *MAKEFILE; open MAKEFILE, "< $file" or die "FixMakefile: Couldn't open $file: $!; bailing out"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; open MAKEFILE, "> $file" or die "FixMakefile: Couldn't open $file: $!; bailing out"; print MAKEFILE $makefile or die $!; close MAKEFILE or die $!; } FixMakefile($mm->{FIRST_MAKEFILE} || 'Makefile'); exit(0); NEWS000664001750001750 32214411570357 13755 0ustar00taitai000000000000Exporter-Tiny-1.0060021.000000 2017-01-30 - First stable release. 1.002000 2018-07-17 - Added support for exporting non-code symbols. 1.004000 2022? - Added support for lexical exports if your Perl version is new enough. README000664001750001750 403114411570357 14157 0ustar00taitai000000000000Exporter-Tiny-1.006002NAME Exporter::Tiny - an exporter with the features of Sub::Exporter but only core dependencies SYNOPSIS package MyUtils; use base "Exporter::Tiny"; our @EXPORT = qw(frobnicate); sub frobnicate { ... } 1; package MyScript; use MyUtils "frobnicate" => { -as => "frob" }; print frob(42); exit; DESCRIPTION Exporter::Tiny supports many of Sub::Exporter's external-facing features including renaming imported functions with the `-as`, `-prefix` and `-suffix` options; explicit destinations with the `into` option; and alternative installers with the `installer` option. But it's written in only about 40% as many lines of code and with zero non-core dependencies. Its internal-facing interface is closer to Exporter.pm, with configuration done through the @EXPORT, @EXPORT_OK and %EXPORT_TAGS package variables. If you are trying to write a module that inherits from Exporter::Tiny, then look at: * Exporter::Tiny::Manual::QuickStart * Exporter::Tiny::Manual::Exporting If you are trying to use a module that inherits from Exporter::Tiny, then look at: * Exporter::Tiny::Manual::Importing BUGS Please report any bugs to . SEE ALSO . Simplified interface to this module: Exporter::Shiny. Less tiny version, with more features: Exporter::Almighty. Other interesting exporters: Sub::Exporter, Exporter. AUTHOR Toby Inkster . COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017, 2022-2023 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. SIGNATURE000664001750001750 1167214411570357 14614 0ustar00taitai000000000000Exporter-Tiny-1.006002This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.87. 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: RIPEMD160 SHA256 e6e19e3751dbb2e8edf03eb9cf7499f9159936c5db25841beacbd0d35c5897ac COPYRIGHT SHA256 5124359bbc1eb6fbc98496e82c9ebd0db246aaa07059f4cd28bd3174f6352b6d CREDITS SHA256 b267abec2558a0f0f3b626a05ff887629140708ad781c511dc1071b253932703 Changes SHA256 2f314c303b24f03c1ffbc54001a90eb7d50ebe724a60b2fe4f2f6e42e5170c1d INSTALL SHA256 1a2929dacaef239beca27a85f7f97b793628dfb22f07fdfb406cb6f3f0d22a6b LICENSE SHA256 db033ca38e844b9406a63a6c90e7e4df7c0f11fefc9fe42ff52ef5ee761eccab MANIFEST SHA256 643867f03c20d76a57a145a95b3ad5c5ccc6a6c81ef519873c5f22b935e18d38 META.json SHA256 52dc0d471fd44ac7664444668cce78fb5e6d52215347aa903d838e278b75c625 META.yml SHA256 e250734e4a30e83f1d2a422aa35713bbd7eeebbb1d7432e9eca7e49f75f5592a Makefile.PL SHA256 47b10ed37d8da7c65245ffe5773cf59654f1545cc0e2fbbfa4f1e25f67bb0ff3 NEWS SHA256 255679a869b7e5ab955f9ea1307c08d7287c86f5af6f21ef0f91513349410969 README SHA256 846fcc88a04c5b7cd65ec32c5f842f8b339d8fc28c1cc75f36fa10af809353e2 TODO SHA256 43562b3806635eddcf6e7ea7cf6edc690a7f52cca15e4fc76593d144fd450aa6 dist.ini SHA256 c606b754c9ac9c88c2b0edc874caa5279a4182c5ab191f32b09ba756874023be doap.ttl SHA256 bbe194f6f9a9832847d82b7cb8b5d5f16c4af255bcef0d25f90992ff268462ea examples/Example/Exporter.pm SHA256 c361b86d13c8fdfbe75840d11dbe6af488e44af27b0edb80fd1eea28c8e935d4 inc/Test/Fatal.pm SHA256 b8b2edfbb16b30d0e3b212a413c55a8de7ce929591d0a1029b70c47c8c0be11a inc/Test/Requires.pm SHA256 083292e0cefc5cd41c82975f7b9aadc6893065d4297dc153b7f13356c0c0a44c inc/Try/Tiny.pm SHA256 a93c5c677f44f7b00a7c414afeafaaa15ee7c7b72a47083936e1a8d37f0970b9 inc/archaic/Test/Builder.pm SHA256 fea307eee1d65187effaaaaf85663e55f1a23c2a25cd6a4963bada80c440075d inc/archaic/Test/Builder/IO/Scalar.pm SHA256 4da2ad5c38d41eb389393f111f01f8e3c885f3ae5c027e540f662ddf44d2895c inc/archaic/Test/Builder/Module.pm SHA256 71d019f6ac3467615dbec9c17aa85eec0f32a4cfd8824f25fda7176e0890de44 inc/archaic/Test/Builder/Tester.pm SHA256 ae528d9fc2962793e98af13f4d4e802fbf8d78b17b1c27a860728a16e8bf4a3a inc/archaic/Test/Builder/Tester/Color.pm SHA256 764f3ed1e0a314e7e9f8d803dff3d894e8c572e2a128d7ce14f2a80268e50543 inc/archaic/Test/More.pm SHA256 c4fd1410a9bd85a0e7700de08c1614fc5928c0d02151ba1ec7d06bd56407e0d5 inc/archaic/Test/Simple.pm SHA256 4d5e0cce28f1a9647dbc6a8b79dba03564f6091e3a6265a1c85d9e46b6274e07 lib/Exporter/Shiny.pm SHA256 3953394263fea8ecf6b8f4e7a8550acd048bb29af628f23e3ade9714b9079a17 lib/Exporter/Tiny.pm SHA256 e1a5741e53f9f9f90b7f7593c12f68ad1df26cb873733dea7029d7202b66685d lib/Exporter/Tiny/Manual/Etc.pod SHA256 160b655fdec2190cd47d03113c16d37ed6c8a0d0c444fe52300d6b3ec7d3ff51 lib/Exporter/Tiny/Manual/Exporting.pod SHA256 8fccf1a9e879880f26bc62d17a8eca26a405fa2c6434dd2312ba138f5b045d4f lib/Exporter/Tiny/Manual/Importing.pod SHA256 a1500c8c59646b3d4756d856795c200ad6e023bb093d97407054e9a288fd41cc lib/Exporter/Tiny/Manual/QuickStart.pod SHA256 4d3896ea5efe37ef1d7ed52c4da53c49fcf00cf504d3db1d69cbd1f2755dbee2 t/01basic.t SHA256 1e979b56fb80efb07094f1172b63e35a90fd1c8291ee0e374d619a4d75465d24 t/02renaming.t SHA256 d62cab975852e82ed5b09c7506edb6651372548e4eea51df86241a1cec1dac2e t/03generators.t SHA256 68f83610a1ccb666b3ed379f52e76f304e4a15b5219d937df605e516196ee6d6 t/04into.t SHA256 e9dddfd7bef6cc4b5c62b1cdfd9bc4b7ed111712bce60870145afeaaf5d43a25 t/05shiny.t SHA256 edff6900f28a1e6bae3e99bf47c3b0eb26c88be1df6688bb98443eb2c67e58c8 t/06notwant.t SHA256 1d6d1949fc3bdcaa5a6cf7665cd7a9a91b97d41e81d77c6e7ced6f0b4bcc48ef t/07regexp.t SHA256 1383bebd6945b7b1f21892bc2302507c6437dbdeb9bdc44510080cf987cfd460 t/08tags.t SHA256 abc62fad4ad5014f0e6b724e4952da4faf53b830687dfa69b1cad399ffd5d279 t/09warnings.t SHA256 70402b76cbfc1e7e3e50075f5b2b9a26cd48fa5ebedc60ade3ac4201f75a1f2d t/10no.t SHA256 b0fcc16f86d948934caf5edf9fe09360a5eb8e60dd15d79b3b31d7f259d1edef t/11noncode.t SHA256 2488f918037f954ecec64a28c8a9e2bcb3ea9a9a7fe092fdcfd1c3bdd11e3f51 t/12noncodegenerators.t SHA256 47728bc580e310a5c3c3c61fb6be7a450ebdf6aa420bbf7c5b1ae514223e533f t/13doesntexist.t SHA256 d816f8d6bf77e42f3f8e34a8f0b6c32bb585c12f66cb27c433c9a0393d64f7a9 t/14lexical.t SHA256 70029832b2fbebf24679c78fd2a8be2f993ecbfa6f8f86185d1fb6d7118ff1ed t/15nonhashvalue.t SHA256 e1a41fa7830088d375109ef40be52c3a17255f06e46e077a6c6a9276f47c6485 t/gh-8.t SHA256 59f9182ed1b30f84045947a2713328e62275e922d083933e2c72fb381d710306 t/gh-9.t -----BEGIN PGP SIGNATURE----- iF0EAREDAB0WIQRVJKj/4+s6z4WzNujOv4Eoaip9OQUCZCbw7wAKCRDOv4Eoaip9 OTUVAKCIzN3uJyzcAQnDiq4S/6jw8q8u7wCeIx0amIqdR06BGDen7SS79R+fl58= =yssG -----END PGP SIGNATURE----- TODO000664001750001750 32114411570357 13745 0ustar00taitai000000000000Exporter-Tiny-1.006002- improve test coverage - more tests and better support for non-code symbols - some kind of shim between Exporter::Tiny and Exporter.pm to allow people to use Exporter::Tiny features with Exporter.pm modules dist.ini000664001750001750 7714411570357 14711 0ustar00taitai000000000000Exporter-Tiny-1.006002;;class='Dist::Inkt::Profile::TOBYINK' ;;name='Exporter-Tiny' doap.ttl000664001750001750 11150514411570357 15014 0ustar00taitai000000000000Exporter-Tiny-1.006002@prefix cpan-uri: . @prefix dc: . @prefix doap: . @prefix doap-changeset: . @prefix doap-deps: . @prefix foaf: . @prefix nfo: . @prefix rdfs: . @prefix xsd: . dc:title "the same terms as the perl 5 programming language system itself". a doap:Project; cpan-uri:x_IRC ; dc:contributor ; doap-deps:runtime-requirement [ doap-deps:on "perl 5.006001"^^doap-deps:CpanId ]; doap-deps:test-recommendation [ doap-deps:on "Test::Fatal"^^doap-deps:CpanId ], [ doap-deps:on "Test::Warnings"^^doap-deps:CpanId ]; doap-deps:test-requirement [ doap-deps:on "Test::More 0.47"^^doap-deps:CpanId ]; doap:bug-database ; doap:created "2013-09-05"^^xsd:date; doap:developer ; doap:download-page ; doap:homepage , ; doap:license ; doap:maintainer ; doap:name "Exporter-Tiny"; doap:programming-language "Perl"; doap:release , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ; doap:repository [ a doap:GitRepository; doap:browse ; ]; doap:shortdesc "an exporter with the features of Sub::Exporter but only core dependencies"; rdfs:seeAlso . a doap:Version; rdfs:label "Initial release"; dc:identifier "Exporter-Tiny-0.026"^^xsd:string; dc:issued "2013-09-05"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Split Exporter::Tiny out from Exporter::TypeTiny."; doap-changeset:thanks ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.026"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.029_01"^^xsd:string; dc:issued "2013-09-26"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation, doap-changeset:Packaging; rdfs:label "Exporter::TypeTiny is being retired, so modify documentation and distribution metadata for Exporter::Tiny to no longer point there."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.029_01"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-0.030"^^xsd:string; dc:issued "2013-09-26"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Test for the 'into' option."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.030"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.031_01"^^xsd:string; dc:issued "2013-12-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging, doap-changeset:Tests; rdfs:label "No longer require a recent version of Test::More; the Test::More bundled with Perl 5.6.2 should suffice."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.031_01"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-0.032"^^xsd:string; dc:issued "2013-12-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.032"^^xsd:string; rdfs:comment "No functional changes since 0.031_01.". a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.033_01"^^xsd:string; dc:issued "2014-01-19"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Add a new wrapper module called Exporter::Shiny."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.033_01"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-0.034"^^xsd:string; dc:issued "2014-01-19"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.034"^^xsd:string; rdfs:comment "No functional changes since 0.033_01.". a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.035_01"^^xsd:string; dc:issued "2014-03-01"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Explicitly list minimum Perl version: 5.6.1."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.035_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.035_02"^^xsd:string; dc:issued "2014-03-01"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Document exactly what Exporter::Shiny is supposed to do."; ], [ a doap-changeset:Tests; rdfs:label "Make t/02renaming.t less noisy."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.035_02"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-0.036"^^xsd:string; dc:issued "2014-03-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.036"^^xsd:string; rdfs:comment "No functional changes since 0.035_02.". a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.037_01"^^xsd:string; dc:issued "2014-03-26"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Fix minor error in documentation of generators."; ], [ a doap-changeset:Addition; rdfs:label "Support Exporter.pm's import negation syntax qw( !foo )."; ], [ a doap-changeset:Addition; rdfs:label "Support Exporter.pm's regexp import syntax qw( /foo/ )."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.037_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.037_02"^^xsd:string; dc:issued "2014-04-02"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Improved handling of hashrefs of options passed to tags, and hashrefs of options found within %EXPORT_TAGS arrayrefs."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.037_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.037_03"^^xsd:string; dc:issued "2014-04-02"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Only attempt to merge hashes if we're sure they're both really hashes!"; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.037_03"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-0.038"^^xsd:string; dc:issued "2014-04-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.038"^^xsd:string; rdfs:comment "No functional changes since 0.037_03.". a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.039_01"^^xsd:string; dc:issued "2014-07-20"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Document warning and error messages produced by Exporter::Tiny."; ], [ a doap-changeset:Change; rdfs:label "No longer die when redefining locally defined subs."; ], [ a doap-changeset:Change; rdfs:label "Warn when redefining any subs."; ], [ a doap-changeset:Change; rdfs:label "Exporter::Tiny would previously cause B.pm to be loaded into memory any time it exported anything. It no longer does."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_01"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-0.040"^^xsd:string; dc:issued "2014-09-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Repackage as a stable release."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.040"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.041_01"^^xsd:string; dc:issued "2014-09-18"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Add an `unimport` feature."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.041_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.041_02"^^xsd:string; dc:issued "2014-09-19"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Option validation needs to happen after expanding tags."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.041_02"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-0.042"^^xsd:string; dc:issued "2014-10-04"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Document the warning emitted when you provide options to a function you are unimporting."; ], [ a doap-changeset:Change; rdfs:label "Housekeeping on %TRACKED."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.042"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.043_01"^^xsd:string; dc:issued "2014-11-09"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Restructure documentation."; ], [ a doap-changeset:Change; rdfs:label "Support { -as => CODE } to programatically rename functions."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.043_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-0.043_02"^^xsd:string; dc:issued "2017-01-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Release using newer versions of toolchain stuff."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.043_02"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-0.044"^^xsd:string; dc:issued "2017-01-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Repackage as a stable release."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.044"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.000000"^^xsd:string; dc:issued "2017-05-22"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Repackage as 1.000000."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.000000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-1.001_000"^^xsd:string; dc:issued "2018-06-26"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Support for exporting non-code symbols such as $Foo, @Bar, and %Baz."; ], [ a doap-changeset:Addition; rdfs:label "Support for generating non-code symbols."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-1.001_001"^^xsd:string; dc:issued "2018-06-29"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Improved test coverage, up from 88.78% on coveralls.io to 96.74%."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_001"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.002000"^^xsd:string; dc:issued "2018-07-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Repackage as 1.002000."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.002000"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.002001"^^xsd:string; dc:issued "2018-07-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Fix dates in changelog."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.002001"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.002002"^^xsd:string; dc:issued "2020-04-24"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Bug in handling regexps in import lists; Exporter::Tiny allowed regexps like /foo/i but not /foo/. Having trailing flags is now optional!"; doap-changeset:thanks ; rdfs:seeAlso ; ], [ a doap-changeset:Bugfix, doap-changeset:Tests; rdfs:label "Tests would fail if `PERL5OPT=-Mfeature=:5.18` environment variable was set. This is because bareword `-default` was being interpreted as the Perl `default` keyword."; doap-changeset:thanks ; rdfs:seeAlso ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.002002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-1.003_000"^^xsd:string; dc:issued "2022-07-21"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Update; rdfs:label "Provide a `-lexical` export option on Perl 5.37.2+."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-1.003_001"^^xsd:string; dc:issued "2022-07-21"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Correctly check Perl version is at least 5.37.2+ before supporting -lexical option."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-1.003_002"^^xsd:string; dc:issued "2022-08-18"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Quote $1 when passing it as a parameter to a function"; doap-changeset:thanks ; rdfs:seeAlso ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_002"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.004000"^^xsd:string; dc:issued "2022-08-26"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "No functional changes; repackage as stable."; ], [ a doap-changeset:Documentation; rdfs:label "Document that the `-lexical` export option is experimental."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004000"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.004001"^^xsd:string; dc:issued "2022-09-09"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Fix handling of non-hashref references in import list."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004001"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.004002"^^xsd:string; dc:issued "2022-09-16"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Fix for t/15nonhashvalue.t on old versions of Test::More which don't support `done_testing`."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004002"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.004003"^^xsd:string; dc:issued "2022-09-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Using ! with a tag now works; it was previously documented as working but not implemented."; doap-changeset:thanks ; rdfs:seeAlso ; ], [ a doap-changeset:Bugfix; rdfs:label "If exporting non-CODE items which happen to have the same name as exported CODE items, their export was being quietly blocked. These exports should now work."; doap-changeset:thanks ; rdfs:seeAlso ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004003"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.004004"^^xsd:string; dc:issued "2022-10-15"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Minor corrections to QuickStart page in the manual."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004004"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Exporter-Tiny-1.005_000"^^xsd:string; dc:issued "2022-10-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Refactored the Perl 5.37.2+ lexical exporter support."; ], [ a doap-changeset:Change; rdfs:label "Introduced lexical exporter support on Perl 5.11.2+ using the Lexical::Var module."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.005_000"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.006000"^^xsd:string; dc:issued "2022-11-21"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Stable version number."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.006000"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.006001"^^xsd:string; dc:issued "2023-03-24"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "No longer dynamically recommend Alt::Lexical::Var::ButSupportModernPerl."; ], [ a doap-changeset:Documentation; rdfs:label "Don't mention Alt::Lexical::Var::ButSupportModernPerl in manual."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.006001"^^xsd:string. a doap:Version; dc:identifier "Exporter-Tiny-1.006002"^^xsd:string; dc:issued "2023-03-31"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Set homepage in metadata to https://exportertiny.github.io."; ], [ a doap-changeset:Documentation; rdfs:label "Link to Exporter::Almighty in pod."; ], [ a doap-changeset:Documentation; rdfs:label "Update copyright dates."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "1.006002"^^xsd:string. a doap:Project; dc:contributor ; doap:download-page ; doap:homepage ; doap:name "Type-Tiny"; doap:programming-language "Perl"; doap:release . a doap:Version; dc:identifier "Type-Tiny-0.026"^^xsd:string; doap-changeset:released-by ; doap:file-release ; doap:revision "0.026"^^xsd:string. a foaf:Person; foaf:name "Tomohiro Hosaka"; foaf:nick "BOKUTIN"; foaf:page , . a foaf:Person; foaf:nick "CHOCOLATEBOY"; foaf:page . a foaf:Person; foaf:name "Diab Jerius"; foaf:nick "DJERIUS"; foaf:page . a foaf:Person; foaf:mbox ; foaf:name "Toby Inkster"; foaf:nick "TOBYINK"; foaf:page . a foaf:Person; foaf:nick "zhumengu"; foaf:page . a foaf:Person; foaf:name "Eugen Konkov"; foaf:nick "KES777"; foaf:page . [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "COPYRIGHT". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "CREDITS". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "INSTALL". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "LICENSE". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "Makefile.PL"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/Example/Exporter.pm"; nfo:programmingLanguage "Perl". 01basic.t000664001750001750 131614411570357 15154 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Very basic Exporter::Tiny test. Check that it allows us to import the functions named in C<< @EXPORT >>. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 2; use lib qw( examples ../examples ); use Example::Exporter; diag("Perl $]"); is fib(6), 8, 'Correctly imported "fib" from Example::Exporter'; ok !__PACKAGE__->can('embiggen'), 'Did not inadvertantly import "embiggen"'; 02renaming.t000664001750001750 245314411570357 15677 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Check renaming imported functions. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 6; BEGIN { *note = *diag unless __PACKAGE__->can("note") }; use lib qw( examples ../examples ); note "Rename functions using -as"; do { package Local::AAA; use Example::Exporter fib => { -as => 'fibonacci' }; ::is fibonacci(6), 8, 'Correctly imported "fibonacci" from Example::Exporter'; ::ok !__PACKAGE__->can('fib'), 'Did not inadvertantly import "fib"'; }; note "Rename functions using -prefix"; do { package Local::BBB; use Example::Exporter fib => { -prefix => 'my' }; ::is myfib(6), 8, 'Correctly imported "myfib" from Example::Exporter'; ::ok !__PACKAGE__->can('fib'), 'Did not inadvertantly import "fib"'; }; note "Rename functions using -suffix"; do { package Local::CCC; use Example::Exporter fib => { -suffix => 'onacci' }; ::is fibonacci(6), 8, 'Correctly imported "fibonacci" from Example::Exporter'; ::ok !__PACKAGE__->can('fib'), 'Did not inadvertantly import "fib"'; }; 03generators.t000664001750001750 141214411570357 16243 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Check renaming imported functions. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 4; use lib qw( examples ../examples ); use Example::Exporter embiggen => {}, embiggen => { -suffix => '_by_2', amount => 2 }, embiggen => { -suffix => '_by_42', amount => 42 }; is embiggen(10), 11, 'embiggen'; is embiggen_by_2(10), 12, 'embiggen_by_2'; is embiggen_by_42(10), 52, 'embiggen_by_42'; is prototype(\&embiggen), '$', 'correct prototype'; 04into.t000664001750001750 114214411570357 15044 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Check the C<< -into >> option works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 2; use lib qw( examples ../examples ); { package Foo; use Example::Exporter { into => "Bar" }, qw( fib ); } { package Bar; } ok( not "Foo"->can("fib") ); ok( "Bar"->can("fib") ); 05shiny.t000664001750001750 165314411570357 15235 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Very basic Exporter::Shiny test. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 3; { package Local::Foo; use Exporter::Shiny qw(foo bar); sub foo { return 42; } sub bar { return 666; } } { package Local::Bar; use Exporter::Shiny -setup => { exports => [qw(foo bar)] }; sub foo { return 42; } sub bar { return 666; } } use Local::Foo qw(foo); use Local::Bar qw(bar); is(foo(), 42); is(bar(), 666); local $@; eval q{ package Local::Baz; use Exporter::Shiny -setup => { exports => [qw(foo bar)], jazzy => 42 }; }; my $e = $@; like($e, qr/Unsupported Sub::Exporter-style options/); 06notwant.t000664001750001750 121714411570357 15572 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test the C<< !notwant >> notation. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 1; { package Local::Foo; use Exporter::Shiny qw(foo bar); sub foo { return 42; } sub bar { return 666; } } my %imported; 'Local::Foo'->import({ into => \%imported }, qw( -all !foo )); is_deeply([sort keys %imported], ['bar']); 07regexp.t000664001750001750 142314411570357 15372 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test the C<< /regexp/ >> notation. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 2; { package Local::Foo; use Exporter::Shiny qw(foo bar); sub foo { return 42; } sub bar { return 666; } } { my %imported; 'Local::Foo'->import({ into => \%imported }, qw( /^F/i )); is_deeply([sort keys %imported], ['foo']); } { my %imported; 'Local::Foo'->import({ into => \%imported }, qw( -all !/^F/i )); is_deeply([sort keys %imported], ['bar']); } 08tags.t000664001750001750 370314411570357 15042 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test that tag expansion works sanely. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 17; BEGIN { package Local::Foo; use Exporter::Shiny qw(foo bar); our @EXPORT = qw(foo); our %EXPORT_TAGS = ( first => [ 'foo' => { xxx => 41 }, 'bar' ], second => [ 'foo', 'bar' ], upper => [ 'foo' => { -as => 'O', -prefix => 'F', -suffix => 'O' }, 'bar' => { -as => 'A', -prefix => 'B', -suffix => 'R' }, ], ); sub _generate_foo { my $me = shift; my ($name, $args) = @_; $args->{xxx} ||= 'foo'; return sub () { $args->{xxx} }; } sub _generate_bar { my $me = shift; my ($name, $args) = @_; $args->{xxx} ||= 'bar'; return sub () { $args->{xxx} }; } }; use Local::Foo -first => { -prefix => 'first_' }, -second => { -prefix => 'second_', xxx => 666 }, -first => { -prefix => 'third_', xxx => 42 }; is(first_foo, 41); is(first_bar, 'bar'); is(second_foo, 666); is(second_bar, 666); is(third_foo, 42); is(third_bar, 42); use Local::Foo -upper => { -prefix => 'MY', xxx => 999 }; is(MYFOO, 999); { package Local::Bar; use Local::Foo; } ok( Local::Bar->can('foo') ); ok( !Local::Bar->can('bar') ); is( Local::Bar::foo(), 'foo' ); { package Local::Baz; # Workaround for people who have PERL5OPT set to load features BEGIN { $INC{'feature.pm'} and 'feature'->unimport('switch') }; use Local::Foo -default; } ok( Local::Baz->can('foo') ); ok( !Local::Baz->can('bar') ); is( Local::Baz::foo(), 'foo' ); { package Local::Xyzzy; use Local::Foo -all; } ok( Local::Xyzzy->can('foo') ); ok( Local::Xyzzy->can('bar') ); is( Local::Xyzzy::foo(), 'foo' ); is( Local::Xyzzy::bar(), 'bar' ); 09warnings.t000664001750001750 302114411570357 15726 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test sub redefinition warnings/errors. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; BEGIN { eval "use Test::Fatal; use Test::Warnings qw(warning :no_end_test); 1" or plan skip_all => "test requires Test::Warnings and Test::Fatal"; plan tests => 4; }; BEGIN { package Local::Exporter; use Exporter::Shiny qw(foo bar); sub foo { 666 } sub bar { 999 } }; like( warning { eval q{ package Local::Test1; sub foo { 42 } use Local::Exporter -all; 1; } }, qr/^Overwriting existing sub 'Local::Test1::foo' with sub 'foo' exported by Local::Exporter/, 'warning about overwriting sub', ); like( exception { eval q{ package Local::Test2; sub foo { 42 } use Local::Exporter { replace => 'die' }, -all; 1; } or die $@ }, qr/^Refusing to overwrite existing sub 'Local::Test2::foo' with sub 'foo' exported by Local::Exporter/, '... which can be fatalized', ); is_deeply( warning { eval q{ package Local::Test3; sub foo { 42 } use Local::Exporter { replace => 'die' }, -all; 1; } }, [], '... or suppressed', ); is_deeply( warning { eval q{ package Local::Test4; use Local::Exporter -all; use Local::Exporter qw(foo); 1; } }, [], 'but importing the exact same sub twice is OK', ); 10no.t000664001750001750 267714411570357 14522 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Check C<< unimport >> works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 9; use lib qw( examples ../examples ); { package Local::Pkg1; use Example::Exporter; ::is( fib(6), 8, 'fib exported' ); no Example::Exporter; } ok( !Local::Pkg1->can('fib'), 'tidied fib' ); { package Local::Pkg2; use Example::Exporter fib => { -as => 'fibo' }; ::is( fibo(6), 8, 'fibo exported' ); no Example::Exporter; } ok( !Local::Pkg2->can('fibo'), 'tidied fibo' ); { package Local::Pkg3; use Example::Exporter -all; ::is( fib(6), 8, 'fib exported' ); ::is( embiggen(6), 7, 'embiggen exported' ); no Example::Exporter qw( /^F/i ); } ok( Local::Pkg3->can('embiggen') && !Local::Pkg3->can('fib'), 'tidied by regexp' ); BEGIN { package Local::Pkg4; use Exporter::Shiny qw( $Foo ); our $Foo = 42; }; our ($xxx, $yyy); local $@; eval q{ use strict; use warnings; package Local::Pkg5; use Local::Pkg4 qw( $Foo ); BEGIN { $::xxx = $Foo }; # why BEGIN needed??? no Local::Pkg4 qw( $Foo ); $::yyy = $Foo; }; my $e = $@; is($xxx, 42, 'importing scalar works'); like($e, qr/Unimporting non-code/, 'unimporting scalar works'); # TODO 11noncode.t000664001750001750 252214411570357 15521 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test Exporter::Tiny exporting non-code symbols. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 7; BEGIN { package My::Exporter; use Exporter::Shiny qw( $Foo @Bar %Baz ); our $Foo = 42; our @Bar = (1, 2, 3); our %Baz = (quux => 'xyzzy'); }; BEGIN { package My::Importer; use My::Exporter -all; }; is($My::Importer::Foo, 42, 'importing scalar'); is_deeply(\@My::Importer::Bar, [1,2,3], 'importing array'); is_deeply(\%My::Importer::Baz, { quux => 'xyzzy' }, 'importing hash'); $My::Importer::Foo /= 2; push @My::Importer::Bar, 4; $My::Importer::Baz{quuux} = 'blarg'; is($My::Exporter::Foo, 21, 'importing scalar does not copy'); is_deeply(\@My::Exporter::Bar, [1,2,3,4], 'importing array does not copy'); is_deeply(\%My::Exporter::Baz, { quux => 'xyzzy', quuux => 'blarg' }, 'importing hash does not copy'); my $into = {}; My::Exporter->import({ into => $into }, qw( $Foo @Bar %Baz )); is_deeply($into, { '$Foo' => \21, '@Bar' => [1..4], '%Baz' => {qw/quux xyzzy quuux blarg/} }, 'importing non-code symbols into hashrefs'); 12noncodegenerators.t000664001750001750 272114411570357 17615 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test Exporter::Tiny exporting non-code symbols from generators. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 7; BEGIN { package My::Exporter; use Exporter::Shiny qw( $Foo @Bar %Baz ); our $_Foo = 42; our @_Bar = (1, 2, 3); our %_Baz = (quux => 'xyzzy'); sub _generateScalar_Foo { \$_Foo } sub _generateArray_Bar { \@_Bar } sub _generateHash_Baz { \%_Baz } }; BEGIN { package My::Importer; use My::Exporter -all; }; is($My::Importer::Foo, 42, 'importing scalar'); is_deeply(\@My::Importer::Bar, [1,2,3], 'importing array'); is_deeply(\%My::Importer::Baz, { quux => 'xyzzy' }, 'importing hash'); $My::Importer::Foo /= 2; push @My::Importer::Bar, 4; $My::Importer::Baz{quuux} = 'blarg'; is($My::Exporter::_Foo, 21, 'importing scalar does not copy'); is_deeply(\@My::Exporter::_Bar, [1,2,3,4], 'importing array does not copy'); is_deeply(\%My::Exporter::_Baz, { quux => 'xyzzy', quuux => 'blarg' }, 'importing hash does not copy'); my $into = {}; My::Exporter->import({ into => $into }, qw( $Foo @Bar %Baz )); is_deeply($into, { '$Foo' => \21, '@Bar' => [1..4], '%Baz' => {qw/quux xyzzy quuux blarg/} }, 'importing non-code symbols into hashrefs'); 13doesntexist.t000664001750001750 247714411570357 16460 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test what happens when trying to import symbols and tags that don't exist or aren't marked as suitable for exporting. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 4; sub exception ($) { local $@; eval shift; return $@; } BEGIN { package My::Exporter; use Exporter::Shiny qw( $Foo Bar Bam wibble ); our $Foo = 42; sub Bar { 666 } sub Baz { 999 } our $Bat = 69; sub _generate_wibble { my $class = shift; my ($name, $arg, $globals) = @_; return sub { $globals }; } }; like( exception q{ use My::Exporter qw(Baz) }, qr/Could not find sub/, 'sub that is not marked for export' ); like( exception q{ use My::Exporter qw(Bam) }, qr/Could not find sub/, 'sub that cannot be found' ); like( exception q{ use My::Exporter qw($Bat) }, qr/Could not find sub/, # this error should probably be changed 'non-code symbol that is not marked for export' ); use My::Exporter -wobble => { butt => 88 }, qw(wibble); is_deeply( wibble->{wobble}, { butt => 88 }, 'unknown tags get added to globals' );14lexical.t000664001750001750 160114411570357 15515 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Tests support for lexical imports on Perl 5.37.2 and above. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Exporter::Tiny (); BEGIN { Exporter::Tiny::_HAS_NATIVE_LEXICAL_SUB or Exporter::Tiny::_HAS_MODULE_LEXICAL_SUB or plan skip_all => "This version of Perl does not support lexical imports"; }; BEGIN { package My::Utils; use Exporter::Shiny qw( foo $bar ); our $bar = 42; sub foo { return $bar } }; { use My::Utils -lexical, qw( foo $bar ); is( foo(), 42 ); is( $bar, 42 ); ok ! main->can( 'foo' ); } ok ! eval ' foo() '; ok ! eval ' $bar '; done_testing; 15nonhashvalue.t000664001750001750 201714411570357 16572 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test that C<< $value >> can be a non-hashref. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 3; BEGIN { package Local::XYZ; use Exporter::Shiny 'mytest'; sub _generate_mytest { my ( $class, $name, $value ) = @_; return sub { $value }; } }; { package Local::ABC1; use Local::XYZ mytest => [ 1, 2, 4 ]; ::is_deeply( mytest(), [ 1, 2, 4 ], 'ARRAY ref', ) or ::diag( ::explain( mytest() ) ); } { package Local::ABC2; use Local::XYZ mytest => \123; ::is_deeply( mytest(), \123, 'SCALAR ref', ) or ::diag( ::explain( mytest() ) ); } { package Local::ABC3; use Local::XYZ mytest => qr/abc/; ::is_deeply( mytest(), qr/abc/, 'Regexp ref', ) or ::diag( ::explain( mytest() ) ); } gh-8.t000664001750001750 302314411570357 14472 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test for GitHub issue 8. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 5; BEGIN { package Local::Exporter; use Exporter::Shiny; sub chocolate { 1 } sub vanilla { 2 } our %EXPORT_TAGS = ( want => [ qw( chocolate vanilla ) ] ); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; }; my %stuff; my $dump = sub { use Data::Dumper; diag Dumper( \%stuff ); }; %stuff = (); Local::Exporter->import( { into => \%stuff }, qw( -all ) ); is_deeply( [ sort keys %stuff ], [ 'chocolate', 'vanilla' ], '-all', ) or &$dump; %stuff = (); Local::Exporter->import( { into => \%stuff }, qw( -all !vanilla ) ); is_deeply( [ sort keys %stuff ], [ 'chocolate' ], '-all !vanilla', ) or &$dump; %stuff = (); Local::Exporter->import( { into => \%stuff }, qw( -want ) ); is_deeply( [ sort keys %stuff ], [ 'chocolate', 'vanilla' ], '-want', ) or &$dump; %stuff = (); Local::Exporter->import( { into => \%stuff }, qw( -all !-want ) ); is_deeply( [ sort keys %stuff ], [], '-all !-want', ) or &$dump; %stuff = (); Local::Exporter->import( { into => \%stuff }, qw( -want !-want ) ); is_deeply( [ sort keys %stuff ], [], '-want !-want', ) or &$dump; gh-9.t000664001750001750 166414411570357 14504 0ustar00taitai000000000000Exporter-Tiny-1.006002/t=pod =encoding utf-8 =head1 PURPOSE Test for GitHub issue 9. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More tests => 3; BEGIN { package Local::Exporter; use Exporter::Shiny qw( FLAVORS @FLAVORS %FLAVORS ); sub FLAVORS { 'CHOCOLATE', 'VANILLA' } our @FLAVORS = ( 'chocolate', 'vanilla' ); our %FLAVORS = ( 1 => 'chocolate', 2 => 'vanilla' ); }; our ( @FLAVORS, %FLAVORS ); use Local::Exporter -all; is_deeply( [ FLAVORS() ], [ qw( CHOCOLATE VANILLA ) ] ); is_deeply( \@FLAVORS, [ qw( chocolate vanilla ) ] ); is_deeply( \%FLAVORS, { qw( 1 chocolate 2 vanilla ) } ); Exporter.pm000664001750001750 210714411570357 20660 0ustar00taitai000000000000Exporter-Tiny-1.006002/examples/Exampleuse 5.006001; use strict; use warnings; package Example::Exporter; # Inherit from Exporter::Tiny. # use base 'Exporter::Tiny'; # The list of functions to export by default. # Be conservative. # our @EXPORT = qw( fib ); # The list of functions which are allowed to # be exported. Be liberal. # our @EXPORT_OK = qw( embiggen ); # Note that there was no need to list "fib" # in @EXPORT_OK. It was in @EXPORT, so it's # implicitly ok. # This is the definition of the "fib" function # that we want to export. # sub fib { my $n = $_[0]; (int($n) eq $n) && ($n >= 0) or die "Expected natural number as argument; got '$n'"; return $n if $n < 2; fib($n - 1) + fib($n - 2); } # We won't define a standard embiggen function. # Instead we will generate one when requested. # sub _generate_embiggen { my ($class, $name, $arg, $globals) = @_; my $embiggen_amount = exists($arg->{amount}) ? $arg->{amount} : 1; # This is the sub that will be installed into # the caller's namespace. # return sub ($) { my $n = $_[0]; return $n + $embiggen_amount; } } 1; # Make Perl Happy™ Fatal.pm000664001750001750 245514411570357 16364 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/Test#line 1 use strict; use warnings; package Test::Fatal; { $Test::Fatal::VERSION = '0.010'; } # ABSTRACT: incredibly simple helpers for testing code with exceptions use Carp (); use Try::Tiny 0.07; use base 'Exporter'; our @EXPORT = qw(exception); our @EXPORT_OK = qw(exception success dies_ok lives_ok); sub exception (&) { my $code = shift; return try { $code->(); return undef; } catch { return $_ if $_; my $problem = defined $_ ? 'false' : 'undef'; Carp::confess("$problem exception caught by Test::Fatal::exception"); }; } sub success (&;@) { my $code = shift; return finally( sub { return if @_; # <-- only run on success $code->(); }, @_ ); } my $Tester; # Signature should match that of Test::Exception sub dies_ok (&;$) { my $code = shift; my $name = shift; require Test::Builder; $Tester ||= Test::Builder->new; my $ok = $Tester->ok( exception( \&$code ), $name ); $ok or $Tester->diag( "expected an exception but none was raised" ); return $ok; } sub lives_ok (&;$) { my $code = shift; my $name = shift; require Test::Builder; $Tester ||= Test::Builder->new; my $ok = $Tester->ok( !exception( \&$code ), $name ); $ok or $Tester->diag( "expected return but an exception was raised" ); return $ok; } 1; __END__ #line 212 Requires.pm000664001750001750 374314411570357 17135 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/Test#line 1 package Test::Requires; use strict; use warnings; our $VERSION = '0.06'; use base 'Test::Builder::Module'; use 5.006000; sub import { my $class = shift; my $caller = caller(0); # export methods { no strict 'refs'; *{"$caller\::test_requires"} = \&test_requires; } # test arguments if (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') { while (my ($mod, $ver) = each %{$_[0]}) { test_requires($mod, $ver, $caller); } } else { for my $mod (@_) { test_requires($mod, undef, $caller); } } } sub test_requires { my ( $mod, $ver, $caller ) = @_; return if $mod eq __PACKAGE__; if (@_ != 3) { $caller = caller(0); } $ver ||= ''; eval qq{package $caller; no warnings; use $mod $ver}; ## no critic. if (my $e = $@) { my $skip_all = sub { my $builder = __PACKAGE__->builder; if (not defined $builder->has_plan) { $builder->skip_all(@_); } elsif ($builder->has_plan eq 'no_plan') { $builder->skip(@_); if ( $builder->can('parent') && $builder->parent ) { die bless {} => 'Test::Builder::Exception'; } exit 0; } else { for (1..$builder->has_plan) { $builder->skip(@_); } if ( $builder->can('parent') && $builder->parent ) { die bless {} => 'Test::Builder::Exception'; } exit 0; } }; if ( $e =~ /^Can't locate/ ) { $skip_all->("requires $mod"); } elsif ( $e =~ /^Perl (\S+) required/ ) { $skip_all->("requires Perl $1"); } elsif ( $e =~ /^\Q$mod\E version (\S+) required/ ) { $skip_all->("requires $mod $1"); } else { $skip_all->("$e"); } } } 1; __END__ #line 128 Tiny.pm000664001750001750 4332514411570357 16140 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/Trypackage Try::Tiny; BEGIN { $Try::Tiny::AUTHORITY = 'cpan:NUFFIN'; } $Try::Tiny::VERSION = '0.21'; use 5.006; # ABSTRACT: minimal try/catch with proper preservation of $@ use strict; use warnings; use Exporter (); our @ISA = qw( Exporter ); our @EXPORT = our @EXPORT_OK = qw(try catch finally); use Carp; $Carp::Internal{+__PACKAGE__}++; BEGIN { eval "use Sub::Name; 1" or *{subname} = sub {1} } # Need to prototype as @ not $$ because of the way Perl evaluates the prototype. # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list # context & not a scalar one sub try (&;@) { my ( $try, @code_refs ) = @_; # we need to save this here, the eval block will be in scalar context due # to $failed my $wantarray = wantarray; # work around perl bug by explicitly initializing these, due to the likelyhood # this will be used in global destruction (perl rt#119311) my ( $catch, @finally ) = (); # find labeled blocks in the argument list. # catch and finally tag the blocks by blessing a scalar reference to them. foreach my $code_ref (@code_refs) { if ( ref($code_ref) eq 'Try::Tiny::Catch' ) { croak 'A try() may not be followed by multiple catch() blocks' if $catch; $catch = ${$code_ref}; } elsif ( ref($code_ref) eq 'Try::Tiny::Finally' ) { push @finally, ${$code_ref}; } else { croak( 'try() encountered an unexpected argument (' . ( defined $code_ref ? $code_ref : 'undef' ) . ') - perhaps a missing semi-colon before or' ); } } # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's # not perfect, but we could provide a list of additional errors for # $catch->(); # name the blocks if we have Sub::Name installed my $caller = caller; subname("${caller}::try {...} " => $try); subname("${caller}::catch {...} " => $catch) if $catch; subname("${caller}::finally {...} " => $_) foreach @finally; # save the value of $@ so we can set $@ back to it in the beginning of the eval # and restore $@ after the eval finishes my $prev_error = $@; my ( @ret, $error ); # failed will be true if the eval dies, because 1 will not be returned # from the eval body my $failed = not eval { $@ = $prev_error; # evaluate the try block in the correct context if ( $wantarray ) { @ret = $try->(); } elsif ( defined $wantarray ) { $ret[0] = $try->(); } else { $try->(); }; return 1; # properly set $fail to false }; # preserve the current error and reset the original value of $@ $error = $@; $@ = $prev_error; # set up a scope guard to invoke the finally block at the end my @guards = map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) } @finally; # at this point $failed contains a true value if the eval died, even if some # destructor overwrote $@ as the eval was unwinding. if ( $failed ) { # if we got an error, invoke the catch block. if ( $catch ) { # This works like given($error), but is backwards compatible and # sets $_ in the dynamic scope for the body of C<$catch> for ($error) { return $catch->($error); } # in case when() was used without an explicit return, the C # loop will be aborted and there's no useful return value } return; } else { # no failure, $@ is back to what it was, everything is fine return $wantarray ? @ret : $ret[0]; } } sub catch (&;@) { my ( $block, @rest ) = @_; croak 'Useless bare catch()' unless wantarray; return ( bless(\$block, 'Try::Tiny::Catch'), @rest, ); } sub finally (&;@) { my ( $block, @rest ) = @_; croak 'Useless bare finally()' unless wantarray; return ( bless(\$block, 'Try::Tiny::Finally'), @rest, ); } { package # hide from PAUSE Try::Tiny::ScopeGuard; use constant UNSTABLE_DOLLARAT => ($] < '5.013002') ? 1 : 0; sub _new { shift; bless [ @_ ]; } sub DESTROY { my ($code, @args) = @{ $_[0] }; local $@ if UNSTABLE_DOLLARAT; eval { $code->(@args); 1; } or do { warn "Execution of finally() block $code resulted in an exception, which " . '*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. ' . 'Your program will continue as if this event never took place. ' . "Original exception text follows:\n\n" . (defined $@ ? $@ : '$@ left undefined...') . "\n" ; } } } __PACKAGE__ __END__ =pod =encoding UTF-8 =head1 NAME Try::Tiny - minimal try/catch with proper preservation of $@ =head1 VERSION version 0.21 =head1 SYNOPSIS You can use Try::Tiny's C and C to expect and handle exceptional conditions, avoiding quirks in Perl and common mistakes: # handle errors with a catch handler try { die "foo"; } catch { warn "caught error: $_"; # not $@ }; You can also use it like a standalone C to catch and ignore any error conditions. Obviously, this is an extreme measure not to be undertaken lightly: # just silence errors try { die "foo"; }; =head1 DESCRIPTION This module provides bare bones C/C/C statements that are designed to minimize common mistakes with eval blocks, and NOTHING else. This is unlike L which provides a nice syntax and avoids adding another call stack layer, and supports calling C from the C block to return from the parent subroutine. These extra features come at a cost of a few dependencies, namely L and L which are occasionally problematic, and the additional catch filtering uses L type constraints which may not be desirable either. The main focus of this module is to provide simple and reliable error handling for those having a hard time installing L, but who still want to write correct C blocks without 5 lines of boilerplate each time. It's designed to work as correctly as possible in light of the various pathological edge cases (see L) and to be compatible with any style of error values (simple strings, references, objects, overloaded objects, etc). If the C block dies, it returns the value of the last statement executed in the C block, if there is one. Otherwise, it returns C in scalar context or the empty list in list context. The following examples all assign C<"bar"> to C<$x>: my $x = try { die "foo" } catch { "bar" }; my $x = try { die "foo" } || { "bar" }; my $x = (try { die "foo" }) // { "bar" }; my $x = eval { die "foo" } || "bar"; You can add C blocks, yielding the following: my $x; try { die 'foo' } finally { $x = 'bar' }; try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' }; C blocks are always executed making them suitable for cleanup code which cannot be handled using local. You can add as many C blocks to a given C block as you like. Note that adding a C block without a preceding C block suppresses any errors. This behaviour is consistent with using a standalone C, but it is not consistent with C/C patterns found in other programming languages, such as Java, Python, Javascript or C#. If you learnt the C/C pattern from one of these languages, watch out for this. =head1 EXPORTS All functions are exported by default using L. If you need to rename the C, C or C keyword consider using L to get L's flexibility. =over 4 =item try (&;@) Takes one mandatory C subroutine, an optional C subroutine and C subroutine. The mandatory subroutine is evaluated in the context of an C block. If no error occurred the value from the first block is returned, preserving list/scalar context. If there was an error and the second subroutine was given it will be invoked with the error in C<$_> (localized) and as that block's first and only argument. C<$@> does B contain the error. Inside the C block it has the same value it had before the C block was executed. Note that the error may be false, but if that happens the C block will still be invoked. Once all execution is finished then the C block, if given, will execute. =item catch (&;@) Intended to be used in the second argument position of C. Returns a reference to the subroutine it was given but blessed as C which allows try to decode correctly what to do with this code reference. catch { ... } Inside the C block the caught error is stored in C<$_>, while previous value of C<$@> is still available for use. This value may or may not be meaningful depending on what happened before the C, but it might be a good idea to preserve it in an error stack. For code that captures C<$@> when throwing new errors (i.e. L), you'll need to do: local $@ = $_; =item finally (&;@) try { ... } catch { ... } finally { ... }; Or try { ... } finally { ... }; Or even try { ... } finally { ... } catch { ... }; Intended to be the second or third element of C. C blocks are always executed in the event of a successful C or if C is run. This allows you to locate cleanup code which cannot be done via C e.g. closing a file handle. When invoked, the C block is passed the error that was caught. If no error was caught, it is passed nothing. (Note that the C block does not localize C<$_> with the error, since unlike in a C block, there is no way to know if C<$_ == undef> implies that there were no errors.) In other words, the following code does just what you would expect: try { die_sometimes(); } catch { # ...code run in case of error } finally { if (@_) { print "The try block died with: @_\n"; } else { print "The try block ran without error.\n"; } }; B block>. C will not do anything about handling possible errors coming from code located in these blocks. Furthermore B blocks are not trappable and are unable to influence the execution of your program>. This is due to limitation of C-based scope guards, which C is implemented on top of. This may change in a future version of Try::Tiny. In the same way C blesses the code reference this subroutine does the same except it bless them as C. =back =head1 BACKGROUND There are a number of issues with C. =head2 Clobbering $@ When you run an C block and it succeeds, C<$@> will be cleared, potentially clobbering an error that is currently being caught. This causes action at a distance, clearing previous errors your caller may have not yet handled. C<$@> must be properly localized before invoking C in order to avoid this issue. More specifically, C<$@> is clobbered at the beginning of the C, which also makes it impossible to capture the previous error before you die (for instance when making exception objects with error stacks). For this reason C will actually set C<$@> to its previous value (the one available before entering the C block) in the beginning of the C block. =head2 Localizing $@ silently masks errors Inside an C block, C behaves sort of like: sub die { $@ = $_[0]; return_undef_from_eval(); } This means that if you were polite and localized C<$@> you can't die in that scope, or your error will be discarded (printing "Something's wrong" instead). The workaround is very ugly: my $error = do { local $@; eval { ... }; $@; }; ... die $error; =head2 $@ might not be a true value This code is wrong: if ( $@ ) { ... } because due to the previous caveats it may have been unset. C<$@> could also be an overloaded error object that evaluates to false, but that's asking for trouble anyway. The classic failure mode is: sub Object::DESTROY { eval { ... } } eval { my $obj = Object->new; die "foo"; }; if ( $@ ) { } In this case since C is not localizing C<$@> but still uses C, it will set C<$@> to C<"">. The destructor is called when the stack is unwound, after C sets C<$@> to C<"foo at Foo.pm line 42\n">, so by the time C is evaluated it has been cleared by C in the destructor. The workaround for this is even uglier than the previous ones. Even though we can't save the value of C<$@> from code that doesn't localize, we can at least be sure the C was aborted due to an error: my $failed = not eval { ... return 1; }; This is because an C that caught a C will always return a false value. =head1 SHINY SYNTAX Using Perl 5.10 you can use L. The C block is invoked in a topicalizer context (like a C block), but note that you can't return a useful value from C using the C blocks without an explicit C. This is somewhat similar to Perl 6's C blocks. You can use it to concisely match errors: try { require Foo; } catch { when (/^Can't locate .*?\.pm in \@INC/) { } # ignore default { die $_ } }; =head1 CAVEATS =over 4 =item * C<@_> is not available within the C block, so you need to copy your arglist. In case you want to work with argument values directly via C<@_> aliasing (i.e. allow C<$_[1] = "foo">), you need to pass C<@_> by reference: sub foo { my ( $self, @args ) = @_; try { $self->bar(@args) } } or sub bar_in_place { my $self = shift; my $args = \@_; try { $_ = $self->bar($_) for @$args } } =item * C returns from the C block, not from the parent sub (note that this is also how C works, but not how L works): sub parent_sub { try { die; } catch { return; }; say "this text WILL be displayed, even though an exception is thrown"; } Instead, you should capture the return value: sub parent_sub { my $success = try { die; 1; }; return unless $success; say "This text WILL NEVER appear!"; } # OR sub parent_sub_with_catch { my $success = try { die; 1; } catch { # do something with $_ return undef; #see note }; return unless $success; say "This text WILL NEVER appear!"; } Note that if you have a C block, it must return C for this to work, since if a C block exists, its return value is returned in place of C when an exception is thrown. =item * C introduces another caller stack frame. L is not used. L will not report this when using full stack traces, though, because C<%Carp::Internal> is used. This lack of magic is considered a feature. =item * The value of C<$_> in the C block is not guaranteed to be the value of the exception thrown (C<$@>) in the C block. There is no safe way to ensure this, since C may be used unhygenically in destructors. The only guarantee is that the C will be called if an exception is thrown. =item * The return value of the C block is not ignored, so if testing the result of the expression for truth on success, be sure to return a false value from the C block: my $obj = try { MightFail->new; } catch { ... return; # avoid returning a true value; }; return unless $obj; =item * C<$SIG{__DIE__}> is still in effect. Though it can be argued that C<$SIG{__DIE__}> should be disabled inside of C blocks, since it isn't people have grown to rely on it. Therefore in the interests of compatibility, C does not disable C<$SIG{__DIE__}> for the scope of the error throwing code. =item * Lexical C<$_> may override the one set by C. For example Perl 5.10's C form uses a lexical C<$_>, creating some confusing behavior: given ($foo) { when (...) { try { ... } catch { warn $_; # will print $foo, not the error warn $_[0]; # instead, get the error like this } } } Note that this behavior was changed once again in L. However, since the entirety of lexical C<$_> is now L, it is unclear whether the new version 18 behavior is final. =back =head1 SEE ALSO =over 4 =item L Much more feature complete, more convenient semantics, but at the cost of implementation complexity. =item L Automatic error throwing for builtin functions and more. Also designed to work well with C/C. =item L A lightweight role for rolling your own exception classes. =item L Exception object implementation with a C statement. Does not localize C<$@>. =item L Provides a C statement, but properly calling C is your responsibility. The C keyword pushes C<$@> onto an error stack, avoiding some of the issues with C<$@>, but you still need to localize to prevent clobbering. =back =head1 LIGHTNING TALK I gave a lightning talk about this module, you can see the slides (Firefox only): L Or read the source: L =head1 VERSION CONTROL L =head1 AUTHORS =over 4 =item * Yuval Kogman =item * Jesse Luehrs =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Yuval Kogman. This is free software, licensed under: The MIT (X11) License =cut Shiny.pm000664001750001750 474414411570357 17320 0ustar00taitai000000000000Exporter-Tiny-1.006002/lib/Exporterpackage Exporter::Shiny; use 5.006001; use strict; use warnings; use Exporter::Tiny (); our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '1.006002'; sub import { my $me = shift; my $caller = caller; (my $nominal_file = $caller) =~ s(::)(/)g; $INC{"$nominal_file\.pm"} ||= __FILE__; if (@_ == 2 and $_[0] eq -setup) { my (undef, $opts) = @_; @_ = @{ delete($opts->{exports}) || [] }; if (%$opts) { Exporter::Tiny::_croak( 'Unsupported Sub::Exporter-style options: %s', join(q[, ], sort keys %$opts), ); } } ref($_) && Exporter::Tiny::_croak('Expected sub name, got ref %s', $_) for @_; no strict qw(refs); push @{"$caller\::ISA"}, 'Exporter::Tiny'; push @{"$caller\::EXPORT_OK"}, @_; } 1; __END__ =pod =encoding utf-8 =head1 NAME Exporter::Shiny - shortcut for Exporter::Tiny =head1 SYNOPSIS use Exporter::Shiny qw( foo bar ); Is a shortcut for: use base "Exporter::Tiny"; push our(@EXPORT_OK), qw( foo bar ); For compatibility with L, the following longer syntax is also supported: use Exporter::Shiny -setup => { exports => [qw( foo bar )], }; =head1 DESCRIPTION This is a very small wrapper to simplify using L. It does the following: =over =item * Marks your package as loaded in C<< %INC >>; =item * Pushes any function names in the import list onto your C<< @EXPORT_OK >>; and =item * Pushes C<< "Exporter::Tiny" >> onto your C<< @ISA >>. =back It doesn't set up C<< %EXPORT_TAGS >> or C<< @EXPORT >>, but there's nothing stopping you doing that yourself. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. This module is just a wrapper around L, so take a look at L and L for further information on what features are available. Other interesting exporters: L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017, 2022-2023 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Tiny.pm000664001750001750 3550314411570357 17166 0ustar00taitai000000000000Exporter-Tiny-1.006002/lib/Exporterpackage Exporter::Tiny; use 5.006001; use strict; use warnings; no warnings qw(void once uninitialized numeric redefine); our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '1.006002'; our @EXPORT_OK = qw< mkopt mkopt_hash _croak _carp >; BEGIN { *_HAS_NATIVE_LEXICAL_SUB = ( $] ge '5.037002' ) ? sub () { !!1 } : sub () { !!0 }; *_HAS_MODULE_LEXICAL_SUB = ( $] ge '5.011002' and eval('require Lexical::Sub') ) ? sub () { !!1 } : sub () { !!0 }; }; sub _croak ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::croak } sub _carp ($;@) { require Carp; my $fmt = shift; @_ = sprintf($fmt, @_); goto \&Carp::carp } my $_process_optlist = sub { my $class = shift; my ($global_opts, $opts, $want, $not_want) = @_; while (@$opts) { my $opt = shift @{$opts}; my ($name, $value) = @$opt; ($name =~ m{\A\!(/.+/[msixpodual]*)\z}) ? do { my @not = $class->_exporter_expand_regexp("$1", $value, $global_opts); ++$not_want->{$_->[0]} for @not; } : ($name =~ m{\A\![:-](.+)\z}) ? do { my @not = $class->_exporter_expand_tag("$1", $value, $global_opts); ++$not_want->{$_->[0]} for @not; } : ($name =~ m{\A\!(.+)\z}) ? (++$not_want->{$1}) : ($name =~ m{\A[:-](.+)\z}) ? push(@$opts, $class->_exporter_expand_tag("$1", $value, $global_opts)) : ($name =~ m{\A/.+/[msixpodual]*\z}) ? push(@$opts, $class->_exporter_expand_regexp($name, $value, $global_opts)) : # else ? push(@$want, $opt); } }; sub import { my $class = shift; my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () }; if ( defined $global_opts->{into} and $global_opts->{into} eq '-lexical' ) { $global_opts->{lexical} = 1; delete $global_opts->{into}; } if ( not defined $global_opts->{into} ) { $global_opts->{into} = caller; } my @want; my %not_want; $global_opts->{not} = \%not_want; my @args = do { no strict qw(refs); @_ ? @_ : @{"$class\::EXPORT"} }; my $opts = mkopt(\@args); $class->$_process_optlist($global_opts, $opts, \@want, \%not_want); $global_opts->{installer} ||= $class->_exporter_lexical_installer( $global_opts ) if $global_opts->{lexical}; my $permitted = $class->_exporter_permitted_regexp($global_opts); $class->_exporter_validate_opts($global_opts); for my $wanted (@want) { next if $not_want{$wanted->[0]}; my %symbols = $class->_exporter_expand_sub(@$wanted, $global_opts, $permitted); $class->_exporter_install_sub($_, $wanted->[1], $global_opts, $symbols{$_}) for keys %symbols; } } sub unimport { my $class = shift; my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () }; $global_opts->{is_unimport} = 1; if ( defined $global_opts->{into} and $global_opts->{into} eq '-lexical' ) { $global_opts->{lexical} = 1; delete $global_opts->{into}; } if ( not defined $global_opts->{into} ) { $global_opts->{into} = caller; } my @want; my %not_want; $global_opts->{not} = \%not_want; my @args = do { our %TRACKED; @_ ? @_ : keys(%{$TRACKED{$class}{$global_opts->{into}}}) }; my $opts = mkopt(\@args); $class->$_process_optlist($global_opts, $opts, \@want, \%not_want); my $permitted = $class->_exporter_permitted_regexp($global_opts); $class->_exporter_validate_unimport_opts($global_opts); my $expando = $class->can('_exporter_expand_sub'); $expando = undef if $expando == \&_exporter_expand_sub; for my $wanted (@want) { next if $not_want{$wanted->[0]}; if ($wanted->[1]) { _carp("Passing options to unimport '%s' makes no sense", $wanted->[0]) unless (ref($wanted->[1]) eq 'HASH' and not keys %{$wanted->[1]}); } my %symbols = defined($expando) ? $class->$expando(@$wanted, $global_opts, $permitted) : ($wanted->[0] => sub { "dummy" }); $class->_exporter_uninstall_sub($_, $wanted->[1], $global_opts) for keys %symbols; } } # Returns a coderef suitable to be used as a sub installer for lexical imports. # sub _exporter_lexical_installer { _HAS_NATIVE_LEXICAL_SUB and return sub { my ( $sigilname, $sym ) = @{ $_[1] }; no warnings ( $] ge '5.037002' ? 'experimental::builtin' : () ); builtin::export_lexically( $sigilname, $sym ); }; _HAS_MODULE_LEXICAL_SUB and return sub { my ( $sigilname, $sym ) = @{ $_[1] }; ( $sigilname =~ /^\w/ ) ? 'Lexical::Sub'->import( $sigilname, $sym ) : 'Lexical::Var'->import( $sigilname, $sym ); }; _croak( 'Lexical export requires Perl 5.37.2+ for native support, or Perl 5.11.2+ with the Lexical::Sub module' ); } # Called once per import/unimport, passed the "global" import options. # Expected to validate the options and carp or croak if there are problems. # Can also take the opportunity to do other stuff if needed. # sub _exporter_validate_opts { 1 } sub _exporter_validate_unimport_opts { 1 } # Called after expanding a tag or regexp to merge the tag's options with # any sub-specific options. # sub _exporter_merge_opts { my $class = shift; my ($tag_opts, $global_opts, @stuff) = @_; $tag_opts = {} unless ref($tag_opts) eq q(HASH); _croak('Cannot provide an -as option for tags') if exists $tag_opts->{-as} && ref $tag_opts->{-as} ne 'CODE'; my $optlist = mkopt(\@stuff); for my $export (@$optlist) { next if defined($export->[1]) && ref($export->[1]) ne q(HASH); my %sub_opts = ( %{ $export->[1] or {} }, %$tag_opts ); $sub_opts{-prefix} = sprintf('%s%s', $tag_opts->{-prefix}, $export->[1]{-prefix}) if exists($export->[1]{-prefix}) && exists($tag_opts->{-prefix}); $sub_opts{-suffix} = sprintf('%s%s', $export->[1]{-suffix}, $tag_opts->{-suffix}) if exists($export->[1]{-suffix}) && exists($tag_opts->{-suffix}); $export->[1] = \%sub_opts; } return @$optlist; } # Given a tag name, looks it up in %EXPORT_TAGS and returns the list of # associated functions. The default implementation magically handles tags # "all" and "default". The default implementation interprets any undefined # tags as being global options. # sub _exporter_expand_tag { no strict qw(refs); my $class = shift; my ($name, $value, $globals) = @_; my $tags = \%{"$class\::EXPORT_TAGS"}; return $class->_exporter_merge_opts($value, $globals, $tags->{$name}->($class, @_)) if ref($tags->{$name}) eq q(CODE); return $class->_exporter_merge_opts($value, $globals, @{$tags->{$name}}) if exists $tags->{$name}; return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"}) if $name eq 'all'; return $class->_exporter_merge_opts($value, $globals, @{"$class\::EXPORT"}) if $name eq 'default'; $globals->{$name} = $value || 1; return; } # Given a regexp-like string, looks it up in @EXPORT_OK and returns the # list of matching functions. # sub _exporter_expand_regexp { no strict qw(refs); our %TRACKED; my $class = shift; my ($name, $value, $globals) = @_; my $compiled = eval("qr$name"); my @possible = $globals->{is_unimport} ? keys( %{$TRACKED{$class}{$globals->{into}}} ) : @{"$class\::EXPORT_OK"}; $class->_exporter_merge_opts($value, $globals, grep /$compiled/, @possible); } # Helper for _exporter_expand_sub. Returns a regexp matching all subs in # the exporter package which are available for export. # sub _exporter_permitted_regexp { no strict qw(refs); my $class = shift; my $re = join "|", map quotemeta, sort { length($b) <=> length($a) or $a cmp $b } @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"}; qr{^(?:$re)$}ms; } # Given a sub name, returns a hash of subs to install (usually just one sub). # Keys are sub names, values are coderefs. # sub _exporter_expand_sub { my $class = shift; my ($name, $value, $globals, $permitted) = @_; $permitted ||= $class->_exporter_permitted_regexp($globals); no strict qw(refs); my $sigil = "&"; if ($name =~ /\A([&\$\%\@\*])(.+)\z/) { $sigil = $1; $name = $2; if ($sigil eq '*') { _croak("Cannot export symbols with a * sigil"); } } my $sigilname = $sigil eq '&' ? $name : "$sigil$name"; if ($sigilname =~ $permitted) { my $generatorprefix = { '&' => "_generate_", '$' => "_generateScalar_", '@' => "_generateArray_", '%' => "_generateHash_", }->{$sigil}; my $generator = $class->can("$generatorprefix$name"); return $sigilname => $class->$generator($sigilname, $value, $globals) if $generator; if ($sigil eq '&') { my $sub = $class->can($name); return $sigilname => $sub if $sub; } else { # Could do this more cleverly, but this works. my $evalled = eval "\\${sigil}${class}::${name}"; return $sigilname => $evalled if $evalled; } } $class->_exporter_fail(@_); } # Called by _exporter_expand_sub if it is unable to generate a key-value # pair for a sub. # sub _exporter_fail { my $class = shift; my ($name, $value, $globals) = @_; return if $globals->{is_unimport}; _croak("Could not find sub '%s' exported by %s", $name, $class); } # Actually performs the installation of the sub into the target package. This # also handles renaming the sub. # sub _exporter_install_sub { my $class = shift; my ($name, $value, $globals, $sym) = @_; my $value_hash = ( ref($value) eq 'HASH' ) ? $value : {}; my $into = $globals->{into}; my $installer = $globals->{installer} || $globals->{exporter}; $name = ref $globals->{as} ? $globals->{as}->($name) : ref $value_hash->{-as} ? $value_hash->{-as}->($name) : exists $value_hash->{-as} ? $value_hash->{-as} : $name; return unless defined $name; my $sigil = "&"; unless (ref($name)) { if ($name =~ /\A([&\$\%\@\*])(.+)\z/) { $sigil = $1; $name = $2; if ($sigil eq '*') { _croak("Cannot export symbols with a * sigil"); } } my ($prefix) = grep defined, $value_hash->{-prefix}, $globals->{prefix}, q(); my ($suffix) = grep defined, $value_hash->{-suffix}, $globals->{suffix}, q(); $name = "$prefix$name$suffix"; } my $sigilname = $sigil eq '&' ? $name : ( $sigil . $name ); # if ({qw/$ SCALAR @ ARRAY % HASH & CODE/}->{$sigil} ne ref($sym)) { # warn $sym; # warn $sigilname; # _croak("Reference type %s does not match sigil %s", ref($sym), $sigil); # } return ($$name = $sym) if ref($name) eq q(SCALAR); return ($into->{$sigilname} = $sym) if ref($into) eq q(HASH); no strict qw(refs); our %TRACKED; if ( ref($sym) eq 'CODE' and ref($into) ? exists($into->{$name}) : exists(&{"$into\::$name"}) and $sym != ( ref($into) ? $into->{$name} : \&{"$into\::$name"} ) ) { my ($level) = grep defined, $value_hash->{-replace}, $globals->{replace}, q(0); my $action = { carp => \&_carp, 0 => \&_carp, '' => \&_carp, warn => \&_carp, nonfatal => \&_carp, croak => \&_croak, fatal => \&_croak, die => \&_croak, }->{$level} || sub {}; # Don't complain about double-installing the same sub. This isn't ideal # because the same named sub might be generated in two different ways. $action = sub {} if $TRACKED{$class}{$into}{$sigilname}; $action->( $action == \&_croak ? "Refusing to overwrite existing sub '%s' with sub '%s' exported by %s" : "Overwriting existing sub '%s' with sub '%s' exported by %s", ref($into) ? $name : "$into\::$name", $_[0], $class, ); } $TRACKED{$class}{$into}{$sigilname} = $sym; no warnings qw(prototype); $installer ? $installer->($globals, [$sigilname, $sym]) : (*{"$into\::$name"} = $sym); } sub _exporter_uninstall_sub { our %TRACKED; my $class = shift; my ($name, $value, $globals, $sym) = @_; my $into = $globals->{into}; ref $into and return; no strict qw(refs); my $sigil = "&"; if ($name =~ /\A([&\$\%\@\*])(.+)\z/) { $sigil = $1; $name = $2; if ($sigil eq '*') { _croak("Cannot export symbols with a * sigil"); } } my $sigilname = $sigil eq '&' ? $name : "$sigil$name"; if ($sigil ne '&') { _croak("Unimporting non-code symbols not supported yet"); } # Cowardly refuse to uninstall a sub that differs from the one # we installed! my $our_coderef = $TRACKED{$class}{$into}{$name}; my $cur_coderef = exists(&{"$into\::$name"}) ? \&{"$into\::$name"} : -1; return unless $our_coderef == $cur_coderef; my $stash = \%{"$into\::"}; my $old = delete $stash->{$name}; my $full_name = join('::', $into, $name); foreach my $type (qw(SCALAR HASH ARRAY IO)) # everything but the CODE { next unless defined(*{$old}{$type}); *$full_name = *{$old}{$type}; } delete $TRACKED{$class}{$into}{$name}; } sub mkopt { my $in = shift or return []; my @out; $in = [map(($_ => ref($in->{$_}) ? $in->{$_} : ()), sort keys %$in)] if ref($in) eq q(HASH); for (my $i = 0; $i < @$in; $i++) { my $k = $in->[$i]; my $v; ($i == $#$in) ? ($v = undef) : !defined($in->[$i+1]) ? (++$i, ($v = undef)) : !ref($in->[$i+1]) ? ($v = undef) : ($v = $in->[++$i]); push @out, [ $k => $v ]; } \@out; } sub mkopt_hash { my $in = shift or return; my %out = map +($_->[0] => $_->[1]), @{ mkopt($in) }; \%out; } 1; __END__ =pod =encoding utf-8 =for stopwords frobnicate greps regexps =head1 NAME Exporter::Tiny - an exporter with the features of Sub::Exporter but only core dependencies =head1 SYNOPSIS package MyUtils; use base "Exporter::Tiny"; our @EXPORT = qw(frobnicate); sub frobnicate { ... } 1; package MyScript; use MyUtils "frobnicate" => { -as => "frob" }; print frob(42); exit; =head1 DESCRIPTION Exporter::Tiny supports many of Sub::Exporter's external-facing features including renaming imported functions with the C<< -as >>, C<< -prefix >> and C<< -suffix >> options; explicit destinations with the C<< into >> option; and alternative installers with the C<< installer >> option. But it's written in only about 40% as many lines of code and with zero non-core dependencies. Its internal-facing interface is closer to Exporter.pm, with configuration done through the C<< @EXPORT >>, C<< @EXPORT_OK >> and C<< %EXPORT_TAGS >> package variables. If you are trying to B a module that inherits from Exporter::Tiny, then look at: =over =item * L =item * L =back If you are trying to B a module that inherits from Exporter::Tiny, then look at: =over =item * L =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. Simplified interface to this module: L. Less tiny version, with more features: L. Other interesting exporters: L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017, 2022-2023 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Builder.pm000664001750001750 16545114411570357 20363 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/archaic/Testpackage Test::Builder; use 5.006; use strict; use warnings; our $VERSION = '0.98'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) BEGIN { if( $] < 5.008 ) { require Test::Builder::IO::Scalar; } } # Make Test::Builder thread-safe for ithreads. BEGIN { use Config; # Load threads::shared when threads are turned on. # 5.8.0's threads are so busted we no longer support them. if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) { require threads::shared; # Hack around YET ANOTHER threads::shared bug. It would # occasionally forget the contents of the variable when sharing it. # So we first copy the data, then share, then put our copy back. *share = sub (\[$@%]) { my $type = ref $_[0]; my $data; if( $type eq 'HASH' ) { %$data = %{ $_[0] }; } elsif( $type eq 'ARRAY' ) { @$data = @{ $_[0] }; } elsif( $type eq 'SCALAR' ) { $$data = ${ $_[0] }; } else { die( "Unknown type: " . $type ); } $_[0] = &threads::shared::share( $_[0] ); if( $type eq 'HASH' ) { %{ $_[0] } = %$data; } elsif( $type eq 'ARRAY' ) { @{ $_[0] } = @$data; } elsif( $type eq 'SCALAR' ) { ${ $_[0] } = $$data; } else { die( "Unknown type: " . $type ); } return $_[0]; }; } # 5.8.0's threads::shared is busted when threads are off # and earlier Perls just don't have that module at all. else { *share = sub { return $_[0] }; *lock = sub { 0 }; } } =head1 NAME Test::Builder - Backend for building test libraries =head1 SYNOPSIS package My::Test::Module; use base 'Test::Builder::Module'; my $CLASS = __PACKAGE__; sub ok { my($test, $name) = @_; my $tb = $CLASS->builder; $tb->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 a building block upon which to write your own test libraries I. =head2 Construction =over 4 =item B 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 C always returns the same Test::Builder object. No matter how many times you call C, you're getting the same object. This is called a singleton. This is done so that multiple modules share such global information as the test counter and where test output is going. If you want a completely new Test::Builder object different from the singleton, use C. =cut our $Test = Test::Builder->new; sub new { my($class) = shift; $Test ||= $class->create; return $Test; } =item B my $Test = Test::Builder->create; Ok, so there can be more than one Test::Builder object and this is how you get it. You might use this instead of C if you're testing a Test::Builder based module, but otherwise you probably want C. B: the implementation is not complete. C, for example, is still shared amongst B Test::Builder objects, even ones created using this method. Also, the method name may change in the future. =cut sub create { my $class = shift; my $self = bless {}, $class; $self->reset; return $self; } =item B my $child = $builder->child($name_of_child); $child->plan( tests => 4 ); $child->ok(some_code()); ... $child->finalize; Returns a new instance of C. Any output from this child will be indented four spaces more than the parent's indentation. When done, the C method I be called explicitly. Trying to create a new child with a previous child still active (i.e., C not called) will C. Trying to run a test when you have an open child will also C and cause the test suite to fail. =cut sub child { my( $self, $name ) = @_; if( $self->{Child_Name} ) { $self->croak("You already have a child named ($self->{Child_Name}) running"); } my $parent_in_todo = $self->in_todo; # Clear $TODO for the child. my $orig_TODO = $self->find_TODO(undef, 1, undef); my $child = bless {}, ref $self; $child->reset; # Add to our indentation $child->_indent( $self->_indent . ' ' ); $child->{$_} = $self->{$_} foreach qw{Out_FH Todo_FH Fail_FH}; if ($parent_in_todo) { $child->{Fail_FH} = $self->{Todo_FH}; } # This will be reset in finalize. We do this here lest one child failure # cause all children to fail. $child->{Child_Error} = $?; $? = 0; $child->{Parent} = $self; $child->{Parent_TODO} = $orig_TODO; $child->{Name} = $name || "Child of " . $self->name; $self->{Child_Name} = $child->name; return $child; } =item B $builder->subtest($name, \&subtests); See documentation of C in Test::More. =cut sub subtest { my $self = shift; my($name, $subtests) = @_; if ('CODE' ne ref $subtests) { $self->croak("subtest()'s second argument must be a code ref"); } # Turn the child into the parent so anyone who has stored a copy of # the Test::Builder singleton will get the child. my($error, $child, %parent); { # child() calls reset() which sets $Level to 1, so we localize # $Level first to limit the scope of the reset to the subtest. local $Test::Builder::Level = $Test::Builder::Level + 1; $child = $self->child($name); %parent = %$self; %$self = %$child; my $run_the_subtests = sub { $subtests->(); $self->done_testing unless $self->_plan_handled; 1; }; if( !eval { $run_the_subtests->() } ) { $error = $@; } } # Restore the parent and the copied child. %$child = %$self; %$self = %parent; # Restore the parent's $TODO $self->find_TODO(undef, 1, $child->{Parent_TODO}); # Die *after* we restore the parent. die $error if $error and !eval { $error->isa('Test::Builder::Exception') }; local $Test::Builder::Level = $Test::Builder::Level + 1; return $child->finalize; } =begin _private =item B<_plan_handled> if ( $Test->_plan_handled ) { ... } Returns true if the developer has explicitly handled the plan via: =over 4 =item * Explicitly setting the number of tests =item * Setting 'no_plan' =item * Set 'skip_all'. =back This is currently used in subtests when we implicitly call C<< $Test->done_testing >> if the developer has not set a plan. =end _private =cut sub _plan_handled { my $self = shift; return $self->{Have_Plan} || $self->{No_Plan} || $self->{Skip_All}; } =item B my $ok = $child->finalize; When your child is done running tests, you must call C to clean up and tell the parent your pass/fail status. Calling finalize on a child with open children will C. If the child falls out of scope before C is called, a failure diagnostic will be issued and the child is considered to have failed. No attempt to call methods on a child after C is called is guaranteed to succeed. Calling this on the root builder is a no-op. =cut sub finalize { my $self = shift; return unless $self->parent; if( $self->{Child_Name} ) { $self->croak("Can't call finalize() with child ($self->{Child_Name}) active"); } local $? = 0; # don't fail if $subtests happened to set $? nonzero $self->_ending; # XXX This will only be necessary for TAP envelopes (we think) #$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" ); local $Test::Builder::Level = $Test::Builder::Level + 1; my $ok = 1; $self->parent->{Child_Name} = undef; if ( $self->{Skip_All} ) { $self->parent->skip($self->{Skip_All}); } elsif ( not @{ $self->{Test_Results} } ) { $self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name ); } else { $self->parent->ok( $self->is_passing, $self->name ); } $? = $self->{Child_Error}; delete $self->{Parent}; return $self->is_passing; } sub _indent { my $self = shift; if( @_ ) { $self->{Indent} = shift; } return $self->{Indent}; } =item B if ( my $parent = $builder->parent ) { ... } Returns the parent C instance, if any. Only used with child builders for nested TAP. =cut sub parent { shift->{Parent} } =item B diag $builder->name; Returns the name of the current builder. Top level builders default to C<$0> (the name of the executable). Child builders are named via the C method. If no name is supplied, will be named "Child of $parent->name". =cut sub name { shift->{Name} } sub DESTROY { my $self = shift; if ( $self->parent and $$ == $self->{Original_Pid} ) { my $name = $self->name; $self->diag(<<"FAIL"); Child ($name) exited without calling finalize() FAIL $self->parent->{In_Destroy} = 1; $self->parent->ok(0, $name); } } =item B $Test->reset; Reinitializes the Test::Builder singleton to its original state. Mostly useful for tests run in persistent environments where the same test might be run multiple times in the same process. =cut our $Level; sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms) my($self) = @_; # We leave this a global because it has to be localized and localizing # hash keys is just asking for pain. Also, it was documented. $Level = 1; $self->{Name} = $0; $self->is_passing(1); $self->{Ending} = 0; $self->{Have_Plan} = 0; $self->{No_Plan} = 0; $self->{Have_Output_Plan} = 0; $self->{Done_Testing} = 0; $self->{Original_Pid} = $$; $self->{Child_Name} = undef; $self->{Indent} ||= ''; share( $self->{Curr_Test} ); $self->{Curr_Test} = 0; $self->{Test_Results} = &share( [] ); $self->{Exported_To} = undef; $self->{Expected_Tests} = 0; $self->{Skip_All} = 0; $self->{Use_Nums} = 1; $self->{No_Header} = 0; $self->{No_Ending} = 0; $self->{Todo} = undef; $self->{Todo_Stack} = []; $self->{Start_Todo} = 0; $self->{Opened_Testhandles} = 0; $self->_dup_stdhandles; return; } =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 $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 C, don't call any of the other methods below. If a child calls "skip_all" in the plan, a C is thrown. Trap this error, call C and don't run any more tests on the child. my $child = $Test->child('some child'); eval { $child->plan( $condition ? ( skip_all => $reason ) : ( tests => 3 ) ) }; if ( eval { $@->isa('Test::Builder::Exception') } ) { $child->finalize; return; } # run your tests =cut my %plan_cmds = ( no_plan => \&no_plan, skip_all => \&skip_all, tests => \&_plan_tests, ); sub plan { my( $self, $cmd, $arg ) = @_; return unless $cmd; local $Level = $Level + 1; $self->croak("You tried to plan twice") if $self->{Have_Plan}; if( my $method = $plan_cmds{$cmd} ) { local $Level = $Level + 1; $self->$method($arg); } else { my @args = grep { defined } ( $cmd, $arg ); $self->croak("plan() doesn't understand @args"); } return 1; } sub _plan_tests { my($self, $arg) = @_; if($arg) { local $Level = $Level + 1; return $self->expected_tests($arg); } elsif( !defined $arg ) { $self->croak("Got an undefined number of tests"); } else { $self->croak("You said to run 0 tests"); } return; } =item B my $max = $Test->expected_tests; $Test->expected_tests($max); Gets/sets the number of tests we expect this test to run and prints out the appropriate headers. =cut sub expected_tests { my $self = shift; my($max) = @_; if(@_) { $self->croak("Number of tests must be a positive integer. You gave it '$max'") unless $max =~ /^\+?\d+$/; $self->{Expected_Tests} = $max; $self->{Have_Plan} = 1; $self->_output_plan($max) unless $self->no_header; } return $self->{Expected_Tests}; } =item B $Test->no_plan; Declares that this test will run an indeterminate number of tests. =cut sub no_plan { my($self, $arg) = @_; $self->carp("no_plan takes no arguments") if $arg; $self->{No_Plan} = 1; $self->{Have_Plan} = 1; return 1; } =begin private =item B<_output_plan> $tb->_output_plan($max); $tb->_output_plan($max, $directive); $tb->_output_plan($max, $directive => $reason); Handles displaying the test plan. If a C<$directive> and/or C<$reason> are given they will be output with the plan. So here's what skipping all tests looks like: $tb->_output_plan(0, "SKIP", "Because I said so"); It sets C<< $tb->{Have_Output_Plan} >> and will croak if the plan was already output. =end private =cut sub _output_plan { my($self, $max, $directive, $reason) = @_; $self->carp("The plan was already output") if $self->{Have_Output_Plan}; my $plan = "1..$max"; $plan .= " # $directive" if defined $directive; $plan .= " $reason" if defined $reason; $self->_print("$plan\n"); $self->{Have_Output_Plan} = 1; return; } =item B $Test->done_testing(); $Test->done_testing($num_tests); Declares that you are done testing, no more tests will be run after this point. If a plan has not yet been output, it will do so. $num_tests is the number of tests you planned to run. If a numbered plan was already declared, and if this contradicts, a failing test will be run to reflect the planning mistake. If C was declared, this will override. If C is called twice, the second call will issue a failing test. If C<$num_tests> is omitted, the number of tests run will be used, like no_plan. C is, in effect, used when you'd want to use C, but safer. You'd use it like so: $Test->ok($a == $b); $Test->done_testing(); Or to plan a variable number of tests: for my $test (@tests) { $Test->ok($test); } $Test->done_testing(@tests); =cut sub done_testing { my($self, $num_tests) = @_; # If done_testing() specified the number of tests, shut off no_plan. if( defined $num_tests ) { $self->{No_Plan} = 0; } else { $num_tests = $self->current_test; } if( $self->{Done_Testing} ) { my($file, $line) = @{$self->{Done_Testing}}[1,2]; $self->ok(0, "done_testing() was already called at $file line $line"); return; } $self->{Done_Testing} = [caller]; if( $self->expected_tests && $num_tests != $self->expected_tests ) { $self->ok(0, "planned to run @{[ $self->expected_tests ]} ". "but done_testing() expects $num_tests"); } else { $self->{Expected_Tests} = $num_tests; } $self->_output_plan($num_tests) unless $self->{Have_Output_Plan}; $self->{Have_Plan} = 1; # The wrong number of tests were run $self->is_passing(0) if $self->{Expected_Tests} != $self->{Curr_Test}; # No tests were run $self->is_passing(0) if $self->{Curr_Test} == 0; return 1; } =item B $plan = $Test->has_plan Find out whether a plan has been defined. C<$plan> is either C (no plan has been set), C (indeterminate # of tests) or an integer (the number of expected tests). =cut sub has_plan { my $self = shift; return( $self->{Expected_Tests} ) if $self->{Expected_Tests}; return('no_plan') if $self->{No_Plan}; return(undef); } =item B $Test->skip_all; $Test->skip_all($reason); Skips all the tests, using the given C<$reason>. Exits immediately with 0. =cut sub skip_all { my( $self, $reason ) = @_; $self->{Skip_All} = $self->parent ? $reason : 1; $self->_output_plan(0, "SKIP", $reason) unless $self->no_header; if ( $self->parent ) { die bless {} => 'Test::Builder::Exception'; } exit(0); } =item B my $pack = $Test->exported_to; $Test->exported_to($pack); Tells Test::Builder what package you exported your functions to. This method isn't terribly useful since modules which share the same Test::Builder object might get exported to different packages and only the last one will be honored. =cut sub exported_to { my( $self, $pack ) = @_; if( defined $pack ) { $self->{Exported_To} = $pack; } return $self->{Exported_To}; } =back =head2 Running tests These actually run the tests, analogous to the functions in Test::More. They all return true if the test passed, false if the test failed. C<$name> is always optional. =over 4 =item B $Test->ok($test, $name); Your basic test. Pass if C<$test> is true, fail if $test is false. Just like Test::Simple's C. =cut sub ok { my( $self, $test, $name ) = @_; if ( $self->{Child_Name} and not $self->{In_Destroy} ) { $name = 'unnamed test' unless defined $name; $self->is_passing(0); $self->croak("Cannot run test ($name) with active children"); } # $test might contain an object which we don't want to accidentally # store, so we turn it into a boolean. $test = $test ? 1 : 0; lock $self->{Curr_Test}; $self->{Curr_Test}++; # In case $name is a string overloaded object, force it to stringify. $self->_unoverload_str( \$name ); $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 # Capture the value of $TODO for the rest of this ok() call # so it can more easily be found by other routines. my $todo = $self->todo(); my $in_todo = $self->in_todo; local $self->{Todo} = $todo if $in_todo; $self->_unoverload_str( \$todo ); my $out; my $result = &share( {} ); unless($test) { $out .= "not "; @$result{ 'ok', 'actual_ok' } = ( ( $self->in_todo ? 1 : 0 ), 0 ); } else { @$result{ 'ok', 'actual_ok' } = ( 1, $test ); } $out .= "ok"; $out .= " $self->{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( $self->in_todo ) { $out .= " # TODO $todo"; $result->{reason} = $todo; $result->{type} = 'todo'; } else { $result->{reason} = ''; $result->{type} = ''; } $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = $result; $out .= "\n"; $self->_print($out); unless($test) { my $msg = $self->in_todo ? "Failed (TODO)" : "Failed"; $self->_print_to_fh( $self->_diag_fh, "\n" ) if $ENV{HARNESS_ACTIVE}; my( undef, $file, $line ) = $self->caller; if( defined $name ) { $self->diag(qq[ $msg test '$name'\n]); $self->diag(qq[ at $file line $line.\n]); } else { $self->diag(qq[ $msg test at $file line $line.\n]); } } $self->is_passing(0) unless $test || $self->in_todo; # Check that we haven't violated the plan $self->_check_is_passing_plan(); return $test ? 1 : 0; } # Check that we haven't yet violated the plan and set # is_passing() accordingly sub _check_is_passing_plan { my $self = shift; my $plan = $self->has_plan; return unless defined $plan; # no plan yet defined return unless $plan !~ /\D/; # no numeric plan $self->is_passing(0) if $plan < $self->{Curr_Test}; } sub _unoverload { my $self = shift; my $type = shift; $self->_try(sub { require overload; }, die_on_fail => 1); foreach my $thing (@_) { if( $self->_is_object($$thing) ) { if( my $string_meth = overload::Method( $$thing, $type ) ) { $$thing = $$thing->$string_meth(); } } } return; } sub _is_object { my( $self, $thing ) = @_; return $self->_try( sub { ref $thing && $thing->isa('UNIVERSAL') } ) ? 1 : 0; } sub _unoverload_str { my $self = shift; return $self->_unoverload( q[""], @_ ); } sub _unoverload_num { my $self = shift; $self->_unoverload( '0+', @_ ); for my $val (@_) { next unless $self->_is_dualvar($$val); $$val = $$val + 0; } return; } # This is a hack to detect a dualvar such as $! sub _is_dualvar { my( $self, $val ) = @_; # Objects are not dualvars. return 0 if ref $val; no warnings 'numeric'; my $numval = $val + 0; return $numval != 0 and $numval ne $val ? 1 : 0; } =item B $Test->is_eq($got, $expected, $name); Like Test::More's C. Checks if C<$got eq $expected>. This is the string version. C only ever matches another C. =item B $Test->is_num($got, $expected, $name); Like Test::More's C. Checks if C<$got == $expected>. This is the numeric version. C only ever matches another C. =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 _diag_fmt { my( $self, $type, $val ) = @_; if( defined $$val ) { if( $type eq 'eq' or $type eq 'ne' ) { # quote and force string context $$val = "'$$val'"; } else { # force numeric context $self->_unoverload_num($val); } } else { $$val = 'undef'; } return; } sub _is_diag { my( $self, $got, $type, $expect ) = @_; $self->_diag_fmt( $type, $_ ) for \$got, \$expect; local $Level = $Level + 1; return $self->diag(<<"DIAGNOSTIC"); got: $got expected: $expect DIAGNOSTIC } sub _isnt_diag { my( $self, $got, $type ) = @_; $self->_diag_fmt( $type, \$got ); local $Level = $Level + 1; return $self->diag(<<"DIAGNOSTIC"); got: $got expected: anything else DIAGNOSTIC } =item B $Test->isnt_eq($got, $dont_expect, $name); Like Test::More's C. Checks if C<$got ne $dont_expect>. This is the string version. =item B $Test->isnt_num($got, $dont_expect, $name); Like Test::More's C. Checks if C<$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->_isnt_diag( $got, 'ne' ) 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->_isnt_diag( $got, '!=' ) unless $test; return $test; } return $self->cmp_ok( $got, '!=', $dont_expect, $name ); } =item B $Test->like($this, qr/$regex/, $name); $Test->like($this, '/$regex/', $name); Like Test::More's C. Checks if $this matches the given C<$regex>. =item B $Test->unlike($this, qr/$regex/, $name); $Test->unlike($this, '/$regex/', $name); Like Test::More's C. Checks if $this B the given C<$regex>. =cut sub like { my( $self, $this, $regex, $name ) = @_; local $Level = $Level + 1; return $self->_regex_ok( $this, $regex, '=~', $name ); } sub unlike { my( $self, $this, $regex, $name ) = @_; local $Level = $Level + 1; return $self->_regex_ok( $this, $regex, '!~', $name ); } =item B $Test->cmp_ok($this, $type, $that, $name); Works just like Test::More's C. $Test->cmp_ok($big_num, '!=', $other_big_num); =cut my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" ); sub cmp_ok { my( $self, $got, $type, $expect, $name ) = @_; my $test; my $error; { ## no critic (BuiltinFunctions::ProhibitStringyEval) local( $@, $!, $SIG{__DIE__} ); # isolate eval my($pack, $file, $line) = $self->caller(); # This is so that warnings come out at the caller's level $test = eval qq[ #line $line "(eval in cmp_ok) $file" \$got $type \$expect; ]; $error = $@; } local $Level = $Level + 1; my $ok = $self->ok( $test, $name ); # Treat overloaded objects as numbers if we're asked to do a # numeric comparison. my $unoverload = $numeric_cmps{$type} ? '_unoverload_num' : '_unoverload_str'; $self->diag(<<"END") if $error; An error occurred while using $type: ------------------------------------ $error ------------------------------------ END unless($ok) { $self->$unoverload( \$got, \$expect ); if( $type =~ /^(eq|==)$/ ) { $self->_is_diag( $got, $type, $expect ); } elsif( $type =~ /^(ne|!=)$/ ) { $self->_isnt_diag( $got, $type ); } 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'; local $Level = $Level + 1; return $self->diag(<<"DIAGNOSTIC"); $got $type $expect DIAGNOSTIC } sub _caller_context { my $self = shift; my( $pack, $file, $line ) = $self->caller(1); my $code = ''; $code .= "#line $line $file\n" if defined $file and defined $line; return $code; } =back =head2 Other Testing Methods These are methods which are used in the course of writing a test but are not themselves tests. =over 4 =item B $Test->BAIL_OUT($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 BAIL_OUT { my( $self, $reason ) = @_; $self->{Bailed_Out} = 1; $self->_print("Bail out! $reason"); exit 255; } =for deprecated BAIL_OUT() used to be BAILOUT() =cut { no warnings 'once'; *BAILOUT = \&BAIL_OUT; } =item B $Test->skip; $Test->skip($why); Skips the current test, reporting C<$why>. =cut sub skip { my( $self, $why ) = @_; $why ||= ''; $self->_unoverload_str( \$why ); lock( $self->{Curr_Test} ); $self->{Curr_Test}++; $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share( { 'ok' => 1, actual_ok => 1, name => '', type => 'skip', reason => $why, } ); my $out = "ok"; $out .= " $self->{Curr_Test}" if $self->use_numbers; $out .= " # skip"; $out .= " $why" if length $why; $out .= "\n"; $self->_print($out); return 1; } =item B $Test->todo_skip; $Test->todo_skip($why); Like C, 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 ||= ''; lock( $self->{Curr_Test} ); $self->{Curr_Test}++; $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share( { 'ok' => 1, actual_ok => 0, name => '', type => 'todo_skip', reason => $why, } ); my $out = "not ok"; $out .= " $self->{Curr_Test}" if $self->use_numbers; $out .= " # TODO & SKIP $why\n"; $self->_print($out); return 1; } =begin _unimplemented =item B $Test->skip_rest; $Test->skip_rest($reason); Like C, only it skips all the rest of the tests you plan to run and terminates the test. If you're running under C, it skips once and terminates the test. =end _unimplemented =back =head2 Test building utility methods These methods are useful when writing your own test methods. =over 4 =item B $Test->maybe_regex(qr/$regex/); $Test->maybe_regex('/$regex/'); This method used to be useful back when Test::Builder worked on Perls before 5.6 which didn't have qr//. Now its pretty useless. Convenience method for building testing functions that take regular expressions as arguments. Takes a quoted regular expression produced by C, or a string representing a regular expression. Returns a Perl value which may be used instead of the corresponding regular expression, or C if its argument is not recognised. For example, a version of C, 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; return $usable_regex unless defined $regex; my( $re, $opts ); # Check for qr/foo/ if( _is_qr($regex) ) { $usable_regex = $regex; } # Check for '/foo/' or 'm,foo,' elsif(( $re, $opts ) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or ( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx ) { $usable_regex = length $opts ? "(?$opts)$re" : $re; } return $usable_regex; } sub _is_qr { my $regex = shift; # is_regexp() checks for regexes in a robust manner, say if they're # blessed. return re::is_regexp($regex) if defined &re::is_regexp; return ref $regex eq 'Regexp'; } sub _regex_ok { my( $self, $this, $regex, $cmp, $name ) = @_; my $ok = 0; my $usable_regex = $self->maybe_regex($regex); unless( defined $usable_regex ) { local $Level = $Level + 1; $ok = $self->ok( 0, $name ); $self->diag(" '$regex' doesn't look much like a regex to me."); return $ok; } { ## no critic (BuiltinFunctions::ProhibitStringyEval) my $test; my $context = $self->_caller_context; local( $@, $!, $SIG{__DIE__} ); # isolate eval $test = eval $context . q{$test = $this =~ /$usable_regex/ ? 1 : 0}; $test = !$test if $cmp eq '!~'; local $Level = $Level + 1; $ok = $self->ok( $test, $name ); } unless($ok) { $this = defined $this ? "'$this'" : 'undef'; my $match = $cmp eq '=~' ? "doesn't match" : "matches"; local $Level = $Level + 1; $self->diag( sprintf <<'DIAGNOSTIC', $this, $match, $regex ); %s %13s '%s' DIAGNOSTIC } return $ok; } # I'm not ready to publish this. It doesn't deal with array return # values from the code or context. =begin private =item B<_try> my $return_from_code = $Test->try(sub { code }); my($return_from_code, $error) = $Test->try(sub { code }); Works like eval BLOCK except it ensures it has no effect on the rest of the test (ie. C<$@> is not set) nor is effected by outside interference (ie. C<$SIG{__DIE__}>) and works around some quirks in older Perls. C<$error> is what would normally be in C<$@>. It is suggested you use this in place of eval BLOCK. =cut sub _try { my( $self, $code, %opts ) = @_; my $error; my $return; { local $!; # eval can mess up $! local $@; # don't set $@ in the test local $SIG{__DIE__}; # don't trip an outside DIE handler. $return = eval { $code->() }; $error = $@; } die $error if $error and $opts{die_on_fail}; return wantarray ? ( $return, $error ) : $return; } =end private =item B my $is_fh = $Test->is_fh($thing); Determines if the given C<$thing> can be used as a filehandle. =cut sub is_fh { my $self = shift; my $maybe_fh = shift; return 0 unless defined $maybe_fh; return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob return eval { $maybe_fh->isa("IO::Handle") } || eval { tied($maybe_fh)->can('TIEHANDLE') }; } =back =head2 Test style =over 4 =item B $Test->level($how_high); How far up the call stack should C<$Test> look when reporting where the test failed. Defaults to 1. Setting L<$Test::Builder::Level> overrides. This is typically useful localized: sub my_ok { my $test = shift; local $Test::Builder::Level = $Test::Builder::Level + 1; $TB->ok($test); } To be polite to other functions wrapping your own you usually want to increment C<$Level> rather than set it to a constant. =cut sub level { my( $self, $level ) = @_; if( defined $level ) { $Level = $level; } return $Level; } =item B $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. Defaults to on. =cut sub use_numbers { my( $self, $use_nums ) = @_; if( defined $use_nums ) { $self->{Use_Nums} = $use_nums; } return $self->{Use_Nums}; } =item B $Test->no_diag($no_diag); If set true no diagnostics will be printed. This includes calls to C. =item B $Test->no_ending($no_ending); Normally, Test::Builder does some extra diagnostics when the test ends. It also changes the exit code as described below. If this is true, none of that will be done. =item B $Test->no_header($no_header); If set to true, no "1..N" header will be printed. =cut foreach my $attribute (qw(No_Header No_Ending No_Diag)) { my $method = lc $attribute; my $code = sub { my( $self, $no ) = @_; if( defined $no ) { $self->{$attribute} = $no; } return $self->{$attribute}; }; no strict 'refs'; ## no critic *{ __PACKAGE__ . '::' . $method } = $code; } =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 $Test->diag(@msgs); Prints out the given C<@msgs>. Like C, arguments are simply appended together. Normally, it uses the C handle, but if this is for a TODO test, the C 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 C is often used in conjunction with a failing test (C) it "passes through" the failure. return ok(...) || diag(...); =for blame transfer Mark Fowler =cut sub diag { my $self = shift; $self->_print_comment( $self->_diag_fh, @_ ); } =item B $Test->note(@msgs); Like C, but it prints to the C handle so it will not normally be seen by the user except in verbose mode. =cut sub note { my $self = shift; $self->_print_comment( $self->output, @_ ); } sub _diag_fh { my $self = shift; local $Level = $Level + 1; return $self->in_todo ? $self->todo_output : $self->failure_output; } sub _print_comment { my( $self, $fh, @msgs ) = @_; return if $self->no_diag; return unless @msgs; # Prevent printing headers when compiling (i.e. -c) return if $^C; # Smash args together like print does. # Convert undef to 'undef' so its readable. my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs; # Escape the beginning, _print will take care of the rest. $msg =~ s/^/# /; local $Level = $Level + 1; $self->_print_to_fh( $fh, $msg ); return 0; } =item B my @dump = $Test->explain(@msgs); Will dump the contents of any references in a human readable format. Handy for things like... is_deeply($have, $want) || diag explain $have; or is_deeply($have, $want) || note explain $have; =cut sub explain { my $self = shift; return map { ref $_ ? do { $self->_try(sub { require Data::Dumper }, die_on_fail => 1); my $dumper = Data::Dumper->new( [$_] ); $dumper->Indent(1)->Terse(1); $dumper->Sortkeys(1) if $dumper->can("Sortkeys"); $dumper->Dump; } : $_ } @_; } =begin _private =item B<_print> $Test->_print(@msgs); Prints to the C filehandle. =end _private =cut sub _print { my $self = shift; return $self->_print_to_fh( $self->output, @_ ); } sub _print_to_fh { my( $self, $fh, @msgs ) = @_; # Prevent printing headers when only compiling. Mostly for when # tests are deparsed with B::Deparse return if $^C; my $msg = join '', @msgs; my $indent = $self->_indent; local( $\, $", $, ) = ( undef, ' ', '' ); # Escape each line after the first with a # so we don't # confuse Test::Harness. $msg =~ s{\n(?!\z)}{\n$indent# }sg; # Stick a newline on the end if it needs it. $msg .= "\n" unless $msg =~ /\n\z/; return print $fh $indent, $msg; } =item B =item B =item B my $filehandle = $Test->output; $Test->output($filehandle); $Test->output($filename); $Test->output(\$scalar); These methods control where Test::Builder will print its output. They take either an open C<$filehandle>, a C<$filename> to open and write to or a C<$scalar> reference to append to. It will always return a C<$filehandle>. B is where normal "ok/not ok" test output goes. Defaults to STDOUT. B is where diagnostic output on test failures and C goes. It is normally not read by Test::Harness and instead is displayed to the user. Defaults to STDERR. C is used instead of C for the diagnostics of a failing TODO test. These will not be seen by the user. Defaults to STDOUT. =cut sub output { my( $self, $fh ) = @_; if( defined $fh ) { $self->{Out_FH} = $self->_new_fh($fh); } return $self->{Out_FH}; } sub failure_output { my( $self, $fh ) = @_; if( defined $fh ) { $self->{Fail_FH} = $self->_new_fh($fh); } return $self->{Fail_FH}; } sub todo_output { my( $self, $fh ) = @_; if( defined $fh ) { $self->{Todo_FH} = $self->_new_fh($fh); } return $self->{Todo_FH}; } sub _new_fh { my $self = shift; my($file_or_fh) = shift; my $fh; if( $self->is_fh($file_or_fh) ) { $fh = $file_or_fh; } elsif( ref $file_or_fh eq 'SCALAR' ) { # Scalar refs as filehandles was added in 5.8. if( $] >= 5.008 ) { open $fh, ">>", $file_or_fh or $self->croak("Can't open scalar ref $file_or_fh: $!"); } # Emulate scalar ref filehandles with a tie. else { $fh = Test::Builder::IO::Scalar->new($file_or_fh) or $self->croak("Can't tie scalar ref $file_or_fh"); } } else { open $fh, ">", $file_or_fh or $self->croak("Can't open test output log $file_or_fh: $!"); _autoflush($fh); } return $fh; } sub _autoflush { my($fh) = shift; my $old_fh = select $fh; $| = 1; select $old_fh; return; } my( $Testout, $Testerr ); sub _dup_stdhandles { my $self = shift; $self->_open_testhandles; # 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 ); $self->reset_outputs; return; } sub _open_testhandles { my $self = shift; return if $self->{Opened_Testhandles}; # 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: $!"; $self->_copy_io_layers( \*STDOUT, $Testout ); $self->_copy_io_layers( \*STDERR, $Testerr ); $self->{Opened_Testhandles} = 1; return; } sub _copy_io_layers { my( $self, $src, $dst ) = @_; $self->_try( sub { require PerlIO; my @src_layers = PerlIO::get_layers($src); _apply_layers($dst, @src_layers) if @src_layers; } ); return; } sub _apply_layers { my ($fh, @layers) = @_; my %seen; my @unique = grep { $_ ne 'unix' and !$seen{$_}++ } @layers; binmode($fh, join(":", "", "raw", @unique)); } =item reset_outputs $tb->reset_outputs; Resets all the output filehandles back to their defaults. =cut sub reset_outputs { my $self = shift; $self->output ($Testout); $self->failure_output($Testerr); $self->todo_output ($Testout); return; } =item carp $tb->carp(@message); Warns with C<@message> but the message will appear to come from the point where the original test function was called (C<< $tb->caller >>). =item croak $tb->croak(@message); Dies with C<@message> but the message will appear to come from the point where the original test function was called (C<< $tb->caller >>). =cut sub _message_at_caller { my $self = shift; local $Level = $Level + 1; my( $pack, $file, $line ) = $self->caller; return join( "", @_ ) . " at $file line $line.\n"; } sub carp { my $self = shift; return warn $self->_message_at_caller(@_); } sub croak { my $self = shift; return die $self->_message_at_caller(@_); } =back =head2 Test Status and Info =over 4 =item B my $curr_test = $Test->current_test; $Test->current_test($num); Gets/sets the current test number we're on. You usually shouldn't have to set this. If set forward, the details of the missing tests are filled in as 'unknown'. if set backward, the details of the intervening tests are deleted. You can erase history if you really want to. =cut sub current_test { my( $self, $num ) = @_; lock( $self->{Curr_Test} ); if( defined $num ) { $self->{Curr_Test} = $num; # If the test counter is being pushed forward fill in the details. my $test_results = $self->{Test_Results}; if( $num > @$test_results ) { my $start = @$test_results ? @$test_results : 0; for( $start .. $num - 1 ) { $test_results->[$_] = &share( { 'ok' => 1, actual_ok => undef, reason => 'incrementing test number', type => 'unknown', name => undef } ); } } # If backward, wipe history. Its their funeral. elsif( $num < @$test_results ) { $#{$test_results} = $num - 1; } } return $self->{Curr_Test}; } =item B my $ok = $builder->is_passing; Indicates if the test suite is currently passing. More formally, it will be false if anything has happened which makes it impossible for the test suite to pass. True otherwise. For example, if no tests have run C will be true because even though a suite with no tests is a failure you can add a passing test to it and start passing. Don't think about it too much. =cut sub is_passing { my $self = shift; if( @_ ) { $self->{Is_Passing} = shift; } return $self->{Is_Passing}; } =item B 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'} } @{ $self->{Test_Results} }; } =item B
my @tests = $Test->details; Like C, 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 C is changed. In these cases, Test::Builder doesn't know the result of the test, so its type is 'unknown'. These details for these tests are filled in. They are considered ok, but the name and actual_ok is left C. 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 its todo actual_ok => 0, # in absolute terms, it failed name => 'hole count', type => 'todo', reason => 'insufficient donuts' }; =cut sub details { my $self = shift; return @{ $self->{Test_Results} }; } =item B my $todo_reason = $Test->todo; my $todo_reason = $Test->todo($pack); If the current tests are considered "TODO" it will return the reason, if any. This reason can come from a C<$TODO> variable or the last call to C. Since a TODO test does not need a reason, this function can return an empty string even when inside a TODO block. Use C<< $Test->in_todo >> to determine if you are currently inside a TODO block. C is about finding the right package to look for C<$TODO> in. It's pretty good at guessing the right package to look at. It first looks for the caller based on C<$Level + 1>, since C is usually called inside a test function. As a last resort it will use C. Sometimes there is some confusion about where todo() should be looking for the C<$TODO> variable. If you want to be sure, tell it explicitly what $pack to use. =cut sub todo { my( $self, $pack ) = @_; return $self->{Todo} if defined $self->{Todo}; local $Level = $Level + 1; my $todo = $self->find_TODO($pack); return $todo if defined $todo; return ''; } =item B my $todo_reason = $Test->find_TODO(); my $todo_reason = $Test->find_TODO($pack); Like C but only returns the value of C<$TODO> ignoring C. Can also be used to set C<$TODO> to a new value while returning the old value: my $old_reason = $Test->find_TODO($pack, 1, $new_reason); =cut sub find_TODO { my( $self, $pack, $set, $new_value ) = @_; $pack = $pack || $self->caller(1) || $self->exported_to; return unless $pack; no strict 'refs'; ## no critic my $old_value = ${ $pack . '::TODO' }; $set and ${ $pack . '::TODO' } = $new_value; return $old_value; } =item B my $in_todo = $Test->in_todo; Returns true if the test is currently inside a TODO block. =cut sub in_todo { my $self = shift; local $Level = $Level + 1; return( defined $self->{Todo} || $self->find_TODO ) ? 1 : 0; } =item B $Test->todo_start(); $Test->todo_start($message); This method allows you declare all subsequent tests as TODO tests, up until the C method has been called. The C and C<$TODO> syntax is generally pretty good about figuring out whether or not we're in a TODO test. However, often we find that this is not possible to determine (such as when we want to use C<$TODO> but the tests are being executed in other packages which can't be inferred beforehand). Note that you can use this to nest "todo" tests $Test->todo_start('working on this'); # lots of code $Test->todo_start('working on that'); # more code $Test->todo_end; $Test->todo_end; This is generally not recommended, but large testing systems often have weird internal needs. We've tried to make this also work with the TODO: syntax, but it's not guaranteed and its use is also discouraged: TODO: { local $TODO = 'We have work to do!'; $Test->todo_start('working on this'); # lots of code $Test->todo_start('working on that'); # more code $Test->todo_end; $Test->todo_end; } Pick one style or another of "TODO" to be on the safe side. =cut sub todo_start { my $self = shift; my $message = @_ ? shift : ''; $self->{Start_Todo}++; if( $self->in_todo ) { push @{ $self->{Todo_Stack} } => $self->todo; } $self->{Todo} = $message; return; } =item C $Test->todo_end; Stops running tests as "TODO" tests. This method is fatal if called without a preceding C method call. =cut sub todo_end { my $self = shift; if( !$self->{Start_Todo} ) { $self->croak('todo_end() called without todo_start()'); } $self->{Start_Todo}--; if( $self->{Start_Todo} && @{ $self->{Todo_Stack} } ) { $self->{Todo} = pop @{ $self->{Todo_Stack} }; } else { delete $self->{Todo}; } return; } =item B my $package = $Test->caller; my($pack, $file, $line) = $Test->caller; my($pack, $file, $line) = $Test->caller($height); Like the normal C, except it reports according to your C. C<$height> will be added to the C. If C winds up off the top of the stack it report the highest context. =cut sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms) my( $self, $height ) = @_; $height ||= 0; my $level = $self->level + $height + 1; my @caller; do { @caller = CORE::caller( $level ); $level--; } until @caller; return wantarray ? @caller : $caller[0]; } =back =cut =begin _private =over 4 =item B<_sanity_check> $self->_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 { my $self = shift; $self->_whoa( $self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!' ); $self->_whoa( $self->{Curr_Test} != @{ $self->{Test_Results} }, 'Somehow you got a different number of results than tests ran!' ); return; } =item B<_whoa> $self->_whoa($check, $description); A sanity check, similar to C. If the C<$check> is true, something has gone horribly wrong. It will die with the given C<$description> and a note to contact the author. =cut sub _whoa { my( $self, $check, $desc ) = @_; if($check) { local $Level = $Level + 1; $self->croak(<<"WHOA"); WHOA! $desc This should never happen! Please contact the author immediately! WHOA } return; } =item B<_my_exit> _my_exit($exit_num); Perl seems to have some trouble with exiting inside an C block. 5.6.1 does some odd things. Instead, this function edits C<$?> directly. It should B be called from inside an C block. It doesn't actually exit, that's your job. =cut sub _my_exit { $? = $_[0]; ## no critic (Variables::RequireLocalizedPunctuationVars) return 1; } =back =end _private =cut sub _ending { my $self = shift; return if $self->no_ending; return if $self->{Ending}++; my $real_exit_code = $?; # Don't bother with an ending if this is a forked copy. Only the parent # should do the ending. if( $self->{Original_Pid} != $$ ) { return; } # Ran tests but never declared a plan or hit done_testing if( !$self->{Have_Plan} and $self->{Curr_Test} ) { $self->is_passing(0); $self->diag("Tests were run but no plan was declared and done_testing() was not seen."); } # Exit if plan() was never called. This is so "require Test::Simple" # doesn't puke. if( !$self->{Have_Plan} ) { return; } # Don't do an ending if we bailed out. if( $self->{Bailed_Out} ) { $self->is_passing(0); return; } # Figure out if we passed or failed and print helpful messages. my $test_results = $self->{Test_Results}; if(@$test_results) { # The plan? We have no plan. if( $self->{No_Plan} ) { $self->_output_plan($self->{Curr_Test}) unless $self->no_header; $self->{Expected_Tests} = $self->{Curr_Test}; } # Auto-extended arrays and elements which aren't explicitly # filled in with a shared reference will puke under 5.8.0 # ithreads. So we have to fill them in by hand. :( my $empty_result = &share( {} ); for my $idx ( 0 .. $self->{Expected_Tests} - 1 ) { $test_results->[$idx] = $empty_result unless defined $test_results->[$idx]; } my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ]; my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests}; if( $num_extra != 0 ) { my $s = $self->{Expected_Tests} == 1 ? '' : 's'; $self->diag(<<"FAIL"); Looks like you planned $self->{Expected_Tests} test$s but ran $self->{Curr_Test}. FAIL $self->is_passing(0); } if($num_failed) { my $num_tests = $self->{Curr_Test}; my $s = $num_failed == 1 ? '' : 's'; my $qualifier = $num_extra == 0 ? '' : ' run'; $self->diag(<<"FAIL"); Looks like you failed $num_failed test$s of $num_tests$qualifier. FAIL $self->is_passing(0); } if($real_exit_code) { $self->diag(<<"FAIL"); Looks like your test exited with $real_exit_code just after $self->{Curr_Test}. FAIL $self->is_passing(0); _my_exit($real_exit_code) && return; } my $exit_code; if($num_failed) { $exit_code = $num_failed <= 254 ? $num_failed : 254; } elsif( $num_extra != 0 ) { $exit_code = 255; } else { $exit_code = 0; } _my_exit($exit_code) && return; } elsif( $self->{Skip_All} ) { _my_exit(0) && return; } elsif($real_exit_code) { $self->diag(<<"FAIL"); Looks like your test exited with $real_exit_code before it could output anything. FAIL $self->is_passing(0); _my_exit($real_exit_code) && return; } else { $self->diag("No tests run!\n"); $self->is_passing(0); _my_exit(255) && return; } $self->is_passing(0); $self->_whoa( 1, "We fell off the end of _ending()" ); } END { $Test->_ending if defined $Test; } =head1 EXIT CODES If all your tests passed, Test::Builder 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::Builder 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 or all passed but wrong # of tests run any other number how many failed (including missing or extras) If you fail more than 254 tests, it will be reported as 254. =head1 THREADS In perl 5.8.1 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 C they will all be effected. While versions earlier than 5.8.1 had threads they contain too many bugs to support. Test::Builder is only thread-aware if threads.pm is loaded I Test::Builder. =head1 MEMORY An informative hash, accessible via C<>, is stored for each test you perform. So memory usage will scale linearly with each test run. Although this is not a problem for most test suites, it can become an issue if you do large (hundred thousands to million) combinatorics tests in the same run. In such cases, you are advised to either split the test file into smaller ones, or use a reverse approach, doing "normal" (code) compares and triggering fail() should anything go unexpected. Future versions of Test::Builder will have a way to turn history off. =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 Eschwern@pobox.comE =head1 COPYRIGHT Copyright 2002-2008 by chromatic Echromatic@wgz.orgE and Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; More.pm000664001750001750 13313614411570357 17672 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/archaic/Testpackage Test::More; use 5.006; use strict; use warnings; #---- perlcritic exemptions. ----# # We use a lot of subroutine prototypes ## no critic (Subroutines::ProhibitSubroutinePrototypes) # 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 ]; return warn @_, " at $file line $line\n"; } our $VERSION = '0.98'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); our @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 done_testing can_ok isa_ok new_ok diag note explain subtest BAIL_OUT ); =head1 NAME Test::More - yet another framework for writing test scripts =head1 SYNOPSIS use Test::More tests => 23; # or use Test::More skip_all => $reason; # or use Test::More; # see done_testing() BEGIN { use_ok( 'Some::Module' ); } require_ok( 'Some::Module' ); # Various ways to say "ok" ok($got eq $expected, $test_name); is ($got, $expected, $test_name); isnt($got, $expected, $test_name); # Rather than print STDERR "# here's what went wrong\n" diag("here's what went wrong"); like ($got, qr/expected/, $test_name); unlike($got, qr/expected/, $test_name); cmp_ok($got, '==', $expected, $test_name); is_deeply($got_complex_structure, $expected_complex_structure, $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); BAIL_OUT($why); # UNIMPLEMENTED!!! my @status = Test::More::status; =head1 DESCRIPTION B If you're just getting started writing tests, have a look at L 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 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 tests => 23; There are cases when you will not know beforehand how many tests your script is going to run. In this case, you can declare your tests at the end. use Test::More; ... run your tests ... done_testing( $number_of_tests_run ); Sometimes you really don't know how many tests were run, or it's too difficult to calculate. In which case you can leave off $number_of_tests_run. 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 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 $tb = Test::More->builder; return $tb->plan(@_); } # This implements "use Test::More 'no_diag'" but the behavior is # deprecated. sub import_extra { my $class = shift; my $list = shift; my @other = (); my $idx = 0; while( $idx <= $#{$list} ) { my $item = $list->[$idx]; if( defined $item and $item eq 'no_diag' ) { $class->builder->no_diag(1); } else { push @other, $item; } $idx++; } @$list = @other; return; } =over 4 =item B done_testing(); done_testing($number_of_tests); If you don't know how many tests you're going to run, you can issue the plan when you're done running tests. $number_of_tests is the same as plan(), it's the number of tests you expected to run. You can omit this, in which case the number of tests you ran doesn't matter, just the fact that your tests ran to conclusion. This is safer than and replaces the "no_plan" plan. =back =cut sub done_testing { my $tb = Test::More->builder; $tb->done_testing(@_); } =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($got eq $expected, $test_name); This simply evaluates any expression (C<$got eq $expected> 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 strongly encourage its use. Should an ok() fail, it will produce some diagnostics: not ok 18 - sufficient mucus # Failed test 'sufficient mucus' # in foo.t at line 42. This is the same as Test::Simple's ok() routine. =cut sub ok ($;$) { my( $test, $name ) = @_; my $tb = Test::More->builder; return $tb->ok( $test, $name ); } =item B =item B is ( $got, $expected, $test_name ); isnt( $got, $expected, $test_name ); Similar to ok(), is() and isnt() compare their two arguments with C and C 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" ); C will only ever match C. So you can test a value agains C like this: is($not_defined, undef, "undefined as expected"); (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 'Is foo the same as bar?' # in 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! is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' ); This does not check if C is true, it checks if it returns 1. Very different. Similar caveats exist for false and 0. In these cases, use ok(). ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' ); A simple call to isnt() usually does not provide a strong test but there are cases when you cannot say much more about a value than that it is different from some other value: new_ok $obj, "Foo"; my $clone = $obj->clone; isa_ok $obj, "Foo", "Foo->clone"; isnt $obj, $clone, "clone() produces a different object"; For those grammatical pedants out there, there's an C function which is an alias of isnt(). =cut sub is ($$;$) { my $tb = Test::More->builder; return $tb->is_eq(@_); } sub isnt ($$;$) { my $tb = Test::More->builder; return $tb->isnt_eq(@_); } *isn't = \&isnt; =item B like( $got, qr/expected/, $test_name ); Similar to ok(), like() matches $got against the regex C. So this: like($got, qr/expected/, 'this is like that'); is similar to: ok( $got =~ /expected/, '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) or (for better compatibility with older perls) as a string that looks like a regex (alternative delimiters are currently not supported): like( $got, '/expected/', 'this is like that' ); Regex options may be placed on the end (C<'/expected/i'>). Its advantages over ok() are similar to that of is() and isnt(). Better diagnostics on failure. =cut sub like ($$;$) { my $tb = Test::More->builder; return $tb->like(@_); } =item B unlike( $got, qr/expected/, $test_name ); Works exactly as like(), only it checks if $got B match the given pattern. =cut sub unlike ($$;$) { my $tb = Test::More->builder; return $tb->unlike(@_); } =item B cmp_ok( $got, $op, $expected, $test_name ); Halfway between ok() and is() lies cmp_ok(). This allows you to compare two arguments using any binary perl operator. # ok( $got eq $expected ); cmp_ok( $got, 'eq', $expected, 'this eq that' ); # ok( $got == $expected ); cmp_ok( $got, '==', $expected, 'this == that' ); # ok( $got && $expected ); cmp_ok( $got, '&&', $expected, 'this && that' ); ...etc... Its advantage over ok() is when the test fails you'll know what $got and $expected were: not ok 1 # Failed test in 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 will interfere: cmp_ok( $big_hairy_number, '==', $another_big_hairy_number ); It's especially useful when comparing greater-than or smaller-than relation between values: cmp_ok( $some_value, '<=', $upper_limit ); =cut sub cmp_ok($$$;$) { my $tb = Test::More->builder; return $tb->cmp_ok(@_); } =item B 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; my $tb = Test::More->builder; unless($class) { my $ok = $tb->ok( 0, "->can(...)" ); $tb->diag(' can_ok() called with empty class or reference'); return $ok; } unless(@methods) { my $ok = $tb->ok( 0, "$class->can(...)" ); $tb->diag(' can_ok() called with no methods'); return $ok; } my @nok = (); foreach my $method (@methods) { $tb->_try( sub { $proto->can($method) } ) or push @nok, $method; } my $name = (@methods == 1) ? "$class->can('$methods[0]')" : "$class->can(...)" ; my $ok = $tb->ok( !@nok, $name ); $tb->diag( map " $class->can('$_') failed\n", @nok ); return $ok; } =item B isa_ok($object, $class, $object_name); isa_ok($subclass, $class, $object_name); isa_ok($ref, $type, $ref_name); Checks to see if the given C<< $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. You can also test a class, to make sure that it has the right ancestor: isa_ok( 'Vole', 'Rodent' ); 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 $tb = Test::More->builder; my $diag; if( !defined $object ) { $obj_name = 'The thing' unless defined $obj_name; $diag = "$obj_name isn't defined"; } else { my $whatami = ref $object ? 'object' : 'class'; # We can't use UNIVERSAL::isa because we want to honor isa() overrides my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } ); if($error) { if( $error =~ /^Can't call method "isa" on unblessed reference/ ) { # Its an unblessed reference $obj_name = 'The reference' unless defined $obj_name; if( !UNIVERSAL::isa( $object, $class ) ) { my $ref = ref $object; $diag = "$obj_name isn't a '$class' it's a '$ref'"; } } elsif( $error =~ /Can't call method "isa" without a package/ ) { # It's something that can't even be a class $obj_name = 'The thing' unless defined $obj_name; $diag = "$obj_name isn't a class or reference"; } else { die <isa on your $whatami and got some weird error. Here's the error. $error WHOA } } else { $obj_name = "The $whatami" unless defined $obj_name; if( !$rslt ) { my $ref = ref $object; $diag = "$obj_name isn't a '$class' it's a '$ref'"; } } } my $name = "$obj_name isa $class"; my $ok; if($diag) { $ok = $tb->ok( 0, $name ); $tb->diag(" $diag\n"); } else { $ok = $tb->ok( 1, $name ); } return $ok; } =item B my $obj = new_ok( $class ); my $obj = new_ok( $class => \@args ); my $obj = new_ok( $class => \@args, $object_name ); A convenience function which combines creating an object and calling isa_ok() on that object. It is basically equivalent to: my $obj = $class->new(@args); isa_ok $obj, $class, $object_name; If @args is not given, an empty list will be used. This function only works on new() and it assumes new() will return just a single object which isa C<$class>. =cut sub new_ok { my $tb = Test::More->builder; $tb->croak("new_ok() must be given at least a class") unless @_; my( $class, $args, $object_name ) = @_; $args ||= []; $object_name = "The object" unless defined $object_name; my $obj; my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } ); if($success) { local $Test::Builder::Level = $Test::Builder::Level + 1; isa_ok $obj, $class, $object_name; } else { $tb->ok( 0, "new() died" ); $tb->diag(" Error was: $error"); } return $obj; } =item B subtest $name => \&code; subtest() runs the &code as its own little test with its own plan and its own result. The main test counts this as a single test using the result of the whole subtest to determine if its ok or not ok. For example... use Test::More tests => 3; pass("First test"); subtest 'An example subtest' => sub { plan tests => 2; pass("This is a subtest"); pass("So is this"); }; pass("Third test"); This would produce. 1..3 ok 1 - First test 1..2 ok 1 - This is a subtest ok 2 - So is this ok 2 - An example subtest ok 3 - Third test A subtest may call "skip_all". No tests will be run, but the subtest is considered a skip. subtest 'skippy' => sub { plan skip_all => 'cuz I said so'; pass('this test will never be run'); }; Returns true if the subtest passed, false otherwise. Due to how subtests work, you may omit a plan if you desire. This adds an implicit C to the end of your subtest. The following two subtests are equivalent: subtest 'subtest with implicit done_testing()', sub { ok 1, 'subtests with an implicit done testing should work'; ok 1, '... and support more than one test'; ok 1, '... no matter how many tests are run'; }; subtest 'subtest with explicit done_testing()', sub { ok 1, 'subtests with an explicit done testing should work'; ok 1, '... and support more than one test'; ok 1, '... no matter how many tests are run'; done_testing(); }; =cut sub subtest { my ($name, $subtests) = @_; my $tb = Test::More->builder; return $tb->subtest(@_); } =item B =item B 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 (;$) { my $tb = Test::More->builder; return $tb->ok( 1, @_ ); } sub fail (;$) { my $tb = Test::More->builder; return $tb->ok( 0, @_ ); } =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 and C. =over 4 =item B 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); Version numbers can be checked like so: # Just like "use Some::Module 1.02" BEGIN { use_ok('Some::Module', 1.02) } Don't try to do this: BEGIN { use_ok('Some::Module'); ...some code that depends on the use... ...happening at compile time... } because the notion of "compile-time" is relative. Instead, you want: BEGIN { use_ok('Some::Module') } BEGIN { ...some code that depends on the use... } If you want the equivalent of C, use a module but not import anything, use C. BEGIN { require_ok "Foo" } =cut sub use_ok ($;@) { my( $module, @imports ) = @_; @imports = () unless @imports; my $tb = Test::More->builder; my( $pack, $filename, $line ) = caller; my $code; if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { # probably a version check. Perl needs to see the bare number # for it to work with non-Exporter based modules. $code = <ok( $eval_result, "use $module;" ); unless($ok) { chomp $eval_error; $@ =~ s{^BEGIN failed--compilation aborted at .*$} {BEGIN failed--compilation aborted at $filename line $line.}m; $tb->diag(< require_ok($module); require_ok($file); Like use_ok(), except it requires the $module or $file. =cut sub require_ok ($) { my($module) = shift; my $tb = Test::More->builder; my $pack = caller; # Try to determine if we've been given a module name or file. # Module names must be barewords, files not. $module = qq['$module'] unless _is_module_name($module); my $code = <ok( $eval_result, "require $module;" ); unless($ok) { chomp $eval_error; $tb->diag(< I'm not quite sure what will happen with filehandles. =over 4 =item B is_deeply( $got, $expected, $test_name ); Similar to is(), except that if $got and $expected are 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. is_deeply() compares the dereferenced values of references, the references themselves (except for their type) are ignored. This means aspects such as blessing and ties are not considered "different". is_deeply() currently has very limited handling of function reference and globs. It merely checks if they have the same referent. This may improve in the future. L and L provide more in-depth functionality along these lines. =cut our( @Data_Stack, %Refs_Seen ); my $DNE = bless [], 'Does::Not::Exist'; sub _dne { return ref $_[0] eq ref $DNE; } ## no critic (Subroutines::RequireArgUnpacking) sub is_deeply { my $tb = Test::More->builder; unless( @_ == 2 or @_ == 3 ) { my $msg = <<'WARNING'; is_deeply() takes two or three args, you gave %d. This usually means you passed an array or hash instead of a reference to it WARNING chop $msg; # clip off newline so carp() will put in line/file _carp sprintf $msg, scalar @_; return $tb->ok(0); } my( $got, $expected, $name ) = @_; $tb->_unoverload_str( \$expected, \$got ); my $ok; if( !ref $got and !ref $expected ) { # neither is a reference $ok = $tb->is_eq( $got, $expected, $name ); } elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't $ok = $tb->ok( 0, $name ); $tb->diag( _format_stack({ vals => [ $got, $expected ] }) ); } else { # both references local @Data_Stack = (); if( _deep_check( $got, $expected ) ) { $ok = $tb->ok( 1, $name ); } else { $ok = $tb->ok( 0, $name ); $tb->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' : _dne($val) ? "Does not exist" : ref $val ? "$val" : "'$val'"; } $out .= "$vars[0] = $vals[0]\n"; $out .= "$vars[1] = $vals[1]\n"; $out =~ s/^/ /msg; return $out; } sub _type { my $thing = shift; return '' if !ref $thing; for my $type (qw(Regexp ARRAY HASH REF SCALAR GLOB CODE)) { return $type if UNIVERSAL::isa( $thing, $type ); } return ''; } =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. =over 4 =item B diag(@diagnostic_message); Prints a diagnostic message which is guaranteed not to interfere with test output. Like C @diagnostic_message is simply concatenated together. Returns false, so as to preserve failure. 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 'There's a foo user' # in foo.t at line 52. # Since there's no foo, check that /etc/bar is set up right. You might remember C with the mnemonic C. B 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. =item B note(@diagnostic_message); Like diag(), except the message will not be seen when the test is run in a harness. It will only be visible in the verbose TAP stream. Handy for putting in notes which might be useful for debugging, but don't indicate a problem. note("Tempfile is $tempfile"); =cut sub diag { return Test::More->builder->diag(@_); } sub note { return Test::More->builder->note(@_); } =item B my @dump = explain @diagnostic_message; Will dump the contents of any references in a human readable format. Usually you want to pass this into C or C. Handy for things like... is_deeply($have, $want) || diag explain $have; or note explain \%args; Some::Class->method(%args); =cut sub explain { return Test::More->builder->explain(@_); } =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. 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: { 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. 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. If your plan is C $how_many is optional and will default to 1. It's perfectly safe to nest SKIP blocks. Each SKIP block must have the label C, 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 ## no critic (Subroutines::RequireFinalReturn) sub skip { my( $why, $how_many ) = @_; my $tb = Test::More->builder; 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 $tb->has_plan eq 'no_plan'; $how_many = 1; } if( defined $how_many and $how_many =~ /\D/ ) { _carp "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?"; $how_many = 1; } for( 1 .. $how_many ) { $tb->skip($why); } no warnings 'exiting'; last SKIP; } =item B 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: { 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 with and using C. 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 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 ) = @_; my $tb = Test::More->builder; 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 $tb->has_plan eq 'no_plan'; $how_many = 1; } for( 1 .. $how_many ) { $tb->todo_skip($why); } no warnings 'exiting'; last TODO; } =item When do I use SKIP vs. TODO? B, 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, 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 Test control =over 4 =item B BAIL_OUT($reason); Indicates to the harness that things are going so badly all testing should terminate. This includes the running of any additional test scripts. This is typically used when testing cannot continue such as a critical module failing to compile or a necessary external utility not being available such as a database connection failing. The test will exit with 255. For even better control look at L. =cut sub BAIL_OUT { my $reason = shift; my $tb = Test::More->builder; $tb->BAIL_OUT($reason); } =back =head2 Discouraged comparison functions The use of the following functions is discouraged as they are not actually testing functions and produce no diagnostics to help figure out what went wrong. They were written before is_deeply() existed because I couldn't figure out how to display a useful diff of two arbitrary data structures. These functions are usually used inside an ok(). ok( eq_array(\@got, \@expected) ); C can do that better and with diagnostics. is_deeply( \@got, \@expected ); They may be deprecated in future versions. =over 4 =item B my $is_eq = eq_array(\@got, \@expected); Checks if two arrays are equivalent. This is a deep check, so multi-level structures are handled correctly. =cut #'# sub eq_array { local @Data_Stack = (); _deep_check(@_); } sub _eq_array { my( $a1, $a2 ) = @_; if( grep _type($_) ne 'ARRAY', $a1, $a2 ) { warn "eq_array passed a non-array ref"; return 0; } 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->[$_]; next if _equal_nonrefs($e1, $e2); 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 _equal_nonrefs { my( $e1, $e2 ) = @_; return if ref $e1 or ref $e2; if ( defined $e1 ) { return 1 if defined $e2 and $e1 eq $e2; } else { return 1 if !defined $e2; } return; } sub _deep_check { my( $e1, $e2 ) = @_; my $tb = Test::More->builder; my $ok = 0; # Effectively turn %Refs_Seen into a stack. This avoids picking up # the same referenced used twice (such as [\$a, \$a]) to be considered # circular. local %Refs_Seen = %Refs_Seen; { $tb->_unoverload_str( \$e1, \$e2 ); # Either they're both references or both not. my $same_ref = !( !ref $e1 xor !ref $e2 ); my $not_ref = ( !ref $e1 and !ref $e2 ); if( defined $e1 xor defined $e2 ) { $ok = 0; } elsif( !defined $e1 and !defined $e2 ) { # Shortcut if they're both undefined. $ok = 1; } elsif( _dne($e1) xor _dne($e2) ) { $ok = 0; } elsif( $same_ref and( $e1 eq $e2 ) ) { $ok = 1; } elsif($not_ref) { push @Data_Stack, { type => '', vals => [ $e1, $e2 ] }; $ok = 0; } else { if( $Refs_Seen{$e1} ) { return $Refs_Seen{$e1} eq $e2; } else { $Refs_Seen{$e1} = "$e2"; } my $type = _type($e1); $type = 'DIFFERENT' unless _type($e2) eq $type; if( $type eq 'DIFFERENT' ) { push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; $ok = 0; } elsif( $type eq 'ARRAY' ) { $ok = _eq_array( $e1, $e2 ); } elsif( $type eq 'HASH' ) { $ok = _eq_hash( $e1, $e2 ); } elsif( $type eq 'REF' ) { push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; $ok = _deep_check( $$e1, $$e2 ); pop @Data_Stack if $ok; } elsif( $type eq 'SCALAR' ) { push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] }; $ok = _deep_check( $$e1, $$e2 ); pop @Data_Stack if $ok; } elsif($type) { push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; $ok = 0; } else { _whoa( 1, "No type in _deep_check" ); } } } return $ok; } sub _whoa { my( $check, $desc ) = @_; if($check) { die <<"WHOA"; WHOA! $desc This should never happen! Please contact the author immediately! WHOA } } =item B my $is_eq = eq_hash(\%got, \%expected); Determines if the two hashes contain the same keys and values. This is a deep check. =cut sub eq_hash { local @Data_Stack = (); return _deep_check(@_); } sub _eq_hash { my( $a1, $a2 ) = @_; if( grep _type($_) ne 'HASH', $a1, $a2 ) { warn "eq_hash passed a non-hash ref"; return 0; } 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; next if _equal_nonrefs($e1, $e2); 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 my $is_eq = eq_set(\@got, \@expected); Similar to eq_array(), except the order of the elements is B important. This is a deep check, but the irrelevancy of order only applies to the top level. ok( eq_set(\@got, \@expected) ); Is better written: is_deeply( [sort @got], [sort @expected] ); B By historical accident, this is not a true set comparison. While the order of elements does not matter, duplicate elements do. B eq_set() does not know how to deal with references at the top level. The following is an example of a comparison which might not work: eq_set([\1, \2], [\2, \1]); L contains much better set comparison functions. =cut sub eq_set { my( $a1, $a2 ) = @_; return 0 unless @$a1 == @$a2; no warnings 'uninitialized'; # It really doesn't matter how we sort them, as long as both arrays are # sorted with the same algorithm. # # Ensure that references are not accidentally treated the same as a # string containing the reference. # # Have to inline the sort routine due to a threading/sort bug. # See [rt.cpan.org 6782] # # I don't know how references would be sorted so we just don't sort # them. This means eq_set doesn't really work with refs. return eq_array( [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ], [ grep( ref, @$a2 ), sort( grep( !ref, @$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. 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 my $test_builder = Test::More->builder; Returns the Test::Builder object underlying Test::More for you to play with. =back =head1 EXIT CODES If all your tests passed, Test::Builder 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::Builder 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 or all passed but wrong # of tests run any other number how many failed (including missing or extras) If you fail more than 254 tests, it will be reported as 254. B This behavior may go away in future versions. =head1 CAVEATS and NOTES =over 4 =item Backwards compatibility Test::More works with Perls as old as 5.6.0. =item utf8 / "Wide character in print" If you use utf8 or other non-ASCII characters with Test::More you might get a "Wide character in print" warning. Using C will not fix it. Test::Builder (which powers Test::More) duplicates STDOUT and STDERR. So any changes to them, including changing their output disciplines, will not be seem by Test::More. The work around is to change the filehandles used by Test::Builder directly. my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; =item Overloaded objects String overloaded objects are compared B (or in cmp_ok()'s case, strings or numbers as appropriate to the comparison op). This prevents Test::More from piercing an object's interface allowing better blackbox testing. So if a function starts returning overloaded objects instead of bare strings your tests won't notice the difference. This is good. However, it does mean that functions like is_deeply() cannot be used to test the internals of string overloaded objects. In this case I would suggest L which contains more flexible testing functions for complex data structures. =item Threads Test::More will only be aware of threads if "use threads" has been done I Test::More is loaded. This is ok: use threads; use Test::More; This may cause problems: use Test::More use threads; 5.8.1 and above are supported. Anything below that has too many bugs. =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 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 is the test runner and output interpreter for Perl. It's the thing that powers C and where the C utility comes from. L tests written with Test.pm, the original testing module, do not play well with other testing libraries. Test::Legacy emulates the Test.pm interface and does play well with others. L for more ways to test complex data structures. And it plays well with Test::More. L is like xUnit but more perlish. L gives you more powerful complex data structure testing. L shows the idea of embedded testing. L installs a whole bunch of useful test modules. =head1 AUTHORS Michael G Schwern Eschwern@pobox.comE with much inspiration from Joshua Pritikin's Test module and lots of help from Barrie Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa gang. =head1 BUGS See F to report and view bugs. =head1 SOURCE The source code repository for Test::More can be found at F. =head1 COPYRIGHT Copyright 2001-2008 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; Simple.pm000664001750001750 1447614411570357 20206 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/archaic/Testpackage Test::Simple; use 5.006; use strict; our $VERSION = '0.98'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); our @EXPORT = qw(ok); my $CLASS = __PACKAGE__; =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 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( $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 ($;$) { ## no critic (Subroutines::ProhibitSubroutinePrototypes) return $CLASS->builder->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 or all passed but wrong # of tests run 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. =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) && 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 'Rating() get' # in 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 tested all the way back to perl 5.6.0. Test::Simple is thread-safe in perl 5.8.1 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. 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 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). =back Look in Test::More's SEE ALSO for more testing modules. =head1 AUTHORS Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern Eschwern@pobox.comE, wardrobe by Calvin Klein. =head1 COPYRIGHT Copyright 2001-2008 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; Module.pm000664001750001750 735014411570357 21541 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/archaic/Test/Builderpackage Test::Builder::Module; use strict; use Test::Builder; require Exporter; our @ISA = qw(Exporter); our $VERSION = '0.98'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) =head1 NAME Test::Builder::Module - Base class for test modules =head1 SYNOPSIS # Emulates Test::Simple package Your::Module; my $CLASS = __PACKAGE__; use base 'Test::Builder::Module'; @EXPORT = qw(ok); sub ok ($;$) { my $tb = $CLASS->builder; return $tb->ok(@_); } 1; =head1 DESCRIPTION This is a superclass for Test::Builder-based modules. It provides a handful of common functionality and a method of getting at the underlying Test::Builder object. =head2 Importing Test::Builder::Module is a subclass of Exporter which means your module is also a subclass of Exporter. @EXPORT, @EXPORT_OK, etc... all act normally. A few methods are provided to do the C 23> part for you. =head3 import Test::Builder::Module provides an import() method which acts in the same basic way as Test::More's, setting the plan and controlling exporting of functions and variables. This allows your module to set the plan independent of Test::More. All arguments passed to import() are passed onto C<< Your::Module->builder->plan() >> with the exception of C<< import =>[qw(things to import)] >>. use Your::Module import => [qw(this that)], tests => 23; says to import the functions this() and that() as well as set the plan to be 23 tests. import() also sets the exported_to() attribute of your builder to be the caller of the import() function. Additional behaviors can be added to your import() method by overriding import_extra(). =cut sub import { my($class) = shift; # Don't run all this when loading ourself. return 1 if $class eq 'Test::Builder::Module'; my $test = $class->builder; my $caller = caller; $test->exported_to($caller); $class->import_extra( \@_ ); my(@imports) = $class->_strip_imports( \@_ ); $test->plan(@_); $class->export_to_level( 1, $class, @imports ); } sub _strip_imports { my $class = shift; my $list = shift; my @imports = (); my @other = (); my $idx = 0; while( $idx <= $#{$list} ) { my $item = $list->[$idx]; if( defined $item and $item eq 'import' ) { push @imports, @{ $list->[ $idx + 1 ] }; $idx++; } else { push @other, $item; } $idx++; } @$list = @other; return @imports; } =head3 import_extra Your::Module->import_extra(\@import_args); import_extra() is called by import(). It provides an opportunity for you to add behaviors to your module based on its import list. Any extra arguments which shouldn't be passed on to plan() should be stripped off by this method. See Test::More for an example of its use. B This mechanism is I as it feels like a bit of an ugly hack in its current form. =cut sub import_extra { } =head2 Builder Test::Builder::Module provides some methods of getting at the underlying Test::Builder object. =head3 builder my $builder = Your::Class->builder; This method returns the Test::Builder object associated with Your::Class. It is not a constructor so you can call it as often as you like. This is the preferred way to get the Test::Builder object. You should I get it via C<< Test::Builder->new >> as was previously recommended. The object returned by builder() may change at runtime so you should call builder() inside each function rather than store it in a global. sub ok { my $builder = Your::Class->builder; return $builder->ok(@_); } =cut sub builder { return Test::Builder->new; } 1; Tester.pm000664001750001750 3625714411570357 21612 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/archaic/Test/Builderpackage Test::Builder::Tester; use strict; our $VERSION = "1.22"; use Test::Builder; use Symbol; use Carp; =head1 NAME Test::Builder::Tester - test testsuites that have been built with Test::Builder =head1 SYNOPSIS use Test::Builder::Tester tests => 1; use Test::More; test_out("not ok 1 - foo"); test_fail(+1); fail("foo"); test_test("fail works"); =head1 DESCRIPTION A module that helps you test testing modules that are built with B. The testing system is designed to be used by performing a three step process for each test you wish to test. This process starts with using C and C in advance to declare what the testsuite you are testing will output with B to stdout and stderr. You then can run the test(s) from your test suite that call B. At this point the output of B is safely captured by B rather than being interpreted as real test output. The final stage is to call C that will simply compare what you predeclared to what B actually outputted, and report the results back with a "ok" or "not ok" (with debugging) to the normal output. =cut #### # set up testing #### my $t = Test::Builder->new; ### # make us an exporter ### use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num); sub import { my $class = shift; my(@plan) = @_; my $caller = caller; $t->exported_to($caller); $t->plan(@plan); my @imports = (); foreach my $idx ( 0 .. $#plan ) { if( $plan[$idx] eq 'import' ) { @imports = @{ $plan[ $idx + 1 ] }; last; } } __PACKAGE__->export_to_level( 1, __PACKAGE__, @imports ); } ### # set up file handles ### # create some private file handles my $output_handle = gensym; my $error_handle = gensym; # and tie them to this package my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; #### # exported functions #### # for remembering that we're testing and where we're testing at my $testing = 0; my $testing_num; # remembering where the file handles were originally connected my $original_output_handle; my $original_failure_handle; my $original_todo_handle; my $original_test_number; my $original_harness_state; my $original_harness_env; # function that starts testing and redirects the filehandles for now sub _start_testing { # even if we're running under Test::Harness pretend we're not # for now. This needed so Test::Builder doesn't add extra spaces $original_harness_env = $ENV{HARNESS_ACTIVE} || 0; $ENV{HARNESS_ACTIVE} = 0; # remember what the handles were set to $original_output_handle = $t->output(); $original_failure_handle = $t->failure_output(); $original_todo_handle = $t->todo_output(); # switch out to our own handles $t->output($output_handle); $t->failure_output($error_handle); $t->todo_output($output_handle); # clear the expected list $out->reset(); $err->reset(); # remember that we're testing $testing = 1; $testing_num = $t->current_test; $t->current_test(0); # look, we shouldn't do the ending stuff $t->no_ending(1); } =head2 Functions These are the six methods that are exported as default. =over 4 =item test_out =item test_err Procedures for predeclaring the output that your test suite is expected to produce until C is called. These procedures automatically assume that each line terminates with "\n". So test_out("ok 1","ok 2"); is the same as test_out("ok 1\nok 2"); which is even the same as test_out("ok 1"); test_out("ok 2"); Once C or C (or C or C) have been called, all further output from B will be captured by B. This means that you will not be able perform further tests to the normal output in the normal way until you call C (well, unless you manually meddle with the output filehandles) =cut sub test_out { # do we need to do any setup? _start_testing() unless $testing; $out->expect(@_); } sub test_err { # do we need to do any setup? _start_testing() unless $testing; $err->expect(@_); } =item test_fail Because the standard failure message that B produces whenever a test fails will be a common occurrence in your test error output, and because it has changed between Test::Builder versions, rather than forcing you to call C with the string all the time like so test_err("# Failed test ($0 at line ".line_num(+1).")"); C exists as a convenience function that can be called instead. It takes one argument, the offset from the current line that the line that causes the fail is on. test_fail(+1); This means that the example in the synopsis could be rewritten more simply as: test_out("not ok 1 - foo"); test_fail(+1); fail("foo"); test_test("fail works"); =cut sub test_fail { # do we need to do any setup? _start_testing() unless $testing; # work out what line we should be on my( $package, $filename, $line ) = caller; $line = $line + ( shift() || 0 ); # prevent warnings # expect that on stderr $err->expect("# Failed test ($0 at line $line)"); } =item test_diag As most of the remaining expected output to the error stream will be created by Test::Builder's C function, B provides a convenience function C that you can use instead of C. The C function prepends comment hashes and spacing to the start and newlines to the end of the expected output passed to it and adds it to the list of expected error output. So, instead of writing test_err("# Couldn't open file"); you can write test_diag("Couldn't open file"); Remember that B's diag function will not add newlines to the end of output and test_diag will. So to check Test::Builder->new->diag("foo\n","bar\n"); You would do test_diag("foo","bar") without the newlines. =cut sub test_diag { # do we need to do any setup? _start_testing() unless $testing; # expect the same thing, but prepended with "# " local $_; $err->expect( map { "# $_" } @_ ); } =item test_test Actually performs the output check testing the tests, comparing the data (with C) that we have captured from B against that that was declared with C and C. This takes name/value pairs that effect how the test is run. =over =item title (synonym 'name', 'label') The name of the test that will be displayed after the C or C. =item skip_out Setting this to a true value will cause the test to ignore if the output sent by the test to the output stream does not match that declared with C. =item skip_err Setting this to a true value will cause the test to ignore if the output sent by the test to the error stream does not match that declared with C. =back As a convenience, if only one argument is passed then this argument is assumed to be the name of the test (as in the above examples.) Once C has been run test output will be redirected back to the original filehandles that B was connected to (probably STDOUT and STDERR,) meaning any further tests you run will function normally and cause success/errors for B. =cut sub test_test { # decode the arguments as described in the pod my $mess; my %args; if( @_ == 1 ) { $mess = shift } else { %args = @_; $mess = $args{name} if exists( $args{name} ); $mess = $args{title} if exists( $args{title} ); $mess = $args{label} if exists( $args{label} ); } # er, are we testing? croak "Not testing. You must declare output with a test function first." unless $testing; # okay, reconnect the test suite back to the saved handles $t->output($original_output_handle); $t->failure_output($original_failure_handle); $t->todo_output($original_todo_handle); # restore the test no, etc, back to the original point $t->current_test($testing_num); $testing = 0; # re-enable the original setting of the harness $ENV{HARNESS_ACTIVE} = $original_harness_env; # check the output we've stashed unless( $t->ok( ( $args{skip_out} || $out->check ) && ( $args{skip_err} || $err->check ), $mess ) ) { # print out the diagnostic information about why this # test failed local $_; $t->diag( map { "$_\n" } $out->complaint ) unless $args{skip_out} || $out->check; $t->diag( map { "$_\n" } $err->complaint ) unless $args{skip_err} || $err->check; } } =item line_num A utility function that returns the line number that the function was called on. You can pass it an offset which will be added to the result. This is very useful for working out the correct text of diagnostic functions that contain line numbers. Essentially this is the same as the C<__LINE__> macro, but the C idiom is arguably nicer. =cut sub line_num { my( $package, $filename, $line ) = caller; return $line + ( shift() || 0 ); # prevent warnings } =back In addition to the six exported functions there exists one function that can only be accessed with a fully qualified function call. =over 4 =item color When C is called and the output that your tests generate does not match that which you declared, C will print out debug information showing the two conflicting versions. As this output itself is debug information it can be confusing which part of the output is from C and which was the original output from your original tests. Also, it may be hard to spot things like extraneous whitespace at the end of lines that may cause your test to fail even though the output looks similar. To assist you C can colour the background of the debug information to disambiguate the different types of output. The debug output will have its background coloured green and red. The green part represents the text which is the same between the executed and actual output, the red shows which part differs. The C function determines if colouring should occur or not. Passing it a true or false value will enable or disable colouring respectively, and the function called with no argument will return the current setting. To enable colouring from the command line, you can use the B module like so: perl -Mlib=Text::Builder::Tester::Color test.t Or by including the B module directly in the PERL5LIB. =cut my $color; sub color { $color = shift if @_; $color; } =back =head1 BUGS Calls C<no_ending>> turning off the ending tests. This is needed as otherwise it will trip out because we've run more tests than we strictly should have and it'll register any failures we had that we were testing for as real failures. The color function doesn't work unless B is compatible with your terminal. Bugs (and requests for new features) can be reported to the author though the CPAN RT system: L =head1 AUTHOR Copyright Mark Fowler Emark@twoshortplanks.comE 2002, 2004. Some code taken from B and B, written by by Michael G Schwern Eschwern@pobox.comE. Hence, those parts Copyright Micheal G Schwern 2001. Used and distributed with permission. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 NOTES Thanks to Richard Clamp Erichardc@unixbeard.netE for letting me use his testing system to try this module out on. =head1 SEE ALSO L, L, L. =cut 1; #################################################################### # Helper class that is used to remember expected and received data package Test::Builder::Tester::Tie; ## # add line(s) to be expected sub expect { my $self = shift; my @checks = @_; foreach my $check (@checks) { $check = $self->_translate_Failed_check($check); push @{ $self->{wanted} }, ref $check ? $check : "$check\n"; } } sub _translate_Failed_check { my( $self, $check ) = @_; if( $check =~ /\A(.*)# (Failed .*test) \((.*?) at line (\d+)\)\Z(?!\n)/ ) { $check = "/\Q$1\E#\\s+\Q$2\E.*?\\n?.*?\Qat $3\E line \Q$4\E.*\\n?/"; } return $check; } ## # return true iff the expected data matches the got data sub check { my $self = shift; # turn off warnings as these might be undef local $^W = 0; my @checks = @{ $self->{wanted} }; my $got = $self->{got}; foreach my $check (@checks) { $check = "\Q$check\E" unless( $check =~ s,^/(.*)/$,$1, or ref $check ); return 0 unless $got =~ s/^$check//; } return length $got == 0; } ## # a complaint message about the inputs not matching (to be # used for debugging messages) sub complaint { my $self = shift; my $type = $self->type; my $got = $self->got; my $wanted = join "\n", @{ $self->wanted }; # are we running in colour mode? if(Test::Builder::Tester::color) { # get color eval { require Term::ANSIColor }; unless($@) { # colours my $green = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_green"); my $red = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_red"); my $reset = Term::ANSIColor::color("reset"); # work out where the two strings start to differ my $char = 0; $char++ while substr( $got, $char, 1 ) eq substr( $wanted, $char, 1 ); # get the start string and the two end strings my $start = $green . substr( $wanted, 0, $char ); my $gotend = $red . substr( $got, $char ) . $reset; my $wantedend = $red . substr( $wanted, $char ) . $reset; # make the start turn green on and off $start =~ s/\n/$reset\n$green/g; # make the ends turn red on and off $gotend =~ s/\n/$reset\n$red/g; $wantedend =~ s/\n/$reset\n$red/g; # rebuild the strings $got = $start . $gotend; $wanted = $start . $wantedend; } } return "$type is:\n" . "$got\nnot:\n$wanted\nas expected"; } ## # forget all expected and got data sub reset { my $self = shift; %$self = ( type => $self->{type}, got => '', wanted => [], ); } sub got { my $self = shift; return $self->{got}; } sub wanted { my $self = shift; return $self->{wanted}; } sub type { my $self = shift; return $self->{type}; } ### # tie interface ### sub PRINT { my $self = shift; $self->{got} .= join '', @_; } sub TIEHANDLE { my( $class, $type ) = @_; my $self = bless { type => $type }, $class; $self->reset; return $self; } sub READ { } sub READLINE { } sub GETC { } sub FILENO { } 1; Etc.pod000664001750001750 1110514411570357 21254 0ustar00taitai000000000000Exporter-Tiny-1.006002/lib/Exporter/Tiny/Manual=pod =encoding utf-8 =for stopwords frobnicate greps regexps =head1 NAME Exporter::Tiny::Manual::Etc - odds and ends =head1 DESCRIPTION =head2 Utility Functions Exporter::Tiny is itself an exporter! These functions are really for internal use, but can be exported if you need them: =over =item C<< mkopt(\@array) >> Similar to C from L. It doesn't support all the fancy options that Data::OptList does (C, C, C and C) but runs about 50% faster. =item C<< mkopt_hash(\@array) >> Similar to C from L. See also C. =back =head2 History L had a bunch of custom exporting code which poked coderefs into its caller's stash. It needed this to be something more powerful than most exporters so that it could switch between exporting Moose, Mouse and Moo-compatible objects on request. L would have been capable, but had too many dependencies for the Type::Tiny project. Meanwhile L, L and L each used the venerable L. However, this meant they were unable to use the features like L-style function renaming which I'd built into Type::Library: ## import "Str" but rename it to "String". use Types::Standard "Str" => { -as => "String" }; And so I decided to factor out code that could be shared by all Type-Tiny's exporters into a single place: Exporter::TypeTiny. As of version 0.026, Exporter::TypeTiny was also made available as L, distributed independently on CPAN. CHOCOLATEBOY had convinced me that it was mature enough to live a life of its own. As of version 0.030, Type-Tiny depends on Exporter::Tiny and Exporter::TypeTiny is being phased out. =head2 Obligatory Exporter Comparison Exporting is unlikely to be your application's performance bottleneck, but nonetheless here are some comparisons. B<< Comparative sizes according to L: >> Exporter 217.1Kb Sub::Exporter::Progressive 263.2Kb Exporter::Tiny 267.7Kb Exporter + Exporter::Heavy 281.5Kb Exporter::Renaming 406.2Kb Sub::Exporter 701.0Kb B<< Performance exporting a single sub: >> Rate SubExp ExpTiny SubExpProg ExpPM SubExp 2489/s -- -56% -85% -88% ExpTiny 5635/s 126% -- -67% -72% SubExpProg 16905/s 579% 200% -- -16% ExpPM 20097/s 707% 257% 19% -- (Exporter::Renaming globally changes the behaviour of Exporter.pm, so could not be included in the same benchmarks.) B<< (Non-Core) Dependencies: >> Exporter -1 Exporter::Renaming 0 Exporter::Tiny 0 Sub::Exporter::Progressive 0 Sub::Exporter 3 B<< Features: >> ExpPM ExpTiny SubExp SubExpProg Can export code symbols............. Yes Yes Yes Yes Can export non-code symbols......... Yes Yes Groups/tags......................... Yes Yes Yes Yes Export by regexp.................... Yes Yes Bang prefix......................... Yes Yes Allows renaming of subs............. Yes Yes Maybe Install code into scalar refs....... Yes Yes Maybe Can be passed an "into" parameter... Yes Yes Maybe Can be passed an "installer" sub.... Yes Yes Maybe Config avoids package variables..... Yes Supports generators................. Yes Yes Sane API for generators............. Yes Yes Unimport............................ Yes (Certain Sub::Exporter::Progressive features are only available if Sub::Exporter is installed.) =head1 SEE ALSO L. L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017, 2022-2023 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Exporting.pod000664001750001750 2065414411570357 22531 0ustar00taitai000000000000Exporter-Tiny-1.006002/lib/Exporter/Tiny/Manual=pod =encoding utf-8 =for stopwords frobnicate greps regexps =head1 NAME Exporter::Tiny::Manual::Exporting - creating an exporter using Exporter::Tiny =head1 SYNOPSIS B<< Read L first! >> =head1 DESCRIPTION Simple configuration works the same as L; inherit from L, and use the C<< @EXPORT >>, C<< @EXPORT_OK >>, and C<< %EXPORT_TAGS >> package variables to list subs to export. Unlike Exporter, Exporter::Tiny performs most of its internal duties (including resolution of tag names to sub names, resolution of sub names to coderefs, and installation of coderefs into the target package) as B, which means that your module (which is a subclass of Exporter::Tiny) can override them to provide interesting behaviour. =head2 Advanced Tag Stuff You can define tags using other tags: use Exporter::Shiny qw( black white red green blue cyan magenta yellow ); our %EXPORT_TAGS = ( rgb => [qw( red green blue )], cym => [qw( cyan magenta yellow )], cymk => [qw( black :cym )], monochrome => [qw( black white )], all => [qw( :rgb :cymk :monochrome )], ); B<< CAVEAT: >> If you create a cycle in the tags, this could put Exporter::Tiny into an infinite loop expanding the tags. Don't do that. =head2 More on Generators Exporter::Tiny has always allowed exported subs to be generated (like L), but until version 0.025 did not have an especially nice API for it. Now, it's easy. If you want to generate a sub C to export, list it in C<< @EXPORT >> or C<< @EXPORT_OK >> as usual, and then simply give your exporter module a class method called C<< _generate_foo >>. push @EXPORT_OK, 'foo'; sub _generate_foo { my $class = shift; my ($name, $args, $globals) = @_; return sub { ...; } } We showed how to do that in L, but one thing we didn't show was that C<< $globals >> gets passed in there. This is the global options hash, as described in L. It can often be useful. In particular it will tell you what package the generated sub is destined to be installed into. To generate non-code symbols, name your generators like this: sub _generateScalar_Foo { ... } # generate a symbol $Foo sub _generateArray_Bar { ... } # generate a symbol @Bar sub _generateHash_Baz { ... } # generate a symbol %Baz You can also generate tags: my %constants; BEGIN { %constants = (FOO => 1, BAR => 2); } use constant \%constants; $EXPORT_TAGS{constants} = sub { my $class = shift; my ($name, $args, $globals) = @_; return keys(%constants); }; =head2 Hooks Sometimes as well as exporting stuff, you want to do some setup or something. You can define a couple of class methods in your package, and they'll get called at the appropriate time: package MyUtils; ...; sub _exporter_validate_opts { my $class = shift; my ($globals) = @_; ...; # do stuff here $class->SUPER::_exporter_validate_opts(@_); } sub _exporter_validate_unimport_opts { my $class = shift; my ($globals) = @_; ...; # do stuff here $class->SUPER::_exporter_validate_unimport_opts(@_); } The C<< $globals >> variable is that famous global options hash. In particular, C<< $globals->{into} >> is useful because it tells you what package has imported you. As you might have guessed, these methods were originally intended to validate the global options hash, but can be used to perform any general duties before the real exporting work is done. =head2 Overriding Internals An important difference between L and Exporter::Tiny is that the latter calls all its internal functions as I<< class methods >>. This means that your subclass can I<< override them >> to alter their behaviour. The following methods are available to be overridden. Despite being named with a leading underscore, they are considered public methods. (The underscore is there to avoid accidentally colliding with any of your own function names.) =over =item C<< _exporter_validate_opts($globals) >> Documented above. =item C<< _exporter_validate_unimport_opts($globals) >> Documented above. =item C<< _exporter_merge_opts($tag_opts, $globals, @exports) >> Called to merge options which have been provided for a tag into the options provided for the exports that the tag expanded to. =item C<< _exporter_expand_tag($name, $args, $globals) >> This method is called to expand an import tag (e.g. C<< ":constants" >>). It is passed the tag name (minus the leading ":"), an optional hashref of options (like C<< { -prefix => "foo_" } >>), and the global options hashref. It is expected to return a list of ($name, $args) arrayref pairs. These names can be sub names to export, or further tag names (which must have their ":"). If returning tag names, be careful to avoid creating a tag expansion loop! The default implementation uses C<< %EXPORT_TAGS >> to expand tags, and provides fallbacks for the C<< :default >> and C<< :all >> tags. =item C<< _exporter_expand_regexp($regexp, $args, $globals) >> Like C<_exporter_expand_regexp>, but given a regexp-like string instead of a tag name. The default implementation greps through C<< @EXPORT_OK >> for imports, and the list of already-imported functions for exports. =item C<< _exporter_expand_sub($name, $args, $globals) >> This method is called to translate a sub name to a hash of name => coderef pairs for exporting to the caller. In general, this would just be a hash with one key and one value, but, for example, L overrides this method so that C<< "+Foo" >> gets expanded to: ( Foo => sub { $type }, is_Foo => sub { $type->check(@_) }, to_Foo => sub { $type->assert_coerce(@_) }, assert_Foo => sub { $type->assert_return(@_) }, ) The default implementation checks that the name is allowed to be exported (using the C<_exporter_permitted_regexp> method), gets the coderef using the generator if there is one (or by calling C<< can >> on your exporter otherwise) and calls C<_exporter_fail> if it's unable to generate or retrieve a coderef. Despite the name, is also called for non-code symbols. =item C<< _exporter_permitted_regexp($globals) >> This method is called to retrieve a regexp for validating the names of exportable subs. If a sub doesn't match the regexp, then the default implementation of C<_exporter_expand_sub> will refuse to export it. (Of course, you may override the default C<_exporter_expand_sub>.) The default implementation of this method assembles the regexp from C<< @EXPORT >> and C<< @EXPORT_OK >>. =item C<< _exporter_fail($name, $args, $globals) >> Called by C<_exporter_expand_sub> if it can't find a coderef to export. The default implementation just throws an exception. But you could emit a warning instead, or just ignore the failed export. If you don't throw an exception then you should be aware that this method is called in list context, and any list it returns will be treated as an C<_exporter_expand_sub>-style hash of names and coderefs for export. =item C<< _exporter_install_sub($name, $args, $globals, $coderef) >> This method actually installs the exported sub into its new destination. Its return value is ignored. The default implementation handles sub renaming (i.e. the C<< -as >>, C<< -prefix >> and C<< -suffix >> functions. This method does a lot of stuff; if you need to override it, it's probably a good idea to just pre-process the arguments and then call the super method rather than trying to handle all of it yourself. Despite the name, is also called for non-code symbols. =item C<< _exporter_uninstall_sub($name, $args, $globals) >> The opposite of C<_exporter_install_sub>. =back =head1 SEE ALSO L. L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017, 2022-2023 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Importing.pod000664001750001750 1552714411570357 22525 0ustar00taitai000000000000Exporter-Tiny-1.006002/lib/Exporter/Tiny/Manual=pod =encoding utf-8 =for stopwords frobnicate greps regexps =head1 NAME Exporter::Tiny::Manual::Importing - importing from Exporter::Tiny-based modules =head1 DESCRIPTION For the purposes of this discussion we'll assume we have a module called C<< MyUtils >> which exports functions called C, C, C, and C. It has a tag set up called C<:colours> which corresponds to C, C, and C. Many of these tricks may seem familiar from L. That is intentional. Exporter::Tiny doesn't attempt to provide every feature of Sub::Exporter, but where it does it usually uses a fairly similar API. =head2 Basic importing It's easy to import a single function from a module: use MyUtils "frobnicate"; Or a list of functions: use MyUtils "red", "green"; Perl's C<< qw() >> shorthand for a list of words is pretty useful: use MyUtils qw( red green ); If the module defines tags, you can import them like this: use MyUtils qw( :colours ); Or with a hyphen instead of a colon: use MyUtils qw( -colours ); Hyphens are good because Perl will autoquote a bareword that follows them: use MyUtils -colours; And it's possible to mix function names and tags in the same list: use MyUtils qw( frobnicate :colours ); =head2 Renaming imported functions It's possible to rename a function you're importing: use MyUtils "frobnicate" => { -as => "frob" }; Or you can apply a prefix and/or suffix. The following imports the function and calls it C. use MyUtils "frobnicate" => { -prefix => "my_", -suffix => "_thing" }; You can apply a prefix/suffix to B functions you import by placing the hashref B in the import list. (This first hashref is referred to as the global options hash, and can do some special things.) use MyUtils { prefix => "my_" }, "frobnicate"; Did you notice that we used C<< -prefix >> and C<< -suffix >> in the normal options hash, but C<< prefix >> and C<< suffix >> (no hyphen) in the global options hash? That's a common pattern with this module. You can import the same function multiple times with different names: use MyUtils "frobnicate" => { -as => "frob" }, "frobnicate" => { -as => "frbnct" }; Tags can take the C<< -prefix >> and C<< -suffix >> options too. The following imports C, C, and C: use MyUtils -colours => { -prefix => "colour_" }; You can also set C<< -as >> to be a coderef to generate a function name. This imports functions called C, C, and C: use MyUtils -colours => { -as => sub { uc($_[0]) } }; Note that it doesn't make sense to use C<< -as >> with a tag unless you're doing this coderef thing. Coderef C<< as >> also works in the global options hash. =head2 DO NOT WANT! Sometimes you want to supply a list of functions you B<< don't >> want to import. To do that, prefix the function with a bang. This imports everything except "frobnicate": use MyUtils qw( -all !frobnicate ); You can add the bang prefix to tags too. This will import everything except the colours. use MyUtils qw( -all !:colours ); Negated imports always "win", so the following will not import "frobnicate", no matter how many times you repeat it... use MyUtils qw( !frobnicate frobnicate frobnicate frobnicate ); =head2 Importing by regexp Here's how you could import all functions beginning with an "f": use MyUtils qw( /^F/i ); Or import everything except functions beginning with a "z": use MyUtils qw( -all !/^Z/i ); Note that regexps are always supplied as I starting with C<< "/" >>, and not as quoted regexp references (C<< qr/.../ >>). =head2 Import functions into another package Occasionally you need to import functions not into your own package, but into a different package. You can do that like this: use MyUtils { into => "OtherPkg" }, "frobnicate"; OtherPkg::frobincate(...); However, L will probably provide you with a better approach which doesn't just work with Exporter::Tiny, but B exporters. =head2 Lexical subs on Perl 5.37.2 and above Often you want to make use of an exported function, but don't want it to "pollute" your namespace. On newer versions of Perl, Exporter::Tiny can use C from L to give you lexical versions of exports. { use MyUtils -lexical, "frobnicate"; frobnicate(...); # ok } frobnicate(...); # not ok This functionality should be considered B until C is included in a stable release of Perl. =head2 Lexical subs on Perl older than 5.37.2 If you install L, then lexical imports should work on versions of Perl as old as 5.12. =head2 Unimporting You can unimport the functions that MyUtils added to your namespace: no MyUtils; Or just specific ones: no MyUtils qw(frobnicate); If you renamed a function when you imported it, you should unimport by the new name: use MyUtils frobnicate => { -as => "frob" }; ...; no MyUtils "frob"; Unimporting using tags and regexps should mostly do what you want. =head1 DIAGNOSTICS =over =item B<< Overwriting existing sub '%s::%s' with sub '%s' exported by %s >> A warning issued if Exporter::Tiny is asked to export a symbol which will result in an existing sub being overwritten. This warning can be suppressed using either of the following: use MyUtils { replace => 1 }, "frobnicate"; use MyUtils "frobnicate" => { -replace => 1 }; Or can be upgraded to a fatal error: use MyUtils { replace => "die" }, "frobnicate"; use MyUtils "frobnicate" => { -replace => "die" }; =item B<< Refusing to overwrite existing sub '%s::%s' with sub '%s' exported by %s >> The fatal version of the above warning. =item B<< Could not find sub '%s' exported by %s >> You requested to import a sub which the package does not provide. =item B<< Cannot provide an -as option for tags >> Because a tag may provide more than one function, it does not make sense to request a single name for it. Instead use C<< -prefix >> or C<< -suffix >>. =item B<< Passing options to unimport '%s' makes no sense >> When you import a sub, it occasionally makes sense to pass some options for it. However, when unimporting, options do nothing, so this warning is issued. =back =head1 SEE ALSO L. L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017, 2022-2023 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. QuickStart.pod000664001750001750 1044514411570357 22641 0ustar00taitai000000000000Exporter-Tiny-1.006002/lib/Exporter/Tiny/Manual=pod =encoding utf-8 =for stopwords frobnicate greps regexps =head1 NAME Exporter::Tiny::Manual::QuickStart - the quickest way to get up and running with Exporter::Tiny =head1 SYNOPSIS package MyUtils; use Exporter::Shiny qw( frobnicate ); sub frobnicate { ...; # your code here } 1; Now people can use your module like this: use MyUtils "frobnicate"; frobnicate(42); Or like this: use MyUtils "frobnicate" => { -as => "frob" }; frob(42); =head1 DESCRIPTION See the synopsis. Yes, it's that simple. =head2 Next steps =head3 Default exports Note that the module in the synopsis doesn't export anything by default. If people load C like this: use MyUtils; Then they haven't imported any functions. You can specify a default set of functions to be exported like this: package MyUtils; use Exporter::Shiny qw( frobnicate ); our @EXPORT = qw( frobnicate ); sub frobnicate { ... } 1; Or, if you want to be a superstar rock god: package MyUtils; use Exporter::Shiny our @EXPORT = qw( frobnicate ); sub frobnicate { ... } 1; =head3 Tags You can provide tags for people to use: package MyUtils; use Exporter::Shiny qw( frobnicate red green blue ); our %EXPORT_TAGS = ( utils => [qw/ frobnicate /], colours => [qw/ red green blue /], ); sub frobnicate { ... } sub red { ... } sub green { ... } sub blue { ... } 1; And people can now import your functions like this: use MyUtils ":colours"; Or this: use MyUtils "-colours"; Or take advantage of the fact that Perl magically quotes barewords preceded by a hyphen: use MyUtils -colours; Two tags are automatically defined for you: C<< -default >> (which is just the same as C<< @EXPORT >>) and C<< -all >> (which is the union of C<< @EXPORT >> and C<< @EXPORT_OK >>). If you don't like them, then you can override them: our %EXPORT_TAGS = ( default => \@some_other_stuff, all => \@more_stuff, ); =head3 Generators Exporting normally just works by copying a sub from your package into your caller's package. But sometimes it's useful instead to generate a I sub to insert into your caller's package. This is pretty easy to do. package MyUtils; use Exporter::Shiny qw( frobnicate ); sub _generate_frobnicate { my ( $me, $name, $args, $globals ) = @_; my $caller = $globals->{into}; return sub { ...; # your code here }; } 1; The parameter C<< $me >> here is a string containing the package name which is being imported from; C<< $caller >> is the destination package; C<< $name >> is the name of the sub (in this case "frobnicate"); and C<< $args >> is a custom argument for this function. (By convention, C<< $args >> is normally a hashref.) # The hashref { foo => 42 } is $args above. # use MyUtils "frobnicate" => { foo => 42 }; =head2 Avoiding Exporter::Shiny Exporter::Shiny is a tiny shim around Exporter::Tiny. It should mostly do what you want, but you may sometimes prefer to use Exporter::Tiny directly. The example in the synopsis could have been written as: package MyUtils; use parent "Exporter::Tiny"; our @EXPORT_OK = qw( frobnicate ); sub frobnicate { ...; # your code here } 1; What Exporter::Shiny does is mostly just to set C<< @EXPORT_OK >> for you and set up inheritance from the base class (Exporter::Tiny). Exporter::Shiny also sets C<< $INC{'MyUtils.pm'} >> for you, which in usually makes little difference, but is useful in some edge cases. =head1 SEE ALSO L. L, L. For more advanced information, see L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017, 2022-2023 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Scalar.pm000664001750001750 3245414411570357 22053 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/archaic/Test/Builder/IOpackage Test::Builder::IO::Scalar; =head1 NAME Test::Builder::IO::Scalar - A copy of IO::Scalar for Test::Builder =head1 DESCRIPTION This is a copy of IO::Scalar which ships with Test::Builder to support scalar references as filehandles on Perl 5.6. Newer versions of Perl simply use C<>'s built in support. Test::Builder can not have dependencies on other modules without careful consideration, so its simply been copied into the distribution. =head1 COPYRIGHT and LICENSE This file came from the "IO-stringy" Perl5 toolkit. Copyright (c) 1996 by Eryq. All rights reserved. Copyright (c) 1999,2001 by ZeeGee Software Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # This is copied code, I don't care. ##no critic use Carp; use strict; use vars qw($VERSION @ISA); use IO::Handle; use 5.005; ### The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = "2.110"; ### Inheritance: @ISA = qw(IO::Handle); #============================== =head2 Construction =over 4 =cut #------------------------------ =item new [ARGS...] I Return a new, unattached scalar handle. If any arguments are given, they're sent to open(). =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = bless \do { local *FH }, $class; tie *$self, $class, $self; $self->open(@_); ### open on anonymous by default $self; } sub DESTROY { shift->close; } #------------------------------ =item open [SCALARREF] I Open the scalar handle on a new scalar, pointed to by SCALARREF. If no SCALARREF is given, a "private" scalar is created to hold the file data. Returns the self object on success, undefined on error. =cut sub open { my ($self, $sref) = @_; ### Sanity: defined($sref) or do {my $s = ''; $sref = \$s}; (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar"; ### Setup: *$self->{Pos} = 0; ### seek position *$self->{SR} = $sref; ### scalar reference $self; } #------------------------------ =item opened I Is the scalar handle opened on something? =cut sub opened { *{shift()}->{SR}; } #------------------------------ =item close I Disassociate the scalar handle from its underlying scalar. Done automatically on destroy. =cut sub close { my $self = shift; %{*$self} = (); 1; } =back =cut #============================== =head2 Input and output =over 4 =cut #------------------------------ =item flush I No-op, provided for OO compatibility. =cut sub flush { "0 but true" } #------------------------------ =item getc I Return the next character, or undef if none remain. =cut sub getc { my $self = shift; ### Return undef right away if at EOF; else, move pos forward: return undef if $self->eof; substr(${*$self->{SR}}, *$self->{Pos}++, 1); } #------------------------------ =item getline I Return the next line, or undef on end of string. Can safely be called in an array context. Currently, lines are delimited by "\n". =cut sub getline { my $self = shift; ### Return undef right away if at EOF: return undef if $self->eof; ### Get next line: my $sr = *$self->{SR}; my $i = *$self->{Pos}; ### Start matching at this point. ### Minimal impact implementation! ### We do the fast fast thing (no regexps) if using the ### classic input record separator. ### Case 1: $/ is undef: slurp all... if (!defined($/)) { *$self->{Pos} = length $$sr; return substr($$sr, $i); } ### Case 2: $/ is "\n": zoom zoom zoom... elsif ($/ eq "\012") { ### Seek ahead for "\n"... yes, this really is faster than regexps. my $len = length($$sr); for (; $i < $len; ++$i) { last if ord (substr ($$sr, $i, 1)) == 10; } ### Extract the line: my $line; if ($i < $len) { ### We found a "\n": $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1); *$self->{Pos} = $i+1; ### Remember where we finished up. } else { ### No "\n"; slurp the remainder: $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos}); *$self->{Pos} = $len; } return $line; } ### Case 3: $/ is ref to int. Do fixed-size records. ### (Thanks to Dominique Quatravaux.) elsif (ref($/)) { my $len = length($$sr); my $i = ${$/} + 0; my $line = substr ($$sr, *$self->{Pos}, $i); *$self->{Pos} += $i; *$self->{Pos} = $len if (*$self->{Pos} > $len); return $line; } ### Case 4: $/ is either "" (paragraphs) or something weird... ### This is Graham's general-purpose stuff, which might be ### a tad slower than Case 2 for typical data, because ### of the regexps. else { pos($$sr) = $i; ### If in paragraph mode, skip leading lines (and update i!): length($/) or (($$sr =~ m/\G\n*/g) and ($i = pos($$sr))); ### If we see the separator in the buffer ahead... if (length($/) ? $$sr =~ m,\Q$/\E,g ### (ordinary sep) TBD: precomp! : $$sr =~ m,\n\n,g ### (a paragraph) ) { *$self->{Pos} = pos $$sr; return substr($$sr, $i, *$self->{Pos}-$i); } ### Else if no separator remains, just slurp the rest: else { *$self->{Pos} = length $$sr; return substr($$sr, $i); } } } #------------------------------ =item getlines I Get all remaining lines. It will croak() if accidentally called in a scalar context. =cut sub getlines { my $self = shift; wantarray or croak("can't call getlines in scalar context!"); my ($line, @lines); push @lines, $line while (defined($line = $self->getline)); @lines; } #------------------------------ =item print ARGS... I Print ARGS to the underlying scalar. B this continues to always cause a seek to the end of the string, but if you perform seek()s and tell()s, it is still safer to explicitly seek-to-end before subsequent print()s. =cut sub print { my $self = shift; *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : "")); 1; } sub _unsafe_print { my $self = shift; my $append = join('', @_) . $\; ${*$self->{SR}} .= $append; *$self->{Pos} += length($append); 1; } sub _old_print { my $self = shift; ${*$self->{SR}} .= join('', @_) . $\; *$self->{Pos} = length(${*$self->{SR}}); 1; } #------------------------------ =item read BUF, NBYTES, [OFFSET] I Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub read { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n); $n = length($read); *$self->{Pos} += $n; ($off ? substr($_[1], $off) : $_[1]) = $read; return $n; } #------------------------------ =item write BUF, NBYTES, [OFFSET] I Write some bytes to the scalar. =cut sub write { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $data = substr($_[1], $off, $n); $n = length($data); $self->print($data); return $n; } #------------------------------ =item sysread BUF, LEN, [OFFSET] I Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub sysread { my $self = shift; $self->read(@_); } #------------------------------ =item syswrite BUF, NBYTES, [OFFSET] I Write some bytes to the scalar. =cut sub syswrite { my $self = shift; $self->write(@_); } =back =cut #============================== =head2 Seeking/telling and other attributes =over 4 =cut #------------------------------ =item autoflush I No-op, provided for OO compatibility. =cut sub autoflush {} #------------------------------ =item binmode I No-op, provided for OO compatibility. =cut sub binmode {} #------------------------------ =item clearerr I Clear the error and EOF flags. A no-op. =cut sub clearerr { 1 } #------------------------------ =item eof I Are we at end of file? =cut sub eof { my $self = shift; (*$self->{Pos} >= length(${*$self->{SR}})); } #------------------------------ =item seek OFFSET, WHENCE I Seek to a given position in the stream. =cut sub seek { my ($self, $pos, $whence) = @_; my $eofpos = length(${*$self->{SR}}); ### Seek: if ($whence == 0) { *$self->{Pos} = $pos } ### SEEK_SET elsif ($whence == 1) { *$self->{Pos} += $pos } ### SEEK_CUR elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos} ### SEEK_END else { croak "bad seek whence ($whence)" } ### Fixup: if (*$self->{Pos} < 0) { *$self->{Pos} = 0 } if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos } return 1; } #------------------------------ =item sysseek OFFSET, WHENCE I Identical to C, I =cut sub sysseek { my $self = shift; $self->seek (@_); } #------------------------------ =item tell I Return the current position in the stream, as a numeric offset. =cut sub tell { *{shift()}->{Pos} } #------------------------------ =item use_RS [YESNO] I B Obey the current setting of $/, like IO::Handle does? Default is false in 1.x, but cold-welded true in 2.x and later. =cut sub use_RS { my ($self, $yesno) = @_; carp "use_RS is deprecated and ignored; \$/ is always consulted\n"; } #------------------------------ =item setpos POS I Set the current position, using the opaque value returned by C. =cut sub setpos { shift->seek($_[0],0) } #------------------------------ =item getpos I Return the current position in the string, as an opaque object. =cut *getpos = \&tell; #------------------------------ =item sref I Return a reference to the underlying scalar. =cut sub sref { *{shift()}->{SR} } #------------------------------ # Tied handle methods... #------------------------------ # Conventional tiehandle interface: sub TIEHANDLE { ((defined($_[1]) && UNIVERSAL::isa($_[1], __PACKAGE__)) ? $_[1] : shift->new(@_)); } sub GETC { shift->getc(@_) } sub PRINT { shift->print(@_) } sub PRINTF { shift->print(sprintf(shift, @_)) } sub READ { shift->read(@_) } sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) } sub WRITE { shift->write(@_); } sub CLOSE { shift->close(@_); } sub SEEK { shift->seek(@_); } sub TELL { shift->tell(@_); } sub EOF { shift->eof(@_); } #------------------------------------------------------------ 1; __END__ =back =cut =head1 WARNINGS Perl's TIEHANDLE spec was incomplete prior to 5.005_57; it was missing support for C, C, and C. Attempting to use these functions with an IO::Scalar will not work prior to 5.005_57. IO::Scalar will not have the relevant methods invoked; and even worse, this kind of bug can lie dormant for a while. If you turn warnings on (via C<$^W> or C), and you see something like this... attempt to seek on unopened filehandle ...then you are probably trying to use one of these functions on an IO::Scalar with an old Perl. The remedy is to simply use the OO version; e.g.: $SH->seek(0,0); ### GOOD: will work on any 5.005 seek($SH,0,0); ### WARNING: will only work on 5.005_57 and beyond =head1 VERSION $Id: Scalar.pm,v 1.6 2005/02/10 21:21:53 dfs Exp $ =head1 AUTHORS =head2 Primary Maintainer David F. Skoll (F). =head2 Principal author Eryq (F). President, ZeeGee Software Inc (F). =head2 Other contributors The full set of contributors always includes the folks mentioned in L. But just the same, special thanks to the following individuals for their invaluable contributions (if I've forgotten or misspelled your name, please email me!): I for contributing C. I for suggesting C. I for finding and fixing the bug in C. I for his offset-using read() and write() implementations. I for his patches to massively improve the performance of C and add C and C. I for stringification and inheritance improvements, and sundry good ideas. I for the IO::Handle inheritance and automatic tie-ing. =head1 SEE ALSO L, which is quite similar but which was designed more-recently and with an IO::Handle-like interface in mind, so you could mix OO- and native-filehandle usage without using tied(). I as of version 2.x, these classes all work like their IO::Handle counterparts, so we have comparable functionality to IO::String. =cut Color.pm000664001750001750 171114411570357 22633 0ustar00taitai000000000000Exporter-Tiny-1.006002/inc/archaic/Test/Builder/Testerpackage Test::Builder::Tester::Color; use strict; our $VERSION = "1.22"; require Test::Builder::Tester; =head1 NAME Test::Builder::Tester::Color - turn on colour in Test::Builder::Tester =head1 SYNOPSIS When running a test script perl -MTest::Builder::Tester::Color test.t =head1 DESCRIPTION Importing this module causes the subroutine color in Test::Builder::Tester to be called with a true value causing colour highlighting to be turned on in debug output. The sole purpose of this module is to enable colour highlighting from the command line. =cut sub import { Test::Builder::Tester::color(1); } =head1 AUTHOR Copyright Mark Fowler Emark@twoshortplanks.comE 2002. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 BUGS This module will have no effect unless Term::ANSIColor is installed. =head1 SEE ALSO L, L =cut 1;