COPYRIGHT000664001750001750 630414343376440 15044 0ustar00taitai000000000000MooseX-XSAccessor-0.010Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: MooseX-XSAccessor Upstream-Contact: Toby Inkster (TOBYINK) Source: https://metacpan.org/release/MooseX-XSAccessor Files: t/moose_accessor_context.t t/moose_accessor_inlining.t t/moose_accessor_override_method.t t/moose_attr_dereference_test.t t/moose_attribute_accessor_generation.t t/moose_attribute_custom_metaclass.t t/moose_attribute_delegation.t t/moose_attribute_does.t t/moose_attribute_inherited_slot_specs.t t/moose_attribute_lazy_initializer.t t/moose_attribute_names.t t/moose_attribute_reader_generation.t t/moose_attribute_required.t t/moose_attribute_traits.t t/moose_attribute_traits_n_meta.t t/moose_attribute_traits_parameterized.t t/moose_attribute_traits_registered.t t/moose_attribute_triggers.t t/moose_attribute_type_unions.t t/moose_attribute_without_any_methods.t t/moose_attribute_writer_generation.t t/moose_bad_coerce.t t/moose_chained_coercion.t t/moose_clone_weak.t t/moose_default_class_role_types.t t/moose_default_undef.t t/moose_delegation_and_modifiers.t t/moose_delegation_arg_aliasing.t t/moose_delegation_target_not_loaded.t t/moose_illegal_options_for_inheritance.t t/moose_inherit_lazy_build.t t/moose_lazy_no_default.t t/moose_method_generation_rules.t t/moose_misc_attribute_tests.t t/moose_more_attr_delegation.t t/moose_no_init_arg.t t/moose_no_slot_access.t t/moose_non_alpha_attr_names.t t/moose_numeric_defaults.t t/moose_trigger_and_coerce.t Copyright: Copyright 2013 Infinity Interactive, Inc. License: GPL-1.0+ or Artistic-1.0 Files: CREDITS Changes LICENSE Makefile.PL README doap.ttl Copyright: Copyright 1970 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/01basic.t t/02accel.t t/03funky.t t/04chained.t t/05lvalue.t Copyright: This software is copyright (c) 2013, 2017 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: dist.ini examples/bench.pl t/lib/MyMoose.pm t/lib/MyMoose/Role.pm Copyright: Copyright 2013 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/06roles.t t/99is_xs.t Copyright: This software is copyright (c) 2022 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: INSTALL t.disabled/moose_misc_attribute_coerce_lazy.t Copyright: Unknown License: Unknown Files: COPYRIGHT SIGNATURE Copyright: None License: public-domain Files: META.json META.yml Copyright: Copyright 2022 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/moose_accessor_overwrite_warning.t Copyright: Copyright 2017 Infinity Interactive, Inc. License: GPL-1.0+ or Artistic-1.0 Files: lib/MooseX/XSAccessor.pm Copyright: This software is copyright (c) 2013, 2017, 2022 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: lib/MooseX/XSAccessor/Trait/Attribute.pm Copyright: This software is copyright (c) 2013, 2022 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 License: Artistic-1.0 This software is Copyright (c) 2022 by the copyright holder(s). This is free software, licensed under: The Artistic License 1.0 License: GPL-1.0 This software is Copyright (c) 2022 by the copyright holder(s). This is free software, licensed under: The GNU General Public License, Version 1, February 1989 CREDITS000664001750001750 26214343376440 14546 0ustar00taitai000000000000MooseX-XSAccessor-0.010Maintainer: - Toby Inkster (TOBYINK) Contributor: - Florian Ragwitz (FLORA) Thanks: - Dagfinn Ilmari MannsÃ¥ker (ILMARI) Changes000664001750001750 452614343376440 15050 0ustar00taitai000000000000MooseX-XSAccessor-0.010MooseX-XSAccessor ================= Created: 2013-06-13 Home page: Bug tracker: Maintainer: Toby Inkster (TOBYINK) 0.010 2022-12-05 [ Test Suite ] - Include tests for the is_xs() function. - Include tests using MooseX::XSAccessor in roles. [ Other ] - Support using MooseX::XSAccessor in roles. 0.009 2018-05-16 [ Test Suite ] - Remove a test which fails on Perl below 5.20. Fixes RT#124835. 0.008 2017-05-01 [ Test Suite ] - Update tests for more recent Moose versions. 0.007 2013-10-30 [ Test Suite ] - Skip the new version of moose_bad_coerce.t if Moose version is too old. 0.006 2013-10-30 [ Test Suite ] - Avoid triggering silly deprecation warnings from MooseX::Attribute::Chained. - Pull latest attribute tests from Moose; the old versions of these test cases broke with Moose 2.11xx. 0.005 2013-08-27 - Added: Integration with MooseX::LvalueAttribute. 0.004 2013-06-17 - Added: Integration with MooseX::Attribute::Chained. Dagfinn Ilmari MannsÃ¥ker++ - Improved `is_xs` implementation. Florian Ragwitz++ 0.003 2013-06-17 [ Documentation ] - Document the circumstances under which predicates and clearers can be acceleated (respectively: if Class::XSAccessor is new enough, and never). [ Packaging ] - Since 0.002 we shouldn't need to skip test `t/moose_default_undef.t` anymore. 0.002 2013-06-16 [ Packaging ] - Support slightly older versions of Class::XSAccessor (back to 1.09). [ Other ] - Don't use Class::XSAccessor 1.16 and below to generate predicate methods, because their behaviour differs observably from Moose. If you want XS predicates, you'll need Class::XSAccessor 1.17 (which is not on CPAN yet). - Refactor overridden install_accessors into an 'after' method modifier, with the hope that this makes MooseX::XSAccessor play nicer with other MooseX modules. 0.001 2013-06-14 Stable release 0.000_02 2013-06-14 [ Bug Fixes ] - Work around some edge cases. [ Documentation ] - Better documentation. [ Packaging ] - Better test cases. [ Other ] - Added: MooseX::XSAccessor::is_xs function. 0.000_01 2013-06-14 Developer release INSTALL000664001750001750 172314343376440 14602 0ustar00taitai000000000000MooseX-XSAccessor-0.010 Installing MooseX-XSAccessor should be straightforward. INSTALLATION WITH CPANMINUS If you have cpanm, you only need one line: % cpanm MooseX::XSAccessor If you are installing into a system-wide directory, you may need to pass the "-S" flag to cpanm, which uses sudo to install the module: % cpanm -S MooseX::XSAccessor INSTALLATION WITH THE CPAN SHELL Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan MooseX::XSAccessor MANUAL INSTALLATION As a last resort, you can manually install it. Download the tarball and unpack it. Consult the file META.json for a list of pre-requisites. Install these first. To build MooseX-XSAccessor: % perl Makefile.PL % make && make test Then install it: % make install If you are installing into a system-wide directory, you may need to run: % sudo make install LICENSE000664001750001750 4365514343376440 14610 0ustar00taitai000000000000MooseX-XSAccessor-0.010This software is copyright (c) 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. 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) 2022 by Toby Inkster. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2022 by Toby Inkster. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End MANIFEST000664001750001750 321614343376440 14701 0ustar00taitai000000000000MooseX-XSAccessor-0.010COPYRIGHT CREDITS Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README SIGNATURE dist.ini doap.ttl examples/bench.pl lib/MooseX/XSAccessor.pm lib/MooseX/XSAccessor/Trait/Attribute.pm t.disabled/moose_misc_attribute_coerce_lazy.t t/01basic.t t/02accel.t t/03funky.t t/04chained.t t/05lvalue.t t/06roles.t t/99is_xs.t t/lib/MyMoose.pm t/lib/MyMoose/Role.pm t/moose_accessor_context.t t/moose_accessor_inlining.t t/moose_accessor_override_method.t t/moose_accessor_overwrite_warning.t t/moose_attr_dereference_test.t t/moose_attribute_accessor_generation.t t/moose_attribute_custom_metaclass.t t/moose_attribute_delegation.t t/moose_attribute_does.t t/moose_attribute_inherited_slot_specs.t t/moose_attribute_lazy_initializer.t t/moose_attribute_names.t t/moose_attribute_reader_generation.t t/moose_attribute_required.t t/moose_attribute_traits.t t/moose_attribute_traits_n_meta.t t/moose_attribute_traits_parameterized.t t/moose_attribute_traits_registered.t t/moose_attribute_triggers.t t/moose_attribute_type_unions.t t/moose_attribute_without_any_methods.t t/moose_attribute_writer_generation.t t/moose_bad_coerce.t t/moose_chained_coercion.t t/moose_clone_weak.t t/moose_default_class_role_types.t t/moose_default_undef.t t/moose_delegation_and_modifiers.t t/moose_delegation_arg_aliasing.t t/moose_delegation_target_not_loaded.t t/moose_illegal_options_for_inheritance.t t/moose_inherit_lazy_build.t t/moose_lazy_no_default.t t/moose_method_generation_rules.t t/moose_misc_attribute_tests.t t/moose_more_attr_delegation.t t/moose_no_init_arg.t t/moose_no_slot_access.t t/moose_non_alpha_attr_names.t t/moose_numeric_defaults.t t/moose_trigger_and_coerce.t META.json000664001750001750 474414343376440 15200 0ustar00taitai000000000000MooseX-XSAccessor-0.010{ "abstract" : "use Class::XSAccessor to speed up Moose accessors", "author" : [ "Toby Inkster (TOBYINK) " ], "dynamic_config" : 0, "generated_by" : "Dist::Inkt::Profile::TOBYINK version 0.024, CPAN::Meta::Converter version 2.150010", "keywords" : [], "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "MooseX-XSAccessor", "no_index" : { "directory" : [ "eg", "examples", "inc", "t", "xt" ] }, "optional_features" : {}, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.17" } }, "runtime" : { "requires" : { "Class::XSAccessor" : "1.09", "Moose" : "2.0600", "perl" : "5.008" }, "suggests" : { "MooseX::Attribute::Chained" : "0", "MooseX::LvalueAttribute" : "0" } }, "test" : { "recommends" : { "MooseX::Attribute::Chained" : "0", "MooseX::FunkyAttributes" : "0", "MooseX::LvalueAttribute" : "0" }, "requires" : { "Import::Into" : "1.001000", "Test::Fatal" : "0", "Test::Moose" : "0", "Test::More" : "0.96", "Test::Requires" : "0" } } }, "provides" : { "MooseX::XSAccessor" : { "file" : "lib/MooseX/XSAccessor.pm", "version" : "0.010" }, "MooseX::XSAccessor::Trait::Attribute" : { "file" : "lib/MooseX/XSAccessor/Trait/Attribute.pm", "version" : "0.010" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/tobyink/p5-moosex-xsaccessor/issues" }, "homepage" : "https://metacpan.org/release/MooseX-XSAccessor", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/tobyink/p5-moosex-xsaccessor.git", "web" : "https://github.com/tobyink/p5-moosex-xsaccessor" }, "x_identifier" : "http://purl.org/NET/cpan-uri/dist/MooseX-XSAccessor/project" }, "version" : "0.010", "x_contributors" : [ "Florian Ragwitz (FLORA) " ], "x_serialization_backend" : "JSON::PP version 4.09", "x_static_install" : 1 } META.yml000664001750001750 256714343376440 15031 0ustar00taitai000000000000MooseX-XSAccessor-0.010--- abstract: 'use Class::XSAccessor to speed up Moose accessors' author: - 'Toby Inkster (TOBYINK) ' build_requires: Import::Into: '1.001000' Test::Fatal: '0' Test::Moose: '0' Test::More: '0.96' Test::Requires: '0' configure_requires: ExtUtils::MakeMaker: '6.17' dynamic_config: 0 generated_by: 'Dist::Inkt::Profile::TOBYINK version 0.024, CPAN::Meta::Converter version 2.150010' keywords: [] license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: MooseX-XSAccessor no_index: directory: - eg - examples - inc - t - xt optional_features: {} provides: MooseX::XSAccessor: file: lib/MooseX/XSAccessor.pm version: '0.010' MooseX::XSAccessor::Trait::Attribute: file: lib/MooseX/XSAccessor/Trait/Attribute.pm version: '0.010' requires: Class::XSAccessor: '1.09' Moose: '2.0600' perl: '5.008' resources: Identifier: http://purl.org/NET/cpan-uri/dist/MooseX-XSAccessor/project bugtracker: https://github.com/tobyink/p5-moosex-xsaccessor/issues homepage: https://metacpan.org/release/MooseX-XSAccessor license: http://dev.perl.org/licenses/ repository: git://github.com/tobyink/p5-moosex-xsaccessor.git version: '0.010' x_contributors: - 'Florian Ragwitz (FLORA) ' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' x_static_install: 1 Makefile.PL000664001750001750 1237114343376440 15544 0ustar00taitai000000000000MooseX-XSAccessor-0.010use strict; use ExtUtils::MakeMaker 6.17; my $EUMM = eval( $ExtUtils::MakeMaker::VERSION ); my $meta = { "abstract" => "use Class::XSAccessor to speed up Moose accessors", "author" => ["Toby Inkster (TOBYINK) "], "dynamic_config" => 0, "generated_by" => "Dist::Inkt::Profile::TOBYINK version 0.024, CPAN::Meta::Converter version 2.150010", "keywords" => [], "license" => ["perl_5"], "meta-spec" => { url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec", version => 2, }, "name" => "MooseX-XSAccessor", "no_index" => { directory => ["eg", "examples", "inc", "t", "xt"] }, "prereqs" => { configure => { requires => { "ExtUtils::MakeMaker" => 6.17 } }, runtime => { requires => { "Class::XSAccessor" => 1.09, "Moose" => "2.0600", "perl" => 5.008 }, suggests => { "MooseX::Attribute::Chained" => 0, "MooseX::LvalueAttribute" => 0 }, }, test => { recommends => { "MooseX::Attribute::Chained" => 0, "MooseX::FunkyAttributes" => 0, "MooseX::LvalueAttribute" => 0, }, requires => { "Import::Into" => "1.001000", "Test::Fatal" => 0, "Test::Moose" => 0, "Test::More" => 0.96, "Test::Requires" => 0, }, }, }, "provides" => { "MooseX::XSAccessor" => { file => "lib/MooseX/XSAccessor.pm", version => "0.010" }, "MooseX::XSAccessor::Trait::Attribute" => { file => "lib/MooseX/XSAccessor/Trait/Attribute.pm", version => "0.010", }, }, "release_status" => "stable", "resources" => { bugtracker => { web => "https://github.com/tobyink/p5-moosex-xsaccessor/issues" }, homepage => "https://metacpan.org/release/MooseX-XSAccessor", license => ["http://dev.perl.org/licenses/"], repository => { type => "git", url => "git://github.com/tobyink/p5-moosex-xsaccessor.git", web => "https://github.com/tobyink/p5-moosex-xsaccessor", }, x_identifier => "http://purl.org/NET/cpan-uri/dist/MooseX-XSAccessor/project", }, "version" => "0.010", "x_contributors" => ["Florian Ragwitz (FLORA) "], "x_static_install" => 1, }; my %dynamic_config; my %WriteMakefileArgs = ( ABSTRACT => $meta->{abstract}, AUTHOR => ($EUMM >= 6.5702 ? $meta->{author} : $meta->{author}[0]), DISTNAME => $meta->{name}, VERSION => $meta->{version}, EXE_FILES => [ map $_->{file}, values %{ $meta->{x_provides_scripts} || {} } ], NAME => do { my $n = $meta->{name}; $n =~ s/-/::/g; $n }, test => { TESTS => "t/*.t" }, %dynamic_config, ); $WriteMakefileArgs{LICENSE} = $meta->{license}[0] if $EUMM >= 6.3001; sub deps { my %r; for my $stage (@_) { for my $dep (keys %{$meta->{prereqs}{$stage}{requires}}) { next if $dep eq 'perl'; my $ver = $meta->{prereqs}{$stage}{requires}{$dep}; $r{$dep} = $ver if !exists($r{$dep}) || $ver >= $r{$dep}; } } \%r; } my ($build_requires, $configure_requires, $runtime_requires, $test_requires); if ($EUMM >= 6.6303) { $WriteMakefileArgs{BUILD_REQUIRES} ||= deps('build'); $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{TEST_REQUIRES} ||= deps('test'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime'); } elsif ($EUMM >= 6.5503) { $WriteMakefileArgs{BUILD_REQUIRES} ||= deps('build', 'test'); $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime'); } elsif ($EUMM >= 6.52) { $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime', 'build', 'test'); } else { $WriteMakefileArgs{PREREQ_PM} ||= deps('configure', 'build', 'test', 'runtime'); } { my ($minperl) = reverse sort( grep defined && /^[0-9]+(\.[0-9]+)?$/, map $meta->{prereqs}{$_}{requires}{perl}, qw( configure build runtime ) ); if (defined($minperl)) { die "Installing $meta->{name} requires Perl >= $minperl" unless $] >= $minperl; $WriteMakefileArgs{MIN_PERL_VERSION} ||= $minperl if $EUMM >= 6.48; } } my $mm = WriteMakefile(%WriteMakefileArgs); exit(0); README000664001750001750 1262214343376440 14451 0ustar00taitai000000000000MooseX-XSAccessor-0.010NAME MooseX::XSAccessor - use Class::XSAccessor to speed up Moose accessors SYNOPSIS package MyClass; use Moose; use MooseX::XSAccessor; has foo => (...); DESCRIPTION This module accelerates Moose-generated accessor, reader, writer and predicate methods using Class::XSAccessor. You get a speed-up for no extra effort. It is automatically applied to every attribute in the class. The use of the following features of Moose attributes prevents a reader from being accelerated: * Lazy builder or lazy default. * Auto-deref. (Does anybody use this anyway??) The use of the following features prevents a writer from being accelerated: * Type constraints (except `Any`; `Any` is effectively a no-op). * Triggers * Weak references An `rw` accessor is effectively a reader and a writer glued together, so both of the above lists apply. Predicates can always be accelerated, provided you're using Class::XSAccessor 1.17 or above. Clearers can not be accelerated (as of current versions of Class::XSAccessor). Functions This module also provides one function, which is not exported so needs to be called by its full name. `MooseX::XSAccessor::is_xs($sub)` Returns a boolean indicating whether a sub is an XSUB. $sub may be a coderef, Class::MOP::Method object, or a qualified sub name as a string (e.g. "MyClass::foo"). This function doesn't just work with accessors, but should be able to detect the difference between Perl and XS subs in general. (It may not be 100% reliable though.) Chained accessors and writers MooseX::XSAccessor can detect chained accessors and writers created using MooseX::Attribute::Chained, and can accelerate those too. package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::Attribute::Chained; has foo => (traits => ["Chained"], is => "rw"); has bar => (traits => ["Chained"], is => "ro", writer => "_set_bar"); has baz => ( is => "rw"); # not chained my $obj = "Local::Class"->new; $obj->foo(1)->_set_bar(2); print $obj->dump; Lvalue accessors MooseX::XSAccessor will detect lvalue accessors created with MooseX::LvalueAttribute and, by default, skip accelerating them. However, by setting $MooseX::XSAccessor::LVALUE to true (preferably using the `local` Perl keyword), you can force it to accelerate those too. This introduces a visible change in behaviour though. MooseX::LvalueAttribute accessors normally allow two patterns for setting the value: $obj->foo = 42; # as an lvalue $obj->foo(42); # as a method call However, once accelerated, they may *only* be set as an lvalue. For this reason, setting $MooseX::XSAccessor::LVALUE to true is considered an experimental feature. HINTS * Make attributes read-only when possible. This means that type constraints and coercions will only apply to the constructor, not the accessors, enabling the accessors to be accelerated. * If you do need a read-write attribute, consider making the main accessor read-only, and having a separate writer method. (Like MooseX::SemiAffordanceAccessor.) * Make defaults eager instead of lazy when possible, allowing your readers to be accelerated. * If you need to accelerate just a specific attribute, apply the attribute trait directly: package MyClass; use Moose; has foo => ( traits => ["MooseX::XSAccessor::Trait::Attribute"], ..., ); * If you don't want to add a dependency on MooseX::XSAccessor, but do want to use it if it's available, the following code will use it optionally: package MyClass; use Moose; BEGIN { eval "use MooseX::XSAccessor" }; has foo => (...); CAVEATS * Calling a writer method without a parameter in Moose does not raise an exception: $person->set_name(); # sets name attribute to "undef" However, this is a fatal error in Class::XSAccessor. * MooseX::XSAccessor does not play nice with attribute traits that alter accessor behaviour, or define additional accessors for attributes. MooseX::SetOnce is an example thereof. MooseX::Attribute::Chained is handled as a special case. * MooseX::XSAccessor only works on blessed hash storage; not e.g. MooseX::ArrayRef or MooseX::InsideOut. MooseX::XSAccessor is usually able to detect such situations and silently switch itself off. BUGS Please report any bugs to . SEE ALSO MooseX::XSAccessor::Trait::Attribute. Moose, Moo, Class::XSAccessor. AUTHOR Toby Inkster . COPYRIGHT AND LICENCE This software is copyright (c) 2013, 2017, 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. SIGNATURE000664001750001750 1576214343376440 15065 0ustar00taitai000000000000MooseX-XSAccessor-0.010This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.87. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: RIPEMD160 SHA256 5a0640e830979da660c6227a91a0e32ed91a571875d48ccafb105a78a8d2687f COPYRIGHT SHA256 f68521d5f7414f191c17943bb440e4ebebeb61e65d46bdceea8d322aadf03bb7 CREDITS SHA256 240ab0a9a1e3a489eefee56784bf7c08cd52cade6cc9a23194b84058abf4ef75 Changes SHA256 23f4df692dae4c3aae2d4f8501ee69e13058dde90d6d5046ae3c8a4cafac18fd INSTALL SHA256 a4f85c6f4d6e8bdd37b7ab08013e3e3bee1fe8e910e20f8f54d5025ffe40f384 LICENSE SHA256 3c5f6782a7ecb1ab87faf1ed1a5088d5359b7697e913a3c08e69c6cabff43c2f MANIFEST SHA256 c00c3e3d550f67057173cd77b312aa2b2966cc85546534eafe0004d16a5de1fc META.json SHA256 5cf9a696249d6c51132e21d628929d0c18c012b1ea8239d2ffe36ff917ca1ad5 META.yml SHA256 74900a2feaade60a4f0d57ceb9646cdabe255f9d5eb1baebb60e686dab50faf5 Makefile.PL SHA256 3eee5bb1d9f81240d5e4c50495d2bf954ad8aa890fe097657f254bc2cb7a96d1 README SHA256 ee0d5d658a1370d88b24e406f06d86b61967eed7334f4078714b6173c38b7a15 dist.ini SHA256 f112ea9e84fff95f5d2fe74a34c85687c878476cf09e26cc2483a994157a4e30 doap.ttl SHA256 c153cd6e43bbda71a89ff1fd9855aa20ba4ebad321e590bae7fd940e7de05fd4 examples/bench.pl SHA256 4492beb0d1194e282aa7a10f5f3b23a5a2446695f59435834c64e750c23aff4d lib/MooseX/XSAccessor.pm SHA256 d20d3c091718ba085ad99e1e4760de86238e990303565df428683d85be40a831 lib/MooseX/XSAccessor/Trait/Attribute.pm SHA256 0152b69e5dabe2d2ae5ff4c8ebe514fdd3423a26f729ef1610af7bb4c47d7e26 t.disabled/moose_misc_attribute_coerce_lazy.t SHA256 66abb6a89887c6227d5572f307b2cadaf6e1abbf4456ef11678350530adba836 t/01basic.t SHA256 4c07cde9d21d4075ade625256b35f175edcbadc16b64a1fa3d8de963c3f36af9 t/02accel.t SHA256 9af1f3c486eff8a35a3bdf9ef89e9804ded3f12ac1d05ef6b3f86d5e75c3fbf3 t/03funky.t SHA256 b49c23e04675c953a13a04ff3134caf3047846b639528e79afd89b264ccad18e t/04chained.t SHA256 fd88cdcb3afd125b221574a9eb4c4fa9c4e752a2ab116d8ba1aa6ca30b831a58 t/05lvalue.t SHA256 08a8e07a144728641d59c685e23eac3b290cb0d459e11c5146fed7f63041aeac t/06roles.t SHA256 ed97882d0d3a269987cf3c3338938bdb43660b545cf872fe912342ac78220e81 t/99is_xs.t SHA256 da4b6e29f2f4d2461e59603e693d5e293b8217b4631ee7a3a8b1e505de649e91 t/lib/MyMoose.pm SHA256 4c66f45cc679f007d7eb9b9e1aa8a081949c6c59032b6b024752a8c0b60870f8 t/lib/MyMoose/Role.pm SHA256 129388e825659134ef8ff373366d75bbbcb2b41fbeb448002073f1d034294c0c t/moose_accessor_context.t SHA256 fe3dac08f11a2f37c0902392560a856b7173bfebb5a7bbfa7e11cb5fff5c64e4 t/moose_accessor_inlining.t SHA256 908cc14d1fc3df9fead62bf776ae9a8864e50d7c3a290ebad37a4dd3bd748351 t/moose_accessor_override_method.t SHA256 6c5acfe96cef3ccb98f183e67bcd08e7c089ddd880214d87ee161a77b9f87486 t/moose_accessor_overwrite_warning.t SHA256 36bda3e12bf7c8ee7db8356960e4db20195404b71a9512b77b2272d28c9d71a6 t/moose_attr_dereference_test.t SHA256 7ac80062a54d2684a36e573a688282f7565192aa9d69919c2bf9e3276d85e49c t/moose_attribute_accessor_generation.t SHA256 2ca01ef591b3bd17323c93adc598373117509412789d2a8ca00cec54c695bfb6 t/moose_attribute_custom_metaclass.t SHA256 06beaf80ee2c128ce1f30972eff0bd4c1b7d8d22577ce6ecd3f60cba73860bb6 t/moose_attribute_delegation.t SHA256 0f3a0784cc055394acc1c5518187ba6123ec3700f810a05d8f7968e47cfdebf2 t/moose_attribute_does.t SHA256 ee1abc90cde9da1db7cfcfaf7d280cf20e3e88b9a7d6283a9a534e7f988f55d6 t/moose_attribute_inherited_slot_specs.t SHA256 120d4ca3a3f490399fb7aa8e818ec7ec0bee283e5c7341b3a1c1f7cf897e8e7f t/moose_attribute_lazy_initializer.t SHA256 393e8f77fbfc804a441a9a5bb14f2b971468c01d2d5d360d65815b4eb89fddd2 t/moose_attribute_names.t SHA256 3ac9e47104723a07e1cef9344723758c9d8e2fddbb6d063c7ccc4ff670bdb12c t/moose_attribute_reader_generation.t SHA256 8ac95879a2a1864b2ae846245e53576fcc71825794712e4096aeb796f1272399 t/moose_attribute_required.t SHA256 8bf3f9e41de2ec90469b93d84aa9d6c7630691f5bde43fa4fdcc2bc8387d5786 t/moose_attribute_traits.t SHA256 fe739e718ec3b932eb7e97c714c21c6081590ebe311f42dde65b4c7a26102019 t/moose_attribute_traits_n_meta.t SHA256 22514e2c79960ab41ca947a006cbab50a069c81cd5d6ab082e4536b5a3665050 t/moose_attribute_traits_parameterized.t SHA256 893f586cd880485838249d101d8a28e82a0ce87ed68a14b262ed6f821cffcb11 t/moose_attribute_traits_registered.t SHA256 769be8867b234c3a21680e5236a2d857e833a1c839a3e2b20885a4cb899c8af0 t/moose_attribute_triggers.t SHA256 3f9e66db18e0035600f82ca15444f33a4141d89771ba0a3c17fbd97d8a77e8f4 t/moose_attribute_type_unions.t SHA256 a8e1acf7291e8a40c003923197fd4a22c57f8abc510a480f38ea55b58b1f907e t/moose_attribute_without_any_methods.t SHA256 e9df543b47257e317ce070372727b1b5bdf6b187be485872fafade695e6061c2 t/moose_attribute_writer_generation.t SHA256 4a69aae57983d08e1218bd6643e3e17c0bbe85353ad7e1d891256eb3c5137cc4 t/moose_bad_coerce.t SHA256 e8304f0bf5d3bb76d477e0e9495ac89757fd81ea182b48dbc6b667d58889e26b t/moose_chained_coercion.t SHA256 cdcb9e7859190d6e876c672c5cdcc879f7112dccea2c71e64a518a478584e1af t/moose_clone_weak.t SHA256 d91734c03817c580afc1461c24da69f786fcef651882312c028610c432b66bf1 t/moose_default_class_role_types.t SHA256 b7b4ebaf5c8b5d052df3a2d3020686deaa5a3b48bc72ac321f3e9d380f93dbef t/moose_default_undef.t SHA256 858725ccfc896c7728dfbd91279989f4785eed2aef994ec7ec731734658bc604 t/moose_delegation_and_modifiers.t SHA256 6ff2419d70a0dcede69679d87f85f2c83658865f7fd839b4449365c6f00a73cc t/moose_delegation_arg_aliasing.t SHA256 06c64e29163790339bb44fe32bc5ce772420da040b3a74365b5e6fe25fda9f5d t/moose_delegation_target_not_loaded.t SHA256 255ab44b6379a847d93bf5362545211f2920fe5758363064d5353df5fdaf418d t/moose_illegal_options_for_inheritance.t SHA256 d83eade3ffbc64806ad26b255924f00ed9e8ec4ac8bd73e5c75edeb49e962ad7 t/moose_inherit_lazy_build.t SHA256 a1430c347c9e8bcd6845b50d4681b50413c33cfdb3c616608f7c9ee4446be369 t/moose_lazy_no_default.t SHA256 6762f69ac4a8b9ed18d927f501017694ca949a65c899d71d9c630c9699305035 t/moose_method_generation_rules.t SHA256 f0aa11bd20c3d91f7884ce4012472c98d871d764a2c9a93e4bda549491275733 t/moose_misc_attribute_tests.t SHA256 db52ec8b3fc72ff8bf9980b32dd32399e577dc2ba0e0da553a73ec87ed859a31 t/moose_more_attr_delegation.t SHA256 57676790c604bf0255116b38b5ff2d8c07211147c1a7063465f5e5f1e26cd6b1 t/moose_no_init_arg.t SHA256 9c04b03981dea8f764152ed799c7a06097cae67843cc5efa49aef10e4eb6679a t/moose_no_slot_access.t SHA256 05bcef09826f118d708ac410c67c00c450143ffead4ba8e3329404f87265acda t/moose_non_alpha_attr_names.t SHA256 117aed0707bf582f5c4c0ad6621b6477091874df5442e239636656900e553569 t/moose_numeric_defaults.t SHA256 ed5943d41f64b4661756f58532fc236cbbb81c797ec86627687e06478cda56d0 t/moose_trigger_and_coerce.t -----BEGIN PGP SIGNATURE----- iF0EAREDAB0WIQRVJKj/4+s6z4WzNujOv4Eoaip9OQUCY439IAAKCRDOv4Eoaip9 ObBRAJ9UdgvmSW4NrtFIULP/tlP+etqOeQCgh0gJ7qd8ApHgyP9JxczZw7iHoXI= =aTYe -----END PGP SIGNATURE----- dist.ini000664001750001750 10314343376440 15164 0ustar00taitai000000000000MooseX-XSAccessor-0.010;;class='Dist::Inkt::Profile::TOBYINK' ;;name='MooseX-XSAccessor' doap.ttl000664001750001750 6771014343376440 15251 0ustar00taitai000000000000MooseX-XSAccessor-0.010@prefix cpan-uri: . @prefix dc: . @prefix doap: . @prefix doap-bugs: . @prefix doap-changeset: . @prefix doap-deps: . @prefix foaf: . @prefix nfo: . @prefix rdfs: . @prefix xsd: . a foaf:Organization; foaf:name "Infinity Interactive, Inc". dc:title "the same terms as the perl 5 programming language system itself". a doap:Project; dc:contributor ; doap-deps:runtime-requirement [ doap-deps:on "perl 5.008"^^doap-deps:CpanId ], [ doap-deps:on "Class::XSAccessor 1.09"^^doap-deps:CpanId; ], [ doap-deps:on "Moose 2.0600"^^doap-deps:CpanId ]; doap-deps:runtime-suggestion [ doap-deps:on "MooseX::Attribute::Chained"^^doap-deps:CpanId; ], [ doap-deps:on "MooseX::LvalueAttribute"^^doap-deps:CpanId; ]; doap-deps:test-recommendation [ doap-deps:on "MooseX::Attribute::Chained"^^doap-deps:CpanId; ], [ doap-deps:on "MooseX::LvalueAttribute"^^doap-deps:CpanId; ], [ doap-deps:on "MooseX::FunkyAttributes"^^doap-deps:CpanId; ]; doap-deps:test-requirement [ doap-deps:on "Import::Into 1.001000"^^doap-deps:CpanId; ], [ doap-deps:on "Test::More 0.96"^^doap-deps:CpanId ], [ doap-deps:on "Test::Fatal"^^doap-deps:CpanId ], [ doap-deps:on "Test::Moose"^^doap-deps:CpanId ], [ doap-deps:on "Test::Requires"^^doap-deps:CpanId ]; doap:bug-database ; doap:created "2013-06-13"^^xsd:date; doap:developer ; doap:download-page ; doap:homepage ; doap:license ; doap:maintainer ; doap:name "MooseX-XSAccessor"; doap:programming-language "Perl"; doap:release , , , , , , , , , , , ; doap:repository [ a doap:GitRepository; doap:browse ; ]; doap:shortdesc "use Class::XSAccessor to speed up Moose accessors". a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Developer release"; dc:identifier "MooseX-XSAccessor-0.000_01"^^xsd:string; dc:issued "2013-06-14"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "MooseX-XSAccessor-0.000_02"^^xsd:string; dc:issued "2013-06-14"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "MooseX::XSAccessor::is_xs function."; ], [ a doap-changeset:Packaging; rdfs:label "Better test cases."; ], [ a doap-changeset:Documentation; rdfs:label "Better documentation."; ], [ a doap-changeset:Bugfix; rdfs:label "Work around some edge cases."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_02"^^xsd:string. a doap:Version; rdfs:label "Stable release"; dc:identifier "MooseX-XSAccessor-0.001"^^xsd:string; dc:issued "2013-06-14"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.001"^^xsd:string; rdfs:comment "No functional changes since 0.000_02.". a doap:Version; dc:identifier "MooseX-XSAccessor-0.002"^^xsd:string; dc:issued "2013-06-16"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Refactor overridden install_accessors into an 'after' method modifier, with the hope that this makes MooseX::XSAccessor play nicer with other MooseX modules."; ], [ a doap-changeset:Packaging; rdfs:label "Support slightly older versions of Class::XSAccessor (back to 1.09)."; ], [ a doap-changeset:Change; rdfs:label "Don't use Class::XSAccessor 1.16 and below to generate predicate methods, because their behaviour differs observably from Moose. If you want XS predicates, you'll need Class::XSAccessor 1.17 (which is not on CPAN yet)."; rdfs:seeAlso ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.002"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.003"^^xsd:string; dc:issued "2013-06-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Document the circumstances under which predicates and clearers can be acceleated (respectively: if Class::XSAccessor is new enough, and never)."; ], [ a doap-changeset:Packaging; rdfs:label "Since 0.002 we shouldn't need to skip test `t/moose_default_undef.t` anymore."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.004"^^xsd:string; dc:issued "2013-06-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Integration with MooseX::Attribute::Chained."; doap-changeset:thanks ; rdfs:comment "This was ILMARI's idea."; ], [ rdfs:label "Improved `is_xs` implementation."; doap-changeset:blame ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.004"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.005"^^xsd:string; dc:issued "2013-08-27"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Integration with MooseX::LvalueAttribute."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.006"^^xsd:string; dc:issued "2013-10-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Avoid triggering silly deprecation warnings from MooseX::Attribute::Chained."; ], [ a doap-changeset:Tests; rdfs:label "Pull latest attribute tests from Moose; the old versions of these test cases broke with Moose 2.11xx."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.006"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.007"^^xsd:string; dc:issued "2013-10-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Skip the new version of moose_bad_coerce.t if Moose version is too old."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.008"^^xsd:string; dc:issued "2017-05-01"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Update tests for more recent Moose versions."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.008"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.009"^^xsd:string; dc:issued "2018-05-16"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Remove a test which fails on Perl below 5.20."; doap-changeset:fixes ; rdfs:comment "It's a hard to track down syntax error and doesn't impact the module's functionality. If anyone knows how to fix it, I'll add it back."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.009"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.010"^^xsd:string; dc:issued "2022-12-05"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Support using MooseX::XSAccessor in roles."; ], [ a doap-changeset:Tests; rdfs:label "Include tests for the is_xs() function."; ], [ a doap-changeset:Tests; rdfs:label "Include tests using MooseX::XSAccessor in roles."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.010"^^xsd:string. a foaf:Person; foaf:name "Florian Ragwitz"; foaf:nick "FLORA"; foaf:page . a foaf:Person; foaf:name "Dagfinn Ilmari Mannsåker"; foaf:nick "ILMARI"; foaf:page . a foaf:Person; foaf:name "Ingy döt Net"; foaf:nick "INGY"; foaf:page . a foaf:Person; foaf:mbox ; foaf:name "Toby Inkster"; foaf:nick "TOBYINK"; foaf:page . a doap-bugs:Issue; doap-bugs:id "124835"^^xsd:string; doap-bugs:page . a doap-bugs:Issue; doap-bugs:id "86127"^^xsd:string; doap-bugs:page . [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "CONTRIBUTING". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "CREDITS". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "Changes". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "LICENSE". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "doap.ttl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "Makefile.PL"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "README". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/bench.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/changes.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/doap.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/makefile.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/people.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/rights.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "MANIFEST.SKIP". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/lib/MyMoose.pm"; nfo:programmingLanguage "Perl"; rdfs:comment "Shim for loading Moose and MooseX::XSAccessor simultaneously.". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/lib/MyMoose/Role.pm"; nfo:programmingLanguage "Perl"; rdfs:comment "Shim for loading Moose::Role and MooseX::XSAccessor simultaneously.". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_accessor_context.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_accessor_inlining.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_accessor_override_method.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_accessor_overwrite_warning.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attr_dereference_test.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_accessor_generation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_custom_metaclass.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_delegation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_does.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_inherited_slot_specs.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_lazy_initializer.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_names.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_reader_generation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_required.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_traits_n_meta.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_traits_parameterized.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_traits_registered.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_traits.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_triggers.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_type_unions.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_without_any_methods.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_writer_generation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_bad_coerce.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_chained_coercion.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_clone_weak.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_default_class_role_types.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_default_undef.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_delegation_and_modifiers.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_delegation_arg_aliasing.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_delegation_target_not_loaded.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_illegal_options_for_inheritance.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_inherit_lazy_build.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_lazy_no_default.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_method_generation_rules.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_misc_attribute_coerce_lazy.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_misc_attribute_tests.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_more_attr_delegation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_no_init_arg.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_non_alpha_attr_names.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_no_slot_access.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_numeric_defaults.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_trigger_and_coerce.t". bench.pl000664001750001750 102014343376440 16771 0ustar00taitai000000000000MooseX-XSAccessor-0.010/examplesuse strict; use warnings; use Benchmark qw(cmpthese); { package Fast; use Moose; use MooseX::XSAccessor; has attr => (is => "rw", isa => "Any"); __PACKAGE__->meta->make_immutable; } { package Slow; use Moose; has attr => (is => "rw", isa => "Any"); __PACKAGE__->meta->make_immutable; } our $Fast = "Fast"->new(attr => 42); our $Slow = "Slow"->new(attr => 42); cmpthese(-1, { Fast => '$::Fast->attr', Slow => '$::Slow->attr', }); __END__ Rate Slow Fast Slow 504123/s -- -66% Fast 1487682/s 195% -- 01basic.t000664001750001750 76014343376440 15403 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor compiles. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; ok eval q{ package Foo; use Moose; use MooseX::XSAccessor; 1; }; done_testing; 02accel.t000664001750001750 302014343376440 15402 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor accelerates particular methods with XS. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Moose; { package Local::Class; use Moose; BEGIN { eval "use MooseX::XSAccessor" }; has thingy => (is => "rw", isa => "Any", predicate => "has_thingy"); has number => (is => "rw", isa => "Num", predicate => "has_number"); has numero => (is => "ro", isa => "Num", predicate => "has_numero"); has semi => (is => "ro", isa => "Str", predicate => "has_semi", writer => "set_semi"); has trig => (reader => "get_trig", writer => "set_trig", trigger => sub { 1 }); } my @expected_xsub = qw/ thingy numero semi get_trig /; my @expected_pp = qw/ new number set_semi set_trig /; my @maybe_xsub = qw/ has_thingy has_number has_numero has_semi /; push @{ (Class::XSAccessor->VERSION > 1.16) ? \@expected_xsub : \@expected_pp }, @maybe_xsub; with_immutable { my $im = "Local::Class"->meta->is_immutable ? "immutable" : "mutable"; ok( MooseX::XSAccessor::is_xs("Local::Class"->can($_)), "$_ is an XSUB ($im class)", ) for @expected_xsub; ok( !MooseX::XSAccessor::is_xs("Local::Class"->can($_)), "$_ is pure Perl ($im class)", ) for @expected_pp; } qw(Local::Class); done_testing; 03funky.t000664001750001750 233514343376440 15500 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor works OK with MooseX::FunkyAttributes. =head1 DEPENDENCIES MooseX::FunkyAttributes 0.002; test skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::FunkyAttributes" => "0.002" }; { package Local::Storage; use Moose; use MooseX::XSAccessor; has slot => (is => "rw"); } { package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::FunkyAttributes; has storage => ( is => "ro", default => sub { "Local::Storage"->new }, ); has delegated => ( is => "rw", traits => [ DelegatedAttribute ], delegated_to => "storage", delegated_accessor => "slot", ); } my $o = "Local::Class"->new; $o->delegated(42); is_deeply( $o, bless( { storage => bless( { slot => 42, }, "Local::Storage", ), }, "Local::Class", ), ); done_testing; 04chained.t000664001750001750 271514343376440 15742 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor works OK with L. =head1 DEPENDENCIES MooseX::Attribute::Chained; test skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::Attribute::Chained" => "0" }; { package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::Attribute::Chained; my $Chained = ['MooseX::Traits::Attribute::Chained']; has foo => (is => "rw", traits => $Chained); has bar => (is => "ro", traits => $Chained, writer => "_set_bar"); has baz => (is => "rw"); sub quux { 42 }; } my $o = "Local::Class"->new(foo => 1, bar => 2); ok($o->meta->get_attribute('foo')->does('MooseX::XSAccessor::Trait::Attribute')); ok($o->meta->get_attribute('foo')->does('MooseX::Traits::Attribute::Chained')); is($o->foo(3)->quux, 42, 'accessor can be chained'); is($o->foo, 3, 'chaining set new value'); is($o->_set_bar(4)->quux, 42, 'writer can be chained'); is($o->bar, 4, 'chaining set new value'); is($o->baz(5), 5, 'non-chained accessor in a chained world'); ok( MooseX::XSAccessor::is_xs(Local::Class->can($_)), "$_ is XSUB" ) for qw(foo bar baz _set_bar); done_testing; 05lvalue.t000664001750001750 262514343376440 15640 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor works OK with L. =head1 DEPENDENCIES MooseX::Attribute::Chained; test skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013, 2017 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::LvalueAttribute" => "0.980" }; { package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::LvalueAttribute; local $MooseX::XSAccessor::LVALUE = 1; has foo => (traits => ["Lvalue"], is => "rw"); has bar => ( is => "rw"); sub quux { 42 }; } my $o = "Local::Class"->new(foo => 1, bar => 2); ok($o->meta->get_attribute('foo')->does('MooseX::XSAccessor::Trait::Attribute')); ok($o->meta->get_attribute('foo')->does('MooseX::LvalueAttribute::Trait::Attribute')); ok($o->meta->get_attribute('bar')->does('MooseX::XSAccessor::Trait::Attribute')); ok(not $o->meta->get_attribute('bar')->does('MooseX::LvalueAttribute::Trait::Attribute')); is($o->foo, 1); is($o->bar, 2); $o->foo++; $o->bar($o->bar + 1); is($o->foo, 2); is($o->bar, 3); ok( MooseX::XSAccessor::is_xs(Local::Class->can($_)), "$_ is XSUB" ) for qw(foo bar); done_testing; 06roles.t000664001750001750 174614343376440 15500 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor accelerates role attributes. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Moose; { package Local::Role; use Moose::Role; BEGIN { eval "use MooseX::XSAccessor" }; has my_str => (is => "ro", isa => "Str"); } { package Local::Class; use Moose; BEGIN { eval "use MooseX::XSAccessor" }; with 'Local::Role'; has my_num => (is => "ro", isa => "Int"); } my @expected_xsub = qw( my_str my_num ); with_immutable { my $im = "Local::Class"->meta->is_immutable ? "immutable" : "mutable"; ok( MooseX::XSAccessor::is_xs("Local::Class"->can($_)), "$_ is an XSUB ($im class)", ) for @expected_xsub; } qw(Local::Class); done_testing; 99is_xs.t000664001750001750 143414343376440 15507 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t=pod =encoding utf-8 =head1 PURPOSE Test different ways of calling C<< MooseX::XSAccessor::is_xs() >>. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; { package Local::Class; use Moose; BEGIN { eval "use MooseX::XSAccessor" }; has my_num => (is => "ro", isa => "Int"); __PACKAGE__->meta->make_immutable; } ok MooseX::XSAccessor::is_xs( Local::Class->meta->get_method("my_num") ); ok MooseX::XSAccessor::is_xs( \&Local::Class::my_num ); ok MooseX::XSAccessor::is_xs( "Local::Class::my_num" ); done_testing; moose_accessor_context.t000664001750001750 365614343376440 20760 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; is( exception { package My::Class; use MyMoose; has s_rw => ( is => 'rw', ); has s_ro => ( is => 'ro', ); has a_rw => ( is => 'rw', isa => 'ArrayRef', auto_deref => 1, ); has a_ro => ( is => 'ro', isa => 'ArrayRef', auto_deref => 1, ); has h_rw => ( is => 'rw', isa => 'HashRef', auto_deref => 1, ); has h_ro => ( is => 'ro', isa => 'HashRef', auto_deref => 1, ); }, undef, 'class definition' ); is( exception { my $o = My::Class->new(); is_deeply [scalar $o->s_rw], [undef], 'uninitialized scalar attribute/rw in scalar context'; is_deeply [$o->s_rw], [undef], 'uninitialized scalar attribute/rw in list context'; is_deeply [scalar $o->s_ro], [undef], 'uninitialized scalar attribute/ro in scalar context'; is_deeply [$o->s_ro], [undef], 'uninitialized scalar attribute/ro in list context'; is_deeply [scalar $o->a_rw], [undef], 'uninitialized ArrayRef attribute/rw in scalar context'; is_deeply [$o->a_rw], [], 'uninitialized ArrayRef attribute/rw in list context'; is_deeply [scalar $o->a_ro], [undef], 'uninitialized ArrayRef attribute/ro in scalar context'; is_deeply [$o->a_ro], [], 'uninitialized ArrayRef attribute/ro in list context'; is_deeply [scalar $o->h_rw], [undef], 'uninitialized HashRef attribute/rw in scalar context'; is_deeply [$o->h_rw], [], 'uninitialized HashRef attribute/rw in list context'; is_deeply [scalar $o->h_ro], [undef], 'uninitialized HashRef attribute/ro in scalar context'; is_deeply [$o->h_ro], [], 'uninitialized HashRef attribute/ro in list context'; }, undef, 'testing' ); done_testing; moose_accessor_inlining.t000664001750001750 116114343376440 21070 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; my $called; { package Foo::Meta::Instance; use MyMoose::Role; sub is_inlinable { 0 } after get_slot_value => sub { $called++ }; } { package Foo; use MyMoose; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { instance => ['Foo::Meta::Instance'], }, ); has foo => (is => 'ro'); } my $foo = Foo->new(foo => 1); is($foo->foo, 1, "got the right value"); is($called, 1, "reader was called"); done_testing; moose_accessor_override_method.t000664001750001750 341614343376440 22445 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Requires { 'Test::Output' => '0.01', # skip all if not installed }; { package Foo; use MyMoose; sub get_a { } sub set_b { } sub has_c { } sub clear_d { } sub e { } sub stub; } my $foo_meta = Foo->meta; stderr_like( sub { $foo_meta->add_attribute( a => ( reader => 'get_a' ) ) }, qr/^You are overwriting a locally defined method \(get_a\) with an accessor/, 'reader overriding gives proper warning' ); stderr_like( sub { $foo_meta->add_attribute( b => ( writer => 'set_b' ) ) }, qr/^You are overwriting a locally defined method \(set_b\) with an accessor/, 'writer overriding gives proper warning' ); stderr_like( sub { $foo_meta->add_attribute( c => ( predicate => 'has_c' ) ) }, qr/^You are overwriting a locally defined method \(has_c\) with an accessor/, 'predicate overriding gives proper warning' ); stderr_like( sub { $foo_meta->add_attribute( d => ( clearer => 'clear_d' ) ) }, qr/^You are overwriting a locally defined method \(clear_d\) with an accessor/, 'clearer overriding gives proper warning' ); stderr_like( sub { $foo_meta->add_attribute( e => ( is => 'rw' ) ) }, qr/^You are overwriting a locally defined method \(e\) with an accessor/, 'accessor overriding gives proper warning' ); stderr_is( sub { $foo_meta->add_attribute( stub => ( is => 'rw' ) ) }, q{}, 'overriding a stub with an accessor does not warn' ); stderr_like( sub { $foo_meta->add_attribute( has => ( is => 'rw' ) ) }, qr/^You are overwriting a locally defined function \(has\) with an accessor/, 'function overriding gives proper warning' ); done_testing; moose_accessor_overwrite_warning.t000664001750001750 77314343376440 23024 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Requires { 'Test::Output' => '0.01', }; { package Bar; use MyMoose; has has_attr => ( is => 'ro', ); ::stderr_like{ has attr => ( is => 'ro', predicate => 'has_attr', ) } qr/\QYou are overwriting/, 'overwriting an accessor for another attribute causes a warning'; } done_testing; moose_attr_dereference_test.t000664001750001750 313214343376440 21737 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Customer; use MyMoose; package Firm; use MyMoose; use Moose::Util::TypeConstraints; ::is( ::exception { has 'customers' => ( is => 'ro', isa => subtype('ArrayRef' => where { (blessed($_) && $_->isa('Customer') || return) for @$_; 1 }), auto_deref => 1, ); }, undef, '... successfully created attr' ); } { my $customer = Customer->new; isa_ok($customer, 'Customer'); my $firm = Firm->new(customers => [ $customer ]); isa_ok($firm, 'Firm'); can_ok($firm, 'customers'); is_deeply( [ $firm->customers ], [ $customer ], '... got the right dereferenced value' ); } { my $firm = Firm->new(); isa_ok($firm, 'Firm'); can_ok($firm, 'customers'); is_deeply( [ $firm->customers ], [], '... got the right dereferenced value' ); } { package AutoDeref; use MyMoose; has 'bar' => ( is => 'rw', isa => 'ArrayRef[Int]', auto_deref => 1, ); } { my $autoderef = AutoDeref->new; isnt( exception { $autoderef->bar(1, 2, 3); }, undef, '... its auto-de-ref-ing, not auto-en-ref-ing' ); is( exception { $autoderef->bar([ 1, 2, 3 ]) }, undef, '... set the results of bar correctly' ); is_deeply [ $autoderef->bar ], [ 1, 2, 3 ], '... auto-dereffed correctly'; } done_testing; moose_attribute_accessor_generation.t000664001750001750 1307114343376440 23522 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Scalar::Util 'isweak'; { package Foo; use MyMoose; eval { has 'foo' => ( accessor => 'foo', ); }; ::ok(!$@, '... created the accessor method okay'); eval { has 'lazy_foo' => ( accessor => 'lazy_foo', lazy => 1, default => sub { 10 } ); }; ::ok(!$@, '... created the lazy accessor method okay'); eval { has 'foo_required' => ( accessor => 'foo_required', required => 1, ); }; ::ok(!$@, '... created the required accessor method okay'); eval { has 'foo_int' => ( accessor => 'foo_int', isa => 'Int', ); }; ::ok(!$@, '... created the accessor method with type constraint okay'); eval { has 'foo_weak' => ( accessor => 'foo_weak', weak_ref => 1 ); }; ::ok(!$@, '... created the accessor method with weak_ref okay'); eval { has 'foo_deref' => ( accessor => 'foo_deref', isa => 'ArrayRef', auto_deref => 1, ); }; ::ok(!$@, '... created the accessor method with auto_deref okay'); eval { has 'foo_deref_ro' => ( reader => 'foo_deref_ro', isa => 'ArrayRef', auto_deref => 1, ); }; ::ok(!$@, '... created the reader method with auto_deref okay'); eval { has 'foo_deref_hash' => ( accessor => 'foo_deref_hash', isa => 'HashRef', auto_deref => 1, ); }; ::ok(!$@, '... created the reader method with auto_deref okay'); } { my $foo = Foo->new(foo_required => 'required'); isa_ok($foo, 'Foo'); # regular accessor can_ok($foo, 'foo'); is($foo->foo(), undef, '... got an unset value'); is( exception { $foo->foo(100); }, undef, '... foo wrote successfully' ); is($foo->foo(), 100, '... got the correct set value'); ok(!isweak($foo->{foo}), '... it is not a weak reference'); # required writer isnt( exception { Foo->new; }, undef, '... cannot create without the required attribute' ); can_ok($foo, 'foo_required'); is($foo->foo_required(), 'required', '... got an unset value'); is( exception { $foo->foo_required(100); }, undef, '... foo_required wrote successfully' ); is($foo->foo_required(), 100, '... got the correct set value'); is( exception { $foo->foo_required(undef); }, undef, '... foo_required did not die with undef' ); is($foo->foo_required, undef, "value is undef"); ok(!isweak($foo->{foo_required}), '... it is not a weak reference'); # lazy ok(!exists($foo->{lazy_foo}), '... no value in lazy_foo slot'); can_ok($foo, 'lazy_foo'); is($foo->lazy_foo(), 10, '... got an deferred value'); # with type constraint can_ok($foo, 'foo_int'); is($foo->foo_int(), undef, '... got an unset value'); is( exception { $foo->foo_int(100); }, undef, '... foo_int wrote successfully' ); is($foo->foo_int(), 100, '... got the correct set value'); isnt( exception { $foo->foo_int("Foo"); }, undef, '... foo_int died successfully' ); ok(!isweak($foo->{foo_int}), '... it is not a weak reference'); # with weak_ref my $test = []; can_ok($foo, 'foo_weak'); is($foo->foo_weak(), undef, '... got an unset value'); is( exception { $foo->foo_weak($test); }, undef, '... foo_weak wrote successfully' ); is($foo->foo_weak(), $test, '... got the correct set value'); ok(isweak($foo->{foo_weak}), '... it is a weak reference'); can_ok( $foo, 'foo_deref'); is_deeply( [$foo->foo_deref()], [], '... default default value'); my @list; is( exception { @list = $foo->foo_deref(); }, undef, "... doesn't deref undef value" ); is_deeply( \@list, [], "returns empty list in list context"); is( exception { $foo->foo_deref( [ qw/foo bar gorch/ ] ); }, undef, '... foo_deref wrote successfully' ); is( Scalar::Util::reftype( scalar $foo->foo_deref() ), "ARRAY", "returns an array reference in scalar context" ); is_deeply( scalar($foo->foo_deref()), [ qw/foo bar gorch/ ], "correct array" ); is( scalar( () = $foo->foo_deref() ), 3, "returns list in list context" ); is_deeply( [ $foo->foo_deref() ], [ qw/foo bar gorch/ ], "correct list" ); can_ok( $foo, 'foo_deref' ); is_deeply( [$foo->foo_deref_ro()], [], "... default default value" ); isnt( exception { $foo->foo_deref_ro( [] ); }, undef, "... read only" ); $foo->{foo_deref_ro} = [qw/la la la/]; is_deeply( scalar($foo->foo_deref_ro()), [qw/la la la/], "scalar context ro" ); is_deeply( [ $foo->foo_deref_ro() ], [qw/la la la/], "list context ro" ); can_ok( $foo, 'foo_deref_hash' ); is_deeply( { $foo->foo_deref_hash() }, {}, "... default default value" ); my %hash; is( exception { %hash = $foo->foo_deref_hash(); }, undef, "... doesn't deref undef value" ); is_deeply( \%hash, {}, "returns empty list in list context"); is( exception { $foo->foo_deref_hash( { foo => 1, bar => 2 } ); }, undef, '... foo_deref_hash wrote successfully' ); is_deeply( scalar($foo->foo_deref_hash), { foo => 1, bar => 2 }, "scalar context" ); %hash = $foo->foo_deref_hash; is_deeply( \%hash, { foo => 1, bar => 2 }, "list context"); } done_testing; moose_attribute_custom_metaclass.t000664001750001750 473514343376440 23042 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo::Meta::Attribute; use MyMoose; extends 'Moose::Meta::Attribute'; around 'new' => sub { my $next = shift; my $self = shift; my $name = shift; $next->($self, $name, (is => 'rw', isa => 'Foo'), @_); }; package Foo; use MyMoose; has 'foo' => (metaclass => 'Foo::Meta::Attribute'); } { my $foo = Foo->new; isa_ok($foo, 'Foo'); my $foo_attr = Foo->meta->get_attribute('foo'); isa_ok($foo_attr, 'Foo::Meta::Attribute'); isa_ok($foo_attr, 'Moose::Meta::Attribute'); is($foo_attr->name, 'foo', '... got the right name for our meta-attribute'); ok($foo_attr->has_accessor, '... our meta-attrubute created the accessor for us'); ok($foo_attr->has_type_constraint, '... our meta-attrubute created the type_constraint for us'); my $foo_attr_type_constraint = $foo_attr->type_constraint; isa_ok($foo_attr_type_constraint, 'Moose::Meta::TypeConstraint'); is($foo_attr_type_constraint->name, 'Foo', '... got the right type constraint name'); is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type constraint parent name'); } { package Bar::Meta::Attribute; use MyMoose; extends 'Class::MOP::Attribute'; package Bar; use MyMoose; ::is( ::exception { has 'bar' => (metaclass => 'Bar::Meta::Attribute'); }, undef, '... the attribute metaclass need not be a Moose::Meta::Attribute as long as it behaves' ); } { package Moose::Meta::Attribute::Custom::Foo; sub register_implementation { 'Foo::Meta::Attribute' } package Moose::Meta::Attribute::Custom::Bar; use MyMoose; extends 'Moose::Meta::Attribute'; package Another::Foo; use MyMoose; ::is( ::exception { has 'foo' => (metaclass => 'Foo'); }, undef, '... the attribute metaclass alias worked correctly' ); ::is( ::exception { has 'bar' => (metaclass => 'Bar', is => 'bare'); }, undef, '... the attribute metaclass alias worked correctly' ); } { my $foo_attr = Another::Foo->meta->get_attribute('foo'); isa_ok($foo_attr, 'Foo::Meta::Attribute'); isa_ok($foo_attr, 'Moose::Meta::Attribute'); my $bar_attr = Another::Foo->meta->get_attribute('bar'); isa_ok($bar_attr, 'Moose::Meta::Attribute::Custom::Bar'); isa_ok($bar_attr, 'Moose::Meta::Attribute'); } done_testing; moose_attribute_delegation.t000664001750001750 3055314343376440 21624 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; # ------------------------------------------------------------------- # HASH handles # ------------------------------------------------------------------- # the canonical form of of the 'handles' # option is the hash ref mapping a # method name to the delegated method name { package Foo; use MyMoose; has 'bar' => (is => 'rw', default => 10); sub baz { 42 } package Bar; use MyMoose; has 'foo' => ( is => 'rw', default => sub { Foo->new }, handles => { 'foo_bar' => 'bar', foo_baz => 'baz', 'foo_bar_to_20' => [ bar => 20 ], }, ); } my $bar = Bar->new; isa_ok($bar, 'Bar'); ok($bar->foo, '... we have something in bar->foo'); isa_ok($bar->foo, 'Foo'); my $meth = Bar->meta->get_method('foo_bar'); isa_ok($meth, 'Moose::Meta::Method::Delegation'); is($meth->associated_attribute->name, 'foo', 'associated_attribute->name for this method is foo'); is($bar->foo->bar, 10, '... bar->foo->bar returned the right default'); can_ok($bar, 'foo_bar'); is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly'); # change the value ... $bar->foo->bar(30); # and make sure the delegation picks it up is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value'); is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly'); # change the value through the delegation ... $bar->foo_bar(50); # and make sure everyone sees it is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value'); is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly'); # change the object we are delegating too my $foo = Foo->new(bar => 25); isa_ok($foo, 'Foo'); is($foo->bar, 25, '... got the right foo->bar'); is( exception { $bar->foo($foo); }, undef, '... assigned the new Foo to Bar->foo' ); is($bar->foo, $foo, '... assigned bar->foo with the new Foo'); is($bar->foo->bar, 25, '... bar->foo->bar returned the right result'); is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again'); # curried handles $bar->foo_bar_to_20; is($bar->foo_bar, 20, '... correctly curried a single argument'); # ------------------------------------------------------------------- # ARRAY handles # ------------------------------------------------------------------- # we also support an array based format # which assumes that the name is the same # on either end { package Engine; use MyMoose; sub go { 'Engine::go' } sub stop { 'Engine::stop' } package Car; use MyMoose; has 'engine' => ( is => 'rw', default => sub { Engine->new }, handles => [ 'go', 'stop' ] ); } my $car = Car->new; isa_ok($car, 'Car'); isa_ok($car->engine, 'Engine'); can_ok($car->engine, 'go'); can_ok($car->engine, 'stop'); is($car->engine->go, 'Engine::go', '... got the right value from ->engine->go'); is($car->engine->stop, 'Engine::stop', '... got the right value from ->engine->stop'); can_ok($car, 'go'); can_ok($car, 'stop'); is($car->go, 'Engine::go', '... got the right value from ->go'); is($car->stop, 'Engine::stop', '... got the right value from ->stop'); # ------------------------------------------------------------------- # REGEXP handles # ------------------------------------------------------------------- # and we support regexp delegation { package Baz; use MyMoose; sub foo { 'Baz::foo' } sub bar { 'Baz::bar' } sub boo { 'Baz::boo' } package Baz::Proxy1; use MyMoose; has 'baz' => ( is => 'ro', isa => 'Baz', default => sub { Baz->new }, handles => qr/.*/ ); package Baz::Proxy2; use MyMoose; has 'baz' => ( is => 'ro', isa => 'Baz', default => sub { Baz->new }, handles => qr/.oo/ ); package Baz::Proxy3; use MyMoose; has 'baz' => ( is => 'ro', isa => 'Baz', default => sub { Baz->new }, handles => qr/b.*/ ); } { my $baz_proxy = Baz::Proxy1->new; isa_ok($baz_proxy, 'Baz::Proxy1'); can_ok($baz_proxy, 'baz'); isa_ok($baz_proxy->baz, 'Baz'); can_ok($baz_proxy, 'foo'); can_ok($baz_proxy, 'bar'); can_ok($baz_proxy, 'boo'); is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value'); is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value'); is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); } { my $baz_proxy = Baz::Proxy2->new; isa_ok($baz_proxy, 'Baz::Proxy2'); can_ok($baz_proxy, 'baz'); isa_ok($baz_proxy->baz, 'Baz'); can_ok($baz_proxy, 'foo'); can_ok($baz_proxy, 'boo'); is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value'); is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); } { my $baz_proxy = Baz::Proxy3->new; isa_ok($baz_proxy, 'Baz::Proxy3'); can_ok($baz_proxy, 'baz'); isa_ok($baz_proxy->baz, 'Baz'); can_ok($baz_proxy, 'bar'); can_ok($baz_proxy, 'boo'); is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value'); is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); } # ------------------------------------------------------------------- # ROLE handles # ------------------------------------------------------------------- { package Foo::Bar; use MyMoose::Role; requires 'foo'; requires 'bar'; package Foo::Baz; use MyMoose; sub foo { 'Foo::Baz::FOO' } sub bar { 'Foo::Baz::BAR' } sub baz { 'Foo::Baz::BAZ' } package Foo::Thing; use MyMoose; has 'thing' => ( is => 'rw', isa => 'Foo::Baz', handles => 'Foo::Bar', ); package Foo::OtherThing; use MyMoose; use Moose::Util::TypeConstraints; has 'other_thing' => ( is => 'rw', isa => 'Foo::Baz', handles => Moose::Util::TypeConstraints::find_type_constraint('Foo::Bar'), ); } { my $foo = Foo::Thing->new(thing => Foo::Baz->new); isa_ok($foo, 'Foo::Thing'); isa_ok($foo->thing, 'Foo::Baz'); ok($foo->meta->has_method('foo'), '... we have the method we expect'); ok($foo->meta->has_method('bar'), '... we have the method we expect'); ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect'); is($foo->foo, 'Foo::Baz::FOO', '... got the right value'); is($foo->bar, 'Foo::Baz::BAR', '... got the right value'); is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value'); } { my $foo = Foo::OtherThing->new(other_thing => Foo::Baz->new); isa_ok($foo, 'Foo::OtherThing'); isa_ok($foo->other_thing, 'Foo::Baz'); ok($foo->meta->has_method('foo'), '... we have the method we expect'); ok($foo->meta->has_method('bar'), '... we have the method we expect'); ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect'); is($foo->foo, 'Foo::Baz::FOO', '... got the right value'); is($foo->bar, 'Foo::Baz::BAR', '... got the right value'); is($foo->other_thing->baz, 'Foo::Baz::BAZ', '... got the right value'); } # ------------------------------------------------------------------- # AUTOLOAD & handles # ------------------------------------------------------------------- { package Foo::Autoloaded; use MyMoose; sub AUTOLOAD { my $self = shift; my $name = our $AUTOLOAD; $name =~ s/.*://; # strip fully-qualified portion if (@_) { return $self->{$name} = shift; } else { return $self->{$name}; } } package Bar::Autoloaded; use MyMoose; has 'foo' => ( is => 'rw', default => sub { Foo::Autoloaded->new }, handles => { 'foo_bar' => 'bar' } ); package Baz::Autoloaded; use MyMoose; has 'foo' => ( is => 'rw', default => sub { Foo::Autoloaded->new }, handles => ['bar'] ); package Goorch::Autoloaded; use MyMoose; ::isnt( ::exception { has 'foo' => ( is => 'rw', default => sub { Foo::Autoloaded->new }, handles => qr/bar/ ); }, undef, '... you cannot delegate to AUTOLOADED class with regexp' ); } # check HASH based delegation w/ AUTOLOAD { my $bar = Bar::Autoloaded->new; isa_ok($bar, 'Bar::Autoloaded'); ok($bar->foo, '... we have something in bar->foo'); isa_ok($bar->foo, 'Foo::Autoloaded'); # change the value ... $bar->foo->bar(30); # and make sure the delegation picks it up is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value'); is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly'); # change the value through the delegation ... $bar->foo_bar(50); # and make sure everyone sees it is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value'); is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly'); # change the object we are delegating too my $foo = Foo::Autoloaded->new; isa_ok($foo, 'Foo::Autoloaded'); $foo->bar(25); is($foo->bar, 25, '... got the right foo->bar'); is( exception { $bar->foo($foo); }, undef, '... assigned the new Foo to Bar->foo' ); is($bar->foo, $foo, '... assigned bar->foo with the new Foo'); is($bar->foo->bar, 25, '... bar->foo->bar returned the right result'); is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again'); } # check ARRAY based delegation w/ AUTOLOAD { my $baz = Baz::Autoloaded->new; isa_ok($baz, 'Baz::Autoloaded'); ok($baz->foo, '... we have something in baz->foo'); isa_ok($baz->foo, 'Foo::Autoloaded'); # change the value ... $baz->foo->bar(30); # and make sure the delegation picks it up is($baz->foo->bar, 30, '... baz->foo->bar returned the right (changed) value'); is($baz->bar, 30, '... baz->foo_bar delegated correctly'); # change the value through the delegation ... $baz->bar(50); # and make sure everyone sees it is($baz->foo->bar, 50, '... baz->foo->bar returned the right (changed) value'); is($baz->bar, 50, '... baz->foo_bar delegated correctly'); # change the object we are delegating too my $foo = Foo::Autoloaded->new; isa_ok($foo, 'Foo::Autoloaded'); $foo->bar(25); is($foo->bar, 25, '... got the right foo->bar'); is( exception { $baz->foo($foo); }, undef, '... assigned the new Foo to Baz->foo' ); is($baz->foo, $foo, '... assigned baz->foo with the new Foo'); is($baz->foo->bar, 25, '... baz->foo->bar returned the right result'); is($baz->bar, 25, '... and baz->foo_bar delegated correctly again'); } # Check that removing attributes removes their handles methods also. { { package Quux; use MyMoose; has foo => ( isa => 'Foo', default => sub { Foo->new }, handles => { 'foo_bar' => 'bar' } ); } my $i = Quux->new; ok($i->meta->has_method('foo_bar'), 'handles method foo_bar is present'); $i->meta->remove_attribute('foo'); ok(!$i->meta->has_method('foo_bar'), 'handles method foo_bar is removed'); } # Make sure that a useful error message is thrown when the delegation target is # not an object { my $i = Bar->new(foo => undef); like( exception { $i->foo_bar }, qr/is not defined/, 'useful error from unblessed reference' ); my $j = Bar->new(foo => []); like( exception { $j->foo_bar }, qr/is not an object \(got 'ARRAY/, 'useful error from unblessed reference' ); my $k = Bar->new(foo => "Foo"); is( exception { $k->foo_baz }, undef, "but not for class name" ); } { package Delegator; use MyMoose; sub full { 1 } sub stub; ::like( ::exception{ has d1 => ( isa => 'X', handles => ['full'], ); }, qr/\QYou cannot overwrite a locally defined method (full) with a delegation/, 'got an error when trying to declare a delegation method that overwrites a local method' ); ::is( ::exception{ has d2 => ( isa => 'X', handles => ['stub'], ); }, undef, 'no error when trying to declare a delegation method that overwrites a stub method' ); } done_testing; moose_attribute_does.t000664001750001750 442514343376440 20422 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo::Role; use MyMoose::Role; use Moose::Util::TypeConstraints; # if does() exists on its own, then # we create a type constraint for # it, just as we do for isa() has 'bar' => (is => 'rw', does => 'Bar::Role'); has 'baz' => ( is => 'rw', does => role_type('Bar::Role') ); package Foo::Class; use MyMoose; with 'Foo::Role'; package Bar::Role; use MyMoose::Role; # if isa and does appear together, then see if Class->does(Role) # if it does work... then the does() check is actually not needed # since the isa() check will imply the does() check has 'foo' => (is => 'rw', isa => 'Foo::Class', does => 'Foo::Role'); package Bar::Class; use MyMoose; with 'Bar::Role'; } my $foo = Foo::Class->new; isa_ok($foo, 'Foo::Class'); my $bar = Bar::Class->new; isa_ok($bar, 'Bar::Class'); is( exception { $foo->bar($bar); }, undef, '... bar passed the type constraint okay' ); isnt( exception { $foo->bar($foo); }, undef, '... foo did not pass the type constraint okay' ); is( exception { $foo->baz($bar); }, undef, '... baz passed the type constraint okay' ); isnt( exception { $foo->baz($foo); }, undef, '... foo did not pass the type constraint okay' ); is( exception { $bar->foo($foo); }, undef, '... foo passed the type constraint okay' ); # some error conditions { package Baz::Class; use MyMoose; # if isa and does appear together, then see if Class->does(Role) # if it does not,.. we have a conflict... so we die loudly ::isnt( ::exception { has 'foo' => (isa => 'Foo::Class', does => 'Bar::Class'); }, undef, '... cannot have a does() which is not done by the isa()' ); } { package Bling; use strict; use warnings; sub bling { 'Bling::bling' } package Bling::Bling; use MyMoose; # if isa and does appear together, then see if Class->does(Role) # if it does not,.. we have a conflict... so we die loudly ::isnt( ::exception { has 'foo' => (isa => 'Bling', does => 'Bar::Class'); }, undef, '... cannot have a isa() which is cannot does()' ); } done_testing; moose_attribute_inherited_slot_specs.t000664001750001750 2373014343376440 23721 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Thing::Meta::Attribute; use MyMoose; extends 'Moose::Meta::Attribute'; around illegal_options_for_inheritance => sub { return (shift->(@_), qw/trigger/); }; package Thing; use MyMoose; sub hello { 'Hello World (from Thing)' } sub goodbye { 'Goodbye World (from Thing)' } package Foo; use MyMoose; use Moose::Util::TypeConstraints; subtype 'FooStr' => as 'Str' => where { /Foo/ }; coerce 'FooStr' => from ArrayRef => via { 'FooArrayRef' }; has 'bar' => (is => 'ro', isa => 'Str', default => 'Foo::bar'); has 'baz' => (is => 'rw', isa => 'Ref'); has 'foo' => (is => 'rw', isa => 'FooStr'); has 'gorch' => (is => 'ro'); has 'gloum' => (is => 'ro', default => sub {[]}); has 'fleem' => (is => 'ro'); has 'bling' => (is => 'ro', isa => 'Thing'); has 'blang' => (is => 'ro', isa => 'Thing', handles => ['goodbye']); has 'bunch_of_stuff' => (is => 'rw', isa => 'ArrayRef'); has 'one_last_one' => (is => 'rw', isa => 'Ref'); # this one will work here .... has 'fail' => (isa => 'CodeRef', is => 'bare'); has 'other_fail' => (metaclass => 'Thing::Meta::Attribute', is => 'bare', trigger => sub { }); package Bar; use MyMoose; use Moose::Util::TypeConstraints; extends 'Foo'; ::is( ::exception { has '+bar' => (default => 'Bar::bar'); }, undef, '... we can change the default attribute option' ); ::is( ::exception { has '+baz' => (isa => 'ArrayRef'); }, undef, '... we can add change the isa as long as it is a subtype' ); ::is( ::exception { has '+foo' => (coerce => 1); }, undef, '... we can change/add coerce as an attribute option' ); ::is( ::exception { has '+gorch' => (required => 1); }, undef, '... we can change/add required as an attribute option' ); ::is( ::exception { has '+gloum' => (lazy => 1); }, undef, '... we can change/add lazy as an attribute option' ); ::is( ::exception { has '+fleem' => (lazy_build => 1); }, undef, '... we can add lazy_build as an attribute option' ); ::is( ::exception { has '+bunch_of_stuff' => (isa => 'ArrayRef[Int]'); }, undef, '... extend an attribute with parameterized type' ); ::is( ::exception { has '+one_last_one' => (isa => subtype('Ref', where { blessed $_ eq 'CODE' })); }, undef, '... extend an attribute with anon-subtype' ); ::is( ::exception { has '+one_last_one' => (isa => 'Value'); }, undef, '... now can extend an attribute with a non-subtype' ); ::is( ::exception { has '+fleem' => (weak_ref => 1); }, undef, '... now allowed to add the weak_ref option via inheritance' ); ::is( ::exception { has '+bling' => (handles => ['hello']); }, undef, '... we can add the handles attribute option' ); # this one will *not* work here .... ::isnt( ::exception { has '+blang' => (handles => ['hello']); }, undef, '... we can not alter the handles attribute option' ); ::is( ::exception { has '+fail' => (isa => 'Ref'); }, undef, '... can now create an attribute with an improper subtype relation' ); ::isnt( ::exception { has '+other_fail' => (trigger => sub {}); }, undef, '... cannot create an attribute with an illegal option' ); ::like( ::exception { has '+does_not_exist' => (isa => 'Str'); }, qr/in Bar/, '... cannot extend a non-existing attribute' ); } my $foo = Foo->new; isa_ok($foo, 'Foo'); is($foo->foo, undef, '... got the right undef default value'); is( exception { $foo->foo('FooString') }, undef, '... assigned foo correctly' ); is($foo->foo, 'FooString', '... got the right value for foo'); isnt( exception { $foo->foo([]) }, undef, '... foo is not coercing (as expected)' ); is($foo->bar, 'Foo::bar', '... got the right default value'); isnt( exception { $foo->bar(10) }, undef, '... Foo::bar is a read/only attr' ); is($foo->baz, undef, '... got the right undef default value'); { my $hash_ref = {}; is( exception { $foo->baz($hash_ref) }, undef, '... Foo::baz accepts hash refs' ); is($foo->baz, $hash_ref, '... got the right value assigned to baz'); my $array_ref = []; is( exception { $foo->baz($array_ref) }, undef, '... Foo::baz accepts an array ref' ); is($foo->baz, $array_ref, '... got the right value assigned to baz'); my $scalar_ref = \(my $var); is( exception { $foo->baz($scalar_ref) }, undef, '... Foo::baz accepts scalar ref' ); is($foo->baz, $scalar_ref, '... got the right value assigned to baz'); is( exception { $foo->bunch_of_stuff([qw[one two three]]) }, undef, '... Foo::bunch_of_stuff accepts an array of strings' ); is( exception { $foo->one_last_one(sub { 'Hello World'}) }, undef, '... Foo::one_last_one accepts a code ref' ); my $code_ref = sub { 1 }; is( exception { $foo->baz($code_ref) }, undef, '... Foo::baz accepts a code ref' ); is($foo->baz, $code_ref, '... got the right value assigned to baz'); } isnt( exception { Bar->new; }, undef, '... cannot create Bar without required gorch param' ); my $bar = Bar->new(gorch => 'Bar::gorch'); isa_ok($bar, 'Bar'); isa_ok($bar, 'Foo'); is($bar->foo, undef, '... got the right undef default value'); is( exception { $bar->foo('FooString') }, undef, '... assigned foo correctly' ); is($bar->foo, 'FooString', '... got the right value for foo'); is( exception { $bar->foo([]) }, undef, '... assigned foo correctly' ); is($bar->foo, 'FooArrayRef', '... got the right value for foo'); is($bar->gorch, 'Bar::gorch', '... got the right default value'); is($bar->bar, 'Bar::bar', '... got the right default value'); isnt( exception { $bar->bar(10) }, undef, '... Bar::bar is a read/only attr' ); is($bar->baz, undef, '... got the right undef default value'); { my $hash_ref = {}; isnt( exception { $bar->baz($hash_ref) }, undef, '... Bar::baz does not accept hash refs' ); my $array_ref = []; is( exception { $bar->baz($array_ref) }, undef, '... Bar::baz can accept an array ref' ); is($bar->baz, $array_ref, '... got the right value assigned to baz'); my $scalar_ref = \(my $var); isnt( exception { $bar->baz($scalar_ref) }, undef, '... Bar::baz does not accept a scalar ref' ); is( exception { $bar->bunch_of_stuff([1, 2, 3]) }, undef, '... Bar::bunch_of_stuff accepts an array of ints' ); isnt( exception { $bar->bunch_of_stuff([qw[one two three]]) }, undef, '... Bar::bunch_of_stuff does not accept an array of strings' ); my $code_ref = sub { 1 }; isnt( exception { $bar->baz($code_ref) }, undef, '... Bar::baz does not accept a code ref' ); } # check some meta-stuff ok(Bar->meta->has_attribute('foo'), '... Bar has a foo attr'); ok(Bar->meta->has_attribute('bar'), '... Bar has a bar attr'); ok(Bar->meta->has_attribute('baz'), '... Bar has a baz attr'); ok(Bar->meta->has_attribute('gorch'), '... Bar has a gorch attr'); ok(Bar->meta->has_attribute('gloum'), '... Bar has a gloum attr'); ok(Bar->meta->has_attribute('bling'), '... Bar has a bling attr'); ok(Bar->meta->has_attribute('bunch_of_stuff'), '... Bar does have a bunch_of_stuff attr'); ok(!Bar->meta->has_attribute('blang'), '... Bar has a blang attr'); ok(Bar->meta->has_attribute('fail'), '... Bar has a fail attr'); ok(!Bar->meta->has_attribute('other_fail'), '... Bar does not have an other_fail attr'); isnt(Foo->meta->get_attribute('foo'), Bar->meta->get_attribute('foo'), '... Foo and Bar have different copies of foo'); isnt(Foo->meta->get_attribute('bar'), Bar->meta->get_attribute('bar'), '... Foo and Bar have different copies of bar'); isnt(Foo->meta->get_attribute('baz'), Bar->meta->get_attribute('baz'), '... Foo and Bar have different copies of baz'); isnt(Foo->meta->get_attribute('gorch'), Bar->meta->get_attribute('gorch'), '... Foo and Bar have different copies of gorch'); isnt(Foo->meta->get_attribute('gloum'), Bar->meta->get_attribute('gloum'), '... Foo and Bar have different copies of gloum'); isnt(Foo->meta->get_attribute('bling'), Bar->meta->get_attribute('bling'), '... Foo and Bar have different copies of bling'); isnt(Foo->meta->get_attribute('bunch_of_stuff'), Bar->meta->get_attribute('bunch_of_stuff'), '... Foo and Bar have different copies of bunch_of_stuff'); ok(Bar->meta->get_attribute('bar')->has_type_constraint, '... Bar::bar inherited the type constraint too'); ok(Bar->meta->get_attribute('baz')->has_type_constraint, '... Bar::baz inherited the type constraint too'); is(Bar->meta->get_attribute('bar')->type_constraint->name, 'Str', '... Bar::bar inherited the right type constraint too'); is(Foo->meta->get_attribute('baz')->type_constraint->name, 'Ref', '... Foo::baz inherited the right type constraint too'); is(Bar->meta->get_attribute('baz')->type_constraint->name, 'ArrayRef', '... Bar::baz inherited the right type constraint too'); ok(!Foo->meta->get_attribute('gorch')->is_required, '... Foo::gorch is not a required attr'); ok(Bar->meta->get_attribute('gorch')->is_required, '... Bar::gorch is a required attr'); is(Foo->meta->get_attribute('bunch_of_stuff')->type_constraint->name, 'ArrayRef', '... Foo::bunch_of_stuff is an ArrayRef'); is(Bar->meta->get_attribute('bunch_of_stuff')->type_constraint->name, 'ArrayRef[Int]', '... Bar::bunch_of_stuff is an ArrayRef[Int]'); ok(!Foo->meta->get_attribute('gloum')->is_lazy, '... Foo::gloum is not a required attr'); ok(Bar->meta->get_attribute('gloum')->is_lazy, '... Bar::gloum is a required attr'); ok(!Foo->meta->get_attribute('foo')->should_coerce, '... Foo::foo should not coerce'); ok(Bar->meta->get_attribute('foo')->should_coerce, '... Bar::foo should coerce'); ok(!Foo->meta->get_attribute('bling')->has_handles, '... Foo::foo should not handles'); ok(Bar->meta->get_attribute('bling')->has_handles, '... Bar::foo should handles'); done_testing; moose_attribute_lazy_initializer.t000664001750001750 754114343376440 23054 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has 'foo' => ( reader => 'get_foo', writer => 'set_foo', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'foo', '... got the right name'); $callback->($value * 2); }, ); has 'lazy_foo' => ( reader => 'get_lazy_foo', lazy => 1, default => 10, initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'lazy_foo', '... got the right name'); $callback->($value * 2); }, ); has 'lazy_foo_w_type' => ( reader => 'get_lazy_foo_w_type', isa => 'Int', lazy => 1, default => 20, initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'lazy_foo_w_type', '... got the right name'); $callback->($value * 2); }, ); has 'lazy_foo_builder' => ( reader => 'get_lazy_foo_builder', builder => 'get_foo_builder', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'lazy_foo_builder', '... got the right name'); $callback->($value * 2); }, ); has 'lazy_foo_builder_w_type' => ( reader => 'get_lazy_foo_builder_w_type', isa => 'Int', builder => 'get_foo_builder_w_type', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'lazy_foo_builder_w_type', '... got the right name'); $callback->($value * 2); }, ); sub get_foo_builder { 100 } sub get_foo_builder_w_type { 1000 } } { my $foo = Foo->new(foo => 10); isa_ok($foo, 'Foo'); is($foo->get_foo, 20, 'initial value set to 2x given value'); is($foo->get_lazy_foo, 20, 'initial lazy value set to 2x given value'); is($foo->get_lazy_foo_w_type, 40, 'initial lazy value with type set to 2x given value'); is($foo->get_lazy_foo_builder, 200, 'initial lazy value with builder set to 2x given value'); is($foo->get_lazy_foo_builder_w_type, 2000, 'initial lazy value with builder and type set to 2x given value'); } { package Bar; use MyMoose; has 'foo' => ( reader => 'get_foo', writer => 'set_foo', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'foo', '... got the right name'); $callback->($value * 2); }, ); __PACKAGE__->meta->make_immutable; } { my $bar = Bar->new(foo => 10); isa_ok($bar, 'Bar'); is($bar->get_foo, 20, 'initial value set to 2x given value'); } { package Fail::Bar; use MyMoose; has 'foo' => ( reader => 'get_foo', writer => 'set_foo', isa => 'Int', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'foo', '... got the right name'); $callback->("Hello $value World"); }, ); __PACKAGE__->meta->make_immutable; } isnt( exception { Fail::Bar->new(foo => 10) }, undef, '... this fails, because initializer returns a bad type' ); done_testing; moose_attribute_names.t000664001750001750 215414343376440 20570 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; my $exception_regex = qr/You must provide a name for the attribute/; { package My::Role; use MyMoose::Role; ::like( ::exception { has; }, $exception_regex, 'has; fails' ); ::like( ::exception { has undef; }, $exception_regex, 'has undef; fails' ); ::is( ::exception { has "" => ( is => 'bare', ); }, undef, 'has ""; works now' ); ::is( ::exception { has 0 => ( is => 'bare', ); }, undef, 'has 0; works now' ); } { package My::Class; use MyMoose; ::like( ::exception { has; }, $exception_regex, 'has; fails' ); ::like( ::exception { has undef; }, $exception_regex, 'has undef; fails' ); ::is( ::exception { has "" => ( is => 'bare', ); }, undef, 'has ""; works now' ); ::is( ::exception { has 0 => ( is => 'bare', ); }, undef, 'has 0; works now' ); } done_testing; moose_attribute_reader_generation.t000664001750001750 504614343376440 23145 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; eval { has 'foo' => ( reader => 'get_foo' ); }; ::ok(!$@, '... created the reader method okay'); eval { has 'lazy_foo' => ( reader => 'get_lazy_foo', lazy => 1, default => sub { 10 } ); }; ::ok(!$@, '... created the lazy reader method okay') or warn $@; eval { has 'lazy_weak_foo' => ( reader => 'get_lazy_weak_foo', lazy => 1, default => sub { our $AREF = [] }, weak_ref => 1, ); }; ::ok(!$@, '... created the lazy weak reader method okay') or warn $@; my $warn; eval { local $SIG{__WARN__} = sub { $warn = $_[0] }; has 'mtfnpy' => ( reder => 'get_mftnpy' ); }; ::ok($warn, '... got a warning for mispelled attribute argument'); } { my $foo = Foo->new; isa_ok($foo, 'Foo'); can_ok($foo, 'get_foo'); is($foo->get_foo(), undef, '... got an undefined value'); isnt( exception { $foo->get_foo(100); }, undef, '... get_foo is a read-only' ); ok(!exists($foo->{lazy_foo}), '... no value in get_lazy_foo slot'); can_ok($foo, 'get_lazy_foo'); is($foo->get_lazy_foo(), 10, '... got an deferred value'); isnt( exception { $foo->get_lazy_foo(100); }, undef, '... get_lazy_foo is a read-only' ); is($foo->get_lazy_weak_foo(), $Foo::AREF, 'got the right value'); ok($foo->meta->get_meta_instance->slot_value_is_weak($foo, 'lazy_weak_foo'), '... and it is weak'); } { my $foo = Foo->new; isa_ok($foo, 'Foo'); my $attr = $foo->meta->find_attribute_by_name("lazy_foo"); isa_ok( $attr, "Moose::Meta::Attribute" ); ok( $attr->is_lazy, "it's lazy" ); is( $attr->get_raw_value($foo), undef, "raw value" ); is( $attr->get_value($foo), 10, "lazy value" ); is( $attr->get_raw_value($foo), 10, "raw value" ); my $lazy_weak_attr = $foo->meta->find_attribute_by_name("lazy_weak_foo"); is( $lazy_weak_attr->get_value($foo), $Foo::AREF, "it's the right value" ); ok( $foo->meta->get_meta_instance->slot_value_is_weak($foo, 'lazy_weak_foo'), "and it is weak"); } { my $foo = Foo->new(foo => 10, lazy_foo => 100); isa_ok($foo, 'Foo'); is($foo->get_foo(), 10, '... got the correct value'); is($foo->get_lazy_foo(), 100, '... got the correct value'); } done_testing; moose_attribute_required.t000664001750001750 333514343376440 21307 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has 'bar' => (is => 'ro', required => 1); has 'baz' => (is => 'rw', default => 100, required => 1); has 'boo' => (is => 'rw', lazy => 1, default => 50, required => 1); } { my $foo = Foo->new(bar => 10, baz => 20, boo => 100); isa_ok($foo, 'Foo'); is($foo->bar, 10, '... got the right bar'); is($foo->baz, 20, '... got the right baz'); is($foo->boo, 100, '... got the right boo'); } { my $foo = Foo->new(bar => 10, boo => 5); isa_ok($foo, 'Foo'); is($foo->bar, 10, '... got the right bar'); is($foo->baz, 100, '... got the right baz'); is($foo->boo, 5, '... got the right boo'); } { my $foo = Foo->new(bar => 10); isa_ok($foo, 'Foo'); is($foo->bar, 10, '... got the right bar'); is($foo->baz, 100, '... got the right baz'); is($foo->boo, 50, '... got the right boo'); } #Yeah.. this doesn't work like this anymore, see below. (groditi) #throws_ok { # Foo->new(bar => 10, baz => undef); #} qr/^Attribute \(baz\) is required and cannot be undef/, '... must supply all the required attribute'; #throws_ok { # Foo->new(bar => 10, boo => undef); #} qr/^Attribute \(boo\) is required and cannot be undef/, '... must supply all the required attribute'; is( exception { Foo->new(bar => 10, baz => undef); }, undef, '... undef is a valid attribute value' ); is( exception { Foo->new(bar => 10, boo => undef); }, undef, '... undef is a valid attribute value' ); like( exception { Foo->new; }, qr/^Attribute \(bar\) is required/, '... must supply all the required attribute' ); done_testing; moose_attribute_traits.t000664001750001750 313414343376440 20772 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package My::Attribute::Trait; use MyMoose::Role; has 'alias_to' => (is => 'ro', isa => 'Str'); has foo => ( is => "ro", default => "blah" ); after 'install_accessors' => sub { my $self = shift; $self->associated_class->add_method( $self->alias_to, $self->get_read_method_ref ); }; } { package My::Class; use MyMoose; has 'bar' => ( traits => [qw/My::Attribute::Trait/], is => 'ro', isa => 'Int', alias_to => 'baz', ); has 'gorch' => ( is => 'ro', isa => 'Int', default => sub { 10 } ); } my $c = My::Class->new(bar => 100); isa_ok($c, 'My::Class'); is($c->bar, 100, '... got the right value for bar'); is($c->gorch, 10, '... got the right value for gorch'); can_ok($c, 'baz'); is($c->baz, 100, '... got the right value for baz'); my $bar_attr = $c->meta->get_attribute('bar'); does_ok($bar_attr, 'My::Attribute::Trait'); ok($bar_attr->has_applied_traits, '... got the applied traits'); is_deeply($bar_attr->applied_traits, [qw/My::Attribute::Trait/], '... got the applied traits'); is($bar_attr->foo, "blah", "attr initialized"); my $gorch_attr = $c->meta->get_attribute('gorch'); ok(!$gorch_attr->does('My::Attribute::Trait'), '... gorch doesnt do the trait'); ok(!$gorch_attr->has_applied_traits, '... no traits applied'); is($gorch_attr->applied_traits, undef, '... no traits applied'); done_testing; moose_attribute_traits_n_meta.t000664001750001750 266114343376440 22321 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package My::Meta::Attribute::DefaultReadOnly; use MyMoose; extends 'Moose::Meta::Attribute'; around 'new' => sub { my $next = shift; my ($self, $name, %options) = @_; $options{is} = 'ro' unless exists $options{is}; $next->($self, $name, %options); }; } { package My::Attribute::Trait; use MyMoose::Role; has 'alias_to' => (is => 'ro', isa => 'Str'); after 'install_accessors' => sub { my $self = shift; $self->associated_class->add_method( $self->alias_to, $self->get_read_method_ref ); }; } { package My::Class; use MyMoose; has 'bar' => ( metaclass => 'My::Meta::Attribute::DefaultReadOnly', traits => [qw/My::Attribute::Trait/], isa => 'Int', alias_to => 'baz', ); } my $c = My::Class->new(bar => 100); isa_ok($c, 'My::Class'); is($c->bar, 100, '... got the right value for bar'); can_ok($c, 'baz'); is($c->baz, 100, '... got the right value for baz'); isa_ok($c->meta->get_attribute('bar'), 'My::Meta::Attribute::DefaultReadOnly'); does_ok($c->meta->get_attribute('bar'), 'My::Attribute::Trait'); is($c->meta->get_attribute('bar')->_is_metadata, 'ro', '... got the right metaclass customization'); done_testing; moose_attribute_traits_parameterized.t000664001750001750 264014343376440 23707 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package My::Attribute::Trait; use MyMoose::Role; sub reversed_name { my $self = shift; scalar reverse $self->name; } } { package My::Class; use MyMoose; has foo => ( traits => [ 'My::Attribute::Trait' => { -alias => { reversed_name => 'eman', }, }, ], is => 'bare', ); } { package My::Other::Class; use MyMoose; has foo => ( traits => [ 'My::Attribute::Trait' => { -alias => { reversed_name => 'reversed', }, -excludes => 'reversed_name', }, ], is => 'bare', ); } my $attr = My::Class->meta->get_attribute('foo'); is($attr->eman, 'oof', 'the aliased method is in the attribute'); ok(!$attr->can('reversed'), "the method was not installed under the other class' alias"); my $other_attr = My::Other::Class->meta->get_attribute('foo'); is($other_attr->reversed, 'oof', 'the aliased method is in the attribute'); ok(!$other_attr->can('enam'), "the method was not installed under the other class' alias"); ok(!$other_attr->can('reversed_name'), "the method was not installed under the original name when that was excluded"); done_testing; moose_attribute_traits_registered.t000664001750001750 601414343376440 23207 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package My::Attribute::Trait; use MyMoose::Role; has 'alias_to' => (is => 'ro', isa => 'Str'); has foo => ( is => "ro", default => "blah" ); after 'install_accessors' => sub { my $self = shift; $self->associated_class->add_method( $self->alias_to, $self->get_read_method_ref ); }; package Moose::Meta::Attribute::Custom::Trait::Aliased; sub register_implementation { 'My::Attribute::Trait' } } { package My::Other::Attribute::Trait; use MyMoose::Role; my $method = sub { 42; }; has the_other_attr => ( isa => "Str", is => "rw", default => "oink" ); after 'install_accessors' => sub { my $self = shift; $self->associated_class->add_method( 'additional_method', $method ); }; package Moose::Meta::Attribute::Custom::Trait::Other; sub register_implementation { 'My::Other::Attribute::Trait' } } { package My::Class; use MyMoose; has 'bar' => ( traits => [qw/Aliased/], is => 'ro', isa => 'Int', alias_to => 'baz', ); } { package My::Derived::Class; use MyMoose; extends 'My::Class'; has '+bar' => ( traits => [qw/Other/], ); } my $c = My::Class->new(bar => 100); isa_ok($c, 'My::Class'); is($c->bar, 100, '... got the right value for bar'); can_ok($c, 'baz') and is($c->baz, 100, '... got the right value for baz'); my $bar_attr = $c->meta->get_attribute('bar'); does_ok($bar_attr, 'My::Attribute::Trait'); is($bar_attr->foo, "blah", "attr initialized"); ok(!$bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity"); ok($bar_attr->does('Aliased'), "attr->does uses aliases"); ok(!$bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles"); ok(!$bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles"); my $quux = My::Derived::Class->new(bar => 1000); is($quux->bar, 1000, '... got the right value for bar'); can_ok($quux, 'baz'); is($quux->baz, 1000, '... got the right value for baz'); my $derived_bar_attr = $quux->meta->get_attribute("bar"); does_ok($derived_bar_attr, 'My::Attribute::Trait' ); is( $derived_bar_attr->foo, "blah", "attr initialized" ); does_ok($derived_bar_attr, 'My::Other::Attribute::Trait' ); is($derived_bar_attr->the_other_attr, "oink", "attr initialized" ); ok(!$derived_bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity"); ok($derived_bar_attr->does('Aliased'), "attr->does uses aliases"); ok(!$derived_bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles"); ok(!$derived_bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles"); can_ok($quux, 'additional_method'); is(eval { $quux->additional_method }, 42, '... got the right value for additional_method'); done_testing; moose_attribute_triggers.t000664001750001750 1373314343376440 21340 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Scalar::Util 'isweak'; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has 'bar' => (is => 'rw', isa => 'Maybe[Bar]', trigger => sub { my ($self, $bar) = @_; $bar->foo($self) if defined $bar; }); has 'baz' => (writer => 'set_baz', reader => 'get_baz', isa => 'Baz', trigger => sub { my ($self, $baz) = @_; $baz->foo($self); }); package Bar; use MyMoose; has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1); package Baz; use MyMoose; has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1); } { my $foo = Foo->new; isa_ok($foo, 'Foo'); my $bar = Bar->new; isa_ok($bar, 'Bar'); my $baz = Baz->new; isa_ok($baz, 'Baz'); is( exception { $foo->bar($bar); }, undef, '... did not die setting bar' ); is($foo->bar, $bar, '... set the value foo.bar correctly'); is($bar->foo, $foo, '... which in turn set the value bar.foo correctly'); ok(isweak($bar->{foo}), '... bar.foo is a weak reference'); is( exception { $foo->bar(undef); }, undef, '... did not die un-setting bar' ); is($foo->bar, undef, '... set the value foo.bar correctly'); is($bar->foo, $foo, '... which in turn set the value bar.foo correctly'); # test the writer is( exception { $foo->set_baz($baz); }, undef, '... did not die setting baz' ); is($foo->get_baz, $baz, '... set the value foo.baz correctly'); is($baz->foo, $foo, '... which in turn set the value baz.foo correctly'); ok(isweak($baz->{foo}), '... baz.foo is a weak reference'); } { my $bar = Bar->new; isa_ok($bar, 'Bar'); my $baz = Baz->new; isa_ok($baz, 'Baz'); my $foo = Foo->new(bar => $bar, baz => $baz); isa_ok($foo, 'Foo'); is($foo->bar, $bar, '... set the value foo.bar correctly'); is($bar->foo, $foo, '... which in turn set the value bar.foo correctly'); ok(isweak($bar->{foo}), '... bar.foo is a weak reference'); is($foo->get_baz, $baz, '... set the value foo.baz correctly'); is($baz->foo, $foo, '... which in turn set the value baz.foo correctly'); ok(isweak($baz->{foo}), '... baz.foo is a weak reference'); } # some errors { package Bling; use MyMoose; ::isnt( ::exception { has('bling' => (is => 'rw', trigger => 'Fail')); }, undef, '... a trigger must be a CODE ref' ); ::isnt( ::exception { has('bling' => (is => 'rw', trigger => [])); }, undef, '... a trigger must be a CODE ref' ); } # Triggers do not fire on built values { package Blarg; use MyMoose; our %trigger_calls; our %trigger_vals; has foo => (is => 'rw', default => sub { 'default foo value' }, trigger => sub { my ($self, $val, $attr) = @_; $trigger_calls{foo}++; $trigger_vals{foo} = $val }); has bar => (is => 'rw', lazy_build => 1, trigger => sub { my ($self, $val, $attr) = @_; $trigger_calls{bar}++; $trigger_vals{bar} = $val }); sub _build_bar { return 'default bar value' } has baz => (is => 'rw', builder => '_build_baz', trigger => sub { my ($self, $val, $attr) = @_; $trigger_calls{baz}++; $trigger_vals{baz} = $val }); sub _build_baz { return 'default baz value' } } { my $blarg; is( exception { $blarg = Blarg->new; }, undef, 'Blarg->new() lives' ); ok($blarg, 'Have a $blarg'); foreach my $attr (qw/foo bar baz/) { is($blarg->$attr(), "default $attr value", "$attr has default value"); } is_deeply(\%Blarg::trigger_calls, {}, 'No triggers fired'); foreach my $attr (qw/foo bar baz/) { $blarg->$attr("Different $attr value"); } is_deeply(\%Blarg::trigger_calls, { map { $_ => 1 } qw/foo bar baz/ }, 'All triggers fired once on assign'); is_deeply(\%Blarg::trigger_vals, { map { $_ => "Different $_ value" } qw/foo bar baz/ }, 'All triggers given assigned values'); is( exception { $blarg => Blarg->new( map { $_ => "Yet another $_ value" } qw/foo bar baz/ ) }, undef, '->new() with parameters' ); is_deeply(\%Blarg::trigger_calls, { map { $_ => 2 } qw/foo bar baz/ }, 'All triggers fired once on construct'); is_deeply(\%Blarg::trigger_vals, { map { $_ => "Yet another $_ value" } qw/foo bar baz/ }, 'All triggers given assigned values'); } # Triggers do not receive the meta-attribute as an argument, but do # receive the old value { package Foo; use MyMoose; our @calls; has foo => (is => 'rw', trigger => sub { push @calls, [@_] }); } { my $attr = Foo->meta->get_attribute('foo'); my $foo = Foo->new; $attr->set_value( $foo, 2 ); is_deeply( \@Foo::calls, [ [ $foo, 2 ] ], 'trigger called correctly on initial set via meta-API', ); @Foo::calls = (); $attr->set_value( $foo, 3 ); is_deeply( \@Foo::calls, [ [ $foo, 3, 2 ] ], 'trigger called correctly on second set via meta-API', ); @Foo::calls = (); $attr->set_raw_value( $foo, 4 ); is_deeply( \@Foo::calls, [ ], 'trigger not called using set_raw_value method', ); @Foo::calls = (); } { my $foo = Foo->new(foo => 2); is_deeply( \@Foo::calls, [ [ $foo, 2 ] ], 'trigger called correctly on construction', ); @Foo::calls = (); $foo->foo(3); is_deeply( \@Foo::calls, [ [ $foo, 3, 2 ] ], 'trigger called correctly on set (with old value)', ); @Foo::calls = (); Foo->meta->make_immutable, redo if Foo->meta->is_mutable; } done_testing; moose_attribute_type_unions.t000664001750001750 425014343376440 22040 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has 'bar' => (is => 'rw', isa => 'ArrayRef | HashRef'); } my $foo = Foo->new; isa_ok($foo, 'Foo'); is( exception { $foo->bar([]) }, undef, '... set bar successfully with an ARRAY ref' ); is( exception { $foo->bar({}) }, undef, '... set bar successfully with a HASH ref' ); isnt( exception { $foo->bar(100) }, undef, '... couldnt set bar successfully with a number' ); isnt( exception { $foo->bar(sub {}) }, undef, '... couldnt set bar successfully with a CODE ref' ); # check the constructor is( exception { Foo->new(bar => []) }, undef, '... created new Foo with bar successfully set with an ARRAY ref' ); is( exception { Foo->new(bar => {}) }, undef, '... created new Foo with bar successfully set with a HASH ref' ); isnt( exception { Foo->new(bar => 50) }, undef, '... didnt create a new Foo with bar as a number' ); isnt( exception { Foo->new(bar => sub {}) }, undef, '... didnt create a new Foo with bar as a CODE ref' ); { package Bar; use MyMoose; has 'baz' => (is => 'rw', isa => 'Str | CodeRef'); } my $bar = Bar->new; isa_ok($bar, 'Bar'); is( exception { $bar->baz('a string') }, undef, '... set baz successfully with a string' ); is( exception { $bar->baz(sub { 'a sub' }) }, undef, '... set baz successfully with a CODE ref' ); isnt( exception { $bar->baz(\(my $var1)) }, undef, '... couldnt set baz successfully with a SCALAR ref' ); isnt( exception { $bar->baz({}) }, undef, '... couldnt set bar successfully with a HASH ref' ); # check the constructor is( exception { Bar->new(baz => 'a string') }, undef, '... created new Bar with baz successfully set with a string' ); is( exception { Bar->new(baz => sub { 'a sub' }) }, undef, '... created new Bar with baz successfully set with a CODE ref' ); isnt( exception { Bar->new(baz => \(my $var2)) }, undef, '... didnt create a new Bar with baz as a number' ); isnt( exception { Bar->new(baz => {}) }, undef, '... didnt create a new Bar with baz as a HASH ref' ); done_testing; moose_attribute_without_any_methods.t000664001750001750 101514343376440 23555 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Moose (); use Moose::Meta::Class; my $meta = Moose::Meta::Class->create('Banana'); my $warn; $SIG{__WARN__} = sub { $warn = "@_" }; $meta->add_attribute('foo'); like $warn, qr/Attribute \(foo\) of class Banana has no associated methods/, 'correct error message'; $warn = ''; $meta->add_attribute('bar', is => 'bare'); is $warn, '', 'add attribute with no methods and is => "bare"'; done_testing; moose_attribute_writer_generation.t000664001750001750 606214343376440 23216 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Scalar::Util 'isweak'; { package Foo; use MyMoose; eval { has 'foo' => ( reader => 'get_foo', writer => 'set_foo', ); }; ::ok(!$@, '... created the writer method okay'); eval { has 'foo_required' => ( reader => 'get_foo_required', writer => 'set_foo_required', required => 1, ); }; ::ok(!$@, '... created the required writer method okay'); eval { has 'foo_int' => ( reader => 'get_foo_int', writer => 'set_foo_int', isa => 'Int', ); }; ::ok(!$@, '... created the writer method with type constraint okay'); eval { has 'foo_weak' => ( reader => 'get_foo_weak', writer => 'set_foo_weak', weak_ref => 1 ); }; ::ok(!$@, '... created the writer method with weak_ref okay'); } { my $foo = Foo->new(foo_required => 'required'); isa_ok($foo, 'Foo'); # regular writer can_ok($foo, 'set_foo'); is($foo->get_foo(), undef, '... got an unset value'); is( exception { $foo->set_foo(100); }, undef, '... set_foo wrote successfully' ); is($foo->get_foo(), 100, '... got the correct set value'); ok(!isweak($foo->{foo}), '... it is not a weak reference'); # required writer isnt( exception { Foo->new; }, undef, '... cannot create without the required attribute' ); can_ok($foo, 'set_foo_required'); is($foo->get_foo_required(), 'required', '... got an unset value'); is( exception { $foo->set_foo_required(100); }, undef, '... set_foo_required wrote successfully' ); is($foo->get_foo_required(), 100, '... got the correct set value'); isnt( exception { $foo->set_foo_required(); }, undef, '... set_foo_required died successfully with no value' ); is( exception { $foo->set_foo_required(undef); }, undef, '... set_foo_required did accept undef' ); ok(!isweak($foo->{foo_required}), '... it is not a weak reference'); # with type constraint can_ok($foo, 'set_foo_int'); is($foo->get_foo_int(), undef, '... got an unset value'); is( exception { $foo->set_foo_int(100); }, undef, '... set_foo_int wrote successfully' ); is($foo->get_foo_int(), 100, '... got the correct set value'); isnt( exception { $foo->set_foo_int("Foo"); }, undef, '... set_foo_int died successfully' ); ok(!isweak($foo->{foo_int}), '... it is not a weak reference'); # with weak_ref my $test = []; can_ok($foo, 'set_foo_weak'); is($foo->get_foo_weak(), undef, '... got an unset value'); is( exception { $foo->set_foo_weak($test); }, undef, '... set_foo_weak wrote successfully' ); is($foo->get_foo_weak(), $test, '... got the correct set value'); ok(isweak($foo->{foo_weak}), '... it is a weak reference'); } done_testing; moose_bad_coerce.t000664001750001750 154714343376440 17455 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Test::Requires { Moose => '2.1102' }; # error message changed { package Foo; use Moose; ::like(::exception { has foo => ( is => 'ro', isa => 'Str', coerce => 1, ); }, qr/\QYou cannot coerce an attribute (foo) unless its type (Str) has a coercion/, 'Cannot coerce unless the type has a coercion'); ::like(::exception { has bar => ( is => 'ro', isa => 'Str', coerce => 1, ); }, qr/\QYou cannot coerce an attribute (bar) unless its type (Str) has a coercion/, 'Cannot coerce unless the type has a coercion - different attribute'); } done_testing; moose_chained_coercion.t000664001750001750 163114343376440 20655 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Baz; use MyMoose; use Moose::Util::TypeConstraints; coerce 'Baz' => from 'HashRef' => via { Baz->new($_) }; has 'hello' => ( is => 'ro', isa => 'Str', ); package Bar; use MyMoose; use Moose::Util::TypeConstraints; coerce 'Bar' => from 'HashRef' => via { Bar->new($_) }; has 'baz' => ( is => 'ro', isa => 'Baz', coerce => 1 ); package Foo; use MyMoose; has 'bar' => ( is => 'ro', isa => 'Bar', coerce => 1, ); } my $foo = Foo->new(bar => { baz => { hello => 'World' } }); isa_ok($foo, 'Foo'); isa_ok($foo->bar, 'Bar'); isa_ok($foo->bar->baz, 'Baz'); is($foo->bar->baz->hello, 'World', '... this all worked fine'); done_testing; moose_clone_weak.t000664001750001750 761014343376440 17513 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Foo; use MyMoose; has bar => ( is => 'ro', weak_ref => 1, ); } { package MyScopeGuard; sub new { my ($class, $cb) = @_; bless { cb => $cb }, $class; } sub DESTROY { shift->{cb}->() } } { my $destroyed = 0; my $foo = do { my $bar = MyScopeGuard->new(sub { $destroyed++ }); my $foo = Foo->new({ bar => $bar }); my $clone = $foo->meta->clone_object($foo); is $destroyed, 0; $clone; }; isa_ok($foo, 'Foo'); is $foo->bar, undef; is $destroyed, 1; } { my $clone; { my $anon = Moose::Meta::Class->create_anon_class; my $foo = $anon->new_object; isa_ok($foo, $anon->name); ok(Class::MOP::class_of($foo), "has a metaclass"); $clone = $anon->clone_object($foo); isa_ok($clone, $anon->name); ok(Class::MOP::class_of($clone), "has a metaclass"); } ok(Class::MOP::class_of($clone), "still has a metaclass"); } { package Foo::Meta::Attr::Trait; use MyMoose::Role; has value_slot => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { shift->name }, ); has count_slot => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { '<>' . shift->name }, ); sub slots { my $self = shift; return ($self->value_slot, $self->count_slot); } sub _set_count { my $self = shift; my ($instance) = @_; my $mi = $self->associated_class->get_meta_instance; $mi->set_slot_value( $instance, $self->count_slot, ($mi->get_slot_value($instance, $self->count_slot) || 0) + 1, ); } sub _clear_count { my $self = shift; my ($instance) = @_; $self->associated_class->get_meta_instance->deinitialize_slot( $instance, $self->count_slot ); } sub has_count { my $self = shift; my ($instance) = @_; $self->associated_class->get_meta_instance->has_slot_value( $instance, $self->count_slot ); } sub count { my $self = shift; my ($instance) = @_; $self->associated_class->get_meta_instance->get_slot_value( $instance, $self->count_slot ); } after set_initial_value => sub { shift->_set_count(@_); }; after set_value => sub { shift->_set_count(@_); }; around _inline_instance_set => sub { my $orig = shift; my $self = shift; my ($instance) = @_; my $mi = $self->associated_class->get_meta_instance; return 'do { ' . $mi->inline_set_slot_value( $instance, $self->count_slot, $mi->inline_get_slot_value( $instance, $self->count_slot ) . ' + 1' ) . ';' . $self->$orig(@_) . '}'; }; after clear_value => sub { shift->_clear_count(@_); }; } { package Bar; use MyMoose; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { attribute => ['Foo::Meta::Attr::Trait'], }, ); has baz => ( is => 'rw' ); } SKIP: { skip "do not play nice with traits that change inlining behaviour", 3; my $attr = Bar->meta->find_attribute_by_name('baz'); my $bar = Bar->new(baz => 1); is($attr->count($bar), 1, "right count"); $bar->baz(2); is($attr->count($bar), 2, "right count"); my $clone = $bar->meta->clone_object($bar); is($attr->count($clone), $attr->count($bar), "right count"); } done_testing; moose_default_class_role_types.t000664001750001750 252714343376440 22464 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Moose::Util::TypeConstraints; { package Foo; use MyMoose; has unknown_class => ( is => 'ro', isa => 'UnknownClass', ); has unknown_role => ( is => 'ro', does => 'UnknownRole', ); } { my $meta = Foo->meta; my $class_tc = $meta->get_attribute('unknown_class')->type_constraint; isa_ok($class_tc, 'Moose::Meta::TypeConstraint::Class'); is($class_tc, find_type_constraint('UnknownClass'), "class type is registered"); like( exception { subtype 'UnknownClass', as 'Str'; }, qr/The type constraint 'UnknownClass' has already been created in Foo and cannot be created again in main/, "Can't redefine implicitly defined class types" ); my $role_tc = $meta->get_attribute('unknown_role')->type_constraint; isa_ok($role_tc, 'Moose::Meta::TypeConstraint::Role'); is($role_tc, find_type_constraint('UnknownRole'), "role type is registered"); like( exception { subtype 'UnknownRole', as 'Str'; }, qr/The type constraint 'UnknownRole' has already been created in Foo and cannot be created again in main/, "Can't redefine implicitly defined class types" ); } done_testing; moose_default_undef.t000664001750001750 64114343376440 20166 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package Foo; use MyMoose; has foo => ( is => 'ro', isa => 'Maybe[Int]', default => undef, predicate => 'has_foo', ); } with_immutable { is(Foo->new->foo, undef); ok(Foo->new->has_foo); } 'Foo'; done_testing; moose_delegation_and_modifiers.t000664001750001750 177514343376440 22410 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Bar; use MyMoose; sub baz { 'Bar::baz' } sub gorch { 'Bar::gorch' } package Foo; use MyMoose; has 'bar' => ( is => 'ro', isa => 'Bar', lazy => 1, default => sub { Bar->new }, handles => [qw[ baz gorch ]] ); package Foo::Extended; use MyMoose; extends 'Foo'; has 'test' => ( is => 'rw', isa => 'Bool', default => sub { 0 }, ); around 'bar' => sub { my $next = shift; my $self = shift; $self->test(1); $self->$next(); }; } my $foo = Foo::Extended->new; isa_ok($foo, 'Foo::Extended'); isa_ok($foo, 'Foo'); ok(!$foo->test, '... the test value has not been changed'); is($foo->baz, 'Bar::baz', '... got the right delegated method'); ok($foo->test, '... the test value has now been changed'); done_testing; moose_delegation_arg_aliasing.t000664001750001750 142514343376440 22215 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Foo; use MyMoose; sub aliased { my $self = shift; $_[1] = $_[0]; } } { package HasFoo; use MyMoose; has foo => ( is => 'ro', isa => 'Foo', handles => { foo_aliased => 'aliased', foo_aliased_curried => ['aliased', 'bar'], } ); } my $hasfoo = HasFoo->new(foo => Foo->new); my $x; $hasfoo->foo->aliased('foo', $x); is($x, 'foo', "direct aliasing works"); undef $x; $hasfoo->foo_aliased('foo', $x); is($x, 'foo', "delegated aliasing works"); undef $x; $hasfoo->foo_aliased_curried($x); is($x, 'bar', "delegated aliasing with currying works"); done_testing; moose_delegation_target_not_loaded.t000664001750001750 156514343376440 23260 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package X; use MyMoose; ::like( ::exception{ has foo => ( is => 'ro', isa => 'Foo', handles => qr/.*/, ) }, qr/\QThe foo attribute is trying to delegate to a class which has not been loaded - Foo/, 'cannot delegate to a class which is not yet loaded' ); ::like( ::exception{ has foo => ( is => 'ro', does => 'Role::Foo', handles => qr/.*/, ) }, qr/\QThe foo attribute is trying to delegate to a role which has not been loaded - Role::Foo/, 'cannot delegate to a role which is not yet loaded' ); } done_testing; moose_illegal_options_for_inheritance.t000664001750001750 366414343376440 24014 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has foo => ( is => 'ro', ); has bar => ( clearer => 'clear_bar', ); } { package Foo::Sub; use MyMoose; extends 'Foo'; ::is( ::exception { has '+foo' => (is => 'rw') }, undef, "can override is" ); ::like( ::exception { has '+foo' => (reader => 'bar') }, qr/illegal/, "can't override reader" ); ::is( ::exception { has '+foo' => (clearer => 'baz') }, undef, "can override unspecified things" ); ::like( ::exception { has '+bar' => (clearer => 'quux') }, qr/illegal/, "can't override clearer" ); ::is( ::exception { has '+bar' => (predicate => 'has_bar') }, undef, "can override unspecified things" ); } { package Bar::Meta::Attribute; use MyMoose::Role; has my_illegal_option => (is => 'ro'); around illegal_options_for_inheritance => sub { return (shift->(@_), 'my_illegal_option'); }; } { package Bar; use MyMoose; ::is( ::exception { has bar => ( traits => ['Bar::Meta::Attribute'], my_illegal_option => 'FOO', is => 'bare', ); }, undef, "can use illegal options" ); has baz => ( traits => ['Bar::Meta::Attribute'], is => 'bare', ); } { package Bar::Sub; use MyMoose; extends 'Bar'; ::like( ::exception { has '+bar' => (my_illegal_option => 'BAR') }, qr/illegal/, "can't override illegal attribute" ); ::is( ::exception { has '+baz' => (my_illegal_option => 'BAR') }, undef, "can add illegal option if superclass doesn't set it" ); } my $bar_attr = Bar->meta->get_attribute('bar'); ok((grep { $_ eq 'my_illegal_option' } $bar_attr->illegal_options_for_inheritance) > 0, '... added my_illegal_option as illegal option for inheritance'); done_testing; moose_inherit_lazy_build.t000664001750001750 320714343376440 21262 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Parent; use MyMoose; has attr => ( is => 'rw', isa => 'Str' ); } { package Child; use MyMoose; extends 'Parent'; has '+attr' => ( lazy_build => 1 ); sub _build_attr { return 'value'; } } my $parent = Parent->new(); my $child = Child->new(); ok( !$parent->meta->get_attribute('attr')->is_lazy_build, 'attribute in parent does not have lazy_build trait' ); ok( !$parent->meta->get_attribute('attr')->is_lazy, 'attribute in parent does not have lazy trait' ); ok( !$parent->meta->get_attribute('attr')->has_builder, 'attribute in parent does not have a builder method' ); ok( !$parent->meta->get_attribute('attr')->has_clearer, 'attribute in parent does not have a clearer method' ); ok( !$parent->meta->get_attribute('attr')->has_predicate, 'attribute in parent does not have a predicate method' ); ok( $child->meta->get_attribute('attr')->is_lazy_build, 'attribute in child has the lazy_build trait' ); ok( $child->meta->get_attribute('attr')->is_lazy, 'attribute in child has the lazy trait' ); ok( $child->meta->get_attribute('attr')->has_builder, 'attribute in child has a builder method' ); ok( $child->meta->get_attribute('attr')->has_clearer, 'attribute in child has a clearer method' ); ok( $child->meta->get_attribute('attr')->has_predicate, 'attribute in child has a predicate method' ); is( $child->attr, 'value', 'attribute defined as lazy_build in child is properly built' ); done_testing; moose_lazy_no_default.t000664001750001750 74514343376440 20545 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; ::like( ::exception{ has foo => ( is => 'ro', lazy => 1, ); }, qr/\QYou cannot have a lazy attribute (foo) without specifying a default value for it/, 'lazy without a default or builder throws an error' ); } done_testing; moose_method_generation_rules.t000664001750001750 352314343376440 22310 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; =pod is => rw, writer => _foo # turns into (reader => foo, writer => _foo) is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before is => rw, accessor => _foo # turns into (accessor => _foo) is => ro, accessor => _foo # error, accesor is rw =cut sub make_class { my ($is, $attr, $class) = @_; eval "package $class; use MyMoose; has 'foo' => ( is => '$is', $attr => '_foo' );"; return $@ ? die $@ : $class; } my $obj; my $class; $class = make_class('rw', 'writer', 'Test::Class::WriterRW'); ok($class, "Can define attr with rw + writer"); $obj = $class->new(); can_ok($obj, qw/foo _foo/); is( exception {$obj->_foo(1)}, undef, "$class->_foo is writer" ); is($obj->foo(), 1, "$class->foo is reader"); isnt( exception {$obj->foo(2)}, undef, "$class->foo is not writer" ); # this should fail ok(!defined $obj->_foo(undef), "$class->_foo is not reader"); $class = make_class('ro', 'writer', 'Test::Class::WriterRO'); ok($class, "Can define attr with ro + writer"); $obj = $class->new(); can_ok($obj, qw/foo _foo/); is( exception {$obj->_foo(1)}, undef, "$class->_foo is writer" ); is($obj->foo(), 1, "$class->foo is reader"); isnt( exception {$obj->foo(1)}, undef, "$class->foo is not writer" ); isnt($obj->_foo(undef), 1, "$class->_foo is not reader"); $class = make_class('rw', 'accessor', 'Test::Class::AccessorRW'); ok($class, "Can define attr with rw + accessor"); $obj = $class->new(); can_ok($obj, qw/_foo/); is( exception {$obj->_foo(1)}, undef, "$class->_foo is writer" ); is($obj->_foo(), 1, "$class->foo is reader"); isnt( exception { make_class('ro', 'accessor', "Test::Class::AccessorRO"); }, undef, "Cant define attr with ro + accessor" ); done_testing; moose_misc_attribute_tests.t000664001750001750 1623114343376440 21663 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Test::Requires { Moose => '2.1102' }; # error message changed { { package Test::Attribute::Inline::Documentation; use MyMoose; has 'foo' => ( documentation => q{ The 'foo' attribute is my favorite attribute in the whole wide world. }, is => 'bare', ); } my $foo_attr = Test::Attribute::Inline::Documentation->meta->get_attribute('foo'); ok($foo_attr->has_documentation, '... the foo has docs'); is($foo_attr->documentation, q{ The 'foo' attribute is my favorite attribute in the whole wide world. }, '... got the foo docs'); } { { package Test::For::Lazy::TypeConstraint; use MyMoose; use Moose::Util::TypeConstraints; has 'bad_lazy_attr' => ( is => 'rw', isa => 'ArrayRef', lazy => 1, default => sub { "test" }, ); has 'good_lazy_attr' => ( is => 'rw', isa => 'ArrayRef', lazy => 1, default => sub { [] }, ); } my $test = Test::For::Lazy::TypeConstraint->new; isa_ok($test, 'Test::For::Lazy::TypeConstraint'); isnt( exception { $test->bad_lazy_attr; }, undef, '... this does not work' ); is( exception { $test->good_lazy_attr; }, undef, '... this does not work' ); } { { package Test::Arrayref::Attributes; use MyMoose; has [qw(foo bar baz)] => ( is => 'rw', ); } my $test = Test::Arrayref::Attributes->new; isa_ok($test, 'Test::Arrayref::Attributes'); can_ok($test, qw(foo bar baz)); } { { package Test::Arrayref::RoleAttributes::Role; use MyMoose::Role; has [qw(foo bar baz)] => ( is => 'rw', ); } { package Test::Arrayref::RoleAttributes; use MyMoose; with 'Test::Arrayref::RoleAttributes::Role'; } my $test = Test::Arrayref::RoleAttributes->new; isa_ok($test, 'Test::Arrayref::RoleAttributes'); can_ok($test, qw(foo bar baz)); } { { package Test::UndefDefault::Attributes; use MyMoose; has 'foo' => ( is => 'ro', isa => 'Str', default => sub { return } ); } isnt( exception { Test::UndefDefault::Attributes->new; }, undef, '... default must return a value which passes the type constraint' ); } { { package OverloadedStr; use MyMoose; use overload '""' => sub { 'this is *not* a string' }; has 'a_str' => ( isa => 'Str' , is => 'rw' ); } my $moose_obj = OverloadedStr->new; is($moose_obj->a_str( 'foobar' ), 'foobar', 'setter took string'); ok($moose_obj, 'this is a *not* a string'); like( exception { $moose_obj->a_str( $moose_obj ) }, qr/Attribute \(a_str\) does not pass the type constraint because\: Validation failed for 'Str' with value .*OverloadedStr/, '... dies without overloading the string' ); } { { package OverloadBreaker; use MyMoose; has 'a_num' => ( isa => 'Int' , is => 'rw', default => 7.5 ); } like( exception { OverloadBreaker->new; }, qr/Attribute \(a_num\) does not pass the type constraint because\: Validation failed for 'Int' with value 7\.5/, '... this doesnt trip overload to break anymore ' ); is( exception { OverloadBreaker->new(a_num => 5); }, undef, '... this works fine though' ); } { { package Test::Builder::Attribute; use MyMoose; has 'foo' => ( required => 1, builder => 'build_foo', is => 'ro'); sub build_foo { return "works" }; } my $meta = Test::Builder::Attribute->meta; my $foo_attr = $meta->get_attribute("foo"); ok($foo_attr->is_required, "foo is required"); ok($foo_attr->has_builder, "foo has builder"); is($foo_attr->builder, "build_foo", ".. and it's named build_foo"); my $instance = Test::Builder::Attribute->new; is($instance->foo, 'works', "foo builder works"); } { { package Test::Builder::Attribute::Broken; use MyMoose; has 'foo' => ( required => 1, builder => 'build_foo', is => 'ro'); } isnt( exception { Test::Builder::Attribute::Broken->new; }, undef, '... no builder, wtf' ); } { { package Test::LazyBuild::Attribute; use MyMoose; has 'foo' => ( lazy_build => 1, is => 'ro'); has '_foo' => ( lazy_build => 1, is => 'ro'); has 'fool' => ( lazy_build => 1, is => 'ro'); sub _build_foo { return "works" }; sub _build__foo { return "works too" }; } my $meta = Test::LazyBuild::Attribute->meta; my $foo_attr = $meta->get_attribute("foo"); my $_foo_attr = $meta->get_attribute("_foo"); ok($foo_attr->is_lazy, "foo is lazy"); ok($foo_attr->is_lazy_build, "foo is lazy_build"); ok($foo_attr->has_clearer, "foo has clearer"); is($foo_attr->clearer, "clear_foo", ".. and it's named clear_foo"); ok($foo_attr->has_builder, "foo has builder"); is($foo_attr->builder, "_build_foo", ".. and it's named build_foo"); ok($foo_attr->has_predicate, "foo has predicate"); is($foo_attr->predicate, "has_foo", ".. and it's named has_foo"); ok($_foo_attr->is_lazy, "_foo is lazy"); ok(!$_foo_attr->is_required, "lazy_build attributes are no longer automatically required"); ok($_foo_attr->is_lazy_build, "_foo is lazy_build"); ok($_foo_attr->has_clearer, "_foo has clearer"); is($_foo_attr->clearer, "_clear_foo", ".. and it's named _clear_foo"); ok($_foo_attr->has_builder, "_foo has builder"); is($_foo_attr->builder, "_build__foo", ".. and it's named _build_foo"); ok($_foo_attr->has_predicate, "_foo has predicate"); is($_foo_attr->predicate, "_has_foo", ".. and it's named _has_foo"); my $instance = Test::LazyBuild::Attribute->new; ok(!$instance->has_foo, "noo foo value yet"); ok(!$instance->_has_foo, "noo _foo value yet"); is($instance->foo, 'works', "foo builder works"); is($instance->_foo, 'works too', "foo builder works too"); like( exception { $instance->fool }, qr/Test::LazyBuild::Attribute does not support builder method \'_build_fool\' for attribute \'fool\'/, "Correct error when a builder method is not present" ); } { package OutOfClassTest; use MyMoose; } is( exception { OutOfClassTest::has('foo', is => 'bare'); }, undef, 'create attr via direct sub call' ); is( exception { OutOfClassTest->can('has')->('bar', is => 'bare'); }, undef, 'create attr via can' ); ok(OutOfClassTest->meta->get_attribute('foo'), 'attr created from sub call'); ok(OutOfClassTest->meta->get_attribute('bar'), 'attr created from can'); { { package Foo; use MyMoose; ::like( ::exception { has 'foo' => ( 'ro', isa => 'Str' ) }, qr/\QYou must pass an even number of attribute options/, 'has throws error with odd number of attribute options' ); } } done_testing; moose_more_attr_delegation.t000664001750001750 1552514343376440 21617 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; =pod This tests the more complex delegation cases and that they do not fail at compile time. =cut { package ChildASuper; use MyMoose; sub child_a_super_method { "as" } package ChildA; use MyMoose; extends "ChildASuper"; sub child_a_method_1 { "a1" } sub child_a_method_2 { Scalar::Util::blessed($_[0]) . " a2" } package ChildASub; use MyMoose; extends "ChildA"; sub child_a_method_3 { "a3" } package ChildB; use MyMoose; sub child_b_method_1 { "b1" } sub child_b_method_2 { "b2" } sub child_b_method_3 { "b3" } package ChildC; use MyMoose; sub child_c_method_1 { "c1" } sub child_c_method_2 { "c2" } sub child_c_method_3_la { "c3" } sub child_c_method_4_la { "c4" } package ChildD; use MyMoose; sub child_d_method_1 { "d1" } sub child_d_method_2 { "d2" } package ChildE; # no Moose sub new { bless {}, shift } sub child_e_method_1 { "e1" } sub child_e_method_2 { "e2" } package ChildF; # no Moose sub new { bless {}, shift } sub child_f_method_1 { "f1" } sub child_f_method_2 { "f2" } $INC{'ChildF.pm'} = __FILE__; package ChildG; use MyMoose; sub child_g_method_1 { "g1" } package ChildH; use MyMoose; sub child_h_method_1 { "h1" } sub parent_method_1 { "child_parent_1" } package ChildI; use MyMoose; sub child_i_method_1 { "i1" } sub parent_method_1 { "child_parent_1" } package Parent; use MyMoose; sub parent_method_1 { "parent_1" } ::can_ok('Parent', 'parent_method_1'); ::isnt( ::exception { has child_a => ( is => "ro", default => sub { ChildA->new }, handles => qr/.*/, ); }, undef, "all_methods requires explicit isa" ); ::is( ::exception { has child_a => ( isa => "ChildA", is => "ro", default => sub { ChildA->new }, handles => qr/.*/, ); }, undef, "allow all_methods with explicit isa" ); ::is( ::exception { has child_b => ( is => 'ro', default => sub { ChildB->new }, handles => [qw/child_b_method_1/], ); }, undef, "don't need to declare isa if method list is predefined" ); ::is( ::exception { has child_c => ( isa => "ChildC", is => "ro", default => sub { ChildC->new }, handles => qr/_la$/, ); }, undef, "can declare regex collector" ); ::isnt( ::exception { has child_d => ( is => "ro", default => sub { ChildD->new }, handles => sub { my ( $class, $delegate_class ) = @_; } ); }, undef, "can't create attr with generative handles parameter and no isa" ); ::is( ::exception { has child_d => ( isa => "ChildD", is => "ro", default => sub { ChildD->new }, handles => sub { my ( $class, $delegate_class ) = @_; return; } ); }, undef, "can't create attr with generative handles parameter and no isa" ); ::is( ::exception { has child_e => ( isa => "ChildE", is => "ro", default => sub { ChildE->new }, handles => ["child_e_method_2"], ); }, undef, "can delegate to non moose class using explicit method list" ); my $delegate_class; ::is( ::exception { has child_f => ( isa => "ChildF", is => "ro", default => sub { ChildF->new }, handles => sub { $delegate_class = $_[1]->name; return; }, ); }, undef, "subrefs on non moose class give no meta" ); ::is( $delegate_class, "ChildF", "plain classes are handed down to subs" ); ::is( ::exception { has child_g => ( isa => "ChildG", default => sub { ChildG->new }, handles => ["child_g_method_1"], ); }, undef, "can delegate to object even without explicit reader" ); ::can_ok('Parent', 'parent_method_1'); ::isnt( ::exception { has child_h => ( isa => "ChildH", is => "ro", default => sub { ChildH->new }, handles => sub { map { $_, $_ } $_[1]->get_all_method_names }, ); }, undef, "Can't override exisiting class method in delegate" ); ::can_ok('Parent', 'parent_method_1'); ::is( ::exception { has child_i => ( isa => "ChildI", is => "ro", default => sub { ChildI->new }, handles => sub { map { $_, $_ } grep { !/^parent_method_1|meta$/ } $_[1]->get_all_method_names; }, ); }, undef, "Test handles code ref for skipping predefined methods" ); sub parent_method { "p" } } # sanity isa_ok( my $p = Parent->new, "Parent" ); isa_ok( $p->child_a, "ChildA" ); isa_ok( $p->child_b, "ChildB" ); isa_ok( $p->child_c, "ChildC" ); isa_ok( $p->child_d, "ChildD" ); isa_ok( $p->child_e, "ChildE" ); isa_ok( $p->child_f, "ChildF" ); isa_ok( $p->child_i, "ChildI" ); ok(!$p->can('child_g'), '... no child_g accessor defined'); ok(!$p->can('child_h'), '... no child_h accessor defined'); is( $p->parent_method, "p", "parent method" ); is( $p->child_a->child_a_super_method, "as", "child supermethod" ); is( $p->child_a->child_a_method_1, "a1", "child method" ); can_ok( $p, "child_a_super_method" ); can_ok( $p, "child_a_method_1" ); can_ok( $p, "child_a_method_2" ); ok( !$p->can( "child_a_method_3" ), "but not subclass of delegate class" ); is( $p->child_a_method_1, $p->child_a->child_a_method_1, "delegate behaves the same" ); is( $p->child_a_method_2, "ChildA a2", "delegates are their own invocants" ); can_ok( $p, "child_b_method_1" ); ok( !$p->can("child_b_method_2"), "but not ChildB's unspecified siblings" ); ok( !$p->can($_), "none of ChildD's methods ($_)" ) for grep { /^child/ } map { $_->name } ChildD->meta->get_all_methods(); can_ok( $p, "child_c_method_3_la" ); can_ok( $p, "child_c_method_4_la" ); is( $p->child_c_method_3_la, "c3", "ChildC method delegated OK" ); can_ok( $p, "child_e_method_2" ); ok( !$p->can("child_e_method_1"), "but not child_e_method_1"); is( $p->child_e_method_2, "e2", "delegate to non moose class (child_e_method_2)" ); can_ok( $p, "child_g_method_1" ); is( $p->child_g_method_1, "g1", "delegate to moose class without reader (child_g_method_1)" ); can_ok( $p, "child_i_method_1" ); is( $p->parent_method_1, "parent_1", "delegate doesn't override existing method" ); done_testing; moose_no_init_arg.t000664001750001750 103214343376440 17664 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Foo; use MyMoose; eval { has 'foo' => ( is => "rw", init_arg => undef, ); }; ::ok(!$@, '... created the attr okay'); } { my $foo = Foo->new( foo => "bar" ); isa_ok($foo, 'Foo'); is( $foo->foo, undef, "field is not set via init arg" ); $foo->foo("blah"); is( $foo->foo, "blah", "field is set via setter" ); } done_testing; moose_no_slot_access.t000664001750001750 353514343376440 20404 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; { package SomeAwesomeDB; sub new_row { } sub read { } sub write { } } { package MooseX::SomeAwesomeDBFields; # implementation of methods not called in the example deliberately # omitted use MyMoose::Role; sub inline_create_instance { my ( $self, $classvar ) = @_; "bless SomeAwesomeDB::new_row(), $classvar"; } sub inline_get_slot_value { my ( $self, $invar, $slot ) = @_; "SomeAwesomeDB::read($invar, \"$slot\")"; } sub inline_set_slot_value { my ( $self, $invar, $slot, $valexp ) = @_; "SomeAwesomeDB::write($invar, \"$slot\", $valexp)"; } sub inline_is_slot_initialized { my ( $self, $invar, $slot ) = @_; "1"; } sub inline_initialize_slot { my ( $self, $invar, $slot ) = @_; ""; } sub inline_slot_access { die "inline_slot_access should not have been used"; } } { package Toy; use MyMoose; use Moose::Util::MetaRole; use Test::More; use Test::Fatal; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { instance => ['MooseX::SomeAwesomeDBFields'] }, ); is( exception { has lazy_attr => ( is => 'ro', isa => 'Bool', lazy => 1, default => sub {0}, ); }, undef, "Adding lazy accessor does not use inline_slot_access" ); is( exception { has rw_attr => ( is => 'rw', ); }, undef, "Adding read-write accessor does not use inline_slot_access" ); is( exception { __PACKAGE__->meta->make_immutable; }, undef, "Inling constructor does not use inline_slot_access" ); done_testing; } moose_non_alpha_attr_names.t000664001750001750 302514343376440 21554 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package Foo; use MyMoose; has 'type' => ( required => 0, reader => 'get_type', default => 1, ); # Assigning types to these non-alpha attrs exposed a bug in Moose. has '@type' => ( isa => 'Str', required => 0, reader => 'get_at_type', writer => 'set_at_type', default => 'at type', ); has 'has spaces' => ( isa => 'Int', required => 0, reader => 'get_hs', default => 42, ); has '!req' => ( required => 1, reader => 'req' ); no Moose; } with_immutable { ok( Foo->meta->has_attribute($_), "Foo has '$_' attribute" ) for 'type', '@type', 'has spaces'; my $foo = Foo->new( '!req' => 42 ); is( $foo->get_type, 1, q{'type' attribute default is 1} ); is( $foo->get_at_type, 'at type', q{'@type' attribute default is 1} ); is( $foo->get_hs, 42, q{'has spaces' attribute default is 42} ); $foo = Foo->new( type => 'foo', '@type' => 'bar', 'has spaces' => 200, '!req' => 84, ); isa_ok( $foo, 'Foo' ); is( $foo->get_at_type, 'bar', q{reader for '@type'} ); is( $foo->get_hs, 200, q{reader for 'has spaces'} ); $foo->set_at_type(99); is( $foo->get_at_type, 99, q{writer for '@type' worked} ); } 'Foo'; done_testing; moose_numeric_defaults.t000664001750001750 576014343376440 20741 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; use B; { package Foo; use MyMoose; has foo => (is => 'ro', default => 100); sub bar { 100 } } with_immutable { my $foo = Foo->new; for my $meth (qw(foo bar)) { my $val = $foo->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Foo'; { package Bar; use MyMoose; has foo => (is => 'ro', lazy => 1, default => 100); sub bar { 100 } } with_immutable { my $bar = Bar->new; for my $meth (qw(foo bar)) { my $val = $bar->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Bar'; { package Baz; use MyMoose; has foo => (is => 'ro', isa => 'Int', lazy => 1, default => 100); sub bar { 100 } } with_immutable { my $baz = Baz->new; for my $meth (qw(foo bar)) { my $val = $baz->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Baz'; { package Foo2; use MyMoose; has foo => (is => 'ro', default => 10.5); sub bar { 10.5 } } with_immutable { my $foo2 = Foo2->new; for my $meth (qw(foo bar)) { my $val = $foo2->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Foo2'; { package Bar2; use MyMoose; has foo => (is => 'ro', lazy => 1, default => 10.5); sub bar { 10.5 } } with_immutable { my $bar2 = Bar2->new; for my $meth (qw(foo bar)) { my $val = $bar2->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Bar2'; { package Baz2; use MyMoose; has foo => (is => 'ro', isa => 'Num', lazy => 1, default => 10.5); sub bar { 10.5 } } with_immutable { my $baz2 = Baz2->new; for my $meth (qw(foo bar)) { my $val = $baz2->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); # it's making sure that the Num value doesn't get converted to a string for regex matching # this is the reason for using a temporary variable, $val for regex matching, # instead of $_[1] in Num implementation in lib/Moose/Util/TypeConstraints/Builtins.pm ok(!($flags & B::SVf_POK), "not a string"); } } 'Baz2'; done_testing; moose_trigger_and_coerce.t000664001750001750 233514343376440 21210 0ustar00taitai000000000000MooseX-XSAccessor-0.010/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Fake::DateTime; use MyMoose; has 'string_repr' => ( is => 'ro' ); package Mortgage; use MyMoose; use Moose::Util::TypeConstraints; coerce 'Fake::DateTime' => from 'Str' => via { Fake::DateTime->new( string_repr => $_ ) }; has 'closing_date' => ( is => 'rw', isa => 'Fake::DateTime', coerce => 1, trigger => sub { my ( $self, $val ) = @_; ::pass('... trigger is being called'); ::isa_ok( $self->closing_date, 'Fake::DateTime' ); ::isa_ok( $val, 'Fake::DateTime' ); } ); } { my $mtg = Mortgage->new( closing_date => 'yesterday' ); isa_ok( $mtg, 'Mortgage' ); # check that coercion worked isa_ok( $mtg->closing_date, 'Fake::DateTime' ); } Mortgage->meta->make_immutable; ok( Mortgage->meta->is_immutable, '... Mortgage is now immutable' ); { my $mtg = Mortgage->new( closing_date => 'yesterday' ); isa_ok( $mtg, 'Mortgage' ); # check that coercion worked isa_ok( $mtg->closing_date, 'Fake::DateTime' ); } done_testing; moose_misc_attribute_coerce_lazy.t000664001750001750 165714343376440 24554 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t.disableduse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package HTTPHeader; use MyMoose; has 'array' => (is => 'ro'); has 'hash' => (is => 'ro'); } { package Request; use MyMoose; use Moose::Util::TypeConstraints; subtype Header => => as Object => where { $_->isa('HTTPHeader') }; coerce Header => from ArrayRef => via { HTTPHeader->new(array => $_[0]) } => from HashRef => via { HTTPHeader->new(hash => $_[0]) }; has 'headers' => ( is => 'rw', isa => 'Header', coerce => 1, lazy => 1, default => sub { [ 'content-type', 'text/html' ] } ); } my $r = Request->new; isa_ok($r, 'Request'); is( exception { $r->headers; }, undef, '... this coerces and passes the type constraint even with lazy' ); done_testing; XSAccessor.pm000664001750001750 1433514343376440 20127 0ustar00taitai000000000000MooseX-XSAccessor-0.010/lib/MooseXpackage MooseX::XSAccessor; use 5.008; use strict; use warnings; use Moose 2.0600 (); use MooseX::XSAccessor::Trait::Attribute (); use Scalar::Util qw(blessed); BEGIN { $MooseX::XSAccessor::AUTHORITY = 'cpan:TOBYINK'; $MooseX::XSAccessor::VERSION = '0.010'; } our $LVALUE; use Moose::Exporter; "Moose::Exporter"->setup_import_methods; sub init_meta { shift; my %p = @_; Moose::Util::MetaRole::apply_metaroles( for => $p{for_class}, class_metaroles => { attribute => [qw( MooseX::XSAccessor::Trait::Attribute )], }, role_metaroles => { applied_attribute => [qw( MooseX::XSAccessor::Trait::Attribute )], }, ); } sub is_xs { my $sub = $_[0]; if ( blessed($sub) and $sub->isa( "Class::MOP::Method" ) ) { $sub = $sub->body; } elsif ( not ref $sub ) { no strict "refs"; $sub = \&{$sub}; } require B; !! B::svref_2object( $sub )->XSUB; } 1; __END__ =pod =for stopwords Auto-deref Mouse/Class::XSAccessor =encoding utf-8 =head1 NAME MooseX::XSAccessor - use Class::XSAccessor to speed up Moose accessors =head1 SYNOPSIS package MyClass; use Moose; use MooseX::XSAccessor; has foo => (...); =head1 DESCRIPTION This module accelerates L-generated accessor, reader, writer and predicate methods using L. You get a speed-up for no extra effort. It is automatically applied to every attribute in the class. =begin private =item init_meta =end private The use of the following features of Moose attributes prevents a reader from being accelerated: =over =item * Lazy builder or lazy default. =item * Auto-deref. (Does anybody use this anyway??) =back The use of the following features prevents a writer from being accelerated: =over =item * Type constraints (except C; C is effectively a no-op). =item * Triggers =item * Weak references =back An C accessor is effectively a reader and a writer glued together, so both of the above lists apply. Predicates can always be accelerated, provided you're using Class::XSAccessor 1.17 or above. Clearers can not be accelerated (as of current versions of Class::XSAccessor). =head2 Functions This module also provides one function, which is not exported so needs to be called by its full name. =over =item C<< MooseX::XSAccessor::is_xs($sub) >> Returns a boolean indicating whether a sub is an XSUB. C<< $sub >> may be a coderef, L object, or a qualified sub name as a string (e.g. C<< "MyClass::foo" >>). This function doesn't just work with accessors, but should be able to detect the difference between Perl and XS subs in general. (It may not be 100% reliable though.) =back =head2 Chained accessors and writers L can detect chained accessors and writers created using L, and can accelerate those too. package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::Attribute::Chained; has foo => (traits => ["Chained"], is => "rw"); has bar => (traits => ["Chained"], is => "ro", writer => "_set_bar"); has baz => ( is => "rw"); # not chained my $obj = "Local::Class"->new; $obj->foo(1)->_set_bar(2); print $obj->dump; =head2 Lvalue accessors L will detect lvalue accessors created with L and, by default, skip accelerating them. However, by setting C<< $MooseX::XSAccessor::LVALUE >> to true (preferably using the C Perl keyword), you can force it to accelerate those too. This introduces a visible change in behaviour though. L accessors normally allow two patterns for setting the value: $obj->foo = 42; # as an lvalue $obj->foo(42); # as a method call However, once accelerated, they may I be set as an lvalue. For this reason, setting C<< $MooseX::XSAccessor::LVALUE >> to true is considered an experimental feature. =head1 HINTS =over =item * Make attributes read-only when possible. This means that type constraints and coercions will only apply to the constructor, not the accessors, enabling the accessors to be accelerated. =item * If you do need a read-write attribute, consider making the main accessor read-only, and having a separate writer method. (Like L.) =item * Make defaults eager instead of lazy when possible, allowing your readers to be accelerated. =item * If you need to accelerate just a specific attribute, apply the attribute trait directly: package MyClass; use Moose; has foo => ( traits => ["MooseX::XSAccessor::Trait::Attribute"], ..., ); =item * If you don't want to add a dependency on MooseX::XSAccessor, but do want to use it if it's available, the following code will use it optionally: package MyClass; use Moose; BEGIN { eval "use MooseX::XSAccessor" }; has foo => (...); =back =head1 CAVEATS =over =item * Calling a writer method without a parameter in Moose does not raise an exception: $person->set_name(); # sets name attribute to "undef" However, this is a fatal error in Class::XSAccessor. =item * MooseX::XSAccessor does not play nice with attribute traits that alter accessor behaviour, or define additional accessors for attributes. L is an example thereof. L is handled as a special case. =item * MooseX::XSAccessor only works on blessed hash storage; not e.g. L or L. MooseX::XSAccessor is usually able to detect such situations and silently switch itself off. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013, 2017, 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. MyMoose.pm000664001750001750 32114343376440 16461 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t/libpackage MyMoose; use Import::Into; use Moose (); use MooseX::XSAccessor (); sub import { shift; my $caller = caller; "Moose"->import::into($caller, @_); "MooseX::XSAccessor"->import::into($caller); } 1;Role.pm000664001750001750 34314343376440 17366 0ustar00taitai000000000000MooseX-XSAccessor-0.010/t/lib/MyMoosepackage MyMoose::Role; use Import::Into; use Moose::Role (); use MooseX::XSAccessor (); sub import { shift; my $caller = caller; "Moose::Role"->import::into($caller, @_); "MooseX::XSAccessor"->import::into($caller); } 1;Attribute.pm000664001750001750 1141314343376440 23147 0ustar00taitai000000000000MooseX-XSAccessor-0.010/lib/MooseX/XSAccessor/Traitpackage MooseX::XSAccessor::Trait::Attribute; use 5.008; use strict; use warnings; use Class::XSAccessor 1.09 (); use Scalar::Util qw(reftype); use B qw(perlstring); BEGIN { $MooseX::XSAccessor::Trait::Attribute::AUTHORITY = 'cpan:TOBYINK'; $MooseX::XSAccessor::Trait::Attribute::VERSION = '0.010'; } # Map Moose terminology to Class::XSAccessor options. my %cxsa_opt = ( accessor => "accessors", reader => "getters", writer => "setters", ); $cxsa_opt{predicate} = "exists_predicates" if Class::XSAccessor->VERSION > 1.16; use Moose::Role; sub accessor_is_simple { my $self = shift; return !!0 if $self->has_type_constraint && $self->type_constraint ne "Any"; return !!0 if $self->should_coerce; return !!0 if $self->has_trigger; return !!0 if $self->is_weak_ref; return !!0 if $self->is_lazy; return !!0 if $self->should_auto_deref; !!1; } sub reader_is_simple { my $self = shift; return !!0 if $self->is_lazy; return !!0 if $self->should_auto_deref; !!1; } sub writer_is_simple { my $self = shift; return !!0 if $self->has_type_constraint && $self->type_constraint ne "Any"; return !!0 if $self->should_coerce; return !!0 if $self->has_trigger; return !!0 if $self->is_weak_ref; !!1; } sub predicate_is_simple { my $self = shift; !!1; } # Class::XSAccessor doesn't do clearers sub clearer_is_simple { !!0; } after install_accessors => sub { my $self = shift; my $slot = $self->name; my $class = $self->associated_class; my $classname = $class->name; # Don't attempt to do anything with instances that are not blessed hashes. my $is_hash = q(HASH) eq reftype( $class->get_meta_instance->create_instance ); return unless $is_hash && $class->get_meta_instance->is_inlinable; # Use inlined get method as a heuristic to detect weird shit. my $inline_get = $self->_inline_instance_get( '$X' ); return unless $inline_get eq sprintf( '$X->{%s}', perlstring $slot ); # Detect use of MooseX::Attribute::Chained my $is_chained = $self->does( 'MooseX::Traits::Attribute::Chained' ); # Detect use of MooseX::LvalueAttribute my $is_lvalue = $self->does( 'MooseX::LvalueAttribute::Trait::Attribute' ); for my $type ( qw/ accessor reader writer predicate clearer / ) { # Only accelerate methods if CXSA can deal with them next unless exists $cxsa_opt{$type}; # Only accelerate methods that exist! next unless $self->${\"has_$type"}; # Check to see they're simple (no type constraint checks, etc) next unless $self->${\"$type\_is_simple"}; my $methodname = $self->$type; my $metamethod = $class->get_method( $methodname ); # Perform the actual acceleration if ( $type eq 'accessor' and $is_lvalue ) { next if $is_chained; next if !$MooseX::XSAccessor::LVALUE; "Class::XSAccessor"->import( class => $classname, replace => 1, lvalue_accessors => +{ $methodname => $slot }, ); } else { "Class::XSAccessor"->import( class => $classname, replace => 1, chained => $is_chained, $cxsa_opt{$type} => +{ $methodname => $slot }, ); } # Naughty stuff!!! # We've overwritten a Moose-generated accessor, so now we need to # inform Moose's metathingies about the new coderef. # $metamethod->body is read-only, so dive straight into the blessed # hash. no strict "refs"; $metamethod->{"body"} = \&{"$classname\::$methodname"}; } return; }; 1; __END__ =pod =for stopwords booleans =encoding utf-8 =head1 NAME MooseX::XSAccessor::Trait::Attribute - get the Class::XSAccessor effect for a single attribute =head1 SYNOPSIS package MyClass; use Moose; has foo => ( traits => ["MooseX::XSAccessor::Trait::Attribute"], ..., ); say __PACKAGE__->meta->get_attribute("foo")->accessor_is_simple; =head1 DESCRIPTION Attributes with this trait have the following additional methods, which each return booleans: =over =item C<< accessor_is_simple >> =item C<< reader_is_simple >> =item C<< writer_is_simple >> =item C<< predicate_is_simple >> =item C<< clearer_is_simple >> =back What is meant by simple? Simple enough for L to take over the accessor's duties. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013, 2022 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.