From 5b984b2965271113395d7ae38e198a3847ba66ca Mon Sep 17 00:00:00 2001 From: denghao Date: Fri, 2 Sep 2022 08:37:03 +0300 Subject: [PATCH] Import Upstream version 0.026 --- Changes | 131 +++++ LICENSE | 379 ++++++++++++ MANIFEST | 17 + META.json | 53 ++ META.yml | 24 + Makefile.PL | 44 ++ README | 664 +++++++++++++++++++++ README.md | 636 ++++++++++++++++++++ cpanfile | 16 + lib/Importer.pm | 1463 +++++++++++++++++++++++++++++++++++++++++++++++ t/Simple.t | 32 ++ t/all_tag.t | 47 ++ t/export_fail.t | 28 + t/import.t | 21 + t/missing.t | 22 + t/units.t | 1083 +++++++++++++++++++++++++++++++++++ 16 files changed, 4660 insertions(+) create mode 100644 Changes create mode 100644 LICENSE create mode 100644 MANIFEST create mode 100644 META.json create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 README.md create mode 100644 cpanfile create mode 100644 lib/Importer.pm create mode 100644 t/Simple.t create mode 100644 t/all_tag.t create mode 100644 t/export_fail.t create mode 100644 t/import.t create mode 100644 t/missing.t create mode 100644 t/units.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..55d3de1 --- /dev/null +++ b/Changes @@ -0,0 +1,131 @@ +0.026 2020-08-16 14:24:02-07:00 America/Los_Angeles + + - Work with strict on by default + +0.025 2018-02-18 12:42:37-08:00 America/Los_Angeles + + - Minor cperl fix + +0.024 2016-10-20 06:11:07-07:00 America/Los_Angeles + + - No changes from dev release + +0.023 2016-09-15 12:08:40-07:00 America/Los_Angeles (TRIAL RELEASE) + + - Remove experimental pin feature + +0.022 2016-09-14 13:38:19-07:00 America/Los_Angeles (TRIAL RELEASE) + + - Fix infinite recursion on empty pins + - Pass caller into on_use + +0.021 2016-08-28 16:44:26-07:00 America/Los_Angeles (TRIAL RELEASE) + + - 'pins' allow multiple inheritence + - 'pins' allow +pin => [...] + - Allow nesting tags + - Allow specs in tags + - Saner arg parsing all around + +0.020 2016-08-27 15:32:16-07:00 America/Los_Angeles (TRIAL RELEASE) + + - Make 'pins' feature more sane + - remove '*' in favor of real inheritance + - use 'undef' for on_use argument when no pin is provided + - Fix bug where menu attribute was reset multiple times using pins + +0.019 2016-08-25 22:00:28-07:00 America/Los_Angeles (TRIAL RELEASE) + + - Rename the 'version-sets' feature to 'pins' to avoid confusions and + conflicts + +0.018 2016-08-21 16:09:24-07:00 America/Los_Angeles (TRIAL RELEASE) + + - Allow renaming of the 'v0' version set + +0.017 2016-08-20 22:57:17-07:00 America/Los_Angeles (TRIAL RELEASE) + + - Add on_use/sub EXPORT_ON_USE { ... } feature + +0.016 2016-08-20 21:41:34-07:00 America/Los_Angeles (TRIAL RELEASE) + + - Add polish to version-sets + - Add '*' version for common things + - Do not allow tags or versions inside a version specification + - More documentation for version-sets + +0.015 2016-08-20 15:26:23-07:00 America/Los_Angeles (TRIAL RELEASE) + + - Add support for version-sets + - Spelling fixes + +0.014 2016-07-12 21:53:31-07:00 America/Los_Angeles + + - Add :ALL tag when none is pre-defined + +0.013 2016-07-09 16:00:05-07:00 America/Los_Angeles + + - Add extra params to custom symbol setters + +0.012 2016-01-26 19:31:40-08:00 America/Los_Angeles + + - Expose optimal_import() + +0.011 2016-01-26 15:55:46-08:00 America/Los_Angeles + + - no changes from last trial + +0.010 2016-01-25 14:21:40-08:00 America/Los_Angeles (TRIAL RELEASE) + + - Remove experimental warning + - _optimal_import aborts if certain vars are present + - Add EXPORT_MAGIC var support + +0.009 2016-01-24 19:29:38-08:00 America/Los_Angeles + + - Quote filename in regex so windows can pass tests + +0.008 2016-01-24 13:59:48-08:00 America/Los_Angeles + + - New Feature: Custom export asignments + - New Feature: Get exports as hash/list/ref + +0.007 2016-01-23 21:22:00-08:00 America/Los_Angeles + + - Less warnings/strict pragmas scattered everywhere + - Strip '&' from exporter_fail args + - Fix support for non-exports listed in @EXPORT (Grr CGI.pm) + +0.006 2016-01-23 17:23:08-08:00 America/Los_Angeles + + - Doc updates + - Remove Exporter.pm clone + - Further optimize _optimal_import + - Fix bugs found in blead testing + +0.005 2016-01-22 09:21:17-08:00 America/Los_Angeles + + - Fix for older perls + +0.004 2016-01-21 21:18:11-08:00 America/Los_Angeles + + - Finish testing + - Bug fixes + - documentation + +0.003 2016-01-17 23:19:45-08:00 America/Los_Angeles + + - Optimized path for most-common import condition + - More testing + - Bug fixes + - Prototype Exporter.pm clone + +0.002 2016-01-16 15:09:11-08:00 America/Los_Angeles + + - Doc fixes + - Bug fixes + - Additional testing (still incomplete) + +0.001 2016-01-15 11:47:38-08:00 America/Los_Angeles + + - Initial Release diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..caa7d07 --- /dev/null +++ b/LICENSE @@ -0,0 +1,379 @@ +This software is copyright (c) 2020 by Chad Granum. + +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) 2020 by Chad Granum. + +This is free software, licensed under: + + The GNU General Public License, Version 1, February 1989 + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + + Copyright (C) 19yy + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! + + +--- The Artistic License 1.0 --- + +This software is Copyright (c) 2020 by Chad Granum. + +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 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..ec26b5c --- /dev/null +++ b/MANIFEST @@ -0,0 +1,17 @@ +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.015. +Changes +LICENSE +MANIFEST +META.json +META.yml +Makefile.PL +README +README.md +cpanfile +lib/Importer.pm +t/Simple.t +t/all_tag.t +t/export_fail.t +t/import.t +t/missing.t +t/units.t diff --git a/META.json b/META.json new file mode 100644 index 0000000..4870be1 --- /dev/null +++ b/META.json @@ -0,0 +1,53 @@ +{ + "abstract" : "Alternative but compatible interface to modules that export symbols.", + "author" : [ + "Chad Granum " + ], + "dynamic_config" : 0, + "generated_by" : "Dist::Zilla version 6.015, CPAN::Meta::Converter version 2.150010", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "Importer", + "prereqs" : { + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "develop" : { + "requires" : { + "Test::Pod" : "1.41" + } + }, + "runtime" : { + "requires" : { + "perl" : "5.008001" + } + }, + "test" : { + "requires" : { + "Test::More" : "0.98" + } + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "http://github.com/exodist/Importer/issues" + }, + "repository" : { + "type" : "git", + "url" : "http://github.com/exodist/Importer/" + } + }, + "version" : "0.026", + "x_generated_by_perl" : "v5.30.2", + "x_serialization_backend" : "Cpanel::JSON::XS version 4.19", + "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" +} + diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..77b496f --- /dev/null +++ b/META.yml @@ -0,0 +1,24 @@ +--- +abstract: 'Alternative but compatible interface to modules that export symbols.' +author: + - 'Chad Granum ' +build_requires: + Test::More: '0.98' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 0 +generated_by: 'Dist::Zilla version 6.015, CPAN::Meta::Converter version 2.150010' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Importer +requires: + perl: '5.008001' +resources: + bugtracker: http://github.com/exodist/Importer/issues + repository: http://github.com/exodist/Importer/ +version: '0.026' +x_generated_by_perl: v5.30.2 +x_serialization_backend: 'YAML::Tiny version 1.73' +x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..c28f82f --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,44 @@ +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.015. +use strict; +use warnings; + +use 5.008001; + +use ExtUtils::MakeMaker; + +my %WriteMakefileArgs = ( + "ABSTRACT" => "Alternative but compatible interface to modules that export symbols.", + "AUTHOR" => "Chad Granum ", + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => 0 + }, + "DISTNAME" => "Importer", + "LICENSE" => "perl", + "MIN_PERL_VERSION" => "5.008001", + "NAME" => "Importer", + "PREREQ_PM" => {}, + "TEST_REQUIRES" => { + "Test::More" => "0.98" + }, + "VERSION" => "0.026", + "test" => { + "TESTS" => "t/*.t" + } +); + + +my %FallbackPrereqs = ( + "Test::More" => "0.98" +); + + +unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { + delete $WriteMakefileArgs{TEST_REQUIRES}; + delete $WriteMakefileArgs{BUILD_REQUIRES}; + $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; +} + +delete $WriteMakefileArgs{CONFIGURE_REQUIRES} + unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; + +WriteMakefile(%WriteMakefileArgs); diff --git a/README b/README new file mode 100644 index 0000000..0007be5 --- /dev/null +++ b/README @@ -0,0 +1,664 @@ +NAME + + Importer - Alternative but compatible interface to modules that export + symbols. + +DESCRIPTION + + This module acts as a layer between Exporter and modules which consume + exports. It is feature-compatible with Exporter, plus some much needed + extras. You can use this to import symbols from any exporter that + follows Exporters specification. The exporter modules themselves do not + need to use or inherit from the Exporter module, they just need to set + @EXPORT and/or other variables. + +SYNOPSIS + + # Import defaults + use Importer 'Some::Module'; + + # Import a list + use Importer 'Another::Module' => qw/foo bar baz/; + + # Import a specific version: + use Importer 'That::Module' => '1.00'; + + # Require a sepcific version of Importer + use Importer 0.001, 'Foo::Bar' => qw/a b c/; + + foo() + bar() + baz() + + # Remove all subroutines imported by Importer + no Importer; + + # Import symbols into variables + my $croak = Importer->get_one(Carp => qw/croak/); + $croak->("This will croak"); + + my $CARP = Importer->get(Carp => qw/croak confess cluck/); + $CARP->{croak}->("This will croak"); + $CARP->{cluck}->("This will cluck"); + $CARP->{confess}->("This will confess"); + +WHY? + + There was recently a discussion on p5p about adding features to + Exporter. This conversation raised some significant concerns, those are + listed here, in addition to others. + + The burden is on export consumers to specify a version of Exporter + + Adding a feature to Exporter means that any consumer module that + relies on the new features must depend on a specific version of + Exporter. This seems somewhat backwards since Exporter is used by the + module you are importing from. + + Exporter.pm is really old/crazy code + + Not much more to say here. It is very old, it is very crazy, and if + you break it you break EVERYTHING. + + Using a modules import() for exporting makes it hard to give it other + purposes + + It is not unusual for a module to want to export symbols and provide + import behaviors. It is also not unusual for a consumer to only want + 1 or the other. Using this module you can import symbols without also + getting the import() side effects. + + In addition, moving forward, modules can specify exports and have a + custom import() without conflating the two. A module can tell you to + use Importer to get the symbols, and to use the module directly for + behaviors. A module could also use Importer within its own import() + method without the need to subclass Exporter, or bring in its + import() method. + + There are other exporter modules on cpan + + This module normally assumes an exporter uses Exporter, so it looks + for the variables and methods Exporter expects. However, other + exporters on cpan can override this using the IMPORTER_MENU() hook. + +COMPATIBILITY + + This module aims for 100% compatibility with every feature of Exporter, + plus added features such as import renaming. + + If you find something that works differently, or not at all when + compared to Exporter please report it as a bug, unless it is noted as + an intentional feature (like import renaming). + +IMPORT PARAMETERS + + use Importer $IMPORTER_VERSION, $FROM_MODULE, $FROM_MODULE_VERSION, \&SET_SYMBOL, @SYMBOLS; + + $IMPORTER_VERSION (optional) + + If you provide a numeric argument as the first argument it will be + treated as a version number. Importer will do a version check to make + sure it is at least at the requested version. + + $FROM_MODULE (required) + + This is the only required argument. This is the name of the module to + import symbols from. + + $FROM_MODULE_VERSION (optional) + + Any numeric argument following the $FROM_MODULE will be treated as a + version check against $FROM_MODULE. + + \&SET_SYMBOL (optional) + + Normally Importer will put the exports into your namespace. This is + usually done via a more complex form of *name = $ref. If you do NOT + want this to happen then you can provide a custom sub to handle the + assignment. + + This is an example that uses this feature to put all the exports into + a lexical hash instead of modifying the namespace (This is how the + get() method is implemented). + + my %CARP; + use Importer Carp => sub { + my ($name, $ref) = @_; + $CARP{$name} = $ref; + }; + + $CARP{cluck}->("This will cluck"); + $CARP{croak}->("This will croak"); + + The first two arguments to the custom sub are the name (no sigil), + and the reference. The additional arguments are key/value pairs: + + sub set_symbol { + my ($name, $ref, %info) = @_; + } + + $info{from} + + Package the symbol comes from. + + $info{into} + + Package to which the symbol should be added. + + $info{sig} + + The sigil that should be used. + + $info{spec} + + Extra details. + + $info{symbol} + + The original symbol name (with sigil) from the original package. + + @SYMBOLS (optional) + + Symbols you wish to import. If no symbols are specified then the + defaults will be used. You may also specify tags using the ':' + prefix. + +SUPPORTED FEATURES + + TAGS + + You can define/import subsets of symbols using predefined tags. + + use Importer 'Some::Thing' => ':tag'; + + Importer will automatically populate the :DEFAULT tag for you. Importer + will also give you an :ALL tag with ALL exports so long as the exporter + does not define a :ALL tag already. + + /PATTERN/ or qr/PATTERN/ + + You can import all symbols that match a pattern. The pattern can be + supplied a string starting and ending with '/', or you can provide a + qr/../ reference. + + use Importer 'Some::Thing' => '/oo/'; + + use Importer 'Some::Thing' => qr/oo/; + + EXCLUDING SYMBOLS + + You can exclude symbols by prefixing them with '!'. + + use Importer 'Some::Thing' + '!foo', # Exclude one specific symbol + '!/pattern/', # Exclude all matching symbols + '!' => qr/oo/, # Exclude all that match the following arg + '!:tag'; # Exclude all in tag + + RENAMING SYMBOLS AT IMPORT + + This is a new feature, Exporter does not support this on its own. + + You can rename symbols at import time using a specification hash + following the import name: + + use Importer 'Some::Thing' => ( + foo => { -as => 'my_foo' }, + ); + + You can also add a prefix and/or postfix: + + use Importer 'Some::Thing' => ( + foo => { -prefix => 'my_' }, + ); + + Using this syntax to set prefix and/or postfix also works on tags and + patterns that are specified for import, in which case the + prefix/postfix is applied to all symbols from the tag/patterm. + + CUSTOM EXPORT ASSIGNMENT + + This lets you provide an alternative to the *name = $ref export + assignment. See the list of parameters to import() + + UNIMPORTING + + See "UNIMPORT PARAMETERS". + + ANONYMOUS EXPORTS + + See "%EXPORT_ANON". + + GENERATED EXPORTS + + See "%EXPORT_GEN". + +UNIMPORT PARAMETERS + + no Importer; # Remove all subs brought in with Importer + + no Importer qw/foo bar/; # Remove only the specified subs + + Only subs can be unimported. + + You can only unimport subs imported using Importer. + +SUPPORTED VARIABLES + + @EXPORT + + This is used exactly the way Exporter uses it. + + List of symbols to export. Sigil is optional for subs. Symbols listed + here are exported by default. If possible you should put symbols in + @EXPORT_OK instead. + + our @EXPORT = qw/foo bar &baz $BAT/; + + @EXPORT_OK + + This is used exactly the way Exporter uses it. + + List of symbols that can be imported. Sigil is optional for subs. + Symbols listed here are not exported by default. This is preferred over + @EXPORT. + + our @EXPORT_OK = qw/foo bar &baz $BAT/; + + %EXPORT_TAGS + + This module supports tags exactly the way Exporter does. + + use Importer 'Some::Thing' => ':DEFAULT'; + + use Importer 'Other::Thing' => ':some_tag'; + + Tags can be specified this way: + + our %EXPORT_TAGS = ( + oos => [qw/foo boo zoo/], + ees => [qw/fee bee zee/], + ); + + @EXPORT_FAIL + + This is used exactly the way Exporter uses it. + + Use this to list subs that are not available on all platforms. If + someone tries to import one of these, Importer will hit your + $from->export_fail(@items) callback to try to resolve the issue. See + Exporter for documentation of this feature. + + our @EXPORT_FAIL = qw/maybe_bad/; + + %EXPORT_ANON + + This is new to this module, Exporter does not support it. + + This allows you to export symbols that are not actually in your package + symbol table. The keys should be the symbol names, the values are the + references for the symbols. + + our %EXPORT_ANON = ( + '&foo' => sub { 'foo' } + '$foo' => \$foo, + ... + ); + + %EXPORT_GEN + + This is new to this module, Exporter does not support it. + + This allows you to export symbols that are generated on export. The key + should be the name of a symbol. The value should be a coderef that + produces a reference that will be exported. + + When the generators are called they will receive 2 arguments, the + package the symbol is being exported into, and the symbol being + imported (name may or may not include sigil for subs). + + our %EXPORT_GEN = ( + '&foo' => sub { + my $from_package = shift; + my ($into_package, $symbol_name) = @_; + ... + return sub { ... }; + }, + ... + ); + + %EXPORT_MAGIC + + This is new to this module. Exporter does not support it. + + This allows you to define custom actions to run AFTER an export has + been injected into the consumers namespace. This is a good place to + enable parser hooks like with Devel::Declare. These will NOT be run if + a consumer uses a custom assignment callback. + + our %EXPORT_MAGIC = ( + foo => sub { + my $from = shift; # Should be the package doing the exporting + my %args = @_; + + my $into = $args{into}; # Package symbol was exported into + my $orig_name = $args{orig_name}; # Original name of the export (in the exporter) + my $new_name = $args{new_name}; # Name the symbol was imported as + my $ref = $args{ref}; # The reference to the symbol + + ...; # whatever you want, return is ignored. + }, + ); + +CLASS METHODS + + Importer->import($from) + + Importer->import($from, $version) + + Importer->import($from, @imports) + + Importer->import($from, $from_version, @imports) + + Importer->import($importer_version, $from, ...) + + This is the magic behind use Importer .... + + Importer->import_into($from, $into, @imports) + + Importer->import_into($from, $level, @imports) + + You can use this to import symbols from $from into $into. $into may + either be a package name, or a caller level to get the name from. + + Importer->unimport() + + Importer->unimport(@sub_name) + + This is the magic behind no Importer .... + + Importer->unimport_from($from, @sub_names) + + Importer->unimport_from($level, @sub_names) + + This lets you remove imported symbols from $from. $from my be a + package name, or a caller level. + + my $exports = Importer->get($from, @imports) + + This returns hashref of { $name => $ref } for all the specified + imports. + + $from should be the package from which to get the exports. + + my @export_refs = Importer->get_list($from, @imports) + + This returns a list of references for each import specified. Only the + export references are returned, the names are not. + + $from should be the package from which to get the exports. + + $export_ref = Importer->get_one($from, $import) + + This returns a single reference to a single export. If you provide + multiple imports then only the LAST one will be used. + + $from should be the package from which to get the exports. + +USING WITH OTHER EXPORTER IMPLEMENTATIONS + + If you want your module to work with Importer, but you use something + other than Exporter to define your exports, you can make it work be + defining the IMPORTER_MENU method in your package. As well other + exporters can be updated to support Importer by putting this sub in + your package. IMPORTER_MENU() must be defined in your package, not a + base class! + + sub IMPORTER_MENU { + my $class = shift; + my ($into, $caller) = @_; + + return ( + export => \@EXPORT, # Default exports + export_ok => \@EXPORT_OK, # Other allowed exports + export_tags => \%EXPORT_TAGS, # Define tags + export_fail => \@EXPORT_FAIL, # For subs that may not always be available + export_anon => \%EXPORT_ANON, # Anonymous symbols to export + export_magic => \%EXPORT_MAGIC, # Magic to apply after a symbol is exported + + generate => \&GENERATE, # Sub to generate dynamic exports + # OR + export_gen => \%EXPORT_GEN, # Hash of builders, key is symbol + # name, value is sub that generates + # the symbol ref. + ); + } + + sub GENERATE { + my ($symbol) = @_; + + ... + + return $ref; + } + + All exports must be listed in either @EXPORT or @EXPORT_OK, or be keys + in %EXPORT_GEN or %EXPORT_ANON to be allowed. 'export_tags', + 'export_fail', 'export_anon', 'export_gen', and 'generate' are + optional. You cannot combine 'generate' and 'export_gen'. + + Note: If your GENERATE sub needs the $class, $into, or $caller then + your IMPORTER_MENU() method will need to build an anonymous sub that + closes over them: + + sub IMPORTER_MENU { + my $class = shift; + my ($into, $caller) = @_; + + return ( + ... + generate => sub { $class->GENERATE($into, $caller, @_) }, + ); + } + +OO Interface + + use Importer; + + my $imp = Importer->new(from => 'Some::Exporter'); + + $imp->do_import('Destination::Package'); + $imp->do_import('Another::Destination', @symbols); + + Or, maybe more useful: + + my $imp = Importer->new(from => 'Carp'); + my $croak = $imp->get_one('croak'); + $croak->("This will croak"); + + OBJECT CONSTRUCTION + + $imp = Importer->new(from => 'Some::Exporter') + + $imp = Importer->new(from => 'Some::Exporter', caller => [$package, + $file, $line]) + + This is how you create a new Importer instance. from => + 'Some::Exporter' is the only required argument. You may also specify + the caller => [...] arrayref, which will be used only for error + reporting. If you do not specify a caller then Importer will attempt + to find the caller dynamically every time it needs it (this is slow + and expensive, but necessary if you intend to re-use the object.) + + OBJECT METHODS + + $imp->do_import($into) + + $imp->do_import($into, @symbols) + + This will import from the objects from package into the $into + package. You can provide a list of @symbols, or you can leave it + empty for the defaults. + + $imp->do_unimport() + + $imp->do_unimport(@symbols) + + This will remove imported symbols from the objects from package. If + you specify a list of @symbols then only the specified symbols will + be removed, otherwise all symbols imported using Importer will be + removed. + + Note: Please be aware of the difference between do_import() and + do_unimport(). For import 'from' us used as the origin, in unimport + it is used as the target. This means you cannot re-use an instance to + import and then unimport. + + ($into, $versions, $exclude, $symbols, $set) = + $imp->parse_args('Dest::Package') + + ($into, $versions, $exclude, $symbols, $set) = + $imp->parse_args('Dest::Package', @symbols) + + This parses arguments. The first argument must be the destination + package. Other arguments can be a mix of symbol names, tags, + patterns, version numbers, and exclusions. + + $caller_ref = $imp->get_caller() + + This will find the caller. This is mainly used for error reporting. + IF the object was constructed with a caller then that is what is + returned, otherwise this will scan the stack looking for the first + call that does not originate from a package that ISA Importer. + + $imp->carp($warning) + + Warn at the callers level. + + $imp->croak($exception) + + Die at the callers level. + + $from_package = $imp->from() + + Get the from package that was specified at construction. + + $file = $imp->from_file() + + Get the filename for the from package. + + $imp->load_from() + + This will load the from package if it has not been loaded already. + This uses some magic to ensure errors in the load process are + reported to the caller. + + $menu_hr = $imp->menu($into) + + Get the export menu built from, or provided by the from package. This + is cached after the first time it is called. Use $imp->reload_menu() + to refresh it. + + The menu structure looks like this: + + $menu = { + # every valid export has a key in the lookup hashref, value is always + # 1, key always includes the sigil + lookup => {'&symbol_a' => 1, '$symbol_b' => 1, ...}, + + # most exports are listed here, symbol name with sigil is key, value is + # a reference to the symbol. If a symbol is missing it may be generated. + exports => {'&symbol_a' => \&symbol_a, '$symbol_b' => \$symbol_b, ...}, + + # Hashref of tags, tag name (without ':' prefix) is key, value is an + # arrayref of symbol names, subs may have a sigil, but are not required + # to. + tags => { DEFAULT => [...], foo => [...], ... }, + + # Magic to apply + magic => { foo => sub { ... }, ... }, + + # This is a hashref just like 'lookup'. Keys are symbols which may not + # always be available. If there are no symbols in this category then + # the value of the 'fail' key will be undef instead of a hashref. + fail => { '&iffy_symbol' => 1, '\&only_on_linux' => 1 }, + # OR fail => undef, + + # If present, this subroutine knows how to generate references for the + # symbols listed in 'lookup', but missing from 'exports'. References + # this returns are NEVER cached. + generate => sub { my $sym_name = shift; ...; return $symbol_ref }, + }; + + $imp->reload_menu($into) + + This will reload the export menu from the from package. + + my $exports = $imp->get(@imports) + + This returns hashref of { $name => $ref } for all the specified + imports. + + my @export_refs = $imp->get_list(@imports) + + This returns a list of references for each import specified. Only the + export references are returned, the names are not. + + $export_ref = $imp->get_one($import) + + This returns a single reference to a single export. If you provide + multiple imports then only the LAST one will be used. + +FUNCTIONS + + These can be imported: + + use Importer 'Importer' => qw/import optimal_import/; + + $bool = optimal_import($from, $into, \@caller, @imports) + + This function will attempt to import @imports from the $from package + into the $into package. @caller needs to have a package name, + filename, and line number. If this function fails then no exporting + will actually happen. + + If the import is successful this will return true. + + If the import is unsuccessful this will return false, and no + modifications to the symbol table will occur. + + $class->import(@imports) + + If you write class intended to be used with Importer, but also need + to provide a legacy import() method for direct consumers of your + class, you can import this import() method. + + package My::Exporter; + + # This will give you 'import()' much like 'use base "Exporter";' + use Importer 'Importer' => qw/import/; + + ... + +SOURCE + + The source code repository for Importer can be found at + http://github.com/exodist/Importer. + +MAINTAINERS + + Chad Granum + +AUTHORS + + Chad Granum + +COPYRIGHT + + Copyright 2015 Chad Granum . + + This program is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. + + See http://dev.perl.org/licenses/ + diff --git a/README.md b/README.md new file mode 100644 index 0000000..c0ae66f --- /dev/null +++ b/README.md @@ -0,0 +1,636 @@ +# NAME + +Importer - Alternative but compatible interface to modules that export symbols. + +# DESCRIPTION + +This module acts as a layer between [Exporter](https://metacpan.org/pod/Exporter) and modules which consume +exports. It is feature-compatible with [Exporter](https://metacpan.org/pod/Exporter), plus some much needed +extras. You can use this to import symbols from any exporter that follows +[Exporter](https://metacpan.org/pod/Exporter)s specification. The exporter modules themselves do not need to use +or inherit from the [Exporter](https://metacpan.org/pod/Exporter) module, they just need to set `@EXPORT` and/or +other variables. + +# SYNOPSIS + + # Import defaults + use Importer 'Some::Module'; + + # Import a list + use Importer 'Another::Module' => qw/foo bar baz/; + + # Import a specific version: + use Importer 'That::Module' => '1.00'; + + # Require a sepcific version of Importer + use Importer 0.001, 'Foo::Bar' => qw/a b c/; + + foo() + bar() + baz() + + # Remove all subroutines imported by Importer + no Importer; + + # Import symbols into variables + my $croak = Importer->get_one(Carp => qw/croak/); + $croak->("This will croak"); + + my $CARP = Importer->get(Carp => qw/croak confess cluck/); + $CARP->{croak}->("This will croak"); + $CARP->{cluck}->("This will cluck"); + $CARP->{confess}->("This will confess"); + +# WHY? + +There was recently a discussion on p5p about adding features to [Exporter](https://metacpan.org/pod/Exporter). +This conversation raised some significant concerns, those are listed here, in +addition to others. + +- The burden is on export consumers to specify a version of Exporter + + Adding a feature to [Exporter](https://metacpan.org/pod/Exporter) means that any consumer module that relies on + the new features must depend on a specific version of [Exporter](https://metacpan.org/pod/Exporter). This seems + somewhat backwards since [Exporter](https://metacpan.org/pod/Exporter) is used by the module you are importing + from. + +- Exporter.pm is really old/crazy code + + Not much more to say here. It is very old, it is very crazy, and if you break + it you break EVERYTHING. + +- Using a modules import() for exporting makes it hard to give it other purposes + + It is not unusual for a module to want to export symbols and provide import + behaviors. It is also not unusual for a consumer to only want 1 or the other. + Using this module you can import symbols without also getting the `import()` + side effects. + + In addition, moving forward, modules can specify exports and have a custom + `import()` without conflating the two. A module can tell you to use Importer + to get the symbols, and to use the module directly for behaviors. A module + could also use Importer within its own `import()` method without the need to + subclass [Exporter](https://metacpan.org/pod/Exporter), or bring in its `import()` method. + +- There are other exporter modules on cpan + + This module normally assumes an exporter uses [Exporter](https://metacpan.org/pod/Exporter), so it looks for the + variables and methods [Exporter](https://metacpan.org/pod/Exporter) expects. However, other exporters on cpan can + override this using the `IMPORTER_MENU()` hook. + +# COMPATIBILITY + +This module aims for 100% compatibility with every feature of [Exporter](https://metacpan.org/pod/Exporter), plus +added features such as import renaming. + +If you find something that works differently, or not at all when compared to +[Exporter](https://metacpan.org/pod/Exporter) please report it as a bug, unless it is noted as an intentional +feature (like import renaming). + +# IMPORT PARAMETERS + + use Importer $IMPORTER_VERSION, $FROM_MODULE, $FROM_MODULE_VERSION, \&SET_SYMBOL, @SYMBOLS; + +- $IMPORTER\_VERSION (optional) + + If you provide a numeric argument as the first argument it will be treated as a + version number. Importer will do a version check to make sure it is at least at + the requested version. + +- $FROM\_MODULE (required) + + This is the only required argument. This is the name of the module to import + symbols from. + +- $FROM\_MODULE\_VERSION (optional) + + Any numeric argument following the `$FROM_MODULE` will be treated as a version + check against `$FROM_MODULE`. + +- \\&SET\_SYMBOL (optional) + + Normally Importer will put the exports into your namespace. This is usually + done via a more complex form of `*name = $ref`. If you do NOT want this to + happen then you can provide a custom sub to handle the assignment. + + This is an example that uses this feature to put all the exports into a lexical + hash instead of modifying the namespace (This is how the `get()` method is + implemented). + + my %CARP; + use Importer Carp => sub { + my ($name, $ref) = @_; + $CARP{$name} = $ref; + }; + + $CARP{cluck}->("This will cluck"); + $CARP{croak}->("This will croak"); + + The first two arguments to the custom sub are the name (no sigil), and the + reference. The additional arguments are key/value pairs: + + sub set_symbol { + my ($name, $ref, %info) = @_; + } + + - $info{from} + + Package the symbol comes from. + + - $info{into} + + Package to which the symbol should be added. + + - $info{sig} + + The sigil that should be used. + + - $info{spec} + + Extra details. + + - $info{symbol} + + The original symbol name (with sigil) from the original package. + +- @SYMBOLS (optional) + + Symbols you wish to import. If no symbols are specified then the defaults will + be used. You may also specify tags using the ':' prefix. + +# SUPPORTED FEATURES + +## TAGS + +You can define/import subsets of symbols using predefined tags. + + use Importer 'Some::Thing' => ':tag'; + +[Importer](https://metacpan.org/pod/Importer) will automatically populate the `:DEFAULT` tag for you. +[Importer](https://metacpan.org/pod/Importer) will also give you an `:ALL` tag with ALL exports so long as the +exporter does not define a `:ALL` tag already. + +## /PATTERN/ or qr/PATTERN/ + +You can import all symbols that match a pattern. The pattern can be supplied a +string starting and ending with '/', or you can provide a `qr/../` reference. + + use Importer 'Some::Thing' => '/oo/'; + + use Importer 'Some::Thing' => qr/oo/; + +## EXCLUDING SYMBOLS + +You can exclude symbols by prefixing them with '!'. + + use Importer 'Some::Thing' + '!foo', # Exclude one specific symbol + '!/pattern/', # Exclude all matching symbols + '!' => qr/oo/, # Exclude all that match the following arg + '!:tag'; # Exclude all in tag + +## RENAMING SYMBOLS AT IMPORT + +_This is a new feature,_ [Exporter](https://metacpan.org/pod/Exporter) _does not support this on its own._ + +You can rename symbols at import time using a specification hash following the +import name: + + use Importer 'Some::Thing' => ( + foo => { -as => 'my_foo' }, + ); + +You can also add a prefix and/or postfix: + + use Importer 'Some::Thing' => ( + foo => { -prefix => 'my_' }, + ); + +Using this syntax to set prefix and/or postfix also works on tags and patterns +that are specified for import, in which case the prefix/postfix is applied to +all symbols from the tag/patterm. + +## CUSTOM EXPORT ASSIGNMENT + +This lets you provide an alternative to the `*name = $ref` export assignment. +See the list of [parameters](#import-parameters) to `import()` + +## UNIMPORTING + +See ["UNIMPORT PARAMETERS"](#unimport-parameters). + +## ANONYMOUS EXPORTS + +See ["%EXPORT\_ANON"](#export_anon). + +## GENERATED EXPORTS + +See ["%EXPORT\_GEN"](#export_gen). + +# UNIMPORT PARAMETERS + + no Importer; # Remove all subs brought in with Importer + + no Importer qw/foo bar/; # Remove only the specified subs + +**Only subs can be unimported**. + +**You can only unimport subs imported using Importer**. + +# SUPPORTED VARIABLES + +## @EXPORT + +This is used exactly the way [Exporter](https://metacpan.org/pod/Exporter) uses it. + +List of symbols to export. Sigil is optional for subs. Symbols listed here are +exported by default. If possible you should put symbols in `@EXPORT_OK` +instead. + + our @EXPORT = qw/foo bar &baz $BAT/; + +## @EXPORT\_OK + +This is used exactly the way [Exporter](https://metacpan.org/pod/Exporter) uses it. + +List of symbols that can be imported. Sigil is optional for subs. Symbols +listed here are not exported by default. This is preferred over `@EXPORT`. + + our @EXPORT_OK = qw/foo bar &baz $BAT/; + +## %EXPORT\_TAGS + +This module supports tags exactly the way [Exporter](https://metacpan.org/pod/Exporter) does. + + use Importer 'Some::Thing' => ':DEFAULT'; + + use Importer 'Other::Thing' => ':some_tag'; + +Tags can be specified this way: + + our %EXPORT_TAGS = ( + oos => [qw/foo boo zoo/], + ees => [qw/fee bee zee/], + ); + +## @EXPORT\_FAIL + +This is used exactly the way [Exporter](https://metacpan.org/pod/Exporter) uses it. + +Use this to list subs that are not available on all platforms. If someone tries +to import one of these, Importer will hit your `$from->export_fail(@items)` +callback to try to resolve the issue. See [Exporter](https://metacpan.org/pod/Exporter) for documentation of +this feature. + + our @EXPORT_FAIL = qw/maybe_bad/; + +## %EXPORT\_ANON + +This is new to this module, [Exporter](https://metacpan.org/pod/Exporter) does not support it. + +This allows you to export symbols that are not actually in your package symbol +table. The keys should be the symbol names, the values are the references for +the symbols. + + our %EXPORT_ANON = ( + '&foo' => sub { 'foo' } + '$foo' => \$foo, + ... + ); + +## %EXPORT\_GEN + +This is new to this module, [Exporter](https://metacpan.org/pod/Exporter) does not support it. + +This allows you to export symbols that are generated on export. The key should +be the name of a symbol. The value should be a coderef that produces a +reference that will be exported. + +When the generators are called they will receive 2 arguments, the package the +symbol is being exported into, and the symbol being imported (name may or may +not include sigil for subs). + + our %EXPORT_GEN = ( + '&foo' => sub { + my $from_package = shift; + my ($into_package, $symbol_name) = @_; + ... + return sub { ... }; + }, + ... + ); + +## %EXPORT\_MAGIC + +This is new to this module. [Exporter](https://metacpan.org/pod/Exporter) does not support it. + +This allows you to define custom actions to run AFTER an export has been +injected into the consumers namespace. This is a good place to enable parser +hooks like with [Devel::Declare](https://metacpan.org/pod/Devel::Declare). These will NOT be run if a consumer uses a +custom assignment callback. + + our %EXPORT_MAGIC = ( + foo => sub { + my $from = shift; # Should be the package doing the exporting + my %args = @_; + + my $into = $args{into}; # Package symbol was exported into + my $orig_name = $args{orig_name}; # Original name of the export (in the exporter) + my $new_name = $args{new_name}; # Name the symbol was imported as + my $ref = $args{ref}; # The reference to the symbol + + ...; # whatever you want, return is ignored. + }, + ); + +# CLASS METHODS + +- Importer->import($from) +- Importer->import($from, $version) +- Importer->import($from, @imports) +- Importer->import($from, $from\_version, @imports) +- Importer->import($importer\_version, $from, ...) + + This is the magic behind `use Importer ...`. + +- Importer->import\_into($from, $into, @imports) +- Importer->import\_into($from, $level, @imports) + + You can use this to import symbols from `$from` into `$into`. `$into` may + either be a package name, or a caller level to get the name from. + +- Importer->unimport() +- Importer->unimport(@sub\_name) + + This is the magic behind `no Importer ...`. + +- Importer->unimport\_from($from, @sub\_names) +- Importer->unimport\_from($level, @sub\_names) + + This lets you remove imported symbols from `$from`. `$from` my be a package + name, or a caller level. + +- my $exports = Importer->get($from, @imports) + + This returns hashref of `{ $name => $ref }` for all the specified imports. + + `$from` should be the package from which to get the exports. + +- my @export\_refs = Importer->get\_list($from, @imports) + + This returns a list of references for each import specified. Only the export + references are returned, the names are not. + + `$from` should be the package from which to get the exports. + +- $export\_ref = Importer->get\_one($from, $import) + + This returns a single reference to a single export. If you provide multiple + imports then only the LAST one will be used. + + `$from` should be the package from which to get the exports. + +# USING WITH OTHER EXPORTER IMPLEMENTATIONS + +If you want your module to work with Importer, but you use something other than +[Exporter](https://metacpan.org/pod/Exporter) to define your exports, you can make it work be defining the +`IMPORTER_MENU` method in your package. As well other exporters can be updated +to support Importer by putting this sub in your package. +**IMPORTER\_MENU() must be defined in your package, not a base class!** + + sub IMPORTER_MENU { + my $class = shift; + my ($into, $caller) = @_; + + return ( + export => \@EXPORT, # Default exports + export_ok => \@EXPORT_OK, # Other allowed exports + export_tags => \%EXPORT_TAGS, # Define tags + export_fail => \@EXPORT_FAIL, # For subs that may not always be available + export_anon => \%EXPORT_ANON, # Anonymous symbols to export + export_magic => \%EXPORT_MAGIC, # Magic to apply after a symbol is exported + + generate => \&GENERATE, # Sub to generate dynamic exports + # OR + export_gen => \%EXPORT_GEN, # Hash of builders, key is symbol + # name, value is sub that generates + # the symbol ref. + ); + } + + sub GENERATE { + my ($symbol) = @_; + + ... + + return $ref; + } + +All exports must be listed in either `@EXPORT` or `@EXPORT_OK`, or be keys in +`%EXPORT_GEN` or `%EXPORT_ANON` to be allowed. 'export\_tags', 'export\_fail', +'export\_anon', 'export\_gen', and 'generate' are optional. You cannot combine +'generate' and 'export\_gen'. + +**Note:** If your GENERATE sub needs the `$class`, `$into`, or `$caller` then +your `IMPORTER_MENU()` method will need to build an anonymous sub that closes +over them: + + sub IMPORTER_MENU { + my $class = shift; + my ($into, $caller) = @_; + + return ( + ... + generate => sub { $class->GENERATE($into, $caller, @_) }, + ); + } + +# OO Interface + + use Importer; + + my $imp = Importer->new(from => 'Some::Exporter'); + + $imp->do_import('Destination::Package'); + $imp->do_import('Another::Destination', @symbols); + +Or, maybe more useful: + + my $imp = Importer->new(from => 'Carp'); + my $croak = $imp->get_one('croak'); + $croak->("This will croak"); + +## OBJECT CONSTRUCTION + +- $imp = Importer->new(from => 'Some::Exporter') +- $imp = Importer->new(from => 'Some::Exporter', caller => \[$package, $file, $line\]) + + This is how you create a new Importer instance. `from => 'Some::Exporter'` + is the only required argument. You may also specify the `caller => [...]` + arrayref, which will be used only for error reporting. If you do not specify a + caller then Importer will attempt to find the caller dynamically every time it + needs it (this is slow and expensive, but necessary if you intend to re-use the + object.) + +## OBJECT METHODS + +- $imp->do\_import($into) +- $imp->do\_import($into, @symbols) + + This will import from the objects `from` package into the `$into` package. + You can provide a list of `@symbols`, or you can leave it empty for the + defaults. + +- $imp->do\_unimport() +- $imp->do\_unimport(@symbols) + + This will remove imported symbols from the objects `from` package. If you + specify a list of `@symbols` then only the specified symbols will be removed, + otherwise all symbols imported using Importer will be removed. + + **Note:** Please be aware of the difference between `do_import()` and + `do_unimport()`. For import 'from' us used as the origin, in unimport it is + used as the target. This means you cannot re-use an instance to import and then + unimport. + +- ($into, $versions, $exclude, $symbols, $set) = $imp->parse\_args('Dest::Package') +- ($into, $versions, $exclude, $symbols, $set) = $imp->parse\_args('Dest::Package', @symbols) + + This parses arguments. The first argument must be the destination package. + Other arguments can be a mix of symbol names, tags, patterns, version numbers, + and exclusions. + +- $caller\_ref = $imp->get\_caller() + + This will find the caller. This is mainly used for error reporting. IF the + object was constructed with a caller then that is what is returned, otherwise + this will scan the stack looking for the first call that does not originate + from a package that ISA Importer. + +- $imp->carp($warning) + + Warn at the callers level. + +- $imp->croak($exception) + + Die at the callers level. + +- $from\_package = $imp->from() + + Get the `from` package that was specified at construction. + +- $file = $imp->from\_file() + + Get the filename for the `from` package. + +- $imp->load\_from() + + This will load the `from` package if it has not been loaded already. This uses + some magic to ensure errors in the load process are reported to the `caller`. + +- $menu\_hr = $imp->menu($into) + + Get the export menu built from, or provided by the `from` package. This is + cached after the first time it is called. Use `$imp->reload_menu()` to + refresh it. + + The menu structure looks like this: + + $menu = { + # every valid export has a key in the lookup hashref, value is always + # 1, key always includes the sigil + lookup => {'&symbol_a' => 1, '$symbol_b' => 1, ...}, + + # most exports are listed here, symbol name with sigil is key, value is + # a reference to the symbol. If a symbol is missing it may be generated. + exports => {'&symbol_a' => \&symbol_a, '$symbol_b' => \$symbol_b, ...}, + + # Hashref of tags, tag name (without ':' prefix) is key, value is an + # arrayref of symbol names, subs may have a sigil, but are not required + # to. + tags => { DEFAULT => [...], foo => [...], ... }, + + # Magic to apply + magic => { foo => sub { ... }, ... }, + + # This is a hashref just like 'lookup'. Keys are symbols which may not + # always be available. If there are no symbols in this category then + # the value of the 'fail' key will be undef instead of a hashref. + fail => { '&iffy_symbol' => 1, '\&only_on_linux' => 1 }, + # OR fail => undef, + + # If present, this subroutine knows how to generate references for the + # symbols listed in 'lookup', but missing from 'exports'. References + # this returns are NEVER cached. + generate => sub { my $sym_name = shift; ...; return $symbol_ref }, + }; + +- $imp->reload\_menu($into) + + This will reload the export menu from the `from` package. + +- my $exports = $imp->get(@imports) + + This returns hashref of `{ $name => $ref }` for all the specified imports. + +- my @export\_refs = $imp->get\_list(@imports) + + This returns a list of references for each import specified. Only the export + references are returned, the names are not. + +- $export\_ref = $imp->get\_one($import) + + This returns a single reference to a single export. If you provide multiple + imports then only the LAST one will be used. + +# FUNCTIONS + +These can be imported: + + use Importer 'Importer' => qw/import optimal_import/; + +- $bool = optimal\_import($from, $into, \\@caller, @imports) + + This function will attempt to import `@imports` from the `$from` package into + the `$into` package. `@caller` needs to have a package name, filename, and + line number. If this function fails then no exporting will actually happen. + + If the import is successful this will return true. + + If the import is unsuccessful this will return false, and no modifications to + the symbol table will occur. + +- $class->import(@imports) + + If you write class intended to be used with [Importer](https://metacpan.org/pod/Importer), but also need to + provide a legacy `import()` method for direct consumers of your class, you can + import this `import()` method. + + package My::Exporter; + + # This will give you 'import()' much like 'use base "Exporter";' + use Importer 'Importer' => qw/import/; + + ... + +# SOURCE + +The source code repository for Importer can be found at +[http://github.com/exodist/Importer](http://github.com/exodist/Importer). + +# MAINTAINERS + +- Chad Granum + +# AUTHORS + +- Chad Granum + +# COPYRIGHT + +Copyright 2015 Chad Granum . + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See [http://dev.perl.org/licenses/](http://dev.perl.org/licenses/) diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..28108ef --- /dev/null +++ b/cpanfile @@ -0,0 +1,16 @@ +# This file is generated by Dist::Zilla::Plugin::CPANFile v6.015 +# Do not edit this file directly. To change prereqs, edit the `dist.ini` file. + +requires "perl" => "5.008001"; + +on 'test' => sub { + requires "Test::More" => "0.98"; +}; + +on 'configure' => sub { + requires "ExtUtils::MakeMaker" => "0"; +}; + +on 'develop' => sub { + requires "Test::Pod" => "1.41"; +}; diff --git a/lib/Importer.pm b/lib/Importer.pm new file mode 100644 index 0000000..f10aada --- /dev/null +++ b/lib/Importer.pm @@ -0,0 +1,1463 @@ +package Importer; +use strict; no strict 'refs'; +use warnings; no warnings 'once'; + +our $VERSION = '0.026'; + +my %SIG_TO_SLOT = ( + '&' => 'CODE', + '$' => 'SCALAR', + '%' => 'HASH', + '@' => 'ARRAY', + '*' => 'GLOB', +); + +our %IMPORTED; + +# This will be used to check if an import arg is a version number +my %NUMERIC = map +($_ => 1), 0 .. 9; + +sub IMPORTER_MENU() { + return ( + export_ok => [qw/optimal_import/], + export_anon => { + import => sub { + my $from = shift; + my @caller = caller(0); + + _version_check($from, \@caller, shift @_) if @_ && $NUMERIC{substr($_[0], 0, 1)}; + + my $file = _mod_to_file($from); + _load_file(\@caller, $file) unless $INC{$file}; + + return if optimal_import($from, $caller[0], \@caller, @_); + + my $self = __PACKAGE__->new( + from => $from, + caller => \@caller, + ); + + $self->do_import($caller[0], @_); + }, + }, + ); +} + +########################################################################### +# +# These are class methods +# import and unimport are what you would expect. +# import_into and unimport_from are the indirect forms you can use in other +# package import() methods. +# +# These all attempt to do a fast optimal-import if possible, then fallback to +# the full-featured import that constructs an object when needed. +# + +sub import { + my $class = shift; + + my @caller = caller(0); + + _version_check($class, \@caller, shift @_) if @_ && $NUMERIC{substr($_[0], 0, 1)}; + + return unless @_; + + my ($from, @args) = @_; + + my $file = _mod_to_file($from); + _load_file(\@caller, $file) unless $INC{$file}; + + return if optimal_import($from, $caller[0], \@caller, @args); + + my $self = $class->new( + from => $from, + caller => \@caller, + ); + + $self->do_import($caller[0], @args); +} + +sub unimport { + my $class = shift; + my @caller = caller(0); + + my $self = $class->new( + from => $caller[0], + caller => \@caller, + ); + + $self->do_unimport(@_); +} + +sub import_into { + my $class = shift; + my ($from, $into, @args) = @_; + + my @caller; + + if (ref($into)) { + @caller = @$into; + $into = $caller[0]; + } + elsif ($into =~ m/^\d+$/) { + @caller = caller($into + 1); + $into = $caller[0]; + } + else { + @caller = caller(0); + } + + my $file = _mod_to_file($from); + _load_file(\@caller, $file) unless $INC{$file}; + + return if optimal_import($from, $into, \@caller, @args); + + my $self = $class->new( + from => $from, + caller => \@caller, + ); + + $self->do_import($into, @args); +} + +sub unimport_from { + my $class = shift; + my ($from, @args) = @_; + + my @caller; + if ($from =~ m/^\d+$/) { + @caller = caller($from + 1); + $from = $caller[0]; + } + else { + @caller = caller(0); + } + + my $self = $class->new( + from => $from, + caller => \@caller, + ); + + $self->do_unimport(@args); +} + +########################################################################### +# +# Constructors +# + +sub new { + my $class = shift; + my %params = @_; + + my $caller = $params{caller} || [caller()]; + + die "You must specify a package to import from at $caller->[1] line $caller->[2].\n" + unless $params{from}; + + return bless { + from => $params{from}, + caller => $params{caller}, # Do not use our caller. + }, $class; +} + +########################################################################### +# +# Shortcuts for getting symbols without any namespace modifications +# + +sub get { + my $proto = shift; + my @caller = caller(1); + + my $self = ref($proto) ? $proto : $proto->new( + from => shift(@_), + caller => \@caller, + ); + + my %result; + $self->do_import($caller[0], @_, sub { $result{$_[0]} = $_[1] }); + return \%result; +} + +sub get_list { + my $proto = shift; + my @caller = caller(1); + + my $self = ref($proto) ? $proto : $proto->new( + from => shift(@_), + caller => \@caller, + ); + + my @result; + $self->do_import($caller[0], @_, sub { push @result => $_[1] }); + return @result; +} + +sub get_one { + my $proto = shift; + my @caller = caller(1); + + my $self = ref($proto) ? $proto : $proto->new( + from => shift(@_), + caller => \@caller, + ); + + my $result; + $self->do_import($caller[0], @_, sub { $result = $_[1] }); + return $result; +} + +########################################################################### +# +# Object methods +# + +sub do_import { + my $self = shift; + + my ($into, $versions, $exclude, $import, $set) = $self->parse_args(@_); + + # Exporter supported multiple version numbers being listed... + _version_check($self->from, $self->get_caller, @$versions) if @$versions; + + return unless @$import; + + $self->_handle_fail($into, $import) if $self->menu($into)->{fail}; + $self->_set_symbols($into, $exclude, $import, $set); +} + +sub do_unimport { + my $self = shift; + + my $from = $self->from; + my $imported = $IMPORTED{$from} or $self->croak("'$from' does not have any imports to remove"); + + my %allowed = map { $_ => 1 } @$imported; + + my @args = @_ ? @_ : @$imported; + + my $stash = \%{"$from\::"}; + + for my $name (@args) { + $name =~ s/^&//; + + $self->croak("Sub '$name' was not imported using " . ref($self)) unless $allowed{$name}; + + my $glob = delete $stash->{$name}; + local *GLOBCLONE = *$glob; + + for my $type (qw/SCALAR HASH ARRAY FORMAT IO/) { + next unless defined(*{$glob}{$type}); + *{"$from\::$name"} = *{$glob}{$type} + } + } +} + +sub from { $_[0]->{from} } + +sub from_file { + my $self = shift; + + $self->{from_file} ||= _mod_to_file($self->{from}); + + return $self->{from_file}; +} + +sub load_from { + my $self = shift; + my $from_file = $self->from_file; + my $this_file = __FILE__; + + return if $INC{$from_file}; + + my $caller = $self->get_caller; + + _load_file($caller, $from_file); +} + +sub get_caller { + my $self = shift; + return $self->{caller} if $self->{caller}; + + my $level = 1; + while(my @caller = caller($level++)) { + return \@caller if @caller && !$caller[0]->isa(__PACKAGE__); + last unless @caller; + } + + # Fallback + return [caller(0)]; +} + +sub croak { + my $self = shift; + my ($msg) = @_; + my $caller = $self->get_caller; + my $file = $caller->[1] || 'unknown file'; + my $line = $caller->[2] || 'unknown line'; + die "$msg at $file line $line.\n"; +} + +sub carp { + my $self = shift; + my ($msg) = @_; + my $caller = $self->get_caller; + my $file = $caller->[1] || 'unknown file'; + my $line = $caller->[2] || 'unknown line'; + warn "$msg at $file line $line.\n"; +} + +sub menu { + my $self = shift; + my ($into) = @_; + + $self->croak("menu() requires the name of the destination package") + unless $into; + + my $for = $self->{menu_for}; + delete $self->{menu} if $for && $for ne $into; + return $self->{menu} || $self->reload_menu($into); +} + +sub reload_menu { + my $self = shift; + my ($into) = @_; + + $self->croak("reload_menu() requires the name of the destination package") + unless $into; + + my $from = $self->from; + + if (my $menu_sub = *{"$from\::IMPORTER_MENU"}{CODE}) { + # Hook, other exporter modules can define this method to be compatible with + # Importer.pm + + my %got = $from->$menu_sub($into, $self->get_caller); + + $got{export} ||= []; + $got{export_ok} ||= []; + $got{export_tags} ||= {}; + $got{export_fail} ||= []; + $got{export_anon} ||= {}; + $got{export_magic} ||= {}; + + $self->croak("'$from' provides both 'generate' and 'export_gen' in its IMPORTER_MENU (They are exclusive, module must pick 1)") + if $got{export_gen} && $got{generate}; + + $got{export_gen} ||= {}; + + $self->{menu} = $self->_build_menu($into => \%got, 1); + } + else { + my %got; + $got{export} = \@{"$from\::EXPORT"}; + $got{export_ok} = \@{"$from\::EXPORT_OK"}; + $got{export_tags} = \%{"$from\::EXPORT_TAGS"}; + $got{export_fail} = \@{"$from\::EXPORT_FAIL"}; + $got{export_gen} = \%{"$from\::EXPORT_GEN"}; + $got{export_anon} = \%{"$from\::EXPORT_ANON"}; + $got{export_magic} = \%{"$from\::EXPORT_MAGIC"}; + + $self->{menu} = $self->_build_menu($into => \%got, 0); + } + + $self->{menu_for} = $into; + + return $self->{menu}; +} + +sub _build_menu { + my $self = shift; + my ($into, $got, $new_style) = @_; + + my $from = $self->from; + + my $export = $got->{export} || []; + my $export_ok = $got->{export_ok} || []; + my $export_tags = $got->{export_tags} || {}; + my $export_fail = $got->{export_fail} || []; + my $export_anon = $got->{export_anon} || {}; + my $export_gen = $got->{export_gen} || {}; + my $export_magic = $got->{export_magic} || {}; + + my $generate = $got->{generate}; + + $generate ||= sub { + my $symbol = shift; + my ($sig, $name) = ($symbol =~ m/^(\W?)(.*)$/); + $sig ||= '&'; + + my $do = $export_gen->{"${sig}${name}"}; + $do ||= $export_gen->{$name} if !$sig || $sig eq '&'; + + return undef unless $do; + + $from->$do($into, $symbol); + } if $export_gen && keys %$export_gen; + + my $lookup = {}; + my $exports = {}; + for my $sym (@$export, @$export_ok, keys %$export_gen, keys %$export_anon) { + my ($sig, $name) = ($sym =~ m/^(\W?)(.*)$/); + $sig ||= '&'; + + $lookup->{"${sig}${name}"} = 1; + $lookup->{$name} = 1 if $sig eq '&'; + + next if $export_gen->{"${sig}${name}"}; + next if $sig eq '&' && $export_gen->{$name}; + next if $got->{generate} && $generate->("${sig}${name}"); + + my $fqn = "$from\::$name"; + # We cannot use *{$fqn}{TYPE} here, it breaks for autoloaded subs, this + # does not: + $exports->{"${sig}${name}"} = $export_anon->{$sym} || ( + $sig eq '&' ? \&{$fqn} : + $sig eq '$' ? \${$fqn} : + $sig eq '@' ? \@{$fqn} : + $sig eq '%' ? \%{$fqn} : + $sig eq '*' ? \*{$fqn} : + # Sometimes people (CGI::Carp) put invalid names (^name=) into + # @EXPORT. We simply go to 'next' in these cases. These modules + # have hooks to prevent anyone actually trying to import these. + next + ); + } + + my $f_import = $new_style || $from->can('import'); + $self->croak("'$from' does not provide any exports") + unless $new_style + || keys %$exports + || $from->isa('Exporter') + || ($INC{'Exporter.pm'} && $f_import && $f_import == \&Exporter::import); + + # Do not cleanup or normalize the list added to the DEFAULT tag, legacy.... + my $tags = { + %$export_tags, + 'DEFAULT' => [ @$export ], + }; + + # Add 'ALL' tag unless already specified. We want to normalize it. + $tags->{ALL} ||= [ sort grep {m/^[\&\$\@\%\*]/} keys %$lookup ]; + + my $fail = @$export_fail ? { + map { + my ($sig, $name) = (m/^(\W?)(.*)$/); + $sig ||= '&'; + ("${sig}${name}" => 1, $sig eq '&' ? ($name => 1) : ()) + } @$export_fail + } : undef; + + my $menu = { + lookup => $lookup, + exports => $exports, + tags => $tags, + fail => $fail, + generate => $generate, + magic => $export_magic, + }; + + return $menu; +} + +sub parse_args { + my $self = shift; + my ($into, @args) = @_; + + my $menu = $self->menu($into); + + my @out = $self->_parse_args($into, $menu, \@args); + pop @out; + return @out; +} + +sub _parse_args { + my $self = shift; + my ($into, $menu, $args, $is_tag) = @_; + + my $from = $self->from; + my $main_menu = $self->menu($into); + $menu ||= $main_menu; + + # First we strip out versions numbers and setters, this simplifies the logic late. + my @sets; + my @versions; + my @leftover; + for my $arg (@$args) { + no warnings 'void'; + + # Code refs are custom setters + # If the first character is an ASCII numeric then it is a version number + push @sets => $arg and next if ref($arg) eq 'CODE'; + push @versions => $arg xor next if $NUMERIC{substr($arg, 0, 1)}; + push @leftover => $arg; + } + + $self->carp("Multiple setters specified, only 1 will be used") if @sets > 1; + my $set = pop @sets; + + $args = \@leftover; + @$args = (':DEFAULT') unless $is_tag || @$args || @versions; + + my %exclude; + my @import; + + while(my $full_arg = shift @$args) { + my $arg = $full_arg; + my $lead = substr($arg, 0, 1); + + my ($spec, $exc); + if ($lead eq '!') { + $exc = $lead; + + if ($arg eq '!') { + # If the current arg is just '!' then we are negating the next item. + $arg = shift @$args; + } + else { + # Strip off the '!' + substr($arg, 0, 1, ''); + } + + # Exporter.pm legacy behavior + # negated first item implies starting with default set: + unshift @$args => ':DEFAULT' unless @import || keys %exclude || @versions; + + # Now we have a new lead character + $lead = substr($arg, 0, 1); + } + else { + # If the item is followed by a reference then they are asking us to + # do something special... + $spec = ref($args->[0]) eq 'HASH' ? shift @$args : {}; + } + + if($lead eq ':') { + substr($arg, 0, 1, ''); + my $tag = $menu->{tags}->{$arg} or $self->croak("$from does not export the :$arg tag"); + + my (undef, $cvers, $cexc, $cimp, $cset, $newmenu) = $self->_parse_args($into, $menu, $tag, $arg); + + $self->croak("Exporter specified version numbers (" . join(', ', @$cvers) . ") in the :$arg tag!") + if @$cvers; + + $self->croak("Exporter specified a custom symbol setter in the :$arg tag!") + if $cset; + + # Merge excludes + %exclude = (%exclude, %$cexc); + + if ($exc) { + $exclude{$_} = 1 for grep {!ref($_) && substr($_, 0, 1) ne '+'} map {$_->[0]} @$cimp; + } + elsif ($spec && keys %$spec) { + $self->croak("Cannot use '-as' to rename multiple symbols included by: $full_arg") + if $spec->{'-as'} && @$cimp > 1; + + for my $set (@$cimp) { + my ($sym, $cspec) = @$set; + + # Start with a blind squash, spec from tag overrides the ones inside. + my $nspec = {%$cspec, %$spec}; + + $nspec->{'-prefix'} = "$spec->{'-prefix'}$cspec->{'-prefix'}" if $spec->{'-prefix'} && $cspec->{'-prefix'}; + $nspec->{'-postfix'} = "$cspec->{'-postfix'}$spec->{'-postfix'}" if $spec->{'-postfix'} && $cspec->{'-postfix'}; + + push @import => [$sym, $nspec]; + } + } + else { + push @import => @$cimp; + } + + # New menu + $menu = $newmenu; + + next; + } + + # Process the item to figure out what symbols are being touched, if it + # is a tag or regex than it can be multiple. + my @list; + if(ref($arg) eq 'Regexp') { + @list = sort grep /$arg/, keys %{$menu->{lookup}}; + } + elsif($lead eq '/' && $arg =~ m{^/(.*)/$}) { + my $pattern = $1; + @list = sort grep /$1/, keys %{$menu->{lookup}}; + } + else { + @list = ($arg); + } + + # Normalize list, always have a sigil + @list = map {m/^\W/ ? $_ : "\&$_" } @list; + + if ($exc) { + $exclude{$_} = 1 for @list; + } + else { + $self->croak("Cannot use '-as' to rename multiple symbols included by: $full_arg") + if $spec->{'-as'} && @list > 1; + + push @import => [$_, $spec] for @list; + } + } + + return ($into, \@versions, \%exclude, \@import, $set, $menu); +} + +sub _handle_fail { + my $self = shift; + my ($into, $import) = @_; + + my $from = $self->from; + my $menu = $self->menu($into); + + # Historically Exporter would strip the '&' off of sub names passed into export_fail. + my @fail = map {my $x = $_->[0]; $x =~ s/^&//; $x} grep $menu->{fail}->{$_->[0]}, @$import or return; + + my @real_fail = $from->can('export_fail') ? $from->export_fail(@fail) : @fail; + + if (@real_fail) { + $self->carp(qq["$_" is not implemented by the $from module on this architecture]) + for @real_fail; + + $self->croak("Can't continue after import errors"); + } + + $self->reload_menu($menu); + return; +} + +sub _set_symbols { + my $self = shift; + my ($into, $exclude, $import, $custom_set) = @_; + + my $from = $self->from; + my $menu = $self->menu($into); + my $caller = $self->get_caller(); + + my $set_symbol = $custom_set || eval <<" EOT" || die $@; +# Inherit the callers warning settings. If they have warnings and we +# redefine their subs they will hear about it. If they do not have warnings +# on they will not. +BEGIN { \${^WARNING_BITS} = \$caller->[9] if defined \$caller->[9] } +#line $caller->[2] "$caller->[1]" +sub { *{"$into\\::\$_[0]"} = \$_[1] } + EOT + + for my $set (@$import) { + my ($symbol, $spec) = @$set; + + my ($sig, $name) = ($symbol =~ m/^(\W)(.*)$/) or die "Invalid symbol: $symbol"; + + # Find the thing we are actually shoving in a new namespace + my $ref = $menu->{exports}->{$symbol}; + $ref ||= $menu->{generate}->($symbol) if $menu->{generate}; + + # Exporter.pm supported listing items in @EXPORT that are not actually + # available for export. So if it is listed (lookup) but nothing is + # there (!$ref) we simply skip it. + $self->croak("$from does not export $symbol") unless $ref || $menu->{lookup}->{"${sig}${name}"}; + next unless $ref; + + my $type = ref($ref); + $type = 'SCALAR' if $type eq 'REF'; + $self->croak("Symbol '$sig$name' requested, but reference (" . ref($ref) . ") does not match sigil ($sig)") + if $ref && $type ne $SIG_TO_SLOT{$sig}; + + # If they directly renamed it then we assume they want it under the new + # name, otherwise excludes get kicked. It is useful to be able to + # exclude an item in a tag/match where the group has a prefix/postfix. + next if $exclude->{"${sig}${name}"} && !$spec->{'-as'}; + + my $new_name = join '' => ($spec->{'-prefix'} || '', $spec->{'-as'} || $name, $spec->{'-postfix'} || ''); + + # Set the symbol (finally!) + $set_symbol->($new_name, $ref, sig => $sig, symbol => $symbol, into => $into, from => $from, spec => $spec); + + # The remaining things get skipped with a custom setter + next if $custom_set; + + # Record the import so that we can 'unimport' + push @{$IMPORTED{$into}} => $new_name if $sig eq '&'; + + # Apply magic + my $magic = $menu->{magic}->{$symbol}; + $magic ||= $menu->{magic}->{$name} if $sig eq '&'; + $from->$magic(into => $into, orig_name => $name, new_name => $new_name, ref => $ref) + if $magic; + } +} + +########################################################################### +# +# The rest of these are utility functions, not methods! +# + +sub _version_check { + my ($mod, $caller, @versions) = @_; + + eval <<" EOT" or die $@; +#line $caller->[2] "$caller->[1]" +\$mod->VERSION(\$_) for \@versions; +1; + EOT +} + +sub _mod_to_file { + my $file = shift; + $file =~ s{::}{/}g; + $file .= '.pm'; + return $file; +} + +sub _load_file { + my ($caller, $file) = @_; + + eval <<" EOT" || die $@; +#line $caller->[2] "$caller->[1]" +require \$file; + EOT +} + + +my %HEAVY_VARS = ( + IMPORTER_MENU => 'CODE', # Origin package has a custom menu + EXPORT_FAIL => 'ARRAY', # Origin package has a failure handler + EXPORT_GEN => 'HASH', # Origin package has generators + EXPORT_ANON => 'HASH', # Origin package has anonymous exports + EXPORT_MAGIC => 'HASH', # Origin package has magic to apply post-export +); + +sub optimal_import { + my ($from, $into, $caller, @args) = @_; + + defined(*{"$from\::$_"}{$HEAVY_VARS{$_}}) and return 0 for keys %HEAVY_VARS; + + # Default to @EXPORT + @args = @{"$from\::EXPORT"} unless @args; + + # Subs will be listed without sigil in %allowed, all others keep sigil + my %allowed = map +(substr($_, 0, 1) eq '&' ? substr($_, 1) : $_ => 1), + @{"$from\::EXPORT"}, @{"$from\::EXPORT_OK"}; + + # First check if it is allowed, stripping '&' if necessary, which will also + # let scalars in, we will deal with those shortly. + # If not allowed return 0 (need to do a heavy import) + # if it is allowed then see if it has a CODE slot, if so use it, otherwise + # we have a symbol that needs heavy due to non-sub, autoload, etc. + # This will not allow $foo to import foo() since '$from' still contains the + # sigil making it an invalid symbol name in our globref below. + my %final = map +( + (!ref($_) && ($allowed{$_} || (substr($_, 0, 1, "") eq '&' && $allowed{$_}))) + ? ($_ => *{"$from\::$_"}{CODE} || return 0) + : return 0 + ), @args; + + eval <<" EOT" || die $@; +# If the caller has redefine warnings enabled then we want to warn them if +# their import redefines things. +BEGIN { \${^WARNING_BITS} = \$caller->[9] if defined \$caller->[9] }; +#line $caller->[2] "$caller->[1]" +(*{"$into\\::\$_"} = \$final{\$_}, push \@{\$Importer::IMPORTED{\$into}} => \$_) for keys %final; +1; + EOT +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Importer - Alternative but compatible interface to modules that export symbols. + +=head1 DESCRIPTION + +This module acts as a layer between L and modules which consume +exports. It is feature-compatible with L, plus some much needed +extras. You can use this to import symbols from any exporter that follows +Ls specification. The exporter modules themselves do not need to use +or inherit from the L module, they just need to set C<@EXPORT> and/or +other variables. + +=head1 SYNOPSIS + + # Import defaults + use Importer 'Some::Module'; + + # Import a list + use Importer 'Another::Module' => qw/foo bar baz/; + + # Import a specific version: + use Importer 'That::Module' => '1.00'; + + # Require a sepcific version of Importer + use Importer 0.001, 'Foo::Bar' => qw/a b c/; + + foo() + bar() + baz() + + # Remove all subroutines imported by Importer + no Importer; + + # Import symbols into variables + my $croak = Importer->get_one(Carp => qw/croak/); + $croak->("This will croak"); + + my $CARP = Importer->get(Carp => qw/croak confess cluck/); + $CARP->{croak}->("This will croak"); + $CARP->{cluck}->("This will cluck"); + $CARP->{confess}->("This will confess"); + +=head1 WHY? + +There was recently a discussion on p5p about adding features to L. +This conversation raised some significant concerns, those are listed here, in +addition to others. + +=over 4 + +=item The burden is on export consumers to specify a version of Exporter + +Adding a feature to L means that any consumer module that relies on +the new features must depend on a specific version of L. This seems +somewhat backwards since L is used by the module you are importing +from. + +=item Exporter.pm is really old/crazy code + +Not much more to say here. It is very old, it is very crazy, and if you break +it you break EVERYTHING. + +=item Using a modules import() for exporting makes it hard to give it other purposes + +It is not unusual for a module to want to export symbols and provide import +behaviors. It is also not unusual for a consumer to only want 1 or the other. +Using this module you can import symbols without also getting the C +side effects. + +In addition, moving forward, modules can specify exports and have a custom +C without conflating the two. A module can tell you to use Importer +to get the symbols, and to use the module directly for behaviors. A module +could also use Importer within its own C method without the need to +subclass L, or bring in its C method. + +=item There are other exporter modules on cpan + +This module normally assumes an exporter uses L, so it looks for the +variables and methods L expects. However, other exporters on cpan can +override this using the C hook. + +=back + +=head1 COMPATIBILITY + +This module aims for 100% compatibility with every feature of L, plus +added features such as import renaming. + +If you find something that works differently, or not at all when compared to +L please report it as a bug, unless it is noted as an intentional +feature (like import renaming). + +=head1 IMPORT PARAMETERS + + use Importer $IMPORTER_VERSION, $FROM_MODULE, $FROM_MODULE_VERSION, \&SET_SYMBOL, @SYMBOLS; + +=over 4 + +=item $IMPORTER_VERSION (optional) + +If you provide a numeric argument as the first argument it will be treated as a +version number. Importer will do a version check to make sure it is at least at +the requested version. + +=item $FROM_MODULE (required) + +This is the only required argument. This is the name of the module to import +symbols from. + +=item $FROM_MODULE_VERSION (optional) + +Any numeric argument following the C<$FROM_MODULE> will be treated as a version +check against C<$FROM_MODULE>. + +=item \&SET_SYMBOL (optional) + +Normally Importer will put the exports into your namespace. This is usually +done via a more complex form of C<*name = $ref>. If you do NOT want this to +happen then you can provide a custom sub to handle the assignment. + +This is an example that uses this feature to put all the exports into a lexical +hash instead of modifying the namespace (This is how the C method is +implemented). + + my %CARP; + use Importer Carp => sub { + my ($name, $ref) = @_; + $CARP{$name} = $ref; + }; + + $CARP{cluck}->("This will cluck"); + $CARP{croak}->("This will croak"); + +The first two arguments to the custom sub are the name (no sigil), and the +reference. The additional arguments are key/value pairs: + + sub set_symbol { + my ($name, $ref, %info) = @_; + } + +=over 4 + +=item $info{from} + +Package the symbol comes from. + +=item $info{into} + +Package to which the symbol should be added. + +=item $info{sig} + +The sigil that should be used. + +=item $info{spec} + +Extra details. + +=item $info{symbol} + +The original symbol name (with sigil) from the original package. + +=back + +=item @SYMBOLS (optional) + +Symbols you wish to import. If no symbols are specified then the defaults will +be used. You may also specify tags using the ':' prefix. + +=back + +=head1 SUPPORTED FEATURES + +=head2 TAGS + +You can define/import subsets of symbols using predefined tags. + + use Importer 'Some::Thing' => ':tag'; + +L will automatically populate the C<:DEFAULT> tag for you. +L will also give you an C<:ALL> tag with ALL exports so long as the +exporter does not define a C<:ALL> tag already. + +=head2 /PATTERN/ or qr/PATTERN/ + +You can import all symbols that match a pattern. The pattern can be supplied a +string starting and ending with '/', or you can provide a C reference. + + use Importer 'Some::Thing' => '/oo/'; + + use Importer 'Some::Thing' => qr/oo/; + +=head2 EXCLUDING SYMBOLS + +You can exclude symbols by prefixing them with '!'. + + use Importer 'Some::Thing' + '!foo', # Exclude one specific symbol + '!/pattern/', # Exclude all matching symbols + '!' => qr/oo/, # Exclude all that match the following arg + '!:tag'; # Exclude all in tag + +=head2 RENAMING SYMBOLS AT IMPORT + +I L I + +You can rename symbols at import time using a specification hash following the +import name: + + use Importer 'Some::Thing' => ( + foo => { -as => 'my_foo' }, + ); + +You can also add a prefix and/or postfix: + + use Importer 'Some::Thing' => ( + foo => { -prefix => 'my_' }, + ); + +Using this syntax to set prefix and/or postfix also works on tags and patterns +that are specified for import, in which case the prefix/postfix is applied to +all symbols from the tag/patterm. + +=head2 CUSTOM EXPORT ASSIGNMENT + +This lets you provide an alternative to the C<*name = $ref> export assignment. +See the list of L to C + +=head2 UNIMPORTING + +See L. + +=head2 ANONYMOUS EXPORTS + +See L. + +=head2 GENERATED EXPORTS + +See L. + +=head1 UNIMPORT PARAMETERS + + no Importer; # Remove all subs brought in with Importer + + no Importer qw/foo bar/; # Remove only the specified subs + +B. + +B. + +=head1 SUPPORTED VARIABLES + +=head2 @EXPORT + +This is used exactly the way L uses it. + +List of symbols to export. Sigil is optional for subs. Symbols listed here are +exported by default. If possible you should put symbols in C<@EXPORT_OK> +instead. + + our @EXPORT = qw/foo bar &baz $BAT/; + +=head2 @EXPORT_OK + +This is used exactly the way L uses it. + +List of symbols that can be imported. Sigil is optional for subs. Symbols +listed here are not exported by default. This is preferred over C<@EXPORT>. + + our @EXPORT_OK = qw/foo bar &baz $BAT/; + +=head2 %EXPORT_TAGS + +This module supports tags exactly the way L does. + + use Importer 'Some::Thing' => ':DEFAULT'; + + use Importer 'Other::Thing' => ':some_tag'; + +Tags can be specified this way: + + our %EXPORT_TAGS = ( + oos => [qw/foo boo zoo/], + ees => [qw/fee bee zee/], + ); + +=head2 @EXPORT_FAIL + +This is used exactly the way L uses it. + +Use this to list subs that are not available on all platforms. If someone tries +to import one of these, Importer will hit your C<< $from->export_fail(@items) >> +callback to try to resolve the issue. See L for documentation of +this feature. + + our @EXPORT_FAIL = qw/maybe_bad/; + +=head2 %EXPORT_ANON + +This is new to this module, L does not support it. + +This allows you to export symbols that are not actually in your package symbol +table. The keys should be the symbol names, the values are the references for +the symbols. + + our %EXPORT_ANON = ( + '&foo' => sub { 'foo' } + '$foo' => \$foo, + ... + ); + +=head2 %EXPORT_GEN + +This is new to this module, L does not support it. + +This allows you to export symbols that are generated on export. The key should +be the name of a symbol. The value should be a coderef that produces a +reference that will be exported. + +When the generators are called they will receive 2 arguments, the package the +symbol is being exported into, and the symbol being imported (name may or may +not include sigil for subs). + + our %EXPORT_GEN = ( + '&foo' => sub { + my $from_package = shift; + my ($into_package, $symbol_name) = @_; + ... + return sub { ... }; + }, + ... + ); + +=head2 %EXPORT_MAGIC + +This is new to this module. L does not support it. + +This allows you to define custom actions to run AFTER an export has been +injected into the consumers namespace. This is a good place to enable parser +hooks like with L. These will NOT be run if a consumer uses a +custom assignment callback. + + our %EXPORT_MAGIC = ( + foo => sub { + my $from = shift; # Should be the package doing the exporting + my %args = @_; + + my $into = $args{into}; # Package symbol was exported into + my $orig_name = $args{orig_name}; # Original name of the export (in the exporter) + my $new_name = $args{new_name}; # Name the symbol was imported as + my $ref = $args{ref}; # The reference to the symbol + + ...; # whatever you want, return is ignored. + }, + ); + +=head1 CLASS METHODS + +=over 4 + +=item Importer->import($from) + +=item Importer->import($from, $version) + +=item Importer->import($from, @imports) + +=item Importer->import($from, $from_version, @imports) + +=item Importer->import($importer_version, $from, ...) + +This is the magic behind C. + +=item Importer->import_into($from, $into, @imports) + +=item Importer->import_into($from, $level, @imports) + +You can use this to import symbols from C<$from> into C<$into>. C<$into> may +either be a package name, or a caller level to get the name from. + +=item Importer->unimport() + +=item Importer->unimport(@sub_name) + +This is the magic behind C. + +=item Importer->unimport_from($from, @sub_names) + +=item Importer->unimport_from($level, @sub_names) + +This lets you remove imported symbols from C<$from>. C<$from> my be a package +name, or a caller level. + +=item my $exports = Importer->get($from, @imports) + +This returns hashref of C<< { $name => $ref } >> for all the specified imports. + +C<$from> should be the package from which to get the exports. + +=item my @export_refs = Importer->get_list($from, @imports) + +This returns a list of references for each import specified. Only the export +references are returned, the names are not. + +C<$from> should be the package from which to get the exports. + +=item $export_ref = Importer->get_one($from, $import) + +This returns a single reference to a single export. If you provide multiple +imports then only the LAST one will be used. + +C<$from> should be the package from which to get the exports. + +=back + +=head1 USING WITH OTHER EXPORTER IMPLEMENTATIONS + +If you want your module to work with Importer, but you use something other than +L to define your exports, you can make it work be defining the +C method in your package. As well other exporters can be updated +to support Importer by putting this sub in your package. +B + + sub IMPORTER_MENU { + my $class = shift; + my ($into, $caller) = @_; + + return ( + export => \@EXPORT, # Default exports + export_ok => \@EXPORT_OK, # Other allowed exports + export_tags => \%EXPORT_TAGS, # Define tags + export_fail => \@EXPORT_FAIL, # For subs that may not always be available + export_anon => \%EXPORT_ANON, # Anonymous symbols to export + export_magic => \%EXPORT_MAGIC, # Magic to apply after a symbol is exported + + generate => \&GENERATE, # Sub to generate dynamic exports + # OR + export_gen => \%EXPORT_GEN, # Hash of builders, key is symbol + # name, value is sub that generates + # the symbol ref. + ); + } + + sub GENERATE { + my ($symbol) = @_; + + ... + + return $ref; + } + +All exports must be listed in either C<@EXPORT> or C<@EXPORT_OK>, or be keys in +C<%EXPORT_GEN> or C<%EXPORT_ANON> to be allowed. 'export_tags', 'export_fail', +'export_anon', 'export_gen', and 'generate' are optional. You cannot combine +'generate' and 'export_gen'. + +B If your GENERATE sub needs the C<$class>, C<$into>, or C<$caller> then +your C method will need to build an anonymous sub that closes +over them: + + sub IMPORTER_MENU { + my $class = shift; + my ($into, $caller) = @_; + + return ( + ... + generate => sub { $class->GENERATE($into, $caller, @_) }, + ); + } + +=head1 OO Interface + + use Importer; + + my $imp = Importer->new(from => 'Some::Exporter'); + + $imp->do_import('Destination::Package'); + $imp->do_import('Another::Destination', @symbols); + +Or, maybe more useful: + + my $imp = Importer->new(from => 'Carp'); + my $croak = $imp->get_one('croak'); + $croak->("This will croak"); + +=head2 OBJECT CONSTRUCTION + +=over 4 + +=item $imp = Importer->new(from => 'Some::Exporter') + +=item $imp = Importer->new(from => 'Some::Exporter', caller => [$package, $file, $line]) + +This is how you create a new Importer instance. C<< from => 'Some::Exporter' >> +is the only required argument. You may also specify the C<< caller => [...] >> +arrayref, which will be used only for error reporting. If you do not specify a +caller then Importer will attempt to find the caller dynamically every time it +needs it (this is slow and expensive, but necessary if you intend to re-use the +object.) + +=back + +=head2 OBJECT METHODS + +=over 4 + +=item $imp->do_import($into) + +=item $imp->do_import($into, @symbols) + +This will import from the objects C package into the C<$into> package. +You can provide a list of C<@symbols>, or you can leave it empty for the +defaults. + +=item $imp->do_unimport() + +=item $imp->do_unimport(@symbols) + +This will remove imported symbols from the objects C package. If you +specify a list of C<@symbols> then only the specified symbols will be removed, +otherwise all symbols imported using Importer will be removed. + +B Please be aware of the difference between C and +C. For import 'from' us used as the origin, in unimport it is +used as the target. This means you cannot re-use an instance to import and then +unimport. + +=item ($into, $versions, $exclude, $symbols, $set) = $imp->parse_args('Dest::Package') + +=item ($into, $versions, $exclude, $symbols, $set) = $imp->parse_args('Dest::Package', @symbols) + +This parses arguments. The first argument must be the destination package. +Other arguments can be a mix of symbol names, tags, patterns, version numbers, +and exclusions. + +=item $caller_ref = $imp->get_caller() + +This will find the caller. This is mainly used for error reporting. IF the +object was constructed with a caller then that is what is returned, otherwise +this will scan the stack looking for the first call that does not originate +from a package that ISA Importer. + +=item $imp->carp($warning) + +Warn at the callers level. + +=item $imp->croak($exception) + +Die at the callers level. + +=item $from_package = $imp->from() + +Get the C package that was specified at construction. + +=item $file = $imp->from_file() + +Get the filename for the C package. + +=item $imp->load_from() + +This will load the C package if it has not been loaded already. This uses +some magic to ensure errors in the load process are reported to the C. + +=item $menu_hr = $imp->menu($into) + +Get the export menu built from, or provided by the C package. This is +cached after the first time it is called. Use C<< $imp->reload_menu() >> to +refresh it. + +The menu structure looks like this: + + $menu = { + # every valid export has a key in the lookup hashref, value is always + # 1, key always includes the sigil + lookup => {'&symbol_a' => 1, '$symbol_b' => 1, ...}, + + # most exports are listed here, symbol name with sigil is key, value is + # a reference to the symbol. If a symbol is missing it may be generated. + exports => {'&symbol_a' => \&symbol_a, '$symbol_b' => \$symbol_b, ...}, + + # Hashref of tags, tag name (without ':' prefix) is key, value is an + # arrayref of symbol names, subs may have a sigil, but are not required + # to. + tags => { DEFAULT => [...], foo => [...], ... }, + + # Magic to apply + magic => { foo => sub { ... }, ... }, + + # This is a hashref just like 'lookup'. Keys are symbols which may not + # always be available. If there are no symbols in this category then + # the value of the 'fail' key will be undef instead of a hashref. + fail => { '&iffy_symbol' => 1, '\&only_on_linux' => 1 }, + # OR fail => undef, + + # If present, this subroutine knows how to generate references for the + # symbols listed in 'lookup', but missing from 'exports'. References + # this returns are NEVER cached. + generate => sub { my $sym_name = shift; ...; return $symbol_ref }, + }; + +=item $imp->reload_menu($into) + +This will reload the export menu from the C package. + +=item my $exports = $imp->get(@imports) + +This returns hashref of C<< { $name => $ref } >> for all the specified imports. + +=item my @export_refs = $imp->get_list(@imports) + +This returns a list of references for each import specified. Only the export +references are returned, the names are not. + +=item $export_ref = $imp->get_one($import) + +This returns a single reference to a single export. If you provide multiple +imports then only the LAST one will be used. + +=back + +=head1 FUNCTIONS + +These can be imported: + + use Importer 'Importer' => qw/import optimal_import/; + +=over 4 + +=item $bool = optimal_import($from, $into, \@caller, @imports) + +This function will attempt to import C<@imports> from the C<$from> package into +the C<$into> package. C<@caller> needs to have a package name, filename, and +line number. If this function fails then no exporting will actually happen. + +If the import is successful this will return true. + +If the import is unsuccessful this will return false, and no modifications to +the symbol table will occur. + +=item $class->import(@imports) + +If you write class intended to be used with L, but also need to +provide a legacy C method for direct consumers of your class, you can +import this C method. + + package My::Exporter; + + # This will give you 'import()' much like 'use base "Exporter";' + use Importer 'Importer' => qw/import/; + + ... + +=back + +=head1 SOURCE + +The source code repository for Importer can be found at +L. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum Eexodist@cpan.orgE + +=back + +=head1 COPYRIGHT + +Copyright 2015 Chad Granum Eexodist7@gmail.comE. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L + +=cut diff --git a/t/Simple.t b/t/Simple.t new file mode 100644 index 0000000..114b6b8 --- /dev/null +++ b/t/Simple.t @@ -0,0 +1,32 @@ +package Importer::Test; +use strict; +use warnings; + +{ + package main; + use Importer '0.001', 'Test::More'; +} + +use Importer 0.001, 'Test::More' => qw/0.88 pass ok $TODO/; +use Importer 'Data::Dumper'; + +pass("Loaded Test::More"); + +our $ok = 'ok'; +our %ok = ( 1 => 1 ); +our @ok = qw/o k/; +ok(1, "imported ok"); + +ok(eval '$TODO = undef; 1', '$TODO was imported') || Test::More::diag($@); + +no Importer; + +::ok(!__PACKAGE__->can($_), "removed sub $_") for qw/pass ok Dumper/; + +::ok(eval '$TODO = undef; 1', '$TODO was not removed') || Test::More::diag($@); + +::is($ok, 'ok', 'did not remove $ok'); +::is_deeply(\%ok, {1 => 1}, 'Did not remove %ok' ); +::is_deeply(\@ok, [qw/o k/], 'Did not remove @ok' ); + +::done_testing(); diff --git a/t/all_tag.t b/t/all_tag.t new file mode 100644 index 0000000..f8a8468 --- /dev/null +++ b/t/all_tag.t @@ -0,0 +1,47 @@ +use Test::More; +use strict; +use warnings; + +BEGIN { + $INC{'My/Exporter/A.pm'} = __FILE__; + $INC{'My/Exporter/B.pm'} = __FILE__; + + package My::Exporter::A; + + our @EXPORT = qw/foo bar/; + our @EXPORT_OK = qw/baz bat/; + + sub foo { 'foo' } + sub bar { 'bar' } + sub baz { 'baz' } + sub bat { 'bat' } + + package My::Exporter::B; + + our @EXPORT = qw/foo bar/; + our @EXPORT_OK = qw/baz bat/; + + our %EXPORT_TAGS = ( + ALL => [qw/foo/], + ); + + sub foo { 'foo' } + sub bar { 'bar' } + sub baz { 'baz' } + sub bat { 'bat' } +} + +subtest "define ALL tag if missing" => sub { + package Importer::A; + use Importer 'My::Exporter::A' => ':ALL'; + main::can_ok(__PACKAGE__, qw/foo bar baz bar/); +}; + +subtest "do not override ALL tag if defined" => sub { + package Importer::B; + use Importer 'My::Exporter::B' => ':ALL'; + main::can_ok(__PACKAGE__, qw/foo/); + main::ok(!__PACKAGE__->can($_), "Did not import $_") for qw/bar baz bat/; +}; + +done_testing; diff --git a/t/export_fail.t b/t/export_fail.t new file mode 100644 index 0000000..98383ce --- /dev/null +++ b/t/export_fail.t @@ -0,0 +1,28 @@ +use strict; +use warnings; + +use Test::More; + +my @got; +BEGIN { + $INC{'FAIL.pm'} = 1; + package FAIL; + + our @EXPORT = qw/foo $bar/; + our @EXPORT_FAIL = qw/foo $bar/; + + sub export_fail { + @got = @_; + return(); + } +} + +use Importer FAIL => qw/&foo $bar/; + +is_deeply( + \@got, + [qw/FAIL foo $bar/], + "'&' stripped from sub export" +); + +done_testing; diff --git a/t/import.t b/t/import.t new file mode 100644 index 0000000..b21faa7 --- /dev/null +++ b/t/import.t @@ -0,0 +1,21 @@ +use strict; +use warnings; +use Test::More; + +BEGIN { + $INC{'My/Exporter.pm'} = 1; + + use Importer Importer => qw/import/; + + our @EXPORT = qw/foo/; + + sub foo { 'foo' } +} + +use My::Exporter; + +can_ok(__PACKAGE__, qw/foo/); + +is(foo(), 'foo', "foo() imported"); + +done_testing; diff --git a/t/missing.t b/t/missing.t new file mode 100644 index 0000000..1d56359 --- /dev/null +++ b/t/missing.t @@ -0,0 +1,22 @@ +use strict; +use warnings; + +use Importer 'Test::More'; + +BEGIN { + $INC{'Export/Tester.pm'} = 1; + package Export::Tester; + + our @EXPORT = qw/foo bar bad/; + + sub foo { 'foo' } + sub bar { 'bar' } +} + +use Importer 'Export::Tester'; + +can_ok(__PACKAGE__, qw/foo bar/); + +pass("Legacy, Exporter.pm allows you to list subs for export that are missing"); + +done_testing; diff --git a/t/units.t b/t/units.t new file mode 100644 index 0000000..3b155a9 --- /dev/null +++ b/t/units.t @@ -0,0 +1,1083 @@ +use strict; +use warnings; + +use Importer 'Test::More'; + +my $CLASS = 'Importer'; + +sub dies(&) { + my $code = shift; + + my $err; + { + local $@; + eval { $code->(); 1 } and return undef; + $err = $@; + } + + $@ = $err; + return $err || 1; +} + +sub warns(&) { + my $code = shift; + + my $warn; + my $warned = 0; + local $SIG{__WARN__} = sub { ($warn) = @_; $warned++ }; + $code->(); + + return undef unless $warned; + + return $warn || $warned; +} + + +### +# These cannot be inside a subtest because of the lexical scopeing +{ + my %CARP; + use Importer Carp => qw/croak confess/, sub { + my ($name, $ref) = @_; + $CARP{$name} = $ref; + }; + is_deeply( + \%CARP, + { + croak => \&Carp::croak, + confess => \&Carp::confess, + }, + "Exports went into the hash." + ); +} + +subtest _version_check => sub { + my $version_check = $CLASS->can('_version_check'); + + ok($version_check->('Importer', [__PACKAGE__, __FILE__, __LINE__], 0.001), "Version check pass" ); + + my $error = dies { $version_check->('Importer', [__PACKAGE__, __FILE__, __LINE__], 100) }; + my $line = __LINE__ - 1; + + my $file = __FILE__; + like( + $error, + qr/version 100 required.*at \Q$file\E line $line/, + "Got expected error" + ); +}; + +subtest import => sub { + ok(!dies { $CLASS->import('0.001') }, "No errors, valid version"); + like(dies { $CLASS->import('100') }, qr/version 100 required/, "bad version check"); + + package Consumer1; + use Importer 'Data::Dumper' => 'Dumper'; + + ::can_ok(__PACKAGE__, 'Dumper'); +}; + +subtest import_into => sub { + $CLASS->import_into('Data::Dumper', 'Consumer2', 'Dumper'); + can_ok('Consumer2', 'Dumper'); + + my $do_it = sub { $CLASS->import_into('Data::Dumper', 0, 'Dumper') }; + package Consumer3; + $do_it->(); + + ::can_ok('Consumer3', 'Dumper'); +}; + +subtest unimport => sub { + package Consumer1; + $CLASS->unimport; + + ::ok(!__PACKAGE__->can('Dumper'), "removed 'Dumper' from Consumer1"); + ::like( + ::dies { $CLASS->unimport('foo') }, + qr/Sub 'foo' was not imported using Importer/, + "we did not import it, we cannot remove it" + ); + + package Consumer100; + + ::like( + ::dies { $CLASS->unimport }, + qr/'Consumer100' does not have any imports to remove/, + "nothing to unimport" + ); +}; + +subtest unimport_from => sub { + $CLASS->unimport_from('Consumer2', 'Dumper'); + ok(!Consumer2->can('Dumper'), "removed 'Dumper' from Consumer2"); + + like( + dies { $CLASS->unimport_from('Consumer100') }, + qr/'Consumer100' does not have any imports to remove/, + "Nothing to unimport" + ); + + my $do_it = sub { $CLASS->unimport_from(0, 'Dumper') }; + my $do_it2 = sub { $CLASS->unimport_from(0, 'foo') }; + + package Consumer3; + $do_it->(); + + ::ok(!Consumer3->can('Dumper'), "removed 'Dumper' from Consumer3"); + + ::like( + ::dies { $do_it2->() }, + qr/Sub 'foo' was not imported using Importer/, + "we did not import it, we cannot remove it" + ); +}; + +subtest new_and_from => sub { + my $one = $CLASS->new(from => 'Data::Dumper'); + isa_ok($one, $CLASS); + is($one->from, 'Data::Dumper', "Saved 'from' from constructor"); + + like( + dies { $CLASS->new() }, + qr/You must specify a package to import from/, + "'from' is a required attribute" + ); + + $one = $CLASS->new(from => 'Data::Dumper', caller => ['Foo::Bar', 'Foo/Bar.pm', 42]); + is_deeply($one->get_caller, ['Foo::Bar', 'Foo/Bar.pm', 42], "Saved caller from construction"); +}; + +subtest from_file => sub { + my $one = $CLASS->new(from => 'Foo::Bar::Baz'); + is($one->from_file, 'Foo/Bar/Baz.pm', "got filename"); +}; + +subtest load_from => sub { + my $one = $CLASS->new(from => 'Some::Fake::Module::AFSGEWGWE::FASDF', caller => ['main', 'fake.pl', 42]); + + like( + dies { $one->load_from }, + qr{Can't locate.*at fake\.pl line 42}, + "Failed to load 'from' module", + ); + + $INC{$one->from_file} = 1; + ok(!dies { $one->load_from }, "file already loaded"); + + ok(!$INC{'Test/Simple.pm'}, "check that our test file is not already loaded"); + $one = $CLASS->new(from => 'Test::Simple'); + ok(!dies { $one->load_from }, "file found"); +}; + +subtest get_caller => sub { + my $one = $CLASS->new(from => 'Fake', caller => ['A', 'A.pm', 42]); + is_deeply($one->get_caller, ['A', 'A.pm', 42], "got stored caller"); + + $one = $CLASS->new(from => 'Fake'); + is_deeply([@{sub { $one->get_caller }->()}[0,1,2]], [__PACKAGE__, __FILE__, __LINE__], "got real caller"); + + my $get = sub { + package Importer; + sub { + package Importer::Subclass; + use base 'Importer'; + sub { + package main; # get_caller loosk at level 1+, so this gets skipped by design + $one->get_caller; + }->() + }->() + }; + + is_deeply([@{$get->()}[0,1,2]], [__PACKAGE__, __FILE__, __LINE__], "got true caller"); +}; + +subtest carp_and_croak => sub { + my $one = $CLASS->new(from => 'fake', caller => ['A', 'A.pm', 42]); + + is( + dies { $one->croak("apple pie") }, + "apple pie at A.pm line 42.\n", + "Died at correct place" + ); + + is( + warns { $one->carp("apple pie") }, + "apple pie at A.pm line 42.\n", + "Warned at correct place" + ); +}; + +subtest menu => sub { + my $menu; + + no warnings 'redefine'; + local *Importer::reload_menu = sub { + my $self = shift; + my ($into) = @_; + $self->{menu} = $menu; + $self->{menu_for} = $into; + return $menu; + }; + + $menu = { a => 1 }; + my $one = $CLASS->new(from => 'fake'); + is_deeply($one->menu('fake2'), $menu, "returned menu"); + + my $old = $menu; + $menu = { b => 2 }; + + is_deeply($one->menu('fake2'), $old, "cached"); + + is_deeply($one->menu('fake3'), $menu, "refreshed with different destination"); + + my $line; + like( + dies { $line = __LINE__; $one->menu() }, + qr/menu\(\) requires the name of the destination package at \Q${\__FILE__}\E line $line/, + "Need 'into' package" + ); +}; + +subtest reload_menu => sub { + my $one = $CLASS->new(from => 'fake'); + + my $line; + like( + dies { $line = __LINE__; $one->reload_menu() }, + qr/menu\(\) requires the name of the destination package at \Q${\__FILE__}\E line $line/, + "Need 'into' package" + ); + + subtest empty => sub { + { + no warnings 'once'; + require Exporter; + @Fake::Exporter1::ISA = ('Exporter'); + *Fake::Exporter2::import = Exporter->can('import'); + *Fake::Exporter3::IMPORTER_MENU = sub { () }; + *Fake::Exporter4::IMPORTER_MENU = sub { (generate => sub { 1 }, export_gen => { a => 1 }) }; + } + + like( + dies { $line = __LINE__; $CLASS->new(from => 'Fake::Exporter4')->reload_menu('fake') }, + qr/'Fake::Exporter4' provides both 'generate' and 'export_gen' in its IMPORTER_MENU \(They are exclusive, module must pick 1\) at \Q${\__FILE__}\E line $line/, + "Bad IMPORT_MENU" + ); + + like( + dies { $line = __LINE__; $CLASS->new(from => 'Fake::Exporter5')->reload_menu('fake') }, + qr/'Fake::Exporter5' does not provide any exports at \Q${\__FILE__}\E line $line/, + "No exports, not an exporter" + ); + + my ($menu1, $menu2, $menu3); + ok(!dies { $menu1 = $CLASS->new(from => 'Fake::Exporter1')->reload_menu('fake') }, "Package isa Exporter with no exports") || diag $@; + ok(!dies { $menu2 = $CLASS->new(from => 'Fake::Exporter2')->reload_menu('fake') }, "Package uses Exporter qw/import/") || diag $@; + ok(!dies { $menu3 = $CLASS->new(from => 'Fake::Exporter3')->reload_menu('fake') }, "Package provides IMPORTER_MENU") || diag $@; + + is_deeply( + [$menu1, $menu1, $menu2], + [$menu2, $menu3, $menu3], + "All empty menus are the same" + ); + + is_deeply( + $menu1, + { + lookup => {}, + exports => {}, + tags => { DEFAULT => [], ALL => [] }, + fail => undef, + generate => undef, + magic => {}, + }, + "Got valid, but empty menu" + ); + }; + + subtest IMPORTER_MENU => sub { + { + package Fake::ExporterI; + sub IMPORTER_MENU { + ::is_deeply( + \@_, + ['Fake::ExporterI', 'fake', ['fake', 'fake.pl', 42]], + "Got input args" + ); + return ( + export => [qw/foo &bar $ZAP %ZAP @ZAP/], + export_ok => [qw/baz ick missing/], + export_tags => {b => [qw/bar baz/]}, + export_fail => [qw/ick/], + export_anon => { x => \&__x, z => \&__z }, + export_gen => { + 'gena' => sub { + sub { 'a' } + }, + '&genb' => sub { + sub { 'b' } + }, + }, + ); + } + + sub foo { 'foo' } + sub bar { 'bar' } + sub baz { 'baz' } + sub ick { 'ick' } + sub __x { 'x' } + sub __z { 'z' } + + # These are here to insure 'exports' does not pull them in, they are listed as generate + sub gena { die 'oops, should not see this' } + sub genb { die 'oops, should not see this' } + + # These are here to insure 'exports' does not pull them in, refs were provided by anon + sub x { die 'oops, should not see this' } + sub y { die 'oops, should not see this' } + + package Fake::ExporterI2; + + sub IMPORTER_MENU { + return ( + generate => \&generate, + ); + } + + sub generate { sub { 'a pie' } } + } + + my $one = $CLASS->new(from => 'Fake::ExporterI', caller => ['fake', 'fake.pl', 42]); + my $menu = $one->reload_menu('fake'); + is($one->{menu_for}, 'fake', "remember who it was generated for"); + ok(my $gen = delete $menu->{generate}, "got a generate function"); + + is_deeply( + $menu, + { + lookup => {qw/ + foo 1 &foo 1 + bar 1 &bar 1 + baz 1 &baz 1 + ick 1 &ick 1 + missing 1 &missing 1 + x 1 &x 1 + z 1 &z 1 + gena 1 &gena 1 + genb 1 &genb 1 + + $ZAP 1 %ZAP 1 @ZAP 1 + /}, + exports => { + '&foo' => \&Fake::ExporterI::foo, + '&bar' => \&Fake::ExporterI::bar, + '&baz' => \&Fake::ExporterI::baz, + '&ick' => \&Fake::ExporterI::ick, + '&x' => \&Fake::ExporterI::__x, + '&z' => \&Fake::ExporterI::__z, + + '&missing' => \&Fake::ExporterI::missing, + + '$ZAP' => \$Fake::ExporterI::ZAP, + '@ZAP' => \@Fake::ExporterI::ZAP, + '%ZAP' => \%Fake::ExporterI::ZAP, + }, + tags => { + 'b' => [qw/bar baz/], + 'DEFAULT' => [qw/foo &bar $ZAP %ZAP @ZAP/], + 'ALL' => [sort qw/&foo &bar &baz &ick &missing &x &z &gena &genb %ZAP $ZAP @ZAP/], + }, + fail => { '&ick' => 1, ick => 1 }, + magic => {}, + }, + "Got menu" + ); + + is($gen->('gena')->(), 'a', "generated a"); + is($gen->('genb')->(), 'b', "generated b"); + + $one = $CLASS->new(from => 'Fake::ExporterI2', caller => ['fake', 'fake.pl', 42]); + $menu = $one->reload_menu('fake'); + is($menu->{generate}, \&Fake::ExporterI2::generate, "can provide custom generate") + }; + + subtest OLD_STYLE => sub { + { + package Fake::ExporterE; + our @EXPORT = qw/foo &bar $ZAP %ZAP @ZAP/; + our @EXPORT_OK = qw/baz ick missing/; + our %EXPORT_TAGS = (b => [qw/bar baz/]); + our @EXPORT_FAIL = qw/ick/; + our %EXPORT_ANON = (x => \&__x, z => \&__z); + our %EXPORT_GEN = ( + 'gena' => sub { + sub { 'a' } + }, + '&genb' => sub { + sub { 'b' } + }, + ); + + sub foo { 'foo' } + sub bar { 'bar' } + sub baz { 'baz' } + sub ick { 'ick' } + sub __x { 'x' } + sub __z { 'z' } + + # These are here to insure 'exports' does not pull them in, they are listed as generate + sub gena { die 'oops, should not see this' } + sub genb { die 'oops, should not see this' } + + # These are here to insure 'exports' does not pull them in, refs were provided by anon + sub x { die 'oops, should not see this' } + sub y { die 'oops, should not see this' } + } + + my $one = $CLASS->new(from => 'Fake::ExporterE', caller => ['fake', 'fake.pl', 42]); + my $menu = $one->reload_menu('fake'); + is($one->{menu_for}, 'fake', "remember who it was generated for"); + ok(my $gen = delete $menu->{generate}, "got a generate function"); + + is_deeply( + $menu, + { + lookup => {qw/ + foo 1 &foo 1 + bar 1 &bar 1 + baz 1 &baz 1 + ick 1 &ick 1 + missing 1 &missing 1 + x 1 &x 1 + z 1 &z 1 + gena 1 &gena 1 + genb 1 &genb 1 + + $ZAP 1 %ZAP 1 @ZAP 1 + /}, + exports => { + '&foo' => \&Fake::ExporterE::foo, + '&bar' => \&Fake::ExporterE::bar, + '&baz' => \&Fake::ExporterE::baz, + '&ick' => \&Fake::ExporterE::ick, + '&x' => \&Fake::ExporterE::__x, + '&z' => \&Fake::ExporterE::__z, + + '&missing' => \&Fake::ExporterE::missing, + + '$ZAP' => \$Fake::ExporterE::ZAP, + '@ZAP' => \@Fake::ExporterE::ZAP, + '%ZAP' => \%Fake::ExporterE::ZAP, + }, + tags => { + 'b' => [qw/bar baz/], + 'DEFAULT' => [qw/foo &bar $ZAP %ZAP @ZAP/], + 'ALL' => [sort qw/&foo &bar &baz &ick &missing &x &z &gena &genb %ZAP $ZAP @ZAP/], + }, + fail => { '&ick' => 1, ick => 1 }, + magic => {}, + }, + "Got menu" + ); + + is($gen->('gena')->(), 'a', "generated a"); + is($gen->('genb')->(), 'b', "generated b"); + }; +}; + +subtest parse_args => sub { + { + package Fake::Exporter::ForArgs; + + sub IMPORTER_MENU { + return ( + export => [qw/foo &bar $ZAP %ZAP @ZAP/], + export_ok => [qw/baz ick missing/], + export_tags => { + b => [qw/bar baz/], + c => [ + boo => {'-as' => 'buz', '-prefix' => 'a_', '-postfix' => '_a'}, + ':b' + ], + }, + export_fail => [qw/ick/], + export_anon => { x => \&__x, z => \&__z }, + export_gen => { + 'gena' => sub { + sub { 'a' } + }, + '&genb' => sub { + sub { 'b' } + }, + }, + ); + } + + sub boo { 'boo' } + sub foo { 'foo' } + sub bar { 'bar' } + sub baz { 'baz' } + sub ick { 'ick' } + sub __x { 'x' } + sub __z { 'z' } + + # These are here to insure 'exports' does not pull them in, they are listed as generate + sub gena { die 'oops, should not see this' } + sub genb { die 'oops, should not see this' } + + # These are here to insure 'exports' does not pull them in, refs were provided by anon + sub x { die 'oops, should not see this' } + sub y { die 'oops, should not see this' } + } + + my $one = $CLASS->new(from => 'Fake::Exporter::ForArgs', caller => ['Foo', 'foo.pl', 42]); + + is_deeply( + [$one->parse_args('Dest')], + [ + 'Dest', + [], + {}, + [ + ['&foo', {}], + ['&bar', {}], + ['$ZAP', {}], + ['%ZAP', {}], + ['@ZAP', {}], + ], + undef, + ], + "Got defaults with empty list" + ); + + my $set = sub { 1 }; + is_deeply( + [$one->parse_args('Dest', $set)], + [ + 'Dest', + [], + {}, + [ + ['&foo', {}], + ['&bar', {}], + ['$ZAP', {}], + ['%ZAP', {}], + ['@ZAP', {}], + ], + $set, + ], + "Got defaults with empty list + custom setter" + ); + + is_deeply( + [$one->parse_args('Dest', 'foo', $set)], + [ + 'Dest', + [], + {}, + [ + ['&foo', {}], + ], + $set, + ], + "Got defaults with 1 item + custom setter" + ); + + is_deeply( + [$one->parse_args('Dest', '!bar')], + [ + 'Dest', + [], + { '&bar' => 1 }, + [ + ['&foo', {}], + ['&bar', {}], + ['$ZAP', {}], + ['%ZAP', {}], + ['@ZAP', {}], + ], + undef, + ], + "Got defaults, exclude bar" + ); + + is_deeply( + [$one->parse_args('Dest', '!' => 'bar')], + [ + 'Dest', + [], + { '&bar' => 1 }, + [ + ['&foo', {}], + ['&bar', {}], + ['$ZAP', {}], + ['%ZAP', {}], + ['@ZAP', {}], + ], + undef, + ], + "Got defaults, exclude bar" + ); + + is_deeply( + [$one->parse_args('Dest', ':DEFAULT', '!:b')], + [ + 'Dest', + [], + { '&bar' => 1, '&baz' => 1 }, + [ + ['&foo', {}], + ['&bar', {}], + ['$ZAP', {}], + ['%ZAP', {}], + ['@ZAP', {}], + ], + undef, + ], + "Got defaults, exclude :b" + ); + + is_deeply( + [$one->parse_args('Dest', ':b' => {-prefix => 'foo_'}, qw/x &y/)], + [ + 'Dest', + [], + {}, + [ + ['&bar', {-prefix => 'foo_'}], + ['&baz', {-prefix => 'foo_'}], + ['&x', {}], + ['&y', {}], + ], + undef, + ], + "Spec for tag" + ); + + is_deeply( + [$one->parse_args('Dest', '/A/' => { -postfix => '_foo' }, '!$ZAP')], + [ + 'Dest', + [], + { '$ZAP' => 1 }, + [ + ['$ZAP', {-postfix => '_foo'}], + ['%ZAP', {-postfix => '_foo'}], + ['@ZAP', {-postfix => '_foo'}], + ], + undef, + ], + "Spec for pattern" + ); + + is_deeply( + [$one->parse_args('Dest', ':c' => {-prefix => 'b_', -postfix => '_b'})], + [ + 'Dest', + [], + {}, + [ + ['&boo', {-as => 'buz', -prefix => 'b_a_', -postfix => '_a_b'}], + ['&bar', {-prefix => 'b_', -postfix => '_b'}], + ['&baz', {-prefix => 'b_', -postfix => '_b'}], + ], + undef, + ], + "Spec for tag with embedded and added specs" + ); + + is_deeply( + [$one->parse_args('Dest', 22, qr/A/, { -postfix => '_foo' }, '!$ZAP', 45)], + [ + 'Dest', + [ 22, 45 ], + { '$ZAP' => 1 }, + [ + ['$ZAP', {-postfix => '_foo'}], + ['%ZAP', {-postfix => '_foo'}], + ['@ZAP', {-postfix => '_foo'}], + ], + undef, + ], + "Spec for qr// (also test version)" + ); + + like( + dies { $one->parse_args('Dest', '/A/' => { -as => 'foo' }) }, + qr{Cannot use '-as' to rename multiple symbols included by: /A/}, + "-as does not work with multiple imports" + ); + + like( + dies { $one->parse_args('Dest', ':b' => { -as => 'foo' }) }, + qr{Cannot use '-as' to rename multiple symbols included by: :b}, + "-as does not work with multiple imports" + ); + + like( + dies { $one->parse_args('Dest', ':bad') }, + qr{Fake::Exporter::ForArgs does not export the :bad tag}, + "-as does not work with multiple imports" + ); +}; + +subtest _handle_fail => sub { + { + package Fake::Exporter::ForFail; + + sub IMPORTER_MENU { + return ( + export => [qw/foo &bar $ZAP %ZAP @ZAP/], + export_ok => [qw/baz ick missing/], + export_tags => {b => [qw/bar baz/]}, + export_fail => [qw/ick foo/], + export_anon => { x => \&__x, z => \&__z }, + export_gen => { + 'gena' => sub { + sub { 'a' } + }, + '&genb' => sub { + sub { 'b' } + }, + }, + ); + } + + sub foo { 'foo' } + sub bar { 'bar' } + sub baz { 'baz' } + sub ick { 'ick' } + sub __x { 'x' } + sub __z { 'z' } + + # These are here to insure 'exports' does not pull them in, they are listed as generate + sub gena { die 'oops, should not see this' } + sub genb { die 'oops, should not see this' } + + # These are here to insure 'exports' does not pull them in, refs were provided by anon + sub x { die 'oops, should not see this' } + sub y { die 'oops, should not see this' } + + sub export_fail { + my $from = shift; + return grep !/foo/, @_; + } + } + + my $one = $CLASS->new(from => 'Fake::Exporter::ForFail', caller => ['Foo', 'foo.pl', 42]); + + ok(!dies { $one->_handle_fail('dest', [['bar'], ['baz']]) }, "no failures") || diag $@; + ok(!dies { $one->_handle_fail('dest', [['bar'], ['foo']]) }, "no failures, but 'foo' was on list") || diag $@; + + like( + warns { + like( + dies { $one->_handle_fail('dest', [['bar'], ['ick']]) }, + qr/Can't continue after import errors/, + "True failure" + ) + }, + qr/"ick" is not implemented by the Fake::Exporter::ForFail module on this architecture/, + "Got expected warning" + ); +}; + +subtest _set_symbols => sub { + { + package Fake::ForSetSymbols; + our @EXPORT = qw/foo &bar $ZAP %ZAP @ZAP $REF/; + our @EXPORT_OK = qw/baz ick missing/; + our %EXPORT_TAGS = (b => [qw/bar baz/]); + our @EXPORT_FAIL = qw/ick/; + our %EXPORT_ANON = (x => \&__x, z => \&__z); + our %EXPORT_GEN = ( + 'gena' => sub { + sub { 'a' } + }, + '&genb' => sub { + my $bad = 'bad'; + return \$bad; # To test sigil mismatch + }, + ); + + our @ZAP = (qw/Z A P/); + our $ZAP = 'ZAP'; + our %ZAP = (ZAP => 1); + our $REF = \$ZAP; + + sub foo { 'foo' } + sub bar { 'bar' } + sub baz { 'baz' } + sub ick { 'ick' } + sub __x { 'x' } + sub __z { 'z' } + + # These are here to insure 'exports' does not pull them in, they are listed as generate + sub gena { die 'oops, should not see this' } + sub genb { die 'oops, should not see this' } + + # These are here to insure 'exports' does not pull them in, refs were provided by anon + sub x { die 'oops, should not see this' } + sub y { die 'oops, should not see this' } + } + + my $one = $CLASS->new(from => 'Fake::ForSetSymbols', caller => ['Foo', 'foo.pl', 42]); + + $one->_set_symbols( + 'Fake::Dest::A', + {'&bar' => 1, '@ZAP' => 1}, + [ + # These first 2 should both be excluded + ['&bar' => {}], + ['&bar' => {-prefix => 'pre_', -postfix => '_post'}], + + # Replicate use of ':b', this one is not excluded though + ['&baz' => {-prefix => 'pre_', -postfix => '_post'}], + + # Exclude + ['@ZAP' => {}], + + # Should import, specific name requested, ignore exclude + ['&bar' => {-as => 'boo'}], + + # Should work fine + ['$REF' => {}], + ['&foo' => {}], + ['&gena' => {}], + ['&x' => {}], + ['$ZAP' => {-prefix => 'pre_', -postfix => '_post'}], + ], + ); + + is(\&Fake::Dest::A::pre_baz_post, \&Fake::ForSetSymbols::baz, 'Exported &baz as pre_baz_post'); + is(\&Fake::Dest::A::boo, \&Fake::ForSetSymbols::bar, 'Exported &bar as &boo'); + is(\&Fake::Dest::A::foo, \&Fake::ForSetSymbols::foo, 'Exported &foo'); + is(\&Fake::Dest::A::x, \&Fake::ForSetSymbols::__x, 'Exported anon &x'); + is(\$Fake::Dest::A::pre_ZAP_post, \$Fake::ForSetSymbols::ZAP, 'Exported $ZAP as $pre_ZAP_post'); + is(Fake::Dest::A::gena(), 'a', 'Generated &gena'); + + { + no warnings 'once'; + ok(\$Fake::Dest::A::REF == \$Fake::ForSetSymbols::REF, 'Exported $REF'); + ok(\@Fake::Dest::A::ZAP != \@Fake::ForSetSymbols::ZAP, 'Excluded @ZAP'); + ok(\&Fake::Dest::A::bar != \&Fake::ForSetSymbols::bar, 'Excluded &bar'); + ok(\&Fake::Dest::A::pre_bar_post != \&Fake::ForSetSymbols::bar, 'Excluded &bar with prefix/postfix'); + } + + ok(!dies { $one->_set_symbols('Fake::Dest::A', {}, [['&missing' => {}]]) }, "Can fake-import missing symbol if it is listed"); + + like( + dies { $one->_set_symbols('Fake::Dest::A', {}, [['&nope' => {}]]) }, + qr/Fake::ForSetSymbols does not export \&nope/, + "unlisted symbol cannot be imported" + ); + + like( + dies { $one->_set_symbols('Fake::Dest::A', {}, [['&genb' => {}]]) }, + qr/Symbol '\&genb' requested, but reference \(SCALAR\) does not match sigil \(\&\)/, + "sigil mismatch" + ); + + # Make sure it finds the correct caller, not our fake one + delete $one->{caller}; + + { + no warnings 'redefine'; + *Fake::Dest::A::foo = sub { 1 }; + } + + ok( + !warns { + no warnings 'redefine'; + $one->_set_symbols('Fake::Dest::A', {}, [['&foo' => {}]]) + }, + "no redefine warnings" + ); + + { + no warnings 'redefine'; + *Fake::Dest::A::foo = sub { 1 }; + } + + like( + warns { + use warnings 'redefine'; + $one->_set_symbols('Fake::Dest::A', {}, [['&foo' => {}]]) + }, + qr/Subroutine Fake::Dest::A::foo redefined/, + "redefine warnings" + ); + + $one = $CLASS->new(from => 'Fake::Dest::A'); + + can_ok('Fake::Dest::A', 'foo'); + $one->do_unimport(qw/foo/); + ok(!'Fake::Dest::A'->can('foo'), "removed &foo"); + + is(\&Fake::Dest::A::pre_baz_post, \&Fake::ForSetSymbols::baz, 'Kept &baz as pre_baz_post'); + is(\&Fake::Dest::A::boo, \&Fake::ForSetSymbols::bar, 'Kept &bar as &boo'); + is(\&Fake::Dest::A::x, \&Fake::ForSetSymbols::__x, 'Kept anon &x'); + is(\$Fake::Dest::A::pre_ZAP_post, \$Fake::ForSetSymbols::ZAP, 'Kept $ZAP as $pre_ZAP_post'); + is(Fake::Dest::A::gena(), 'a', 'Kept &gena'); + + $one->do_unimport(); + is(\$Fake::Dest::A::pre_ZAP_post, \$Fake::ForSetSymbols::ZAP, 'Kept $ZAP as $pre_ZAP_post'); + ok(!'Fake::Dest::A'->can($_), "removed \&$_") for qw/pre_baz_post boo x gena/; +}; + +subtest version_check => sub { + local *version_check = $CLASS->can('_version_check') or die "where did _version_check go?"; + ok(version_check($CLASS, ['foo', 'foo.pl', 42], '0.001'), "version check pass"); + like( + dies { version_check($CLASS, ['foo', 'foo.pl', 42], '9999') }, + qr/version 9999 required.*foo\.pl line 42/, + "Version Check fails" + ); +}; + +subtest mod_to_file => sub { + local *mod_to_file = $CLASS->can('_mod_to_file') or die "where did _mod_to_file go?"; + is(mod_to_file('Foo::Bar::Baz'), 'Foo/Bar/Baz.pm', "Converted module to filename"); +}; + +subtest load_file => sub { + local *load_file = $CLASS->can('_load_file') or die "where did _load_file go?"; + ok(load_file(['foo', 'foo.pl', 42], 'Data/Dumper.pm'), "Load file pass"); + eval <<" EOT" && die "Ooops, wtf?"; +#line 42 "foo.pl" +require Fake::File::That::Better::Not::Exist::SAGSDGDS; +1; + EOT + my $error = $@; + like($error, qr/locate.*\@INC/ms, "predicted error message is somewhat sane"); + is( + dies { load_file(['foo', 'foo.pl', 42], 'Fake/File/That/Better/Not/Exist/SAGSDGDS.pm') }, + $error, + "Load file fails" + ); +}; + +subtest optimal_import => sub { + { + package Fake::ForOptimal::A; + our @EXPORT = qw/foo &bar $ZAP %ZAP @ZAP/; + sub foo { 'foo' } + sub bar { 'bar' } + } + my $optimal = $CLASS->can('optimal_import'); + + ok($optimal->('Fake::ForOptimal::A', 'FDestA', ['F', 'F.pm', 4], qw/foo/), "Success"); + can_ok('FDestA', 'foo'); + + ok(!$optimal->('Fake::ForOptimal::A', 'FDestA', ['F', 'F.pm', 4], qw/bar @ZAP/), "Failure"); + ok(!'FDestA'->can('bar'), 'Did not export anything'); + + ok(!$optimal->('Fake::ForOptimal::A', 'FDestA', ['F', 'F.pm', 4], qw/bloop/), "Failure, not a valid export"); + + { + package Fake::ForOptimal::B; + our @EXPORT = qw/foo &bar/; + sub foo { 'foo' } + sub bar { 'bar' } + } + ok($optimal->('Fake::ForOptimal::B', 'FDestB', ['F', 'F.pm', 4]), "Success with defaults"); + can_ok('FDestB', 'foo', 'bar'); + + + no warnings 'once'; + *FDestD::foo = sub { 'xyz' }; + like( + warns { $optimal->('Fake::ForOptimal::A', 'FDestD', ['F', 'F.pm', 4], 'foo') }, + qr/Subroutine FDestD::foo redefined(?:, called by F\.pm:4)? at F\.pm line 4/, + "Got redefine warning" + ); + + { + package FDestD; + Importer->unimport; + } + + ok(!FDestD->can('foo'), "Removed 'foo'"); +}; + +subtest get => sub { + is_deeply( + Importer->get(Carp => qw/croak confess/), + { + croak => \&Carp::croak, + confess => \&Carp::confess, + }, + "Exports went into the hash (class)." + ); + + is_deeply( + Importer->new(from => 'Carp')->get(qw/croak confess/), + { + croak => \&Carp::croak, + confess => \&Carp::confess, + }, + "Exports went into the hash (instance)." + ); +}; + +subtest get_list => sub { + is_deeply( + [Importer->get_list(Carp => qw/croak confess/)], + [ \&Carp::croak, \&Carp::confess ], + "list of refs (class)." + ); + + is_deeply( + [Importer->new(from => 'Carp')->get_list(qw/croak confess/)], + [ \&Carp::croak, \&Carp::confess ], + "list of refs (instance)." + ); +}; + +subtest get_one => sub { + is_deeply( + Importer->get_one(Carp => qw/confess/), + \&Carp::confess, + "one ref (class)." + ); + + is_deeply( + Importer->new(from => 'Carp')->get_one(qw/croak/), + \&Carp::croak, + "one ref (instance)." + ); + + is_deeply( + Importer->get_one(Carp => qw/confess croak/), + \&Carp::croak, + "one ref (last)." + ); +}; + +subtest magic => sub { + BEGIN { + $INC{'Magic/Exporter.pm'} = 1; + package Magic::Exporter; + our @EXPORT = qw/foo/; + our %EXPORT_MAGIC = ( foo => sub { $main::MAGIC = [@_] } ); + + sub foo { 1 } + } + + use Importer 'Magic::Exporter' => (foo => { -as => 'foo2' }); + can_ok(__PACKAGE__, 'foo2'); + is_deeply( + $main::MAGIC, + [ + 'Magic::Exporter', + into => __PACKAGE__, + orig_name => 'foo', + new_name => 'foo2', + ref => \&Magic::Exporter::foo, + ], + "Magic callback was called, args as expected" + ); +}; + +done_testing;