Sub-Exporter-0.986/000755 000766 000766 00000000000 12156716434 014066 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/Changes000644 000766 000766 00000011623 12156716434 015364 0ustar00rjbsrjbs000000 000000 Revision history for Sub-Exporter 0.986 2013-06-14 18:45:45 America/New_York typo fixes in docs (thanks, David Steinbrunner!) 0.985 2013-02-20 19:02:30 America/New_York documentation fixes (thanks, George Hartzell) 0.984 2012-06-05 07:59:40 America/New_York documentation fixes (thanks, GitHub user "everybody") 0.983 2011-01-24 documentation fixes (thanks, Karen Etheridge and Luc St-Louis!) 0.982 2009-01-16 add metadata for repo 0.981 2008-10-24 finally fix very occasional hash ordering issue in tests fix typo in SYNOPSIS (thanks, Florian!) 0.980 2008-09-14 fix inadvertant futzing with group generator args https://rt.cpan.org/Ticket/Display.html?id=38885 thanks, trendele! 0.979 2008-04-29 add INIT collector declare reservation of all CAPS collectors clarify documentation of -setup after report by GAISSMAI 0.978 2007-11-19 improve documentation of new installer/generator options deprecate calling "installer" the "exporter" WARNING: "exporter" OPTION WILL BE REMOVED AFTER 2008-06-01 major refactoring of the core generation/installation code tentative interface documentation for replacing it! 0.976 2007-08-30 fixed merge_col, which was not updated to work with \name generators collector hooks can now alter @_ to replace the value to be collected clarify args passed to generator in Tutorial; thanks MARKSTOS added commented-out name_map to Sub::Exporter::Util; future feature? 0.975 2007-07-04 update Tutorial to show (preferred) \'name' style for generators changed "standard" name of curry_class to curry_method added curry_chain added Sub::Exporter::Cookbook 0.974 2007-04-22 fix a bug: would try to export routines that didn't exist in the exporting package; this caused Sub::Install to give the unhelpful message "argument 'code' is not optional" 0.973 2007-02-02 document changes made in 0.972 minor code changes for readability 0.972 2006-12-05 allow exporter config to provide name (via string ref) of generator for groups and exports similarly allow a string ref for a method name for a collector hook remove some pointless conditions 0.971 2006-11-06 minor documentation clarification add Perl::Critic tests (disabled by default) 0.970 2006-06-27 defaults populate before collectors collect, now default group's value is undef by default, not 1 mixin_exporter can now export into objects, creating virtual classes 0.966 2006-06-17 correct documentation of collector hook args simplify internal use of setup_exporter clean up documentation in ::Util 0.965 2006-06-05 curry_class now allows the export to curry a differently-named method 0.961 2006-06-05 Data::OptList is now in its own dist; updated to use it 0.960 2006-05-31 added into and into_config to config 100% test coverage... almost! fix bug that prevented validation of opt lists with must_be=class 0.954 2006-05-11 tweaks to Data::OptList, moving toward its own dist: now it exports expand_opt_list is now opt_list_as_hash 0.953 2006-05-10 require Params::Util for craftier opt list validation use reinstall, rather than install, to avoid warnings on redef 0.952 2006-04-30 add missing file to manifest 0.951 2006-04-30 fix util-mixin.t to skip if prereqs are missing various changes to improve blessed/weird generators (thanks to Yuval Kogman for pointing problems out) 0.95 2006-04-26 break out Data::OptList for future disting remove an "optimization" that broke expand_opt_list improve detection of group generators improve data passed to hooks (if you relied on the guts, you'll break) the ::Util module 0.93 2006-03-26 internal refactoring add more arguments to collector hook calls 0.92 2006-03-16 FIX BUG in nested imports: when importing groups A and B, and group B includes group A, the nested group would be ignored, even though it was not recursing allow 'into_level' parameter to setup_exporter rewrite collection collector to be more efficient rewrite opt list handlers to be more efficient restate some code to improve clarity and coverage (now 100%) better diagnostic messages 0.91 2006-03-16 added "import elsewhere" option to generated exporter (thanks chansen!) 0.90 2006-03-11 first public release Sub-Exporter-0.986/dist.ini000644 000766 000766 00000000324 12156716434 015531 0ustar00rjbsrjbs000000 000000 name = Sub-Exporter author = Ricardo Signes license = Perl_5 copyright_holder = Ricardo Signes copyright_year = 2007 [@RJBS] [RemovePrereqs] remove = E::Parent remove = Package::Generator Sub-Exporter-0.986/lib/000755 000766 000766 00000000000 12156716434 014634 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/LICENSE000644 000766 000766 00000043661 12156716434 015105 0ustar00rjbsrjbs000000 000000 This software is copyright (c) 2007 by Ricardo Signes. 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) 2007 by Ricardo Signes. 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, Suite 500, Boston, MA 02110-1335 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) 2007 by Ricardo Signes. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Sub-Exporter-0.986/Makefile.PL000644 000766 000766 00000003177 12156716434 016050 0ustar00rjbsrjbs000000 000000 use strict; use warnings; use 5.006; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "a sophisticated exporter for custom-built routines", "AUTHOR" => "Ricardo Signes ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "Sub-Exporter", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "Sub::Exporter", "PREREQ_PM" => { "Carp" => 0, "Data::OptList" => "0.100", "Params::Util" => "0.14", "Sub::Install" => "0.92", "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Exporter" => 0, "File::Find" => 0, "File::Temp" => 0, "Test::More" => "0.96", "base" => 0, "overload" => 0, "subs" => 0 }, "VERSION" => "0.986", "test" => { "TESTS" => "t/*.t" } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { my $tr = delete $WriteMakefileArgs{TEST_REQUIRES}; my $br = $WriteMakefileArgs{BUILD_REQUIRES}; for my $mod ( keys %$tr ) { if ( exists $br->{$mod} ) { $br->{$mod} = $tr->{$mod} if $tr->{$mod} > $br->{$mod}; } else { $br->{$mod} = $tr->{$mod}; } } } unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Sub-Exporter-0.986/MANIFEST000644 000766 000766 00000001432 12156716434 015217 0ustar00rjbsrjbs000000 000000 Changes LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/Sub/Exporter.pm lib/Sub/Exporter/Cookbook.pod lib/Sub/Exporter/Tutorial.pod lib/Sub/Exporter/Util.pm t/00-compile.t t/000-report-versions-tiny.t t/col-init.t t/collection.t t/expand-group.t t/faux-export.t t/gen-callable.t t/group-generator.t t/inherited.t t/into-level.t t/lib/Test/SubExporter/DashSetup.pm t/lib/Test/SubExporter/Faux.pm t/lib/Test/SubExporter/GroupGen.pm t/lib/Test/SubExporter/GroupGenSubclass.pm t/lib/Test/SubExporter/ObjGen.pm t/lib/Test/SubExporter/s_e.pm t/real-export-groupgen.t t/real-export-href.t t/real-export-setup.t t/util-curry.t t/util-currychain.t t/util-like.t t/util-merge.t t/util-mixin.t t/util-namemap.t t/valid-config.t xt/release/changes_has_content.t xt/release/pod-syntax.t Sub-Exporter-0.986/META.json000644 000766 000766 00000020451 12156716434 015511 0ustar00rjbsrjbs000000 000000 { "abstract" : "a sophisticated exporter for custom-built routines", "author" : [ "Ricardo Signes " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 4.300034, CPAN::Meta::Converter version 2.131560", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Sub-Exporter", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "Test::Pod" : "1.41", "version" : "0.9901" } }, "runtime" : { "requires" : { "Carp" : "0", "Data::OptList" : "0.100", "Params::Util" : "0.14", "Sub::Install" : "0.92", "perl" : "5.006", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Exporter" : "0", "File::Find" : "0", "File::Temp" : "0", "Test::More" : "0.96", "base" : "0", "overload" : "0", "subs" : "0" } } }, "release_status" : "stable", "resources" : { "homepage" : "https://github.com/rjbs/sub-exporter", "repository" : { "type" : "git", "url" : "https://github.com/rjbs/sub-exporter.git", "web" : "https://github.com/rjbs/sub-exporter" } }, "version" : "0.986", "x_Dist_Zilla" : { "perl" : { "version" : "5.019000" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "name" : "@RJBS/Git::GatherDir", "version" : "2.013" }, { "class" : "Dist::Zilla::Plugin::CheckPrereqsIndexed", "name" : "@RJBS/CheckPrereqsIndexed", "version" : "0.009" }, { "class" : "Dist::Zilla::Plugin::CheckExtraTests", "name" : "@RJBS/CheckExtraTests", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "@RJBS/@Filter/PruneCruft", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "@RJBS/@Filter/ManifestSkip", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@RJBS/@Filter/MetaYAML", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@RJBS/@Filter/License", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Readme", "name" : "@RJBS/@Filter/Readme", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@RJBS/@Filter/ExecDir", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@RJBS/@Filter/ShareDir", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "name" : "@RJBS/@Filter/MakeMaker", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@RJBS/@Filter/Manifest", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@RJBS/@Filter/TestRelease", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@RJBS/@Filter/ConfirmRelease", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@RJBS/@Filter/UploadToCPAN", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "@RJBS/AutoPrereqs", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Git::NextVersion", "name" : "@RJBS/Git::NextVersion", "version" : "2.013" }, { "class" : "Dist::Zilla::Plugin::PkgVersion", "name" : "@RJBS/PkgVersion", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@RJBS/MetaConfig", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@RJBS/MetaJSON", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@RJBS/NextRelease", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Test::ChangesHasContent", "name" : "@RJBS/Test::ChangesHasContent", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@RJBS/PodSyntaxTests", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::Test::Compile", "name" : "@RJBS/Test::Compile", "version" : "2.002" }, { "class" : "Dist::Zilla::Plugin::ReportVersions::Tiny", "name" : "@RJBS/ReportVersions::Tiny", "version" : "1.08" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "@RJBS/TestMoreWithSubtests", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::PodWeaver", "name" : "@RJBS/PodWeaver", "version" : "3.101641" }, { "class" : "Dist::Zilla::Plugin::GithubMeta", "name" : "@RJBS/GithubMeta", "version" : "0.28" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "name" : "@RJBS/@Git/Check", "version" : "2.013" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "name" : "@RJBS/@Git/Commit", "version" : "2.013" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "name" : "@RJBS/@Git/Tag", "version" : "2.013" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "name" : "@RJBS/@Git/Push", "version" : "2.013" }, { "class" : "Dist::Zilla::Plugin::RemovePrereqs", "config" : { "Dist::Zilla::Plugin::RemovePrereqs" : { "modules_to_remove" : [ "E::Parent", "Package::Generator" ] } }, "name" : "RemovePrereqs", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "4.300034" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "4.300034" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : "0" }, "version" : "4.300034" } } } Sub-Exporter-0.986/META.yml000644 000766 000766 00000012437 12156716434 015346 0ustar00rjbsrjbs000000 000000 --- abstract: 'a sophisticated exporter for custom-built routines' author: - 'Ricardo Signes ' build_requires: Exporter: 0 File::Find: 0 File::Temp: 0 Test::More: 0.96 base: 0 overload: 0 subs: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300034, CPAN::Meta::Converter version 2.131560' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Sub-Exporter requires: Carp: 0 Data::OptList: 0.100 Params::Util: 0.14 Sub::Install: 0.92 perl: 5.006 strict: 0 warnings: 0 resources: homepage: https://github.com/rjbs/sub-exporter repository: https://github.com/rjbs/sub-exporter.git version: 0.986 x_Dist_Zilla: perl: version: 5.019000 plugins: - class: Dist::Zilla::Plugin::Git::GatherDir name: '@RJBS/Git::GatherDir' version: 2.013 - class: Dist::Zilla::Plugin::CheckPrereqsIndexed name: '@RJBS/CheckPrereqsIndexed' version: 0.009 - class: Dist::Zilla::Plugin::CheckExtraTests name: '@RJBS/CheckExtraTests' version: 0.011 - class: Dist::Zilla::Plugin::PruneCruft name: '@RJBS/@Filter/PruneCruft' version: 4.300034 - class: Dist::Zilla::Plugin::ManifestSkip name: '@RJBS/@Filter/ManifestSkip' version: 4.300034 - class: Dist::Zilla::Plugin::MetaYAML name: '@RJBS/@Filter/MetaYAML' version: 4.300034 - class: Dist::Zilla::Plugin::License name: '@RJBS/@Filter/License' version: 4.300034 - class: Dist::Zilla::Plugin::Readme name: '@RJBS/@Filter/Readme' version: 4.300034 - class: Dist::Zilla::Plugin::ExecDir name: '@RJBS/@Filter/ExecDir' version: 4.300034 - class: Dist::Zilla::Plugin::ShareDir name: '@RJBS/@Filter/ShareDir' version: 4.300034 - class: Dist::Zilla::Plugin::MakeMaker name: '@RJBS/@Filter/MakeMaker' version: 4.300034 - class: Dist::Zilla::Plugin::Manifest name: '@RJBS/@Filter/Manifest' version: 4.300034 - class: Dist::Zilla::Plugin::TestRelease name: '@RJBS/@Filter/TestRelease' version: 4.300034 - class: Dist::Zilla::Plugin::ConfirmRelease name: '@RJBS/@Filter/ConfirmRelease' version: 4.300034 - class: Dist::Zilla::Plugin::UploadToCPAN name: '@RJBS/@Filter/UploadToCPAN' version: 4.300034 - class: Dist::Zilla::Plugin::AutoPrereqs name: '@RJBS/AutoPrereqs' version: 4.300034 - class: Dist::Zilla::Plugin::Git::NextVersion name: '@RJBS/Git::NextVersion' version: 2.013 - class: Dist::Zilla::Plugin::PkgVersion name: '@RJBS/PkgVersion' version: 4.300034 - class: Dist::Zilla::Plugin::MetaConfig name: '@RJBS/MetaConfig' version: 4.300034 - class: Dist::Zilla::Plugin::MetaJSON name: '@RJBS/MetaJSON' version: 4.300034 - class: Dist::Zilla::Plugin::NextRelease name: '@RJBS/NextRelease' version: 4.300034 - class: Dist::Zilla::Plugin::Test::ChangesHasContent name: '@RJBS/Test::ChangesHasContent' version: 0.006 - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@RJBS/PodSyntaxTests' version: 4.300034 - class: Dist::Zilla::Plugin::Test::Compile name: '@RJBS/Test::Compile' version: 2.002 - class: Dist::Zilla::Plugin::ReportVersions::Tiny name: '@RJBS/ReportVersions::Tiny' version: 1.08 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: '@RJBS/TestMoreWithSubtests' version: 4.300034 - class: Dist::Zilla::Plugin::PodWeaver name: '@RJBS/PodWeaver' version: 3.101641 - class: Dist::Zilla::Plugin::GithubMeta name: '@RJBS/GithubMeta' version: 0.28 - class: Dist::Zilla::Plugin::Git::Check name: '@RJBS/@Git/Check' version: 2.013 - class: Dist::Zilla::Plugin::Git::Commit name: '@RJBS/@Git/Commit' version: 2.013 - class: Dist::Zilla::Plugin::Git::Tag name: '@RJBS/@Git/Tag' version: 2.013 - class: Dist::Zilla::Plugin::Git::Push name: '@RJBS/@Git/Push' version: 2.013 - class: Dist::Zilla::Plugin::RemovePrereqs config: Dist::Zilla::Plugin::RemovePrereqs: modules_to_remove: - E::Parent - Package::Generator name: RemovePrereqs version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: 4.300034 - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: 4.300034 zilla: class: Dist::Zilla::Dist::Builder config: is_trial: 0 version: 4.300034 Sub-Exporter-0.986/README000644 000766 000766 00000000476 12156716434 014755 0ustar00rjbsrjbs000000 000000 This archive contains the distribution Sub-Exporter, version 0.986: a sophisticated exporter for custom-built routines This software is copyright (c) 2007 by Ricardo Signes. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Sub-Exporter-0.986/t/000755 000766 000766 00000000000 12156716434 014331 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/xt/000755 000766 000766 00000000000 12156716434 014521 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/xt/release/000755 000766 000766 00000000000 12156716434 016141 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/xt/release/changes_has_content.t000644 000766 000766 00000002011 12156716434 022315 0ustar00rjbsrjbs000000 000000 #!perl use Test::More tests => 2; note 'Checking Changes'; my $changes_file = 'Changes'; my $newver = '0.986'; my $trial_token = '-TRIAL'; SKIP: { ok(-e $changes_file, "$changes_file file exists") or skip 'Changes is missing', 1; ok(_get_changes($newver), "$changes_file has content for $newver"); } done_testing; # _get_changes copied and adapted from Dist::Zilla::Plugin::Git::Commit # by Jerome Quelin sub _get_changes { my $newver = shift; # parse changelog to find commit message open(my $fh, '<', $changes_file) or die "cannot open $changes_file: $!"; my $changelog = join('', <$fh>); close $fh; my @content = grep { /^$newver(?:$trial_token)?(?:\s+|$)/ ... /^\S/ } # from newver to un-indented split /\n/, $changelog; shift @content; # drop the version line # drop unindented last line and trailing blank lines pop @content while ( @content && $content[-1] =~ /^(?:\S|\s*$)/ ); # return number of non-blank lines return scalar @content; } Sub-Exporter-0.986/xt/release/pod-syntax.t000644 000766 000766 00000000212 12156716434 020427 0ustar00rjbsrjbs000000 000000 #!perl use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); Sub-Exporter-0.986/t/00-compile.t000644 000766 000766 00000003126 12156716434 016365 0ustar00rjbsrjbs000000 000000 #!perl use strict; use warnings; use Test::More; use File::Find; use File::Temp qw{ tempdir }; my @modules; find( sub { return if $File::Find::name !~ /\.pm\z/; my $found = $File::Find::name; $found =~ s{^lib/}{}; $found =~ s{[/\\]}{::}g; $found =~ s/\.pm$//; # nothing to skip push @modules, $found; }, 'lib', ); sub _find_scripts { my $dir = shift @_; my @found_scripts = (); find( sub { return unless -f; my $found = $File::Find::name; # nothing to skip open my $FH, '<', $_ or do { note( "Unable to open $found in ( $! ), skipping" ); return; }; my $shebang = <$FH>; return unless $shebang =~ /^#!.*?\bperl\b\s*$/; push @found_scripts, $found; }, $dir, ); return @found_scripts; } my @scripts; do { push @scripts, _find_scripts($_) if -d $_ } for qw{ bin script scripts }; my $plan = scalar(@modules) + scalar(@scripts); $plan ? (plan tests => $plan) : (plan skip_all => "no tests to run"); { # fake home for cpan-testers # no fake requested ## local $ENV{HOME} = tempdir( CLEANUP => 1 ); like( qx{ $^X -Ilib -e "require $_; print '$_ ok'" }, qr/^\s*$_ ok/s, "$_ loaded ok" ) for sort @modules; SKIP: { eval "use Test::Script 1.05; 1;"; skip "Test::Script needed to test script compilation", scalar(@scripts) if $@; foreach my $file ( @scripts ) { my $script = $file; $script =~ s!.*/!!; script_compiles( $file, "$script script compiles" ); } } } Sub-Exporter-0.986/t/000-report-versions-tiny.t000644 000766 000766 00000005063 12156716434 021161 0ustar00rjbsrjbs000000 000000 use strict; use warnings; use Test::More 0.88; # This is a relatively nice way to avoid Test::NoWarnings breaking our # expectations by adding extra tests, without using no_plan. It also helps # avoid any other test module that feels introducing random tests, or even # test plans, is a nice idea. our $success = 0; END { $success && done_testing; } # List our own version used to generate this my $v = "\nGenerated by Dist::Zilla::Plugin::ReportVersions::Tiny v1.08\n"; eval { # no excuses! # report our Perl details my $want = '5.006'; $v .= "perl: $] (wanted $want) on $^O from $^X\n\n"; }; defined($@) and diag("$@"); # Now, our module version dependencies: sub pmver { my ($module, $wanted) = @_; $wanted = " (want $wanted)"; my $pmver; eval "require $module;"; if ($@) { if ($@ =~ m/Can't locate .* in \@INC/) { $pmver = 'module not found.'; } else { diag("${module}: $@"); $pmver = 'died during require.'; } } else { my $version; eval { $version = $module->VERSION; }; if ($@) { diag("${module}: $@"); $pmver = 'died during VERSION check.'; } elsif (defined $version) { $pmver = "$version"; } else { $pmver = ''; } } # So, we should be good, right? return sprintf('%-45s => %-10s%-15s%s', $module, $pmver, $wanted, "\n"); } eval { $v .= pmver('Carp','any version') }; eval { $v .= pmver('Data::OptList','0.100') }; eval { $v .= pmver('Exporter','any version') }; eval { $v .= pmver('ExtUtils::MakeMaker','6.30') }; eval { $v .= pmver('File::Find','any version') }; eval { $v .= pmver('File::Temp','any version') }; eval { $v .= pmver('Params::Util','0.14') }; eval { $v .= pmver('Sub::Install','0.92') }; eval { $v .= pmver('Test::More','0.96') }; eval { $v .= pmver('Test::Pod','1.41') }; eval { $v .= pmver('base','any version') }; eval { $v .= pmver('overload','any version') }; eval { $v .= pmver('strict','any version') }; eval { $v .= pmver('subs','any version') }; eval { $v .= pmver('version','0.9901') }; eval { $v .= pmver('warnings','any version') }; # All done. $v .= <<'EOT'; Thanks for using my code. I hope it works for you. If not, please try and include this output in the bug report. That will help me reproduce the issue and solve your problem. EOT diag($v); ok(1, "we really didn't test anything, just reporting data"); $success = 1; # Work around another nasty module on CPAN. :/ no warnings 'once'; $Template::Test::NO_FLUSH = 1; exit 0; Sub-Exporter-0.986/t/col-init.t000644 000766 000766 00000002170 12156716434 016234 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests exercise the handling of collections in the exporter option lists. =cut use Test::More tests => 3; use Data::OptList qw(mkopt_hash); BEGIN { use_ok('Sub::Exporter'); } sub is_defined { my ($class, $value, $arg) = @_; return defined $value; } my $counter = 0; my $config = { exports => [ qw(circsaw drill handsaw nailgun) ], collectors => [ INIT => sub { my ($value, $arg) = @_; return 0 if @{$arg->{import_args}}; # in other words, fail if args $_[0] = [ $counter++ ]; return 1; }, ] }; $config->{$_} = mkopt_hash($config->{$_}) for qw(exports collectors); { my $collection = Sub::Exporter::_collect_collections( $config, [ ], 'main', ); is_deeply( $collection, { INIT => [ 0 ] }, "collection returned properly from collector", ); } { my $collection = eval { Sub::Exporter::_collect_collections( $config, [ [ handsaw => undef ] ], 'main', ); }; like( $@, qr/INIT failed/, "the init collector is run even when other things are here", ); } Sub-Exporter-0.986/t/collection.t000644 000766 000766 00000005515 12156716434 016657 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests exercise the handling of collections in the exporter option lists. =cut use Test::More tests => 8; use Data::OptList qw(mkopt_hash); BEGIN { use_ok('Sub::Exporter'); } sub is_defined { my ($class, $value, $arg) = @_; return defined $value; } my $config = { exports => [ qw(circsaw drill handsaw nailgun), hammer => sub { sub { print "BANG BANG BANG\n" } }, ], groups => { default => [ 'handsaw', 'hammer' => { claw => 1 }, ], cutters => [ qw(circsaw handsaw), circsaw => { as => 'buzzsaw' } ], }, collectors => [ 'defaults', brand_preference => sub { 0 }, model_preference => sub { 1 }, sets_own_value => sub { $_[0] = { foo => 10 } }, definedp => \'is_defined', ] }; $config->{$_} = mkopt_hash($config->{$_}) for qw(exports collectors); { my $collection = Sub::Exporter::_collect_collections( $config, [ [ circsaw => undef ], [ defaults => { foo => 1, bar => 2 } ] ], 'main', ); is_deeply( $collection, { defaults => { foo => 1, bar => 2 } }, "collection returned properly from collector", ); } { my $collection = Sub::Exporter::_collect_collections( $config, [ [ sets_own_value => undef ] ], 'main', ); is_deeply( $collection, { sets_own_value => { foo => 10} }, "a collector can alter the stack to change its own value", ); } { my $arg = [ [ defaults => [ 1 ] ], [ defaults => { foo => 1, bar => 2 } ] ]; eval { Sub::Exporter::_collect_collections($config, $arg, 'main'); }; like( $@, qr/collection \S+ provided multiple/, "can't provide multiple collection values", ); } { # because the brand_preference validator always fails, this should die my $arg = [ [ brand_preference => [ 1, 2, 3 ] ] ]; eval { Sub::Exporter::_collect_collections($config, $arg, 'main') }; like( $@, qr/brand_preference failed validation/, "collector validator prevents bad export" ); } { # the definedp collector should require a defined value; this should be ok my $arg = [ [ definedp => {} ] ]; my $collection = Sub::Exporter::_collect_collections($config, $arg, 'main'); is_deeply( $collection, { definedp => {} }, "collector validator allows collection" ); } { # the definedp collector should require a defined value; this should die my $arg = [ [ definedp => undef ] ]; eval { Sub::Exporter::_collect_collections($config, $arg, 'main') }; like( $@, qr/definedp failed validation/, "collector validator prevents bad export" ); } { my $arg = [ [ model_preference => [ 1, 2, 3 ] ] ]; my $collection = Sub::Exporter::_collect_collections($config, $arg, 'main'); is_deeply( $collection, { model_preference => [ 1, 2, 3 ] }, "true-returning validator allows collection", ); } Sub-Exporter-0.986/t/expand-group.t000644 000766 000766 00000012417 12156716434 017134 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests check export group expansion, name prefixing, and option merging. =cut use Test::More tests => 55; BEGIN { use_ok('Sub::Exporter'); } my $import_target; my $config = { exports => [ qw(a b c) ], groups => { A => [ 'a' ], B => [ qw(b c) ], C => [ qw(a b :C) ], D => [ qw(:A :B) ], a_as_b => [ a => { -as => 'b' } ], prefixed_A => [ -A => { -prefix => 'alfa_' } ], suffixed_A => [ -A => { -suffix => '_yankee' } ], diprefixed_A => [ -prefixed_A => { -prefix => 'bravo_' } ], disuffixed_A => [ -suffixed_A => { -suffix => '_zulu' } ], presuffixed_A=> [ -A => { -prefix => 'freakin_', -suffix => '_right' } ], a_to_subref => [ a => { -as => \$import_target }, 'b' ], prefixed_a_s => [ -a_to_subref => { -prefix => 'alfa_' } ], } }; my @single_tests = ( [ "simple group 1", [ ':A' => undef ] => [ [ a => undef ] ] ], [ "simple group 2", [ ':B' => undef ] => [ [ b => undef ], [ c => undef ] ] ], [ "group of groups", [ ':D' => undef ], [ [ a => undef ], [ b => undef ], [ c => undef ] ], ], [ "recursive group", [ ':C' => undef ], [ [ a => undef ], [b => undef ] ], ], [ "group with empty args", [ -A => { } ], [ [ a => undef ] ], ], [ "group with prefix", [ -A => { -prefix => 'alpha_' } ], [ [ a => { -as => 'alpha_a' } ] ], ], [ "group with suffix", [ -A => { -suffix => '_import' } ], [ [ a => { -as => 'a_import' } ] ], ], [ "recursive group with prefix", [ -C => { -prefix => 'kappa_' } ], [ [ a => { -as => 'kappa_a' } ], [ b => { -as => 'kappa_b' } ] ], ], [ "recursive group with suffix", [ -C => { -suffix => '_etc' } ], [ [ a => { -as => 'a_etc' } ], [ b => { -as => 'b_etc' } ] ], ], [ "group that renames", [ -a_as_b => undef ], [ [ a => { -as => 'b' } ] ], ], [ "group that renames, with options", [ -a_as_b => { foo => 10 } ], [ [ a => { -as => 'b', foo => 10 } ] ], ], [ "group that renames, with a prefix", [ -a_as_b => { -prefix => 'not_really_' } ], [ [ a => { -as => 'not_really_b' } ] ], ], [ "group that renames, with a suffix", [ -a_as_b => { -suffix => '_or_not' } ], [ [ a => { -as => 'b_or_not' } ] ], ], [ "group that renames, with a prefix and suffix", [ -a_as_b => { -prefix => 'not_really_' } ], [ [ a => { -as => 'not_really_b' } ] ], ], [ "recursive group with a built-in prefix", [ -prefixed_A => undef ], [ [ a => { -as => 'alfa_a' } ] ], ], [ "recursive group with built-in and passed-in prefix", [ -prefixed_A => { -prefix => 'bravo_' } ], [ [ a => { -as => 'bravo_alfa_a' } ] ], ], [ "recursive group with built-in and passed-in suffix", [ -suffixed_A => { -suffix => '_zulu' } ], [ [ a => { -as => 'a_yankee_zulu' } ] ], ], [ "multi-prefixed group", [ -diprefixed_A => undef ], [ [ a => { -as => 'bravo_alfa_a' } ] ], ], [ "multi-suffixed group", [ -disuffixed_A => undef ], [ [ a => { -as => 'a_yankee_zulu' } ] ], ], [ "multi-prefixed group with prefix", [ -diprefixed_A => { -prefix => 'charlie_' } ], [ [ a => { -as => 'charlie_bravo_alfa_a' } ] ], ], [ "group with built-in prefix and suffix", [ -presuffixed_A => undef ], [ [ a => { -as => 'freakin_a_right' } ] ], ], [ "group with built-in prefix and suffix, plus prefix", [ -presuffixed_A => { -prefix => 'totally_' } ], [ [ a => { -as => 'totally_freakin_a_right' } ] ], ], [ "group with built-in prefix and suffix, plus suffix", [ -presuffixed_A => { -suffix => '_dude' } ], [ [ a => { -as => 'freakin_a_right_dude' } ] ], ], [ "group with built-in prefix and suffix, plus prefix and suffix", [ -presuffixed_A => { -prefix => 'totally_', -suffix => '_dude' } ], [ [ a => { -as => 'totally_freakin_a_right_dude' } ] ], ], [ "group that exports to scalar (unusual)", [ -a_to_subref => undef ], [ [ a => { -as => \$import_target } ], [ b => undef ] ], ], [ "group that exports to scalar, with prefix", [ -a_to_subref => { -prefix => 'jubju' } ], [ [ a => { -as => \$import_target } ], [ b => { -as => 'jubjub' } ] ], ], ); for my $test (@single_tests) { my ($label, $given, $expected) = @$test; my @got = Sub::Exporter::_expand_group( 'Class', $config, $given, {}, ); is_deeply(\@got, $expected, "expand_group: $label"); } for my $test (@single_tests) { my ($label, $given, $expected) = @$test; my $got = Sub::Exporter::_expand_groups( 'Class', $config, [ $given ], ); is_deeply($got, $expected, "expand_groups: $label [single test]"); } my @multi_tests = ( [ "group and export", [ [ ':A', undef ], [ c => undef ] ], [ [ a => undef ], [ c => undef ] ] ], [ "two groups with different merges", [ [ -A => { -prefix => 'A_' } ], [ -prefixed_A => { -suffix => '_p' } ] ], [ [ a => { -as => 'A_a' } ], [ a => { -as => 'alfa_a_p' } ], ] ], ); for my $test (@multi_tests) { my ($label, $given, $expected) = @$test; my $got = Sub::Exporter::_expand_groups( 'Class', $config, $given, ); is_deeply($got, $expected, "expand_groups: $label"); } Sub-Exporter-0.986/t/faux-export.t000644 000766 000766 00000005733 12156716434 017010 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests check the output of build_installer when handed an alternate installer that returns its plan. =cut use Test::More tests => 11; BEGIN { use_ok('Sub::Exporter'); } use lib 't/lib'; use Test::SubExporter::Faux; my $config = { exports => [ qw(circsaw drill handsaw nailgun), hammer => sub { sub { print "BANG BANG BANG\n" } }, ], groups => { default => [ 'handsaw', 'hammer' => { claw => 1 }, ], cutters => [ qw(circsaw handsaw), circsaw => { -as => 'buzzsaw' } ], }, collectors => [ 'defaults', 'brand_preference' => sub { 0 }, ] }; { my ($generator, $installer, $reset, $exports) = faux_installer; my $code = sub { $reset->(); splice @_, 1, 0, { generator => $generator, installer => $installer }; Sub::Exporter::build_exporter($config)->(@_); }; $code->('Tools::Power'); exports_ok( $exports, [ [ handsaw => {} ], [ hammer => { claw => 1 } ] ], "exporting with no arguments gave us default group" ); $code->('Tools::Power', ':all'); exports_ok( [ sort { $a->[0] cmp $b->[0] } @$exports ], [ map { [ $_ => {} ] } sort qw(circsaw drill handsaw nailgun hammer), ], "exporting :all gave us all exports", ); $code->('Tools::Power', drill => { -as => 'auger' }); exports_ok( $exports, [ [ drill => {} ] ], "'-as' parameter is not passed to generators", ); $code->('Tools::Power', ':cutters'); exports_ok( $exports, [ [ circsaw => {} ], [ handsaw => {} ], [ circsaw => {} ] ], "group with two export instances of one export", ); eval { $code->('Tools::Power', 'router') }; like($@, qr/not exported/, "can't export un-exported export (got that?)"); eval { $code->('Tools::Power', ':sockets') }; like($@, qr/not exported/, "can't export nonexistent group, either"); # because the brand_preference validator always fails, this should die eval { $code->('Tools::Power', brand_preference => [ '...' ]) }; like( $@, qr/brand_preference failed validation/, "collector validator prevents bad export" ); } { my ($generator, $installer, $reset, $exports) = faux_installer; my $code = sub { $reset->(); splice @_, 1, 0, { generator => $generator, installer => $installer }; Sub::Exporter::build_exporter({ exports => [ 'foo' ] })->(@_); }; $code->('Example::Foo'); exports_ok( $exports, [ ], "exporting with no arguments gave us default default group, i.e., nothing" ); $code->('Tools::Power', ':all'); exports_ok( $exports, [ [ foo => {} ] ], "exporting :all gave us all exports, i.e., foo", ); } { package Test::SubExport::FAUX; my ($generator, $installer, $reset, $exports) = main::faux_installer; Sub::Exporter::setup_exporter({ exports => [ 'X' ], installer => $installer, generator => $generator, }); __PACKAGE__->import(':all'); main::exports_ok($exports, [ [ X => {} ] ], "setup (not built) exporter"); } Sub-Exporter-0.986/t/gen-callable.t000644 000766 000766 00000001065 12156716434 017026 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 8; use lib 't/lib'; BEGIN { use_ok("Sub::Exporter"); use_ok("Test::SubExporter::ObjGen", 'baz', '-meta', 'quux', '-ringo'); } is(quux(), 'QUUX', 'blessed coderef generator'); is(baz(), 'BAZ', 'object with &{} as generator'); is(foo(), 'FOO', 'object with &{} as group generator (1/2)'); is(bar(), 'BAR', 'object with &{} as group generator (2/2)'); is(ringo(), 'starr', 'blessed coderef as group generator (1/2)'); is(richard(), 'starkey', 'blessed coderef as group generator (2/2)'); Sub-Exporter-0.986/t/group-generator.t000644 000766 000766 00000007265 12156716434 017650 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests check export group expansion, specifically the expansion of groups that use group generators. =cut # XXX: The framework is stolen from expand-group. I guess it should be # factored out. Whatever. -- rjbs, 2006-03-12 use Test::More tests => 12; BEGIN { use_ok('Sub::Exporter'); } my $alfa = sub { 'alfa' }; my $bravo = sub { 'bravo' }; my $returner = sub { my ($class, $group, $arg, $collection) = @_; my %given = ( class => $class, group => $group, arg => $arg, collection => $collection, ); return { foo => sub { return { name => 'foo', %given }; }, bar => sub { return { name => 'bar', %given }; }, }; }; my $config = { exports => [ ], groups => { alphabet => sub { { A => $alfa, b => $bravo } }, broken => sub { [ qw(this is broken because it is not a hashref) ] }, generated => $returner, nested => [qw( :generated )], }, collectors => [ 'col1' ], }; my @single_tests = ( # [ comment, \@group, \@output ] # [ "simple group 1", [ ':A' => undef ] => [ [ a => undef ] ] ], [ "simple group generator", [ -alphabet => undef ], [ [ A => $alfa ], [ b => $bravo ] ], ], [ "simple group generator with prefix", [ -alphabet => { -prefix => 'prefix_' } ], [ [ prefix_A => $alfa ], [ prefix_b => $bravo ] ], ], ); for my $test (@single_tests) { my ($label, $given, $expected) = @$test; my @got = Sub::Exporter::_expand_group( 'Class', $config, $given, {}, ); is_deeply( [ sort { lc $a->[0] cmp lc $b->[0] } @got ], $expected, "expand_group: $label", ); } for my $test (@single_tests) { my ($label, $given, $expected) = @$test; my $got = Sub::Exporter::_expand_groups( 'Class', $config, [ $given ], ); is_deeply( [ sort { lc $a->[0] cmp lc $b->[0] } @$got ], $expected, "expand_groups: $label [single test]", ); } my @multi_tests = ( # [ $comment, \@groups, \@output ] ); for my $test (@multi_tests) { my ($label, $given, $expected) = @$test; my $got = Sub::Exporter::_expand_groups( 'Class', $config, $given, ); is_deeply($got, $expected, "expand_groups: $label"); } ## eval { Sub::Exporter::_expand_groups('Class', $config, [[ -broken => undef ]]) }; like($@, qr/did not return a hash/, "exception on non-hashref groupgen return", ); ## { my $got = Sub::Exporter::_expand_groups( 'Class', $config, [ [ -alphabet => undef ] ], {}, ); my %code = map { $_->[0] => $_->[1] } @$got; my $a = $code{A}; my $b = $code{b}; is($a->(), 'alfa', "generated 'a' sub does what we think"); is($b->(), 'bravo', "generated 'b' sub does what we think"); } { my $got = Sub::Exporter::_expand_groups( 'Class', $config, [ [ -generated => { xyz => 1 } ] ], { col1 => { value => 2 } }, ); my %code = map { $_->[0] => $_->[1] } @$got; for (qw(foo bar)) { is_deeply( $code{$_}->(), { name => $_, class => 'Class', group => 'generated', arg => { xyz => 1 }, collection => { col1 => { value => 2 } }, }, "generated foo does what we expect", ); } } { my $got = Sub::Exporter::_expand_groups( 'Class', $config, [ [ -nested => { xyz => 1 } ] ], { col1 => { value => 2 } }, ); my %code = map { $_->[0] => $_->[1] } @$got; for (qw(foo bar)) { is_deeply( $code{$_}->(), { name => $_, class => 'Class', group => 'generated', arg => { xyz => 1 }, collection => { col1 => { value => 2 } }, }, "generated foo (via nested group) does what we expect", ); } } Sub-Exporter-0.986/t/inherited.t000644 000766 000766 00000001134 12156716434 016470 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests check that the inherited form of a routine is the exported one. =cut use Test::More tests => 3; BEGIN { use_ok('Sub::Exporter'); } package E::Parent; use Sub::Exporter -setup => { exports => [ qw(foo) ] }; sub foo { return 1; } package E::Child; use base qw(E::Parent); sub foo { return 2; } package Test::Sub::Exporter::EPARENT; E::Parent->import('foo'); main::is(foo(), 1, "get result of parent's import"); package Test::Sub::Exporter::ECHILD; E::Child->import('foo'); main::is(foo(), 2, "get result of child's import"); Sub-Exporter-0.986/t/into-level.t000644 000766 000766 00000006061 12156716434 016577 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests exercise the "into" and "into_level" special arguments to the built exporter. =cut use Test::More tests => 14; BEGIN { use_ok('Sub::Exporter'); } BEGIN { package Test::SubExport::FROM; use strict; use warnings; use Sub::Exporter -setup => { exports => [ qw(A B) ], groups => { default => [ ':all' ], a => [ 'A' ], b => [ 'B' ] } }; sub A { 'A' } sub B { 'B' } 1; } BEGIN { package Test::SubExport::HAS_DEFAULT_INTO_LEVEL; use strict; use warnings; use Sub::Exporter -setup => { exports => [ qw(C) ], into_level => 1, }; sub C { 'C' } 1; } BEGIN { package Test::SubExport::HAS_DEFAULT_INTO; use strict; use warnings; use Sub::Exporter -setup => { exports => [ qw(foo) ], into => 'Test::SubExport::DEFAULT_INTO', }; sub foo { 'foo' } 1; } BEGIN { package Test::SubExport::INTO; use strict; use warnings; sub import { my $package = shift; my $caller = caller(0); Test::SubExport::FROM->import( { into => $caller }, @_ ); } 1; } BEGIN { package Test::SubExport::LEVEL; use strict; use warnings; sub import { my $package = shift; Test::SubExport::FROM->import( { into_level => 1 }, @_ ); } 1; } BEGIN { package Test::SubExport::DEFAULT_LEVEL; use strict; use warnings; sub import { my $package = shift; Test::SubExport::HAS_DEFAULT_INTO_LEVEL->import(@_); } 1; } package Test::SubExport::INTO::A; Test::SubExport::INTO->import('A'); main::can_ok(__PACKAGE__, 'A' ); main::cmp_ok( __PACKAGE__->can('A'), '==', Test::SubExport::FROM->can('A'), 'sub A was exported' ); package Test::SubExport::INTO::ALL; Test::SubExport::INTO->import(':all'); main::can_ok(__PACKAGE__, 'A', 'B' ); main::cmp_ok( __PACKAGE__->can('A'), '==', Test::SubExport::FROM->can('A'), 'sub A was exported' ); main::cmp_ok( __PACKAGE__->can('B'), '==', Test::SubExport::FROM->can('B'), 'sub B was exported' ); package Test::SubExport::LEVEL::ALL; Test::SubExport::LEVEL->import(':all'); main::can_ok(__PACKAGE__, 'A', 'B' ); main::cmp_ok( __PACKAGE__->can('A'), '==', Test::SubExport::FROM->can('A'), 'sub A was exported' ); main::cmp_ok( __PACKAGE__->can('B'), '==', Test::SubExport::FROM->can('B'), 'sub B was exported' ); package Test::SubExport::LEVEL::DEFAULT; Test::SubExport::DEFAULT_LEVEL->import(':all'); main::can_ok(__PACKAGE__, 'C'); main::cmp_ok( __PACKAGE__->can('C'), '==', Test::SubExport::HAS_DEFAULT_INTO_LEVEL->can('C'), 'sub C was exported' ); package Test::SubExport::NON_DEFAULT_INTO; main::is( Test::SubExport::DEFAULT_INTO->can('foo'), undef, "before import, 'default into' target can't foo", ); Test::SubExport::HAS_DEFAULT_INTO->import('-all'); main::is( __PACKAGE__->can('foo'), undef, "after import, calling package can't foo", ); main::is( Test::SubExport::DEFAULT_INTO->can('foo'), \&Test::SubExport::HAS_DEFAULT_INTO::foo, "after import, calling package can't foo", ); Sub-Exporter-0.986/t/lib/000755 000766 000766 00000000000 12156716434 015077 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/t/real-export-groupgen.t000644 000766 000766 00000003545 12156716434 020613 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests check export group expansion, specifically the expansion of groups that use group generators, more specifically when actually imported. =cut use Test::More tests => 8; use lib 't/lib'; use Carp; BEGIN { local $SIG{__DIE__} = sub { Carp::confess @_ }; use_ok('Test::SubExporter::GroupGen'); Test::SubExporter::GroupGen->import( col1 => { value => 2 }, -generated => { xyz => 1 }, -generated => { xyz => 5, -prefix => 'five_' }, -symbolic => { xyz => 2 }, ); use_ok('Test::SubExporter::GroupGenSubclass'); Test::SubExporter::GroupGenSubclass->import( col1 => { value => 3 }, -symbolic => { -prefix => 'subclass_', xyz => 4 }, ); } for my $routine (qw(foo bar)) { is_deeply( main->$routine(), { name => $routine, class => 'Test::SubExporter::GroupGen', group => 'generated', arg => { xyz => 1 }, collection => { col1 => { value => 2 } }, }, "generated $routine does what we expect", ); my $five = "five_$routine"; is_deeply( main->$five(), { name => $routine, class => 'Test::SubExporter::GroupGen', group => 'generated', arg => { xyz => 5 }, collection => { col1 => { value => 2 } }, }, "generated $five does what we expect", ); } is_deeply( main->baz(), { name => 'baz', class => 'Test::SubExporter::GroupGen', group => 'symbolic', arg => { xyz => 2 }, collection => { col1 => { value => 2 } }, }, "parent class's generated baz does what we expect", ); is_deeply( main->subclass_baz(), { name => 'baz-sc', class => 'Test::SubExporter::GroupGenSubclass', group => 'symbolic', arg => { xyz => 4 }, collection => { col1 => { value => 3 } }, }, "inheriting class's generated baz does what we expect", ); Sub-Exporter-0.986/t/real-export-href.t000644 000766 000766 00000010166 12156716434 017706 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests exercise the use of Sub::Exporter via its setup_exporter routine. They use Test::SubExporter::s_e, bundled in ./t/lib, which uses this calling style. =cut use Test::More tests => 48; BEGIN { use_ok('Sub::Exporter'); } our $exporting_class = 'Test::SubExporter::s_e'; use lib 't/lib'; for my $iteration (1..2) { { package Test::SubExporter::BUILT; my $import = Sub::Exporter::build_exporter({ exports => [ 'X' ] }); Sub::Exporter::setup_exporter({ exports => [ 'X' ], into => 'Test::SubExporter::VIOLATED' . "_$iteration", as => 'gimme_X_from', }); sub X { return "expected" } package Test::SubExporter::BUILT::CONSUMER; $import->('Test::SubExporter::BUILT', ':all'); main::is(X(), "expected", "manually constructed importer worked"); eval < { -as => 'plugh' }); use subs qw(plugh); main::is( plugh, "Nothing happens.", "RENAME: default export xyzzy=>plugh works as expected" ); package Test::SubExporter::SAILOR; main::use_ok($exporting_class, ':sailor'); use subs qw(xyzzy hs_works hs_fails); main::is( xyzzy, "Nothing happens.", "SAILOR: default export xyzzy works as expected" ); main::is( hs_works, "Something happens!", "SAILOR: hs_works export works as expected" ); main::is( hs_fails, "Nothing happens yet.", "SAILOR: hs_fails export works as expected" ); package Test::SubExporter::Z3; main::use_ok( $exporting_class, hello_sailor => { game => 'zork3' }, hi_sailor => undef, ); use subs qw(hello_sailor hi_sailor); main::is( hello_sailor, "Something happens!", "Z3: custom hello_sailor works as expected" ); main::is( hi_sailor, "Nothing happens yet.", "Z3: hi_sailor, using symbolic import and no args, works as expected" ); package Test::SubExporter::FROTZ_SAILOR; main::use_ok($exporting_class, -sailor => { -prefix => 'frotz_' }); use subs map { "frotz_$_" }qw(xyzzy hs_works hs_fails); main::is( frotz_xyzzy, "Nothing happens.", "FROTZ_SAILOR: default export xyzzy works as expected" ); main::is( frotz_hs_works, "Something happens!", "FROTZ_SAILOR: hs_works export works as expected" ); main::is( frotz_hs_fails, "Nothing happens yet.", "FROTZ_SAILOR: hs_fails export works as expected" ); package Test::SubExporter::Z3_REF; my $hello; main::use_ok( $exporting_class, hello_sailor => { game => 'zork3', -as => \$hello } ); eval "hello_sailor;"; main::like( $@, qr/Bareword "hello_sailor" not allowed/, "Z3_REF: hello_sailor isn't actually imported to package" ); main::is( $hello->(), "Something happens!", "Z3_REF: hello_sailor properly exported to scalar ref", ); package Test::SubExporter::Z3_BADREF; main::require_ok($exporting_class); eval { Test::SubExporter::s_e->import(hello_sailor => { game => 'zork3', -as => {} }); }; main::like( $@, qr/invalid reference type/, "can't pass a non-scalar ref to -as", ); } sub install_upstream { Sub::Exporter::setup_exporter({ exports => [ 'X' ], as => 'gimme_X_from', into_level => 1, }); } package Test::SubExporter::LEVEL_1; sub X { return 1 }; main::install_upstream; package Test::SubExporter::CALLS_LEVEL_1; Test::SubExporter::LEVEL_1->gimme_X_from(X => { -as => 'x_from_1' }); use subs 'x_from_1'; main::is(x_from_1(), 1, "imported from uplevel-installed exporter"); Sub-Exporter-0.986/t/real-export-setup.t000644 000766 000766 00000007132 12156716434 020121 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests exercise that the polymorphic exporter-builder used when Sub::Exporter's -import group is invoked. They use Test::SubExporter::DashSetup, bundled in ./t/lib, which uses this calling style. =cut use Test::More tests => 40; BEGIN { use_ok('Sub::Exporter'); } our $exporting_class = 'Test::SubExporter::DashSetup'; use lib 't/lib'; for my $iteration (1..2) { { package Test::SubExporter::SETUP; use Sub::Exporter -setup => [ qw(X) ]; sub X { return "desired" } package Test::SubExporter::SETUP::CONSUMER; Test::SubExporter::SETUP->import(':all'); main::is(X(), "desired", "constructed importer (via -setup [LIST]) worked"); } { package Test::SubExporter::EXPORT_MISSING; use Sub::Exporter -setup => [ qw(X) ]; package Test::SubExporter::SETUP::CONSUMER_OF_MISSING; eval { Test::SubExporter::EXPORT_MISSING->import(':all') }; main::like( $@, qr/can't locate export/, "croak if we're configured to export something that can't be found", ); } { package Test::SubExporter::SETUPFAILURE; eval { Sub::Exporter->import( -setup => sub { 1 }) }; main::like($@, qr/-setup failed validation/, "only [],{} ok for -setup"); } package Test::SubExporter::DEFAULT; main::use_ok($exporting_class); use subs qw(xyzzy hello_sailor); main::is( xyzzy, "Nothing happens.", "DEFAULT: default export xyzzy works as expected" ); main::is( hello_sailor, "Nothing happens yet.", "DEFAULT: default export hello_sailor works as expected" ); package Test::SubExporter::RENAME; main::use_ok($exporting_class, xyzzy => { -as => 'plugh' }); use subs qw(plugh); main::is( plugh, "Nothing happens.", "RENAME: default export xyzzy=>plugh works as expected" ); package Test::SubExporter::SAILOR; main::use_ok($exporting_class, ':sailor');; use subs qw(xyzzy hs_works hs_fails); main::is( xyzzy, "Nothing happens.", "SAILOR: default export xyzzy works as expected" ); main::is( hs_works, "Something happens!", "SAILOR: hs_works export works as expected" ); main::is( hs_fails, "Nothing happens yet.", "SAILOR: hs_fails export works as expected" ); package Test::SubExporter::Z3; main::use_ok($exporting_class, hello_sailor => { game => 'zork3' }); use subs qw(hello_sailor); main::is( hello_sailor, "Something happens!", "Z3: custom hello_sailor works as expected" ); package Test::SubExporter::FROTZ_SAILOR; main::use_ok($exporting_class, -sailor => { -prefix => 'frotz_' }); use subs map { "frotz_$_" }qw(xyzzy hs_works hs_fails); main::is( frotz_xyzzy, "Nothing happens.", "FROTZ_SAILOR: default export xyzzy works as expected" ); main::is( frotz_hs_works, "Something happens!", "FROTZ_SAILOR: hs_works export works as expected" ); main::is( frotz_hs_fails, "Nothing happens yet.", "FROTZ_SAILOR: hs_fails export works as expected" ); } { package Test::SubExporter::SETUPALT; use Sub::Exporter -setup => { -as => 'alternimport', exports => [ qw(Y) ], }; sub X { return "desired" } sub Y { return "other" } package Test::SubExporter::SETUP::ALTCONSUMER; Test::SubExporter::SETUPALT->import(':all'); eval { X() }; main::like($@, qr/undefined subroutine/i, "X didn't get imported"); eval { Y() }; main::like($@, qr/undefined subroutine/i, "Y didn't get imported"); Test::SubExporter::SETUPALT->alternimport(':all'); main::is(Y(), "other", "other importer (via -setup { -as ...}) worked"); } Sub-Exporter-0.986/t/util-curry.t000644 000766 000766 00000003276 12156716434 016645 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 10; BEGIN { use_ok("Sub::Exporter"); } BEGIN { package Thing; BEGIN { main::use_ok('Sub::Exporter::Util', 'curry_class'); } use Sub::Exporter -setup => { exports => { return_invocant => curry_class, talkback => curry_class('return_invocant'), }, }; sub new { bless { key => "value" } => $_[0] } sub return_invocant { return $_[0] } } BEGIN { package Thing::Subclass; our @ISA = qw(Thing); } package Test::SubExporter::CURRY::0; BEGIN { Thing->import(qw(return_invocant)); } main::is( Thing->return_invocant, "Thing", "method call on Thing returns Thing", ); main::is( Thing::Subclass->return_invocant, "Thing::Subclass", "method call on Thing::Subclass returns Thing::Subclass", ); main::is( return_invocant(), 'Thing', 'return of method class-curried from Thing is Thing' ); package Test::SubExporter::CURRY::1; BEGIN { Thing::Subclass->import(qw(return_invocant)); } main::is( Thing->return_invocant, "Thing", "method call on Thing returns Thing", ); main::is( Thing::Subclass->return_invocant, "Thing::Subclass", "method call on Thing::Subclass returns Thing::Subclass", ); main::is( return_invocant(), 'Thing::Subclass', 'return of method class-curried from Thing::Subclass is Thing::Subclass' ); package Test::SubExporter::CURRY::2; BEGIN { Thing->import(qw(talkback)); } main::is( talkback(), 'Thing', 'imported talkback acts like return_invocant' ); package Test::SubExporter::CURRY::Object; BEGIN { Thing->new->import(qw(talkback)); } main::isa_ok( talkback(), 'Thing', 'the result of object-curried talkback' ); Sub-Exporter-0.986/t/util-currychain.t000644 000766 000766 00000003255 12156716434 017645 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 4; BEGIN { use_ok("Sub::Exporter::Util", qw(curry_chain)); } # So, some packages that we'll chain methods through. { package Test::CurryChain::Head; sub new { my ($class, @arg) = @_; bless [ @arg ] => $class; } sub next_obj { shift; return Test::CurryChain::Tail->new(@_); } sub false { return; } sub non_invocant { return 1; } package Test::CurryChain::Tail; sub new { my ($class, @arg) = @_; bless [ @arg ] => $class; } sub rev_guts { return reverse @{shift()}; } } { # Then the generator which could be put into a Sub::Exporter -setup. # This is an optlist. AREF = args; undef = no args; CODE = args generator my $generator = curry_chain( next_obj => [ 1, 2, 3 ], rev_guts => undef, ); my $curried_sub = $generator->('Test::CurryChain::Head'); my @result = $curried_sub->(); is_deeply( \@result, [ 3, 2, 1], "simple curried chain behaves as expected" ); } { # This one will fail, beacuse the second call returns false. my $generator = curry_chain( new => [ 1, 2, 3 ], false => undef, will_fail => undef, ); my $curried_sub = $generator->('Test::CurryChain::Head'); eval { $curried_sub->() }; like($@, qr/can't call will_fail/, "exception on broken chain"); } { # This one will fail, beacuse the second call returns a true non-invocant. my $generator = curry_chain( new => [ 1, 2, 3 ], non_invocant => undef, will_fail => undef, ); my $curried_sub = $generator->('Test::CurryChain::Head'); eval { $curried_sub->() }; like($@, qr/can't call will_fail/, "exception on broken chain"); } Sub-Exporter-0.986/t/util-like.t000644 000766 000766 00000006027 12156716434 016422 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 11; BEGIN { use_ok("Sub::Exporter"); } use lib 't/lib'; use Test::SubExporter::Faux; my ($generator, $installer, $reset, $exports); BEGIN { ($generator, $installer, $reset, $exports) = faux_installer; } my %generator; BEGIN { %generator = ( foo => sub { sub { 1 } }, bar => sub { sub { 2 } }, baz => sub { sub { 3 } }, BAR => sub { sub { 4 } }, xyzzy => sub { sub { 5 } }, ); } BEGIN { isa_ok($installer, 'CODE'); package Thing; BEGIN { main::use_ok('Sub::Exporter::Util', 'like'); } use Sub::Exporter -setup => { installer => $installer, generator => $generator, collectors => { -like => like }, exports => \%generator, }; } package main; my $code = sub { $reset->(); Thing->import(@_); }; $code->(qw(foo xyzzy)); exports_ok( $exports, [ [ foo => {} ], [ xyzzy => {} ] ], "the basics work normally" ); $code->(-like => qr/^b/i); exports_ok( $exports, [ [ BAR => {} ], [ baz => {} ], [ bar => {} ] ], "give me everything starting with b or B (qr//)" ); $code->(-like => [ qr/^b/i ]); exports_ok( $exports, [ [ BAR => {} ], [ baz => {} ], [ bar => {} ] ], "give me everything starting with b or B ([qr//])" ); $code->(-like => [ qr/^b/i => undef ]); exports_ok( $exports, [ [ BAR => {} ], [ baz => {} ], [ bar => {} ] ], "give me everything starting with b or B ([qr//=>undef])" ); # XXX: must use verbose exporter my %col = ( -like => [ qr/^b/i => { -prefix => 'like_' }, qr/zz/i => { -suffix => '_y2' }, ]); $code->(%col); everything_ok( $exports, [ [ BAR => { class => 'Thing', generator => $generator{BAR}, name => 'BAR', arg => {}, collection => \%col, as => 'like_BAR', into => 'main', }, ], [ bar => { class => 'Thing', generator => $generator{bar}, name => 'bar', arg => {}, collection => \%col, as => 'like_bar', into => 'main', }, ], [ baz => { class => 'Thing', generator => $generator{baz}, name => 'baz', arg => {}, collection => \%col, as => 'like_baz', into => 'main', }, ], [ xyzzy => { class => 'Thing', generator => $generator{xyzzy}, name => 'xyzzy', arg => {}, collection => \%col, as => 'xyzzy_y2', into => 'main', }, ], ], 'give me everything starting with b or B as like_$_ ([qr//=>{...}])' ); { my $like = Sub::Exporter::Util::like(); is(ref($like), 'CODE', 'like() gives us a generator'); eval { $like->() }; like($@, qr/no regex supplied/, "exception with no args to like->()"); eval { $like->([ "fake*reg{3}exp" => { a => 1 } ]) }; like($@, qr/not a regex/i, "exception with non qr// pattern in like"); } Sub-Exporter-0.986/t/util-merge.t000644 000766 000766 00000003317 12156716434 016574 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; use Test::More tests => 8; BEGIN { use_ok("Sub::Exporter"); } BEGIN { package Thing; BEGIN { main::use_ok("Sub::Exporter::Util", 'merge_col'); } use Sub::Exporter -setup => { collectors => [ qw(defaults etc) ], exports => { merge_col( defaults => { stack => sub { my @x = @_; sub { return @x } }, kcats => \'_kcats_gen', }, empty => { bogus => sub { my @x = @_; sub { return @x } }, klame => sub { my @x = @_; sub { return @x } }, }, etc => { other => sub { my @x = @_; sub { return @x } }, }, ), plain => sub { my @x = @_; sub { return @x } }, }, }; sub _kcats_gen { my @x = @_; sub { return reverse @x } } } package Test::SubExporter::MERGE::0; my %col; BEGIN { Thing->import( defaults => ($col{defaults} = { x => 10 }), etc => ($col{etc} = { home => "Kansas" }), stack => { x => 20, y => 30 }, kcats => { y => 3 }, bogus => undef, klame => { bar => 99 }, other => undef, plain => { foo => 10 }, ); } my %tests = ( stack => [ 'Thing', 'stack', { x => 20, y => 30 }, \%col ], kcats => [ \%col, { x => 10, y => 3 }, 'kcats', 'Thing' ], bogus => [ 'Thing', 'bogus', {}, \%col ], klame => [ 'Thing', 'klame', { bar => 99 }, \%col ], other => [ 'Thing', 'other', { home => "Kansas" }, \%col ], plain => [ 'Thing', 'plain', { foo => 10 }, \%col ], ); while (my ($name, $expected) = each %tests) { main::is_deeply( [ __PACKAGE__->$name ], $expected, "$name returned proper value", ); } Sub-Exporter-0.986/t/util-mixin.t000644 000766 000766 00000005342 12156716434 016621 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; use Test::More; BEGIN { if (eval { require Package::Generator; 1; }) { plan 'no_plan'; } else { plan skip_all => "the mixin exporter requires Package::Generator"; } } BEGIN { use_ok("Sub::Exporter"); } BEGIN { package Thing; use Sub::Exporter -setup => { exports => { bar => sub { sub { 1 } }, foo => sub { my ($c, $n, $a) = @_; sub { return $c . ($a->{arg}) } } }, }; } BEGIN { package Thing::Mixin; BEGIN { main::use_ok("Sub::Exporter::Util", 'mixin_installer'); } use Sub::Exporter -setup => { installer => mixin_installer, exports => { bar => sub { sub { 1 } }, foo => sub { my ($c, $n, $a) = @_; sub { return $c . ($a->{arg}) } } }, }; } package Test::SubExporter::MIXIN::0; BEGIN { Thing->import( { installer => Sub::Exporter::Util::mixin_installer }, -all => { arg => '0' }, ); } package Test::SubExporter::MIXIN::1; BEGIN { Thing->import( { installer => Sub::Exporter::Util::mixin_installer }, -all => { arg => '1' }, ); } package Test::SubExporter::MIXIN::2; BEGIN { Thing::Mixin->import( -all => { arg => '2' }, ); } package Test::SubExporter::MIXIN::3; BEGIN { Thing::Mixin->import( -all => { arg => '3' }, ); } package main; my @pkg = map { "Test::SubExporter::MIXIN::$_" } (0 .. 3); for (0 .. $#pkg) { my $ext = $_ > 1 ? '::Mixin' : ''; my $val = eval { $pkg[$_]->foo } || ($@ ? "died: $@" : undef); is( $val, "Thing$ext$_", "mixed in method in $pkg[$_] returns correctly" ); is($pkg[$_]->bar, 1, "bar method for $pkg[$_] is ok, too"); } my @super = map {; no strict 'refs'; [ @{$_ . "::ISA"} ] } @pkg; for my $x (0 .. $#pkg) { is(@{$super[$x]}, 1, "one parent for $pkg[$x]: @{$super[$x]}"); for my $y (($x + 1) .. $#pkg) { isnt("@{$super[$x]}", "@{$super[$y]}", "parent($x) ne parent($y)") } } { package Test::SubExporter::OBJECT; sub new { bless {} => shift } sub plugh { "plugh" } } package main; my $obj_1 = Test::SubExporter::OBJECT->new; isa_ok($obj_1, "Test::SubExporter::OBJECT", "first object"); is(ref $obj_1, "Test::SubExporter::OBJECT", "first object's ref is TSEO"); my $obj_2 = Test::SubExporter::OBJECT->new; isa_ok($obj_2, "Test::SubExporter::OBJECT", "second object"); is(ref $obj_2, "Test::SubExporter::OBJECT", "second object's ref is TSEO"); Thing::Mixin->import({ into => $obj_1 }, qw(bar)); pass("mixin-exporting to an object didn't die"); is( eval { $obj_1->bar }, 1, "now that object has a bar method" ); isa_ok($obj_1, "Test::SubExporter::OBJECT"); isnt(ref $obj_1, "Test::SubExporter::OBJECT", "but its actual class isnt TSEO"); Sub-Exporter-0.986/t/util-namemap.t000644 000766 000766 00000001057 12156716434 017112 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; use Test::More skip_all => 'not actually offerring this feature yet'; # use Test::More tests => 3; BEGIN { use_ok("Sub::Exporter::Util", 'name_map'); } is_deeply( { name_map( '_?_gen' => [ qw(fee fie) ], '_make_?' => [ qw(foo bar) ], ), }, { fee => \'_fee_gen', fie => \'_fie_gen', foo => \'_make_foo', bar => \'_make_bar', }, 'example from docs works just dandy', ); eval { name_map(foo => [ qw(bar) ] ) }; like($@, qr/no \?/, 'exception raised with no ? in template'); Sub-Exporter-0.986/t/valid-config.t000644 000766 000766 00000002420 12156716434 017056 0ustar00rjbsrjbs000000 000000 #!perl -T use strict; use warnings; =head1 TEST PURPOSE These tests make sure that invalid configurations passed to setup/build_exporter throw exceptions. =cut use Test::More tests => 6; BEGIN { use_ok('Sub::Exporter'); } eval { Sub::Exporter::build_exporter({ exports => [ qw(foo) ], collectors => [ qw(foo) ], }) }; like($@, qr/used in both/, "can't use one name in exports and collectors"); eval { Sub::Exporter::build_exporter({ collections => [ qw(foo) ], # This one gets me all the time. Live & learn. }) }; like($@, qr/unknown options/, "unknown options raise an exception"); eval { Sub::Exporter::setup_exporter({ into => 'Your::Face', into_level => 5, }) }; like( $@, qr/may not both/, "into and into_level are mutually exclusive (in setup_exporter)" ); eval { Sub::Exporter::build_exporter({})->( Class => { into => 'Your::Face', into_level => 1 } ); }; like( $@, qr/may not both/, "into and into_level are mutually exclusive (in exporter)" ); eval { Sub::Exporter::build_exporter({ into => "This::Doesnt::Matter", into_level => 0, }) }; like( $@, qr(^into and into_level may not both be supplied to exporter), "can't use one name in exports and collectors" ); Sub-Exporter-0.986/t/lib/Test/000755 000766 000766 00000000000 12156716434 016016 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/t/lib/Test/SubExporter/000755 000766 000766 00000000000 12156716434 020300 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/t/lib/Test/SubExporter/DashSetup.pm000644 000766 000766 00000001310 12156716434 022531 0ustar00rjbsrjbs000000 000000 #!perl package Test::SubExporter::DashSetup; use strict; use warnings; use Sub::Exporter -setup => { exports => { xyzzy => undef, hello_sailor => \&_hs_gen, }, groups => { default => [ qw(xyzzy hello_sailor) ], sailor => [ xyzzy => undef, hello_sailor => { -as => 'hs_works', game => 'zork3' }, hello_sailor => { -as => 'hs_fails', game => 'zork1' }, ] }, collectors => [ 'defaults' ], }; sub xyzzy { return "Nothing happens." }; sub _hs_gen { my ($class, $name, $arg, $collection) = @_; if (($arg->{game}||'') eq 'zork3') { return sub { return "Something happens!" }; } else { return sub { return "Nothing happens yet." }; } } "y2"; Sub-Exporter-0.986/t/lib/Test/SubExporter/Faux.pm000644 000766 000766 00000003237 12156716434 021546 0ustar00rjbsrjbs000000 000000 use strict; use warnings; package Test::SubExporter::Faux; use base qw(Exporter); our @EXPORT = qw(faux_installer exports_ok everything_ok); sub faux_installer { my ($verbose) = @_; $verbose = 1; my @exported; my $reset = sub { @exported = () }; my $generator = sub { my ($arg) = @_; # my ($class, $name, $generator) = @$arg{qw(class name generator)}; return $arg; }; my $installer = sub { my ($arg, $to_export) = @_; for (my $i = 0; $i < @$to_export; $i += 2) { my ($as, $gen_arg) = @$to_export[ $i, $i+1 ]; # my ($class, $generator, $name, $arg, $collection, $as, $into) = @_; my $everything = { class => $gen_arg->{class}, generator => $gen_arg->{generator}, name => $gen_arg->{name}, arg => $gen_arg->{arg}, collection => $gen_arg->{col}, as => $as, into => $arg->{into}, }; push @exported, [ $gen_arg->{name}, ($verbose ? $everything : $gen_arg->{arg}), ]; } }; return ($generator, $installer, $reset, \@exported); } sub exports_ok { my ($got, $expected, $comment) = @_; my $got_simple = [ map { [ $_->[0], $_->[1]{arg} ] } @$got ]; my @g = sort { ($a->[0] cmp $b->[0]) || ($a->[1] <=> $b->[1]) } @$got_simple; my @e = sort { ($a->[0] cmp $b->[0]) || ($a->[1] <=> $b->[1]) } @$expected; main::is_deeply(\@e, \@g, $comment); } sub everything_ok { my ($got, $expected, $comment) = @_; my @g = sort { ($a->[0] cmp $b->[0]) || ($a->[1] <=> $b->[1]) } @$got; my @e = sort { ($a->[0] cmp $b->[0]) || ($a->[1] <=> $b->[1]) } @$expected; main::is_deeply(\@e, \@g, $comment); } 1; Sub-Exporter-0.986/t/lib/Test/SubExporter/GroupGen.pm000644 000766 000766 00000002057 12156716434 022370 0ustar00rjbsrjbs000000 000000 #!perl package Test::SubExporter::GroupGen; use strict; use warnings; use Sub::Exporter; my $alfa = sub { 'alfa' }; my $bravo = sub { 'bravo' }; my $returner = sub { my ($class, $group, $arg, $collection) = @_; my %given = ( class => $class, group => $group, arg => $arg, collection => $collection, ); return { foo => sub { return { name => 'foo', %given }; }, bar => sub { return { name => 'bar', %given }; }, }; }; sub gen_group_by_name { my ($class, $group, $arg, $collection) = @_; my %given = ( class => $class, group => $group, arg => $arg, collection => $collection, ); return { baz => sub { return { name => 'baz', %given }; }, }; } my $config = { exports => [ ], groups => { alphabet => sub { { a => $alfa, b => $bravo } }, generated => $returner, # symbolic => \&gen_group_by_name, # symbolic => sub { shift->gen_group_by_name(@_) }, symbolic => \'gen_group_by_name', }, collectors => [ 'col1' ], }; Sub::Exporter::setup_exporter($config); "gg"; Sub-Exporter-0.986/t/lib/Test/SubExporter/GroupGenSubclass.pm000644 000766 000766 00000000617 12156716434 024070 0ustar00rjbsrjbs000000 000000 use strict; use warnings; package Test::SubExporter::GroupGenSubclass; use base qw(Test::SubExporter::GroupGen); sub gen_group_by_name { my ($class, $group, $arg, $collection) = @_; my %given = ( class => $class, group => $group, arg => $arg, collection => $collection, ); return { baz => sub { return { name => 'baz-sc', %given }; }, }; } "power overwhelming"; Sub-Exporter-0.986/t/lib/Test/SubExporter/ObjGen.pm000644 000766 000766 00000001733 12156716434 022006 0ustar00rjbsrjbs000000 000000 #!perl package Test::SubExporter::ObjGen::Obj; use strict; use warnings; sub new { my $class = shift; my $code = $class->can(shift); bless { code => $code } => $class; } sub group { return { foo => sub { return 'FOO' }, bar => sub { return 'BAR' }, }; } sub baz { return sub { return 'BAZ'; }; } use overload '&{}' => sub { $_[0]->{code} }, 'bool' => sub { 1 }; package Test::SubExporter::ObjGen; my ($group_o, $group_b, $baz, $quux); BEGIN { $quux = sub { sub { 'QUUX' } }; bless $quux => 'Test::SubExporter::Whatever'; $group_o = sub { return { ringo => sub { 'starr' }, richard => sub { 'starkey' }, } }; bless $group_o => 'Test::SubExporter::Whatever'; $baz = Test::SubExporter::ObjGen::Obj->new('baz'); $group_b = Test::SubExporter::ObjGen::Obj->new('group'); } use Sub::Exporter -setup => { exports => { baz => $baz, quux => $quux }, groups => { meta => $group_b, ringo => $group_o }, }; "call me"; Sub-Exporter-0.986/t/lib/Test/SubExporter/s_e.pm000644 000766 000766 00000001371 12156716434 021406 0ustar00rjbsrjbs000000 000000 #!perl package Test::SubExporter::s_e; use strict; use warnings; use Sub::Exporter; Sub::Exporter::setup_exporter({ exports => { xyzzy => undef, hello_sailor => \&_hs_gen, hi_sailor => \"_hs_gen", }, groups => { default => [ qw(xyzzy hello_sailor) ], sailor => [ xyzzy => undef, hello_sailor => { -as => 'hs_works', game => 'zork3' }, hello_sailor => { -as => 'hs_fails', game => 'zork1' }, ] }, collectors => [ 'defaults' ], }); sub xyzzy { return "Nothing happens." }; sub _hs_gen { my ($class, $name, $arg, $collection) = @_; if (($arg->{game}||'') eq 'zork3') { return sub { return "Something happens!" }; } else { return sub { return "Nothing happens yet." }; } } "y2"; Sub-Exporter-0.986/lib/Sub/000755 000766 000766 00000000000 12156716434 015365 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/lib/Sub/Exporter/000755 000766 000766 00000000000 12156716434 017175 5ustar00rjbsrjbs000000 000000 Sub-Exporter-0.986/lib/Sub/Exporter.pm000644 000766 000766 00000107065 12156716434 017544 0ustar00rjbsrjbs000000 000000 use 5.006; use strict; use warnings; package Sub::Exporter; { $Sub::Exporter::VERSION = '0.986'; } # ABSTRACT: a sophisticated exporter for custom-built routines use Carp (); use Data::OptList 0.100 (); use Params::Util 0.14 (); # _CODELIKE use Sub::Install 0.92 (); # Given a potential import name, this returns the group name -- if it's got a # group prefix. sub _group_name { my ($name) = @_; return if (index q{-:}, (substr $name, 0, 1)) == -1; return substr $name, 1; } # \@groups is a canonicalized opt list of exports and groups this returns # another canonicalized opt list with groups replaced with relevant exports. # \%seen is groups we've already expanded and can ignore. # \%merge is merged options from the group we're descending through. sub _expand_groups { my ($class, $config, $groups, $collection, $seen, $merge) = @_; $seen ||= {}; $merge ||= {}; my @groups = @$groups; for my $i (reverse 0 .. $#groups) { if (my $group_name = _group_name($groups[$i][0])) { my $seen = { %$seen }; # faux-dynamic scoping splice @groups, $i, 1, _expand_group($class, $config, $groups[$i], $collection, $seen, $merge); } else { # there's nothing to munge in this export's args next unless my %merge = %$merge; # we have things to merge in; do so my $prefix = (delete $merge{-prefix}) || ''; my $suffix = (delete $merge{-suffix}) || ''; if ( Params::Util::_CODELIKE($groups[$i][1]) ## no critic Private or Params::Util::_SCALAR0($groups[$i][1]) ## no critic Private ) { # this entry was build by a group generator $groups[$i][0] = $prefix . $groups[$i][0] . $suffix; } else { my $as = ref $groups[$i][1]{-as} ? $groups[$i][1]{-as} : $groups[$i][1]{-as} ? $prefix . $groups[$i][1]{-as} . $suffix : $prefix . $groups[$i][0] . $suffix; $groups[$i][1] = { %{ $groups[$i][1] }, %merge, -as => $as }; } } } return \@groups; } # \@group is a name/value pair from an opt list. sub _expand_group { my ($class, $config, $group, $collection, $seen, $merge) = @_; $merge ||= {}; my ($group_name, $group_arg) = @$group; $group_name = _group_name($group_name); Carp::croak qq(group "$group_name" is not exported by the $class module) unless exists $config->{groups}{$group_name}; return if $seen->{$group_name}++; if (ref $group_arg) { my $prefix = (delete $merge->{-prefix}||'') . ($group_arg->{-prefix}||''); my $suffix = ($group_arg->{-suffix}||'') . (delete $merge->{-suffix}||''); $merge = { %$merge, %$group_arg, ($prefix ? (-prefix => $prefix) : ()), ($suffix ? (-suffix => $suffix) : ()), }; } my $exports = $config->{groups}{$group_name}; if ( Params::Util::_CODELIKE($exports) ## no critic Private or Params::Util::_SCALAR0($exports) ## no critic Private ) { # I'm not very happy with this code for hiding -prefix and -suffix, but # it's needed, and I'm not sure, offhand, how to make it better. # -- rjbs, 2006-12-05 my $group_arg = $merge ? { %$merge } : {}; delete $group_arg->{-prefix}; delete $group_arg->{-suffix}; my $group = Params::Util::_CODELIKE($exports) ## no critic Private ? $exports->($class, $group_name, $group_arg, $collection) : $class->$$exports($group_name, $group_arg, $collection); Carp::croak qq(group generator "$group_name" did not return a hashref) if ref $group ne 'HASH'; my $stuff = [ map { [ $_ => $group->{$_} ] } keys %$group ]; return @{ _expand_groups($class, $config, $stuff, $collection, $seen, $merge) }; } else { $exports = Data::OptList::mkopt($exports, "$group_name exports"); return @{ _expand_groups($class, $config, $exports, $collection, $seen, $merge) }; } } sub _mk_collection_builder { my ($col, $etc) = @_; my ($config, $import_args, $class, $into) = @$etc; my %seen; sub { my ($collection) = @_; my ($name, $value) = @$collection; Carp::croak "collection $name provided multiple times in import" if $seen{ $name }++; if (ref(my $hook = $config->{collectors}{$name})) { my $arg = { name => $name, config => $config, import_args => $import_args, class => $class, into => $into, }; my $error_msg = "collection $name failed validation"; if (Params::Util::_SCALAR0($hook)) { ## no critic Private Carp::croak $error_msg unless $class->$$hook($value, $arg); } else { Carp::croak $error_msg unless $hook->($value, $arg); } } $col->{ $name } = $value; } } # Given a config and pre-canonicalized importer args, remove collections from # the args and return them. sub _collect_collections { my ($config, $import_args, $class, $into) = @_; my @collections = map { splice @$import_args, $_, 1 } grep { exists $config->{collectors}{ $import_args->[$_][0] } } reverse 0 .. $#$import_args; unshift @collections, [ INIT => {} ] if $config->{collectors}{INIT}; my $col = {}; my $builder = _mk_collection_builder($col, \@_); for my $collection (@collections) { $builder->($collection) } return $col; } sub setup_exporter { my ($config) = @_; Carp::croak 'into and into_level may not both be supplied to exporter' if exists $config->{into} and exists $config->{into_level}; my $as = delete $config->{as} || 'import'; my $into = exists $config->{into} ? delete $config->{into} : exists $config->{into_level} ? caller(delete $config->{into_level}) : caller(0); my $import = build_exporter($config); Sub::Install::reinstall_sub({ code => $import, into => $into, as => $as, }); } sub _key_intersection { my ($x, $y) = @_; my %seen = map { $_ => 1 } keys %$x; my @names = grep { $seen{$_} } keys %$y; } # Given the config passed to setup_exporter, which contains sugary opt list # data, rewrite the opt lists into hashes, catch a few kinds of invalid # configurations, and set up defaults. Since the config is a reference, it's # rewritten in place. my %valid_config_key; BEGIN { %valid_config_key = map { $_ => 1 } qw(as collectors installer generator exports groups into into_level), qw(exporter), # deprecated } sub _assert_collector_names_ok { my ($collectors) = @_; for my $reserved_name (grep { /\A[_A-Z]+\z/ } keys %$collectors) { Carp::croak "unknown reserved collector name: $reserved_name" if $reserved_name ne 'INIT'; } } sub _rewrite_build_config { my ($config) = @_; if (my @keys = grep { not exists $valid_config_key{$_} } keys %$config) { Carp::croak "unknown options (@keys) passed to Sub::Exporter"; } Carp::croak q(into and into_level may not both be supplied to exporter) if exists $config->{into} and exists $config->{into_level}; # XXX: Remove after deprecation period. if ($config->{exporter}) { Carp::cluck "'exporter' argument to build_exporter is deprecated. Use 'installer' instead; the semantics are identical."; $config->{installer} = delete $config->{exporter}; } Carp::croak q(into and into_level may not both be supplied to exporter) if exists $config->{into} and exists $config->{into_level}; for (qw(exports collectors)) { $config->{$_} = Data::OptList::mkopt_hash( $config->{$_}, $_, [ 'CODE', 'SCALAR' ], ); } _assert_collector_names_ok($config->{collectors}); if (my @names = _key_intersection(@$config{qw(exports collectors)})) { Carp::croak "names (@names) used in both collections and exports"; } $config->{groups} = Data::OptList::mkopt_hash( $config->{groups}, 'groups', [ 'HASH', # standard opt list 'ARRAY', # standard opt list 'CODE', # group generator 'SCALAR', # name of group generation method ] ); # by default, export nothing $config->{groups}{default} ||= []; # by default, build an all-inclusive 'all' group $config->{groups}{all} ||= [ keys %{ $config->{exports} } ]; $config->{generator} ||= \&default_generator; $config->{installer} ||= \&default_installer; } sub build_exporter { my ($config) = @_; _rewrite_build_config($config); my $import = sub { my ($class) = shift; # XXX: clean this up -- rjbs, 2006-03-16 my $special = (ref $_[0]) ? shift(@_) : {}; Carp::croak q(into and into_level may not both be supplied to exporter) if exists $special->{into} and exists $special->{into_level}; if ($special->{exporter}) { Carp::cluck "'exporter' special import argument is deprecated. Use 'installer' instead; the semantics are identical."; $special->{installer} = delete $special->{exporter}; } my $into = defined $special->{into} ? delete $special->{into} : defined $special->{into_level} ? caller(delete $special->{into_level}) : defined $config->{into} ? $config->{into} : defined $config->{into_level} ? caller($config->{into_level}) : caller(0); my $generator = delete $special->{generator} || $config->{generator}; my $installer = delete $special->{installer} || $config->{installer}; # this builds a AOA, where the inner arrays are [ name => value_ref ] my $import_args = Data::OptList::mkopt([ @_ ]); # is this right? defaults first or collectors first? -- rjbs, 2006-06-24 $import_args = [ [ -default => undef ] ] unless @$import_args; my $collection = _collect_collections($config, $import_args, $class, $into); my $to_import = _expand_groups($class, $config, $import_args, $collection); # now, finally $import_arg is really the "to do" list _do_import( { class => $class, col => $collection, config => $config, into => $into, generator => $generator, installer => $installer, }, $to_import, ); }; return $import; } sub _do_import { my ($arg, $to_import) = @_; my @todo; for my $pair (@$to_import) { my ($name, $import_arg) = @$pair; my ($generator, $as); if ($import_arg and Params::Util::_CODELIKE($import_arg)) { ## no critic # This is the case when a group generator has inserted name/code pairs. $generator = sub { $import_arg }; $as = $name; } else { $import_arg = { $import_arg ? %$import_arg : () }; Carp::croak qq("$name" is not exported by the $arg->{class} module) unless exists $arg->{config}{exports}{$name}; $generator = $arg->{config}{exports}{$name}; $as = exists $import_arg->{-as} ? (delete $import_arg->{-as}) : $name; } my $code = $arg->{generator}->( { class => $arg->{class}, name => $name, arg => $import_arg, col => $arg->{col}, generator => $generator, } ); push @todo, $as, $code; } $arg->{installer}->( { class => $arg->{class}, into => $arg->{into}, col => $arg->{col}, }, \@todo, ); } ## Cute idea, possibly for future use: also supply an "unimport" for: ## no Module::Whatever qw(arg arg arg); # sub _unexport { # my (undef, undef, undef, undef, undef, $as, $into) = @_; # # if (ref $as eq 'SCALAR') { # undef $$as; # } elsif (ref $as) { # Carp::croak "invalid reference type for $as: " . ref $as; # } else { # no strict 'refs'; # delete &{$into . '::' . $as}; # } # } sub default_generator { my ($arg) = @_; my ($class, $name, $generator) = @$arg{qw(class name generator)}; if (not defined $generator) { my $code = $class->can($name) or Carp::croak "can't locate exported subroutine $name via $class"; return $code; } # I considered making this "$class->$generator(" but it seems that # overloading precedence would turn an overloaded-as-code generator object # into a string before code. -- rjbs, 2006-06-11 return $generator->($class, $name, $arg->{arg}, $arg->{col}) if Params::Util::_CODELIKE($generator); ## no critic Private # This "must" be a scalar reference, to a generator method name. # -- rjbs, 2006-12-05 return $class->$$generator($name, $arg->{arg}, $arg->{col}); } sub default_installer { my ($arg, $to_export) = @_; for (my $i = 0; $i < @$to_export; $i += 2) { my ($as, $code) = @$to_export[ $i, $i+1 ]; # Allow as isa ARRAY to push onto an array? # Allow into isa HASH to install name=>code into hash? if (ref $as eq 'SCALAR') { $$as = $code; } elsif (ref $as) { Carp::croak "invalid reference type for $as: " . ref $as; } else { Sub::Install::reinstall_sub({ code => $code, into => $arg->{into}, as => $as }); } } } sub default_exporter { Carp::cluck "default_exporter is deprecated; call default_installer instead; the semantics are identical"; goto &default_installer; } setup_exporter({ exports => [ qw(setup_exporter build_exporter), _import => sub { build_exporter($_[2]) }, ], groups => { all => [ qw(setup_exporter build_export) ], }, collectors => { -setup => \&_setup }, }); sub _setup { my ($value, $arg) = @_; if (ref $value eq 'HASH') { push @{ $arg->{import_args} }, [ _import => { -as => 'import', %$value } ]; return 1; } elsif (ref $value eq 'ARRAY') { push @{ $arg->{import_args} }, [ _import => { -as => 'import', exports => $value } ]; return 1; } return; } "jn8:32"; # <-- magic true value __END__ =pod =head1 NAME Sub::Exporter - a sophisticated exporter for custom-built routines =head1 VERSION version 0.986 =head1 SYNOPSIS Sub::Exporter must be used in two places. First, in an exporting module: # in the exporting module: package Text::Tweaker; use Sub::Exporter -setup => { exports => [ qw(squish titlecase), # always works the same way reformat => \&build_reformatter, # generator to build exported function trim => \&build_trimmer, indent => \&build_indenter, ], collectors => [ 'defaults' ], }; Then, in an importing module: # in the importing module: use Text::Tweaker 'squish', indent => { margin => 5 }, reformat => { width => 79, justify => 'full', -as => 'prettify_text' }, defaults => { eol => 'CRLF' }; With this setup, the importing module ends up with three routines: C, C, and C. The latter two have been built to the specifications of the importer -- they are not just copies of the code in the exporting package. =head1 DESCRIPTION B If you're not familiar with Exporter or exporting, read L first! =head2 Why Generators? The biggest benefit of Sub::Exporter over existing exporters (including the ubiquitous Exporter.pm) is its ability to build new coderefs for export, rather than to simply export code identical to that found in the exporting package. If your module's consumers get a routine that works like this: use Data::Analyze qw(analyze); my $value = analyze($data, $tolerance, $passes); and they constantly pass only one or two different set of values for the non-C<$data> arguments, your code can benefit from Sub::Exporter. By writing a simple generator, you can let them do this, instead: use Data::Analyze analyze => { tolerance => 0.10, passes => 10, -as => analyze10 }, analyze => { tolerance => 0.15, passes => 50, -as => analyze50 }; my $value = analyze10($data); The package with the generator for that would look something like this: package Data::Analyze; use Sub::Exporter -setup => { exports => [ analyze => \&build_analyzer, ], }; sub build_analyzer { my ($class, $name, $arg) = @_; return sub { my $data = shift; my $tolerance = shift || $arg->{tolerance}; my $passes = shift || $arg->{passes}; analyze($data, $tolerance, $passes); } } Your module's user now has to do less work to benefit from it -- and remember, you're often your own user! Investing in customized subroutines is an investment in future laziness. This also avoids a common form of ugliness seen in many modules: package-level configuration. That is, you might have seen something like the above implemented like so: use Data::Analyze qw(analyze); $Data::Analyze::default_tolerance = 0.10; $Data::Analyze::default_passes = 10; This might save time, until you have multiple modules using Data::Analyze. Because there is only one global configuration, they step on each other's toes and your code begins to have mysterious errors. Generators can also allow you to export class methods to be called as subroutines: package Data::Methodical; use Sub::Exporter -setup => { exports => { some_method => \&_curry_class } }; sub _curry_class { my ($class, $name) = @_; sub { $class->$name(@_); }; } Because of the way that exporters and Sub::Exporter work, any package that inherits from Data::Methodical can inherit its exporter and override its C. If a user imports C from that package, he'll receive a subroutine that calls the method on the subclass, rather than on Data::Methodical itself. =head2 Other Customizations Building custom routines with generators isn't the only way that Sub::Exporters allows the importing code to refine its use of the exported routines. They may also be renamed to avoid naming collisions. Consider the following code: # this program determines to which circle of Hell you will be condemned use Morality qw(sin virtue); # for calculating viciousness use Math::Trig qw(:all); # for dealing with circles The programmer has inadvertently imported two C routines. The solution, in Exporter.pm-based modules, would be to import only one and then call the other by its fully-qualified name. Alternately, the importer could write a routine that did so, or could mess about with typeglobs. How much easier to write: # this program determines to which circle of Hell you will be condemned use Morality qw(virtue), sin => { -as => 'offense' }; use Math::Trig -all => { -prefix => 'trig_' }; and to have at one's disposal C and C -- not to mention C and C. =head1 EXPORTER CONFIGURATION You can configure an exporter for your package by using Sub::Exporter like so: package Tools; use Sub::Exporter -setup => { exports => [ qw(function1 function2 function3) ] }; This is the simplest way to use the exporter, and is basically equivalent to this: package Tools; use base qw(Exporter); our @EXPORT_OK = qw(function1 function2 function3); Any basic use of Sub::Exporter will look like this: package Tools; use Sub::Exporter -setup => \%config; The following keys are valid in C<%config>: exports - a list of routines to provide for exporting; each routine may be followed by generator groups - a list of groups to provide for exporting; each must be followed by either (a) a list of exports, possibly with arguments for each export, or (b) a generator collectors - a list of names into which values are collected for use in routine generation; each name may be followed by a validator In addition to the basic options above, a few more advanced options may be passed: into_level - how far up the caller stack to look for a target (default 0) into - an explicit target (package) into which to export routines In other words: Sub::Exporter installs a C routine which, when called, exports routines to the calling namespace. The C and C options change where those exported routines are installed. generator - a callback used to produce the code that will be installed default: Sub::Exporter::default_generator installer - a callback used to install the code produced by the generator default: Sub::Exporter::default_installer For information on how these callbacks are used, see the documentation for C> and C>. =head2 Export Configuration The C list may be provided as an array reference or a hash reference. The list is processed in such a way that the following are equivalent: { exports => [ qw(foo bar baz), quux => \&quux_generator ] } { exports => { foo => undef, bar => undef, baz => undef, quux => \&quux_generator } } Generators are code that return coderefs. They are called with four parameters: $class - the class whose exporter has been called (the exporting class) $name - the name of the export for which the routine is being build \%arg - the arguments passed for this export \%col - the collections for this import Given the configuration in the L, the following C statement: use Text::Tweaker reformat => { -as => 'make_narrow', width => 33 }, defaults => { eol => 'CR' }; would result in the following call to C<&build_reformatter>: my $code = build_reformatter( 'Text::Tweaker', 'reformat', { width => 33 }, # note that -as is not passed in { defaults => { eol => 'CR' } }, ); The returned coderef (C<$code>) would then be installed as C in the calling package. Instead of providing a coderef in the configuration, a reference to a method name may be provided. This method will then be called on the invocant of the C method. (In this case, we do not pass the C<$class> parameter, as it would be redundant.) =head2 Group Configuration The C list can be passed in the same forms as C. Groups must have values to be meaningful, which may either list exports that make up the group (optionally with arguments) or may provide a way to build the group. The simpler case is the first: a group definition is a list of exports. Here's the example that could go in exporter in the L. groups => { default => [ qw(reformat) ], shorteners => [ qw(squish trim) ], email_safe => [ 'indent', reformat => { -as => 'email_format', width => 72 } ], }, Groups are imported by specifying their name prefixed be either a dash or a colon. This line of code would import the C group: use Text::Tweaker qw(-shorteners); Arguments passed to a group when importing are merged into the groups options and passed to any relevant generators. Groups can contain other groups, but looping group structures are ignored. The other possible value for a group definition, a coderef, allows one generator to build several exportable routines simultaneously. This is useful when many routines must share enclosed lexical variables. The coderef must return a hash reference. The keys will be used as export names and the values are the subs that will be exported. This example shows a simple use of the group generator. package Data::Crypto; use Sub::Exporter -setup => { groups => { cipher => \&build_cipher_group } }; sub build_cipher_group { my ($class, $group, $arg) = @_; my ($encode, $decode) = build_codec($arg->{secret}); return { cipher => $encode, decipher => $decode }; } The C and C routines are built in a group because they are built together by code which encloses their secret in their environment. =head3 Default Groups If a module that uses Sub::Exporter is Cd with no arguments, it will try to export the group named C. If that group has not been specifically configured, it will be empty, and nothing will happen. Another group is also created if not defined: C. The C group contains all the exports from the exports list. =head2 Collector Configuration The C entry in the exporter configuration gives names which, when found in the import call, have their values collected and passed to every generator. For example, the C generator that we saw above could be rewritten as: sub build_analyzer { my ($class, $name, $arg, $col) = @_; return sub { my $data = shift; my $tolerance = shift || $arg->{tolerance} || $col->{defaults}{tolerance}; my $passes = shift || $arg->{passes} || $col->{defaults}{passes}; analyze($data, $tolerance, $passes); } } That would allow the importer to specify global defaults for his imports: use Data::Analyze 'analyze', analyze => { tolerance => 0.10, -as => analyze10 }, analyze => { tolerance => 0.15, passes => 50, -as => analyze50 }, defaults => { passes => 10 }; my $A = analyze10($data); # equivalent to analyze($data, 0.10, 10); my $C = analyze50($data); # equivalent to analyze($data, 0.15, 50); my $B = analyze($data, 0.20); # equivalent to analyze($data, 0.20, 10); If values are provided in the C list during exporter setup, they must be code references, and are used to validate the importer's values. The validator is called when the collection is found, and if it returns false, an exception is thrown. We could ensure that no one tries to set a global data default easily: collectors => { defaults => sub { return (exists $_[0]->{data}) ? 0 : 1 } } Collector coderefs can also be used as hooks to perform arbitrary actions before anything is exported. When the coderef is called, it is passed the value of the collection and a hashref containing the following entries: name - the name of the collector config - the exporter configuration (hashref) import_args - the arguments passed to the exporter, sans collections (aref) class - the package on which the importer was called into - the package into which exports will be exported Collectors with all-caps names (that is, made up of underscore or capital A through Z) are reserved for special use. The only currently implemented special collector is C, whose hook (if present in the exporter configuration) is always run before any other hook. =head1 CALLING THE EXPORTER Arguments to the exporter (that is, the arguments after the module name in a C statement) are parsed as follows: First, the collectors gather any collections found in the arguments. Any reference type may be given as the value for a collector. For each collection given in the arguments, its validator (if any) is called. Next, groups are expanded. If the group is implemented by a group generator, the generator is called. There are two special arguments which, if given to a group, have special meaning: -prefix - a string to prepend to any export imported from this group -suffix - a string to append to any export imported from this group Finally, individual export generators are called and all subs, generated or otherwise, are installed in the calling package. There is only one special argument for export generators: -as - where to install the exported sub Normally, C<-as> will contain an alternate name for the routine. It may, however, contain a reference to a scalar. If that is the case, a reference the generated routine will be placed in the scalar referenced by C<-as>. It will not be installed into the calling package. =head2 Special Exporter Arguments The generated exporter accept some special options, which may be passed as the first argument, in a hashref. These options are: into_level into generator installer These override the same-named configuration options described in L. =head1 SUBROUTINES =head2 setup_exporter This routine builds and installs an C routine. It is called with one argument, a hashref containing the exporter configuration. Using this, it builds an exporter and installs it into the calling package with the name "import." In addition to the normal exporter configuration, a few named arguments may be passed in the hashref: into - into what package should the exporter be installed into_level - into what level up the stack should the exporter be installed as - what name should the installed exporter be given By default the exporter is installed with the name C into the immediate caller of C. In other words, if your package calls C without providing any of the three above arguments, it will have an C routine installed. Providing both C and C will cause an exception to be thrown. The exporter is built by C>. =head2 build_exporter Given a standard exporter configuration, this routine builds and returns an exporter -- that is, a subroutine that can be installed as a class method to perform exporting on request. Usually, this method is called by C>, which then installs the exporter as a package's import routine. =head2 default_generator This is Sub::Exporter's default generator. It takes bits of configuration that have been gathered during the import and turns them into a coderef that can be installed. my $code = default_generator(\%arg); Passed arguments are: class - the class on which the import method was called name - the name of the export being generated arg - the arguments to the generator col - the collections generator - the generator to be used to build the export (code or scalar ref) =head2 default_installer This is Sub::Exporter's default installer. It does what Sub::Exporter promises: it installs code into the target package. default_installer(\%arg, \@to_export); Passed arguments are: into - the package into which exports should be delivered C<@to_export> is a list of name/value pairs. The default exporter assigns code (the values) to named slots (the names) in the given package. If the name is a scalar reference, the scalar reference is made to point to the code reference instead. =head1 EXPORTS Sub::Exporter also offers its own exports: the C and C routines described above. It also provides a special "setup" collector, which will set up an exporter using the parameters passed to it. Note that the "setup" collector (seen in examples like the L above) uses C, not C. This means that the special arguments like "into" and "as" for C are not accepted here. Instead, you may write something like: use Sub::Exporter { into => 'Target::Package' }, -setup => { -as => 'do_import', exports => [ ... ], } ; Finding a good reason for wanting to do this is left as an exercise for the reader. =head1 COMPARISONS There are a whole mess of exporters on the CPAN. The features included in Sub::Exporter set it apart from any existing Exporter. Here's a summary of some other exporters and how they compare. =over =item * L and co. This is the standard Perl exporter. Its interface is a little clunky, but it's fast and ubiquitous. It can do some things that Sub::Exporter can't: it can export things other than routines, it can import "everything in this group except this symbol," and some other more esoteric things. These features seem to go nearly entirely unused. It always exports things exactly as they appear in the exporting module; it can't rename or customize routines. Its groups ("tags") can't be nested. L is a whole lot like Exporter, but it does significantly less: it supports exporting symbols, but not groups, pattern matching, or negation. The fact that Sub::Exporter can't export symbols other than subroutines is a good idea, not a missing feature. For simple uses, setting up Sub::Exporter is about as easy as Exporter. For complex uses, Sub::Exporter makes hard things possible, which would not be possible with Exporter. When using a module that uses Sub::Exporter, users familiar with Exporter will probably see no difference in the basics. These two lines do about the same thing in whether the exporting module uses Exporter or Sub::Exporter. use Some::Module qw(foo bar baz); use Some::Module qw(foo :bar baz); The definition for exporting in Exporter.pm might look like this: package Some::Module; use base qw(Exporter); our @EXPORT_OK = qw(foo bar baz quux); our %EXPORT_TAGS = (bar => [ qw(bar baz) ]); Using Sub::Exporter, it would look like this: package Some::Module; use Sub::Exporter -setup => { exports => [ qw(foo bar baz quux) ], groups => { bar => [ qw(bar baz) ]} }; Sub::Exporter respects inheritance, so that a package may export inherited routines, and will export the most inherited version. Exporting methods without currying away the invocant is a bad idea, but Sub::Exporter allows you to do just that -- and anyway, there are other uses for this feature, like packages of exported subroutines which use inheritance specifically to allow more specialized, but similar, packages. L provides a wrapper around the standard Exporter. It makes it simpler to build groups, but doesn't provide any more functionality. Because it is a front-end to Exporter, it will store your exporter's configuration in global package variables. =item * Attribute-Based Exporters Some exporters use attributes to mark variables to export. L supports exporting any kind of symbol, and supports groups. Using a module like Exporter or Sub::Exporter, it's easy to look at one place and see what is exported, but it's impossible to look at a variable definition and see whether it is exported by that alone. Exporter::Simple makes this trade in reverse: each variable's declaration includes its export definition, but there is no one place to look to find a manifest of exports. More importantly, Exporter::Simple does not add any new features to those of Exporter. In fact, like Exporter::Easy, it is just a front-end to Exporter, so it ends up storing its configuration in global package variables. (This means that there is one place to look for your exporter's manifest, actually. You can inspect the C<@EXPORT> package variables, and other related package variables, at runtime.) L isn't actually attribute based, but looks similar. Its syntax is borrowed from Perl 6, and implemented by a source filter. It is a prototype of an interface that is still being designed. It should probably be avoided for production work. On the other hand, L implements Perl 6-like exporting, but translates it into Perl 5 by providing attributes. =item * Other Exporters L wraps the standard Exporter to allow it to export symbols with changed names. L performs a special kind of routine generation, giving each importing package an instance of your class, and then exporting the instance's methods as normal routines. (Sub::Exporter, of course, can easily emulate this behavior, as shown above.) L implements a form of renaming (using its C<_map> argument) and of prefixing, and implements groups. It also avoids using package variables for its configuration. =back =head1 TODO =over =item * write a set of longer, more demonstrative examples =item * solidify the "custom exporter" interface (see C<&default_exporter>) =item * add an "always" group =back =head1 THANKS Hans Dieter Pearcey provided helpful advice while I was writing Sub::Exporter. Ian Langworth and Shawn Sorichetti asked some good questions and helped me improve my documentation quite a bit. Yuval Kogman helped me find a bunch of little problems. Thanks, guys! =head1 BUGS Please report any bugs or feature requests through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2007 by Ricardo Signes. 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 Sub-Exporter-0.986/lib/Sub/Exporter/Cookbook.pod000644 000766 000766 00000020630 12156716434 021450 0ustar00rjbsrjbs000000 000000 # ABSTRACT: useful, demonstrative, or stupid Sub::Exporter tricks # PODNAME: Sub::Exporter::Cookbook __END__ =pod =head1 NAME Sub::Exporter::Cookbook - useful, demonstrative, or stupid Sub::Exporter tricks =head1 VERSION version 0.986 =head1 OVERVIEW Sub::Exporter is a fairly simple tool, and can be used to achieve some very simple goals. Its basic behaviors and their basic application (that is, "traditional" exporting of routines) are described in L and L. This document presents applications that may not be immediately obvious, or that can demonstrate how certain features can be put to use (for good or evil). =head1 THE RECIPES =head2 Exporting Methods as Routines With Exporter.pm, exporting methods is a non-starter. Sub::Exporter makes it simple. By using the C utility provided in L, a method can be exported with the invocant built in. package Object::Strenuous; use Sub::Exporter::Util 'curry_method'; use Sub::Exporter -setup => { exports => [ objection => curry_method('new') ], }; With this configuration, the importing code may contain: my $obj = objection("irrelevant"); ...and this will be equivalent to: my $obj = Object::Strenuous->new("irrelevant"); The built-in invocant is determined by the invocant for the C method. That means that if we were to subclass Object::Strenuous as follows: package Object::Strenuous::Repeated; @ISA = 'Object::Strenuous'; ...then importing C from the subclass would build-in that subclass. Finally, since the invocant can be an object, you can write something like this: package Cypher; use Sub::Exporter::Util 'curry_method'; use Sub::Exporter -setup => { exports => [ encypher => curry_method ], }; with the expectation that C will be called on an instantiated Cypher object: BEGIN { my $cypher = Cypher->new( ... ); $cypher->import('encypher'); } Now there is a globally-available C routine which calls the encypher method on an otherwise unavailable Cypher object. =head2 Exporting Methods as Methods While exporting modules usually export subroutines to be called as subroutines, it's easy to use Sub::Exporter to export subroutines meant to be called as methods on the importing package or its objects. Here's a trivial (and naive) example: package Mixin::DumpObj; use Data::Dumper; use Sub::Exporter -setup => { exports => [ qw(dump) ] }; sub dump { my ($self) = @_; return Dumper($self); } When writing your own object class, you can then import C to be used as a method, called like so: $object->dump; By assuming that the importing class will provide a certain interface, a method-exporting module can be used as a simple plugin: package Number::Plugin::Upto; use Sub::Exporter -setup => { into => 'Number', exports => [ qw(upto) ], groups => [ default => [ qw(upto) ] ], }; sub upto { my ($self) = @_; return 1 .. abs($self->as_integer); } The C line in the configuration says that this plugin will export, by default, into the Number package, not into the C-ing package. It can be exported anyway, though, and will work as long as the destination provides an C method like the one it expects. To import it to a different destination, one can just write: use Number::Plugin::Upto { into => 'Quantity' }; =head2 Mixing-in Complex External Behavior When exporting methods to be used as methods (see above), one very powerful option is to export methods that are generated routines that maintain an enclosed reference to the exporting module. This allows a user to import a single method which is implemented in terms of a complete, well-structured package. Here is a very small example: package Data::Analyzer; use Sub::Exporter -setup => { exports => [ analyze => \'_generate_analyzer' ], }; sub _generate_analyzer { my ($mixin, $name, $arg, $col) = @_; return sub { my ($self) = @_; my $values = [ $self->values ]; my $analyzer = $mixin->new($values); $analyzer->perform_analysis; $analyzer->aggregate_results; return $analyzer->summary; }; } If imported by any package providing a C method, this plugin will provide a single C method that acts as a simple interface to a more complex set of behaviors. Even more importantly, because the C<$mixin> value will be the invocant on which the C was actually called, one can subclass C and replace only individual pieces of the complex behavior, making it easy to write complex, subclassable toolkits with simple single points of entry for external interfaces. =head2 Exporting Constants While Sub::Exporter isn't in the constant-exporting business, it's easy to export constants by using one of its sister modules, Package::Generator. package Important::Constants; use Sub::Exporter -setup => { collectors => [ constants => \'_set_constants' ], }; sub _set_constants { my ($class, $value, $data) = @_; Package::Generator->assign_symbols( $data->{into}, [ MEANING_OF_LIFE => \42, ONE_TRUE_BASE => \13, FACTORS => [ 6, 9 ], ], ); return 1; } Then, someone can write: use Important::Constants 'constants'; print "The factors @FACTORS produce $MEANING_OF_LIFE in $ONE_TRUE_BASE."; (The constants must be exported via a collector, because they are effectively altering the importing class in a way other than installing subroutines.) =head2 Altering the Importer's @ISA It's trivial to make a collector that changes the inheritance of an importing package: use Sub::Exporter -setup => { collectors => { -base => \'_make_base' }, }; sub _make_base { my ($class, $value, $data) = @_; my $target = $data->{into}; push @{"$target\::ISA"}, $class; } Then, the user of your class can write: use Some::Class -base; and become a subclass. This can be quite useful in building, for example, a module that helps build plugins. We may want a few utilities imported, but we also want to inherit behavior from some base plugin class; package Framework::Util; use Sub::Exporter -setup => { exports => [ qw(log global_config) ], groups => [ _plugin => [ qw(log global_config) ] collectors => { '-plugin' => \'_become_plugin' }, }; sub _become_plugin { my ($class, $value, $data) = @_; my $target = $data->{into}; push @{"$target\::ISA"}, $class->plugin_base_class; push @{ $data->{import_args} }, '-_plugin'; } Now, you can write a plugin like this: package Framework::Plugin::AirFreshener; use Framework::Util -plugin; =head2 Eating Exporter.pm's Brain You probably shouldn't actually do this in production. It's offered more as a demonstration than a suggestion. sub exporter_upgrade { my ($pkg) = @_; my $new_pkg = "$pkg\::UsingSubExporter"; return $new_pkg if $new_pkg->isa($pkg); Sub::Exporter::setup_exporter({ as => 'import', into => $new_pkg, exports => [ @{"$pkg\::EXPORT_OK"} ], groups => { %{"$pkg\::EXPORT_TAG"}, default => [ @{"$pkg\::EXPORTS"} ], }, }); @{"$new_pkg\::ISA"} = $pkg; return $new_pkg; } This routine, given the name of an existing package configured to use Exporter.pm, returns the name of a new package with a Sub::Exporter-powered C routine. This lets you import C into the current package with the name C by writing: BEGIN { require Toolkit; exporter_upgrade('Toolkit')->import(exported_sub => { -as => 'foo' }) } If you're feeling particularly naughty, this routine could have been declared in the UNIVERSAL package, meaning you could write: BEGIN { require Toolkit; Toolkit->exporter_upgrade->import(exported_sub => { -as => 'foo' }) } The new package will have all the same exporter configuration as the original, but will support export and group renaming, including exporting into scalar references. Further, since Sub::Exporter uses C to find the routine being exported, the new package may be subclassed and some of its exports replaced. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2007 by Ricardo Signes. 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 Sub-Exporter-0.986/lib/Sub/Exporter/Tutorial.pod000644 000766 000766 00000021666 12156716434 021517 0ustar00rjbsrjbs000000 000000 # PODNAME: Sub::Exporter::Tutorial # ABSTRACT: a friendly guide to exporting with Sub::Exporter __END__ =pod =head1 NAME Sub::Exporter::Tutorial - a friendly guide to exporting with Sub::Exporter =head1 VERSION version 0.986 =head1 DESCRIPTION =head2 What's an Exporter? When you C a module, first it is required, then its C method is called. The Perl documentation tells us that the following two lines are equivalent: use Module LIST; BEGIN { require Module; Module->import(LIST); } The method named C is the module's I, it exports functions and variables into its caller's namespace. =head2 The Basics of Sub::Exporter Sub::Exporter builds a custom exporter which can then be installed into your module. It builds this method based on configuration passed to its C method. A very basic use case might look like this: package Addition; use Sub::Exporter; Sub::Exporter::setup_exporter({ exports => [ qw(plus) ]}); sub plus { my ($x, $y) = @_; return $x + $y; } This would mean that when someone used your Addition module, they could have its C routine imported into their package: use Addition qw(plus); my $z = plus(2, 2); # this works, because now plus is in the main package That syntax to set up the exporter, above, is a little verbose, so for the simple case of just naming some exports, you can write this: use Sub::Exporter -setup => { exports => [ qw(plus) ] }; ...which is the same as the original example -- except that now the exporter is built and installed at compile time. Well, that and you typed less. =head2 Using Export Groups You can specify whole groups of things that should be exportable together. These are called groups. L calls these tags. To specify groups, you just pass a C key in your exporter configuration: package Food; use Sub::Exporter -setup => { exports => [ qw(apple banana beef fluff lox rabbit) ], groups => { fauna => [ qw(beef lox rabbit) ], flora => [ qw(apple banana) ], } }; Now, to import all that delicious foreign meat, your consumer needs only to write: use Food qw(:fauna); use Food qw(-fauna); Either one of the above is acceptable. A colon is more traditional, but barewords with a leading colon can't be enquoted by a fat arrow. We'll see why that matters later on. Groups can contain other groups. If you include a group name (with the leading dash or colon) in a group definition, it will be expanded recursively when the exporter is called. The exporter will B recurse into the same group twice while expanding groups. There are two special groups: C and C. The C group is defined for you and contains all exportable subs. You can redefine it, if you want to export only a subset when all exports are requested. The C group is the set of routines to export when nothing specific is requested. By default, there is no C group. =head2 Renaming Your Imports Sometimes you want to import something, but you don't like the name as which it's imported. Sub::Exporter can rename your imports for you. If you wanted to import C from the Food package, but you don't like the name, you could write this: use Food lox => { -as => 'salmon' }; Now you'd get the C routine, but it would be called salmon in your package. You can also rename entire groups by using the C option: use Food -fauna => { -prefix => 'cute_little_' }; Now you can call your C routine. (You can also call C, but that hardly seems as enticing.) When you define groups, you can include renaming. use Sub::Exporter -setup => { exports => [ qw(apple banana beef fluff lox rabbit) ], groups => { fauna => [ qw(beef lox), rabbit => { -as => 'coney' } ], } }; A prefix on a group like that does the right thing. This is when it's useful to use a dash instead of a colon to indicate a group: you can put a fat arrow between the group and its arguments, then. use Food -fauna => { -prefix => 'lovely_' }; eat( lovely_coney ); # this works Prefixes also apply recursively. That means that this code works: use Sub::Exporter -setup => { exports => [ qw(apple banana beef fluff lox rabbit) ], groups => { fauna => [ qw(beef lox), rabbit => { -as => 'coney' } ], allowed => [ -fauna => { -prefix => 'willing_' }, 'banana' ], } }; ... use Food -allowed => { -prefix => 'any_' }; $dinner = any_willing_coney; # yum! Groups can also be passed a C<-suffix> argument. Finally, if the C<-as> argument to an exported routine is a reference to a scalar, a reference to the routine will be placed in that scalar. =head2 Building Subroutines to Order Sometimes, you want to export things that you don't have on hand. You might want to offer customized routines built to the specification of your consumer; that's just good business! With Sub::Exporter, this is easy. To offer subroutines to order, you need to provide a generator when you set up your exporter. A generator is just a routine that returns a new routine. L is talking about these when it discusses closures and function templates. The canonical example of a generator builds a unique incrementor; here's how you'd do that with Sub::Exporter; package Package::Counter; use Sub::Exporter -setup => { exports => [ counter => sub { my $i = 0; sub { $i++ } } ], groups => { default => [ qw(counter) ] }, }; Now anyone can use your Package::Counter module and he'll receive a C in his package. It will count up by one, and will never interfere with anyone else's counter. This isn't very useful, though, unless the consumer can explain what he wants. This is done, in part, by supplying arguments when importing. The following example shows how a generator can take and use arguments: package Package::Counter; sub _build_counter { my ($class, $name, $arg) = @_; $arg ||= {}; my $i = $arg->{start} || 0; return sub { $i++ }; } use Sub::Exporter -setup => { exports => [ counter => \'_build_counter' ], groups => { default => [ qw(counter) ] }, }; Now, the consumer can (if he wants) specify a starting value for his counter: use Package::Counter counter => { start => 10 }; Arguments to a group are passed along to the generators of routines in that group, but Sub::Exporter arguments -- anything beginning with a dash -- are never passed in. When groups are nested, the arguments are merged as the groups are expanded. Notice, too, that in the example above, we gave a reference to a method I rather than a method I. By giving the name rather than the subroutine, we make it possible for subclasses of our "Package::Counter" module to replace the C<_build_counter> method. When a generator is called, it is passed four parameters: =over =item * the invocant on which the exporter was called =item * the name of the export being generated (not the name it's being installed as) =item * the arguments supplied for the routine =item * the collection of generic arguments =back The fourth item is the last major feature that hasn't been covered. =head2 Argument Collectors Sometimes you will want to accept arguments once that can then be available to any subroutine that you're going to export. To do this, you specify collectors, like this: package Menu::Airline use Sub::Exporter -setup => { exports => ... , groups => ... , collectors => [ qw(allergies ethics) ], }; Collectors look like normal exports in the import call, but they don't do anything but collect data which can later be passed to generators. If the module was used like this: use Menu::Airline allergies => [ qw(peanuts) ], ethics => [ qw(vegan) ]; ...the consumer would get a salad. Also, all the generators would be passed, as their fourth argument, something like this: { allerges => [ qw(peanuts) ], ethics => [ qw(vegan) ] } Generators may have arguments in their definition, as well. These must be code refs that perform validation of the collected values. They are passed the collection value and may return true or false. If they return false, the exporter will throw an exception. =head2 Generating Many Routines in One Scope Sometimes it's useful to have multiple routines generated in one scope. This way they can share lexical data which is otherwise unavailable. To do this, you can supply a generator for a group which returns a hashref of names and code references. This generator is passed all the usual data, and the group may receive the usual C<-prefix> or C<-suffix> arguments. =head1 SEE ALSO =over 4 =item * L for complete documentation and references to other exporters =back =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2007 by Ricardo Signes. 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 Sub-Exporter-0.986/lib/Sub/Exporter/Util.pm000644 000766 000766 00000021345 12156716434 020455 0ustar00rjbsrjbs000000 000000 use strict; use warnings; package Sub::Exporter::Util; { $Sub::Exporter::Util::VERSION = '0.986'; } # ABSTRACT: utilities to make Sub::Exporter easier use Data::OptList (); use Params::Util (); sub curry_method { my $override_name = shift; sub { my ($class, $name) = @_; $name = $override_name if defined $override_name; sub { $class->$name(@_); }; } } BEGIN { *curry_class = \&curry_method; } sub curry_chain { # In the future, we can make \%arg an optional prepend, like the "special" # args to the default Sub::Exporter-generated import routine. my (@opt_list) = @_; my $pairs = Data::OptList::mkopt(\@opt_list, 'args', 'ARRAY'); sub { my ($class) = @_; sub { my $next = $class; for my $i (0 .. $#$pairs) { my $pair = $pairs->[ $i ]; unless (Params::Util::_INVOCANT($next)) { ## no critic Private my $str = defined $next ? "'$next'" : 'undef'; Carp::croak("can't call $pair->[0] on non-invocant $str") } my ($method, $args) = @$pair; if ($i == $#$pairs) { return $next->$method($args ? @$args : ()); } else { $next = $next->$method($args ? @$args : ()); } } }; } } # =head2 name_map # # This utility returns an list to be used in specify export generators. For # example, the following: # # exports => { # name_map( # '_?_gen' => [ qw(fee fie) ], # '_make_?' => [ qw(foo bar) ], # ), # } # # is equivalent to: # # exports => { # name_map( # fee => \'_fee_gen', # fie => \'_fie_gen', # foo => \'_make_foo', # bar => \'_make_bar', # ), # } # # This can save a lot of typing, when providing many exports with similarly-named # generators. # # =cut # # sub name_map { # my (%groups) = @_; # # my %map; # # while (my ($template, $names) = each %groups) { # for my $name (@$names) { # (my $export = $template) =~ s/\?/$name/ # or Carp::croak 'no ? found in name_map template'; # # $map{ $name } = \$export; # } # } # # return %map; # } sub merge_col { my (%groups) = @_; my %merged; while (my ($default_name, $group) = each %groups) { while (my ($export_name, $gen) = each %$group) { $merged{$export_name} = sub { my ($class, $name, $arg, $col) = @_; my $merged_arg = exists $col->{$default_name} ? { %{ $col->{$default_name} }, %$arg } : $arg; if (Params::Util::_CODELIKE($gen)) { ## no critic Private $gen->($class, $name, $merged_arg, $col); } else { $class->$$gen($name, $merged_arg, $col); } } } } return %merged; } sub __mixin_class_for { my ($class, $mix_into) = @_; require Package::Generator; my $mixin_class = Package::Generator->new_package({ base => "$class\:\:__mixin__", }); ## no critic (ProhibitNoStrict) no strict 'refs'; if (ref $mix_into) { unshift @{"$mixin_class" . "::ISA"}, ref $mix_into; } else { unshift @{"$mix_into" . "::ISA"}, $mixin_class; } return $mixin_class; } sub mixin_installer { sub { my ($arg, $to_export) = @_; my $mixin_class = __mixin_class_for($arg->{class}, $arg->{into}); bless $arg->{into} => $mixin_class if ref $arg->{into}; Sub::Exporter::default_installer( { %$arg, into => $mixin_class }, $to_export, ); }; } sub mixin_exporter { Carp::cluck "mixin_exporter is deprecated; use mixin_installer instead; it behaves identically"; return mixin_installer; } sub like { sub { my ($value, $arg) = @_; Carp::croak "no regex supplied to regex group generator" unless $value; # Oh, qr//, how you bother me! See the p5p thread from around now about # fixing this problem... too bad it won't help me. -- rjbs, 2006-04-25 my @values = eval { $value->isa('Regexp') } ? ($value, undef) : @$value; while (my ($re, $opt) = splice @values, 0, 2) { Carp::croak "given pattern for regex group generater is not a Regexp" unless eval { $re->isa('Regexp') }; my @exports = keys %{ $arg->{config}->{exports} }; my @matching = grep { $_ =~ $re } @exports; my %merge = $opt ? %$opt : (); my $prefix = (delete $merge{-prefix}) || ''; my $suffix = (delete $merge{-suffix}) || ''; for my $name (@matching) { my $as = $prefix . $name . $suffix; push @{ $arg->{import_args} }, [ $name => { %merge, -as => $as } ]; } } 1; } } use Sub::Exporter -setup => { exports => [ qw( like name_map merge_col curry_method curry_class curry_chain mixin_installer mixin_exporter ) ] }; 1; __END__ =pod =head1 NAME Sub::Exporter::Util - utilities to make Sub::Exporter easier =head1 VERSION version 0.986 =head1 DESCRIPTION This module provides a number of utility functions for performing common or useful operations when setting up a Sub::Exporter configuration. All of the utilities may be exported, but none are by default. =head1 THE UTILITIES =head2 curry_method exports => { some_method => curry_method, } This utility returns a generator which will produce an invocant-curried version of a method. In other words, it will export a method call with the exporting class built in as the invocant. A module importing the code some the above example might do this: use Some::Module qw(some_method); my $x = some_method; This would be equivalent to: use Some::Module; my $x = Some::Module->some_method; If Some::Module is subclassed and the subclass's import method is called to import C, the subclass will be curried in as the invocant. If an argument is provided for C it is used as the name of the curried method to export. This means you could export a Widget constructor like this: exports => { widget => curry_method('new') } This utility may also be called as C, for backwards compatibility. =head2 curry_chain C behaves like C>, but is meant for generating exports that will call several methods in succession. exports => { reticulate => curry_chain( new => gather_data => analyze => [ detail => 100 ] => 'results' ), } If imported from Spliner, calling the C routine will be equivalent to: Spliner->new->gather_data->analyze(detail => 100)->results; If any method returns something on which methods may not be called, the routine croaks. The arguments to C form an optlist. The names are methods to be called and the arguments, if given, are arrayrefs to be dereferenced and passed as arguments to those methods. C returns a generator like those expected by Sub::Exporter. B at present, there is no way to pass arguments from the generated routine to the method calls. This will probably be solved in future revisions by allowing the opt list's values to be subroutines that will be called with the generated routine's stack. =head2 merge_col exports => { merge_col(defaults => { twiddle => \'_twiddle_gen', tweak => \&_tweak_gen, }), } This utility wraps the given generator in one that will merge the named collection into its args before calling it. This means that you can support a "default" collector in multiple exports without writing the code each time. You can specify as many pairs of collection names and generators as you like. =head2 mixin_installer use Sub::Exporter -setup => { installer => Sub::Exporter::Util::mixin_installer, exports => [ qw(foo bar baz) ], }; This utility returns an installer that will install into a superclass and adjust the ISA importing class to include the newly generated superclass. If the target of importing is an object, the hierarchy is reversed: the new class will be ISA the object's class, and the object will be reblessed. B: This utility requires that Package::Generator be installed. =head2 like It's a collector that adds imports for anything like given regex. If you provide this configuration: exports => [ qw(igrep imap islurp exhausted) ], collectors => { -like => Sub::Exporter::Util::like }, A user may import from your module like this: use Your::Iterator -like => qr/^i/; # imports igre, imap, islurp or use Your::Iterator -like => [ qr/^i/ => { -prefix => 'your_' } ]; The group-like prefix and suffix arguments are respected; other arguments are passed on to the generators for matching exports. =head1 AUTHOR Ricardo Signes =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2007 by Ricardo Signes. 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