commit 5b984b2965271113395d7ae38e198a3847ba66ca Author: denghao Date: Fri Sep 2 08:37:03 2022 +0300 Import Upstream version 0.026 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;