COPYRIGHT000664001750001750 702312425206152 13213 0ustar00taitai000000000000Kavorka-0.036Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: Kavorka Upstream-Contact: Toby Inkster (TOBYINK) Source: https://metacpan.org/release/Kavorka Files: README lib/Kavorka.pm lib/Kavorka/Manual.pod lib/Kavorka/Manual/API.pod lib/Kavorka/Manual/ExtendingKavorka.pod lib/Kavorka/Manual/Functions.pod lib/Kavorka/Manual/MethodModifiers.pod lib/Kavorka/Manual/Methods.pod lib/Kavorka/Manual/MultiSubs.pod lib/Kavorka/Manual/PrototypeAndAttributes.pod lib/Kavorka/Manual/Signatures.pod lib/Kavorka/Parameter.pm lib/Kavorka/Signature.pm lib/Kavorka/Sub.pm lib/MooseX/KavorkaInfo.pm t/01basic.t t/02named-functions.t t/03anon-functions.t t/04named-methods.t t/05anon-methods.t t/10positional.t t/11named.t t/12invocant.t t/13slurpy.t t/14underscores.t t/20modifiers-moo.t t/21modifiers-moose.t t/22modifiers-mouse.t t/23modifiers-tiny.t t/24multimodifiers.t t/28modifiers-augment.t t/29modifiers-override.t t/30multi.t t/31multimulti.t t/32multiredefine.t t/33cacheinvalidationishard.t t/50types.t t/51coerce.t t/52typeexpr.t t/53typeexpr-moosextypes.t t/54typefallback.t t/59valueconstraints.t t/60alias.t t/61ro.t t/62locked.t t/63freshoverride.t t/69traits.t t/70introspection.t t/71moosemeta.t t/80returntype.t t/90closures.t t/91lvalue.t t/92weirdvars.t t/93prototypes.t Copyright: This software is copyright (c) 2013-2014 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: Changes META.json META.yml doap.ttl lib/Kavorka/MethodModifier.pm lib/Kavorka/Multi.pm lib/Kavorka/ReturnType.pm lib/Kavorka/Sub/After.pm lib/Kavorka/Sub/Around.pm lib/Kavorka/Sub/Augment.pm lib/Kavorka/Sub/Before.pm lib/Kavorka/Sub/ClassMethod.pm lib/Kavorka/Sub/Fun.pm lib/Kavorka/Sub/Method.pm lib/Kavorka/Sub/ObjectMethod.pm lib/Kavorka/Sub/Override.pm lib/Kavorka/TraitFor/Parameter/alias.pm lib/Kavorka/TraitFor/Parameter/assumed.pm lib/Kavorka/TraitFor/Parameter/locked.pm lib/Kavorka/TraitFor/Parameter/optional.pm lib/Kavorka/TraitFor/Parameter/ref_alias.pm lib/Kavorka/TraitFor/Parameter/ro.pm lib/Kavorka/TraitFor/ReturnType/assumed.pm lib/Kavorka/TraitFor/Sub/begin.pm lib/Kavorka/TraitFor/Sub/fresh.pm lib/Kavorka/TraitFor/Sub/override.pm lib/Parse/KeywordX.pm t/lib/Local/Bad.pm Copyright: Copyright 2014 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: INSTALL LICENSE TODO examples/benchmarks-named.pl examples/benchmarks-pos.pl examples/dancer2/example.pl examples/dancer2/lib/KavorkaX/Dancer2.pm examples/meta.pl Copyright: Unknown License: Unknown Files: examples/benchmarks.pl t/94bypassparsing.t t/95rolesatisfaction.t t/98undefer.t Copyright: This software is copyright (c) 2014 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: COPYRIGHT CREDITS SIGNATURE Copyright: None License: public-domain Files: examples/benchmarks-multisub.pl examples/fibonacci.pl Copyright: This software is copyright (c) 2013 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: Makefile.PL dist.ini Copyright: Copyright 2013 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/99threads.t Copyright: This software is copyright (c) 2014 by Aaron James Trevena. License: GPL-1.0+ or Artistic-1.0 License: Artistic-1.0 This software is Copyright (c) 2014 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) 2014 by the copyright holder(s). This is free software, licensed under: The GNU General Public License, Version 1, February 1989 CREDITS000664001750001750 60212425206150 12712 0ustar00taitai000000000000Kavorka-0.036Maintainer: - Toby Inkster (TOBYINK) Contributor: - Aaron James Trevena (TEEJAY) - Chris Tijerina (CAMSPI) - Grzegorz Rożniecki (XAERXESS) - Piers Cawley (PDCAWLEY) - Thibaut Le Page (THILP) Thanks: - Jonathan Cast - SPICEMAN - Syohei Yoshida (SYOHEX) Changes000664001750001750 3014112425206150 13226 0ustar00taitai000000000000Kavorka-0.036Kavorka ======= Created: 2013-09-23 Home page: Bug tracker: Maintainer: Toby Inkster (TOBYINK) 0.036 2014-11-01 [ Bug Fixes ] - Avoid inadvertantly autovivifying things in Sub::Defer's big hash of deferred subs. Chris Tijerina++ 0.035 2014-09-30 [ Test Suite ] - Add a test case for Sub::Defer-related weirdness. [ Other ] - Make it easier to do weird things subclassing Kavorka::Multi. 0.034 2014-09-07 - Avoid triggering RT#98666. - Updated: Switch from Sub::Name+Sub::Identify to the shiny new Sub::Util. 0.033 2014-08-22 [ Bug Fixes ] - Type::Registry::DWIM changed its API. (Kavorka probably shouldn't be using it anyway because it's an undocumented internal part of Type::Utils.) SpiceMan++ 0.032 2014-08-13 [ Bug Fixes ] - Work around a bug in Moo(?) or maybe the Perl keyword API(?) by undeferring Moo's deferred subs. Fixes RT#95786. Jonathan Cast++ 0.031 2014-08-13 [ Bug Fixes ] - Add `multi` to @EXPORT_OK. Thibaut Le Page++ - Fix link to Kavorka::Manual::Signatures. Thibaut Le Page++ [ Documentation ] - Update benchmarks given that Type::Tiny::XS is hellishly fast. [ Packaging ] - Recommend Type::Tiny::XS. [ Other ] - Updated: Bump required version of Return::Type. - Updated: Cope with changes to Exporter::Tiny; avoid triggering warnings. 0.030 2014-03-20 [ Bug Fixes ] - Eliminate dependency on Devel::Pragma, which fixes Kavorka on threaded Perls. Fixes RT#94015. Piers Cawley++ [ Test Suite ] - Add test using Kavorka on threaded Perls. Aaron James Trevena++ [ Other ] - Added: Introduce `f` as an alternative to `fun`. 0.029 2014-02-26 - Added: Kavorka::TraitFor::Sub::begin. 0.028 2014-02-21 The 'perlsub-compat' Release [ Test Suite ] - Add test cases covering bare @ and % sigils. [ Other ] - Allow attributes to *precede* signatures. - Make parsing of parameter defaults laxer so that an equals sign followed by no expression is allowed. 0.027 2014-01-30 - Minor change to the hook allowing keywords to deal with calls that bypass the Perl keyword API. 0.026 2014-01-30 - Allow keywords to detect when the keyword sub has been called in a way that bypasses the Perl keyword API's custom parsing (e.g. using a prototype, or as a coderef). By default, keywords croak when this is detected. - Method modifier keywords can now detect when the keyword sub has been called bypassing custom parsing, and act sanely rather than croaking. 0.025 2013-12-23 [ Bug Fixes ] - Value constraints for parameters without type constraints were being ignored. [ Test Suite ] - Tests for value constraints. [ Other ] - Added: Support non-block form of value constraints, taken from Perl 6 / Method::Signatures. 0.024 2013-12-18 [ Bug Fixes ] - s/namespace::clean/namespace::sweep/ 0.023 2013-12-17 [ Bug Fixes ] - Fix test case - should not depend on Moops! Syohei Yoshida++ 0.022 2013-12-16 [ Documentation ] - Fix typos in Kavorka::Manual::MultiSubs. Grzegorz Rożniecki++ [ Other ] - Added: Kavorka::TraitFor::Sub::fresh. - Added: Kavorka::TraitFor::Sub::override. 0.021 2013-11-30 [ Documentation ] - Rearrange some of the traits documentation. [ Other ] - Added: Implement a `ref_alias` trait, inspired by Method::Signatures. - Disallow the `assumed` parameter trait for multi subs. - Split out most of the implementation for the `optional` trait (except for special parsing rules) into Kavorka::TraitFor::ReturnType::optional. - Split out some sanity_check stuff into the trait modules. 0.020 2013-11-27 [ Documentation ] - Explain different ways to extend Kavorka. [ Other ] - Added: Kavorka::TraitFor::Parameter::assumed. - Can now use 'but' as another alias for 'is'/'does'. - Split out the assumed trait for return types as Kavorka::TraitFor::ReturnType::assumed. - Subs can now have traits. 0.019 2013-11-23 - Added: Provide an `augment` keyword which will work in Moose/Mouse, but not Moo. - Added: Provide an `override` keyword which will work in Moose/Mouse, but not Moo. - Allow named parameters to be passed in as a hashref rather than a hash. - Split out some of the Kavorka::Parameter features (aliases, locked hashrefs, read-only parameters) into parameter traits. 0.018 2013-11-18 - Allow non-Type::Tiny type constraints to be returned by type constraint expressions, provided they can be converted to Type::Tiny objects via Types::TypeTiny::to_TypeTiny. 0.017 2013-11-18 - Extensibility via parameter traits. - Rename Kavorka::Signature::Parameter -> Kavorka::Parameter. - Rename Kavorka::Signature::ReturnType -> Kavorka::ReturnType. 0.016 2013-11-07 [ Bug Fixes ] - Bypass the Internals::SvREADONLY prototype because handling of the ($;$) prototype changed in 5.16.0 and we were relying on the new behaviour. 0.015 2013-11-07 [ BACK COMPAT ] - Change the syntax of lexical functions and methods to include the `my` keyword in their declaration. [ Bug Fixes ] - $sub->signature now returns undef if no signature was given in the declaration. - Most of the closure issues associated with Parse::Keyword are now worked around. [ Documentation ] - Document that fun ($x, $y=$x) {...} doesn't work how you might expect it to, and some work-arounds. [ Test Suite ] - Tidy up some of the closure tests. [ Other ] - Checking if @_ < 0 is silly; stop doing that. 0.014 2013-11-05 Gunpowder, treason and plot - Added: Lexical functions and methods. - Added: Return types, optionally with coercion. - Updated: Work with (and indeed require Type::Tiny 0.032). 0.013 2013-10-27 [ Bug Fixes ] - Compiled dispatchers introduced in Kavorka 0.012 are essentially a form of cache. No cache invalidation was in place, leading to issues when adding extra same-named multi method candidates to parent classes after a multi method had already been invoked in a child class. Cache invalidation now works. [ Test Suite ] - Test for cache invalidation of compiled multi sub dispatchers. - Test that definition of multi subs happens at runtime, and definition can continue even after the multi sub has been invoked. 0.012 2013-10-26 [ Documentation ] - Various documentation improvements. [ Other ] - Optimization: avoid double type checks in multi subs. - Optimization: compile dispatchers for multi subs on demand. 0.011 2013-10-25 [ Documentation ] - Split up documentation into a manual with bite-sized chunks. [ Other ] - Allow multiple method names to be modified with a single method modifier. - Rename ${^NEXT} variable to $next for `around` method modifiers. - Support Perl 5.20 style :prototype(...) attribute. 0.010 2013-10-23 - Allow package variables such as $Foo::Bar in signatures. - General refactoring of variable name parsing. - Support 'my' and 'our' prefixes to variable names in signatures. 0.009 2013-10-22 [ Documentation ] - Minor fix to KavorkaX::Dancer2 example extension module. [ Packaging ] - Package my TODO list. 0.008 2013-10-17 [ Documentation ] - Include an example of extending Kavorka to cover some Dancer2 concepts. - Minor documentation fixes. [ Other ] - Make subclassing Kavorka.pm itself a little easier. 0.007 2013-10-16 - Allow named parameters to have multiple "outside" names. - Make the parentheses surrounding long named parameters optional. - Refactor Kavorka::Sub. 0.006 2013-10-15 [ Documentation ] - Document interplay between multi subs and multiple inheritance. [ Test Suite ] - Test cases for multi subs versus multiple inheritance. [ Other ] - Use invocant as starting point for searching for multi method candidates. 0.005 2013-10-13 [ Bug Fixes ] - Fix error parsing `where` clauses. [ Documentation ] - Included fibonnacci.pl example of using multi subs. [ Other ] - $parameter->constraints is now an arrayref of coderefs rather than an arrayref of strings of Perl code. - Changed error message resulting from failed value constraint. 0.004 2013-10-13 [ Documentation ] - Correct minor typo. [ Other ] - Added: Implement multi subs and multi methods. 0.003 2013-10-12 - Allow @_ and %_ to be used in signatures. - Improve sanity checking for signatures. 0.002 2013-10-11 - Added: Kavorka::Signature now provides args_min and args_max methods. - Refactor some of the code generation in Kavorka::Signature. 0.001 2013-10-09 First public release 0.000_11 2013-10-09 [ Documentation ] - Document Kavorka's exports. - Fix MooseX::KavorkaInfo SYNOPSIS. - Provide an example script using MooseX::KavorkaInfo. [ Test Suite ] - Check that it's possible to define a method called `method`. [ Other ] - Throw an exception if people use method modifier keywords to define anonymous functions. 0.000_10 2013-10-09 [ Documentation ] - Minor documentation improvements. [ Other ] - Added: MooseX::KavorkaInfo provides Kavorka->info data through Moose meta objects. - Allow Function::Parameters-style type constraint expressions. 0.000_09 2013-10-08 [ Documentation ] - Document the yadayada operator. [ Test Suite ] - Tests for lvalue subs. [ Other ] - Better support for subroutine attributes. - Change parsing technique for named subs. 0.000_08 2013-10-08 [ Documentation ] - Documented Kavorka::Signature. - Documented Kavorka::Signature::Parameter. - Documented Kavorka::Sub. - Improve 'Introspection API' section of documentation for Kavorka.pm itself. [ Test Suite ] - Add tests for introspection API. [ Other ] - Function objects doing the Kavorka::Sub role now keep track of which keyword they were declared with. - Tidy up and improve the Kavorka::Signature API. - Tidy up the Kavorka::Sub API. 0.000_07 2013-10-08 [ Documentation ] - Documented an 'rw' trait which is just a no-op. - Documented traits better. [ Test Suite ] - Add tests for various traits. [ Other ] - Implemented the 'alias' trait. - Implemented the 'locked' trait. - Implemented the 'ro' trait. - Long overdue refactoring of the code-generating internals of Kavorka::Signature::Parameter. 0.000_06 2013-10-07 [ Bug Fixes ] - Fix installing of method modifiers into Moo::Role roles. [ Test Suite ] - Add tests for method modifiers in Class::Tiny/Role::Tiny. - Add tests for method modifiers in Moo. - Add tests for method modifiers in Moose. - Add tests for method modifiers in Mouse. 0.000_05 2013-10-07 [ Bug Fixes ] - Fix off-by-one bug failing to populate a slurpy array/arrayref if it would only have one item. - Fix warning assigning odd number of items to %_ which should have been fatal instead. [ Test Suite ] - Add tests for non-inlinable type constraints. - Add tests for type coercions. 0.000_04 2013-10-06 [ Test Suite ] - Add tests for invocants. - Add tests for slurpy parameters. [ Other ] - Allow anonymous slurpy parameters. - Also populate the %_ hash for functions with a hash(ref) slurpy but zero named parameters. - Minor speed-ups. 0.000_03 2013-10-05 [ Bug Fixes ] - Error message for unknown named parameters isn't unintentionally always thrown for all named parameters except the first. [ Documentation ] - Include my TODO file. [ Test Suite ] - Add tests for named parameters. - Add tests for positional parameters. - Add tests for the `method` keyword. [ Other ] - The `default` attribute of Kavorka::Signature::Parameter is now a coderef rather than a string. 0.000_02 2013-10-04 [ Bug Fixes ] - Fix error finding the position to start slurping from in signatures that have a slurpy after zero positional parameters. - Fix syntax error compiling functions using non-inlinable type constraints in the signature. [ Documentation ] - Include benchmarking script as an example. [ Test Suite ] - Add some rudimentary tests for type constraints. 0.000_01 2013-10-03 Preview release INSTALL000664001750001750 163612425206147 12761 0ustar00taitai000000000000Kavorka-0.036 Installing Kavorka should be straightforward. INSTALLATION WITH CPANMINUS If you have cpanm, you only need one line: % cpanm Kavorka 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 Kavorka INSTALLATION WITH THE CPAN SHELL Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan Kavorka 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 Kavorka: % 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 4365512425206147 12764 0ustar00taitai000000000000Kavorka-0.036This software is copyright (c) 2014 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) 2014 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) 2014 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 434612425206152 13056 0ustar00taitai000000000000Kavorka-0.036COPYRIGHT CREDITS Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README SIGNATURE TODO dist.ini doap.ttl examples/benchmarks-multisub.pl examples/benchmarks-named.pl examples/benchmarks-pos.pl examples/benchmarks.pl examples/dancer2/example.pl examples/dancer2/lib/KavorkaX/Dancer2.pm examples/fibonacci.pl examples/meta.pl lib/Kavorka.pm lib/Kavorka/Manual.pod lib/Kavorka/Manual/API.pod lib/Kavorka/Manual/ExtendingKavorka.pod lib/Kavorka/Manual/Functions.pod lib/Kavorka/Manual/MethodModifiers.pod lib/Kavorka/Manual/Methods.pod lib/Kavorka/Manual/MultiSubs.pod lib/Kavorka/Manual/PrototypeAndAttributes.pod lib/Kavorka/Manual/Signatures.pod lib/Kavorka/MethodModifier.pm lib/Kavorka/Multi.pm lib/Kavorka/Parameter.pm lib/Kavorka/ReturnType.pm lib/Kavorka/Signature.pm lib/Kavorka/Sub.pm lib/Kavorka/Sub/After.pm lib/Kavorka/Sub/Around.pm lib/Kavorka/Sub/Augment.pm lib/Kavorka/Sub/Before.pm lib/Kavorka/Sub/ClassMethod.pm lib/Kavorka/Sub/Fun.pm lib/Kavorka/Sub/Method.pm lib/Kavorka/Sub/ObjectMethod.pm lib/Kavorka/Sub/Override.pm lib/Kavorka/TraitFor/Parameter/alias.pm lib/Kavorka/TraitFor/Parameter/assumed.pm lib/Kavorka/TraitFor/Parameter/locked.pm lib/Kavorka/TraitFor/Parameter/optional.pm lib/Kavorka/TraitFor/Parameter/ref_alias.pm lib/Kavorka/TraitFor/Parameter/ro.pm lib/Kavorka/TraitFor/ReturnType/assumed.pm lib/Kavorka/TraitFor/Sub/begin.pm lib/Kavorka/TraitFor/Sub/fresh.pm lib/Kavorka/TraitFor/Sub/override.pm lib/MooseX/KavorkaInfo.pm lib/Parse/KeywordX.pm t/01basic.t t/02named-functions.t t/03anon-functions.t t/04named-methods.t t/05anon-methods.t t/10positional.t t/11named.t t/12invocant.t t/13slurpy.t t/14underscores.t t/20modifiers-moo.t t/21modifiers-moose.t t/22modifiers-mouse.t t/23modifiers-tiny.t t/24multimodifiers.t t/28modifiers-augment.t t/29modifiers-override.t t/30multi.t t/31multimulti.t t/32multiredefine.t t/33cacheinvalidationishard.t t/50types.t t/51coerce.t t/52typeexpr.t t/53typeexpr-moosextypes.t t/54typefallback.t t/59valueconstraints.t t/60alias.t t/61ro.t t/62locked.t t/63freshoverride.t t/69traits.t t/70introspection.t t/71moosemeta.t t/80returntype.t t/90closures.t t/91lvalue.t t/92weirdvars.t t/93prototypes.t t/94bypassparsing.t t/95rolesatisfaction.t t/98undefer.t t/99threads.t t/lib/Local/Bad.pm META.json000664001750001750 1516012425206152 13362 0ustar00taitai000000000000Kavorka-0.036{ "abstract" : "function signatures with the lure of the animal", "author" : [ "Toby Inkster (TOBYINK) " ], "dynamic_config" : 0, "generated_by" : "Dist::Inkt::Profile::TOBYINK version 0.023, CPAN::Meta::Converter version 2.142690", "keywords" : [], "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Kavorka", "no_index" : { "directory" : [ "eg", "examples", "inc", "t", "xt" ] }, "optional_features" : {}, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.17" } }, "develop" : { "suggests" : { "Dist::Inkt" : "0.001" } }, "runtime" : { "recommends" : { "Type::Tiny::XS" : "0.010" }, "requires" : { "Data::Alias" : "0", "Exporter::Tiny" : "0.026", "Module::Runtime" : "0", "Moo" : "1.003001", "PadWalker" : "0", "Parse::Keyword" : "0.06", "Return::Type" : "0.004", "Sub::Util" : "0", "Type::Parser" : "0.032", "Type::Registry" : "0.032", "Type::Utils" : "0.032", "Types::Standard" : "0.032", "match::simple" : "0", "namespace::sweep" : "0.006", "perl" : "5.014" } }, "test" : { "recommends" : { "Class::Method::Modifiers" : "2.03", "Class::Tiny" : "0", "Moose" : "2.0000", "Mouse" : "1.00", "Role::Tiny" : "1.003000" }, "requires" : { "Test::Fatal" : "0", "Test::More" : "0.96", "Test::Requires" : "0" } } }, "provides" : { "Kavorka" : { "file" : "lib/Kavorka.pm", "version" : "0.036" }, "Kavorka::MethodModifier" : { "file" : "lib/Kavorka/MethodModifier.pm", "version" : "0.036" }, "Kavorka::Multi" : { "file" : "lib/Kavorka/Multi.pm", "version" : "0.036" }, "Kavorka::Parameter" : { "file" : "lib/Kavorka/Parameter.pm", "version" : "0.036" }, "Kavorka::ReturnType" : { "file" : "lib/Kavorka/ReturnType.pm", "version" : "0.036" }, "Kavorka::Signature" : { "file" : "lib/Kavorka/Signature.pm", "version" : "0.036" }, "Kavorka::Sub" : { "file" : "lib/Kavorka/Sub.pm", "version" : "0.036" }, "Kavorka::Sub::After" : { "file" : "lib/Kavorka/Sub/After.pm", "version" : "0.036" }, "Kavorka::Sub::Around" : { "file" : "lib/Kavorka/Sub/Around.pm", "version" : "0.036" }, "Kavorka::Sub::Augment" : { "file" : "lib/Kavorka/Sub/Augment.pm", "version" : "0.036" }, "Kavorka::Sub::Before" : { "file" : "lib/Kavorka/Sub/Before.pm", "version" : "0.036" }, "Kavorka::Sub::ClassMethod" : { "file" : "lib/Kavorka/Sub/ClassMethod.pm", "version" : "0.036" }, "Kavorka::Sub::Fun" : { "file" : "lib/Kavorka/Sub/Fun.pm", "version" : "0.036" }, "Kavorka::Sub::Method" : { "file" : "lib/Kavorka/Sub/Method.pm", "version" : "0.036" }, "Kavorka::Sub::ObjectMethod" : { "file" : "lib/Kavorka/Sub/ObjectMethod.pm", "version" : "0.036" }, "Kavorka::Sub::Override" : { "file" : "lib/Kavorka/Sub/Override.pm", "version" : "0.036" }, "Kavorka::TraitFor::Parameter::alias" : { "file" : "lib/Kavorka/TraitFor/Parameter/alias.pm", "version" : "0.036" }, "Kavorka::TraitFor::Parameter::assumed" : { "file" : "lib/Kavorka/TraitFor/Parameter/assumed.pm", "version" : "0.036" }, "Kavorka::TraitFor::Parameter::locked" : { "file" : "lib/Kavorka/TraitFor/Parameter/locked.pm", "version" : "0.036" }, "Kavorka::TraitFor::Parameter::optional" : { "file" : "lib/Kavorka/TraitFor/Parameter/optional.pm", "version" : "0.036" }, "Kavorka::TraitFor::Parameter::ref_alias" : { "file" : "lib/Kavorka/TraitFor/Parameter/ref_alias.pm", "version" : "0.036" }, "Kavorka::TraitFor::Parameter::ro" : { "file" : "lib/Kavorka/TraitFor/Parameter/ro.pm", "version" : "0.036" }, "Kavorka::TraitFor::ReturnType::assumed" : { "file" : "lib/Kavorka/TraitFor/ReturnType/assumed.pm", "version" : "0.036" }, "Kavorka::TraitFor::Sub::begin" : { "file" : "lib/Kavorka/TraitFor/Sub/begin.pm", "version" : "0.036" }, "Kavorka::TraitFor::Sub::fresh" : { "file" : "lib/Kavorka/TraitFor/Sub/fresh.pm", "version" : "0.036" }, "Kavorka::TraitFor::Sub::override" : { "file" : "lib/Kavorka/TraitFor/Sub/override.pm", "version" : "0.036" }, "MooseX::KavorkaInfo" : { "file" : "lib/MooseX/KavorkaInfo.pm", "version" : "0.036" }, "MooseX::KavorkaInfo::DummyInfo" : { "file" : "lib/MooseX/KavorkaInfo.pm" }, "MooseX::KavorkaInfo::Trait::Method" : { "file" : "lib/MooseX/KavorkaInfo.pm", "version" : "0.036" }, "MooseX::KavorkaInfo::Trait::WrappedMethod" : { "file" : "lib/MooseX/KavorkaInfo.pm", "version" : "0.036" }, "Parse::KeywordX" : { "file" : "lib/Parse/KeywordX.pm", "version" : "0.036" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://rt.cpan.org/Dist/Display.html?Queue=Kavorka" }, "homepage" : "https://metacpan.org/release/Kavorka", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/tobyink/p5-kavorka.git", "web" : "https://github.com/tobyink/p5-kavorka" }, "x_IRC" : "irc://irc.perl.org/#moops", "x_identifier" : "http://purl.org/NET/cpan-uri/dist/Kavorka/project" }, "version" : "0.036", "x_contributors" : [ "Grzegorz Rożniecki (XAERXESS) ", "Aaron James Trevena (TEEJAY) ", "Piers Cawley (PDCAWLEY) ", "Thibaut Le Page (THILP) ", "Chris Tijerina (CAMSPI) " ] } META.yml000664001750001750 1041512425206152 13210 0ustar00taitai000000000000Kavorka-0.036--- abstract: 'function signatures with the lure of the animal' author: - 'Toby Inkster (TOBYINK) ' build_requires: Test::Fatal: '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.023, CPAN::Meta::Converter version 2.142690' keywords: [] license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Kavorka no_index: directory: - eg - examples - inc - t - xt optional_features: {} provides: Kavorka: file: lib/Kavorka.pm version: '0.036' Kavorka::MethodModifier: file: lib/Kavorka/MethodModifier.pm version: '0.036' Kavorka::Multi: file: lib/Kavorka/Multi.pm version: '0.036' Kavorka::Parameter: file: lib/Kavorka/Parameter.pm version: '0.036' Kavorka::ReturnType: file: lib/Kavorka/ReturnType.pm version: '0.036' Kavorka::Signature: file: lib/Kavorka/Signature.pm version: '0.036' Kavorka::Sub: file: lib/Kavorka/Sub.pm version: '0.036' Kavorka::Sub::After: file: lib/Kavorka/Sub/After.pm version: '0.036' Kavorka::Sub::Around: file: lib/Kavorka/Sub/Around.pm version: '0.036' Kavorka::Sub::Augment: file: lib/Kavorka/Sub/Augment.pm version: '0.036' Kavorka::Sub::Before: file: lib/Kavorka/Sub/Before.pm version: '0.036' Kavorka::Sub::ClassMethod: file: lib/Kavorka/Sub/ClassMethod.pm version: '0.036' Kavorka::Sub::Fun: file: lib/Kavorka/Sub/Fun.pm version: '0.036' Kavorka::Sub::Method: file: lib/Kavorka/Sub/Method.pm version: '0.036' Kavorka::Sub::ObjectMethod: file: lib/Kavorka/Sub/ObjectMethod.pm version: '0.036' Kavorka::Sub::Override: file: lib/Kavorka/Sub/Override.pm version: '0.036' Kavorka::TraitFor::Parameter::alias: file: lib/Kavorka/TraitFor/Parameter/alias.pm version: '0.036' Kavorka::TraitFor::Parameter::assumed: file: lib/Kavorka/TraitFor/Parameter/assumed.pm version: '0.036' Kavorka::TraitFor::Parameter::locked: file: lib/Kavorka/TraitFor/Parameter/locked.pm version: '0.036' Kavorka::TraitFor::Parameter::optional: file: lib/Kavorka/TraitFor/Parameter/optional.pm version: '0.036' Kavorka::TraitFor::Parameter::ref_alias: file: lib/Kavorka/TraitFor/Parameter/ref_alias.pm version: '0.036' Kavorka::TraitFor::Parameter::ro: file: lib/Kavorka/TraitFor/Parameter/ro.pm version: '0.036' Kavorka::TraitFor::ReturnType::assumed: file: lib/Kavorka/TraitFor/ReturnType/assumed.pm version: '0.036' Kavorka::TraitFor::Sub::begin: file: lib/Kavorka/TraitFor/Sub/begin.pm version: '0.036' Kavorka::TraitFor::Sub::fresh: file: lib/Kavorka/TraitFor/Sub/fresh.pm version: '0.036' Kavorka::TraitFor::Sub::override: file: lib/Kavorka/TraitFor/Sub/override.pm version: '0.036' MooseX::KavorkaInfo: file: lib/MooseX/KavorkaInfo.pm version: '0.036' MooseX::KavorkaInfo::DummyInfo: file: lib/MooseX/KavorkaInfo.pm MooseX::KavorkaInfo::Trait::Method: file: lib/MooseX/KavorkaInfo.pm version: '0.036' MooseX::KavorkaInfo::Trait::WrappedMethod: file: lib/MooseX/KavorkaInfo.pm version: '0.036' Parse::KeywordX: file: lib/Parse/KeywordX.pm version: '0.036' recommends: Type::Tiny::XS: '0.010' requires: Data::Alias: '0' Exporter::Tiny: '0.026' Module::Runtime: '0' Moo: '1.003001' PadWalker: '0' Parse::Keyword: '0.06' Return::Type: '0.004' Sub::Util: '0' Type::Parser: '0.032' Type::Registry: '0.032' Type::Utils: '0.032' Types::Standard: '0.032' match::simple: '0' namespace::sweep: '0.006' perl: '5.014' resources: IRC: irc://irc.perl.org/#moops Identifier: http://purl.org/NET/cpan-uri/dist/Kavorka/project bugtracker: http://rt.cpan.org/Dist/Display.html?Queue=Kavorka homepage: https://metacpan.org/release/Kavorka license: http://dev.perl.org/licenses/ repository: git://github.com/tobyink/p5-kavorka.git version: '0.036' x_contributors: - 'Grzegorz Rożniecki (XAERXESS) ' - 'Aaron James Trevena (TEEJAY) ' - 'Piers Cawley (PDCAWLEY) ' - 'Thibaut Le Page (THILP) ' - 'Chris Tijerina (CAMSPI) ' Makefile.PL000664001750001750 3021112425206152 13705 0ustar00taitai000000000000Kavorka-0.036use strict; use ExtUtils::MakeMaker 6.17; my $EUMM = eval( $ExtUtils::MakeMaker::VERSION ); my $meta = { "abstract" => "function signatures with the lure of the animal", "author" => ["Toby Inkster (TOBYINK) "], "dynamic_config" => 0, "generated_by" => "Dist::Inkt::Profile::TOBYINK version 0.023, CPAN::Meta::Converter version 2.142690", "keywords" => [], "license" => ["perl_5"], "meta-spec" => { url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec", version => 2, }, "name" => "Kavorka", "no_index" => { directory => ["eg", "examples", "inc", "t", "xt"] }, "prereqs" => { configure => { requires => { "ExtUtils::MakeMaker" => 6.17 } }, develop => { suggests => { "Dist::Inkt" => 0.001 } }, runtime => { recommends => { "Type::Tiny::XS" => "0.010" }, requires => { "Data::Alias" => 0, "Exporter::Tiny" => 0.026, "match::simple" => 0, "Module::Runtime" => 0, "Moo" => 1.003001, "namespace::sweep" => 0.006, "PadWalker" => 0, "Parse::Keyword" => 0.06, "perl" => 5.014, "Return::Type" => 0.004, "Sub::Util" => 0, "Type::Parser" => 0.032, "Type::Registry" => 0.032, "Type::Utils" => 0.032, "Types::Standard" => 0.032, }, }, test => { recommends => { "Class::Method::Modifiers" => 2.03, "Class::Tiny" => 0, "Moose" => "2.0000", "Mouse" => "1.00", "Role::Tiny" => "1.003000", }, requires => { "Test::Fatal" => 0, "Test::More" => 0.96, "Test::Requires" => 0 }, }, }, "provides" => { "Kavorka" => { file => "lib/Kavorka.pm", version => 0.036 }, "Kavorka::MethodModifier" => { file => "lib/Kavorka/MethodModifier.pm", version => 0.036 }, "Kavorka::Multi" => { file => "lib/Kavorka/Multi.pm", version => 0.036 }, "Kavorka::Parameter" => { file => "lib/Kavorka/Parameter.pm", version => 0.036 }, "Kavorka::ReturnType" => { file => "lib/Kavorka/ReturnType.pm", version => 0.036 }, "Kavorka::Signature" => { file => "lib/Kavorka/Signature.pm", version => 0.036 }, "Kavorka::Sub" => { file => "lib/Kavorka/Sub.pm", version => 0.036 }, "Kavorka::Sub::After" => { file => "lib/Kavorka/Sub/After.pm", version => 0.036 }, "Kavorka::Sub::Around" => { file => "lib/Kavorka/Sub/Around.pm", version => 0.036 }, "Kavorka::Sub::Augment" => { file => "lib/Kavorka/Sub/Augment.pm", version => 0.036 }, "Kavorka::Sub::Before" => { file => "lib/Kavorka/Sub/Before.pm", version => 0.036 }, "Kavorka::Sub::ClassMethod" => { file => "lib/Kavorka/Sub/ClassMethod.pm", version => 0.036 }, "Kavorka::Sub::Fun" => { file => "lib/Kavorka/Sub/Fun.pm", version => 0.036 }, "Kavorka::Sub::Method" => { file => "lib/Kavorka/Sub/Method.pm", version => 0.036 }, "Kavorka::Sub::ObjectMethod" => { file => "lib/Kavorka/Sub/ObjectMethod.pm", version => 0.036 }, "Kavorka::Sub::Override" => { file => "lib/Kavorka/Sub/Override.pm", version => 0.036 }, "Kavorka::TraitFor::Parameter::alias" => { file => "lib/Kavorka/TraitFor/Parameter/alias.pm", version => 0.036 }, "Kavorka::TraitFor::Parameter::assumed" => { file => "lib/Kavorka/TraitFor/Parameter/assumed.pm", version => 0.036, }, "Kavorka::TraitFor::Parameter::locked" => { file => "lib/Kavorka/TraitFor/Parameter/locked.pm", version => 0.036, }, "Kavorka::TraitFor::Parameter::optional" => { file => "lib/Kavorka/TraitFor/Parameter/optional.pm", version => 0.036, }, "Kavorka::TraitFor::Parameter::ref_alias" => { file => "lib/Kavorka/TraitFor/Parameter/ref_alias.pm", version => 0.036, }, "Kavorka::TraitFor::Parameter::ro" => { file => "lib/Kavorka/TraitFor/Parameter/ro.pm", version => 0.036 }, "Kavorka::TraitFor::ReturnType::assumed" => { file => "lib/Kavorka/TraitFor/ReturnType/assumed.pm", version => 0.036, }, "Kavorka::TraitFor::Sub::begin" => { file => "lib/Kavorka/TraitFor/Sub/begin.pm", version => 0.036 }, "Kavorka::TraitFor::Sub::fresh" => { file => "lib/Kavorka/TraitFor/Sub/fresh.pm", version => 0.036 }, "Kavorka::TraitFor::Sub::override" => { file => "lib/Kavorka/TraitFor/Sub/override.pm", version => 0.036 }, "MooseX::KavorkaInfo" => { file => "lib/MooseX/KavorkaInfo.pm", version => 0.036 }, "MooseX::KavorkaInfo::DummyInfo" => { file => "lib/MooseX/KavorkaInfo.pm" }, "MooseX::KavorkaInfo::Trait::Method" => { file => "lib/MooseX/KavorkaInfo.pm", version => 0.036 }, "MooseX::KavorkaInfo::Trait::WrappedMethod" => { file => "lib/MooseX/KavorkaInfo.pm", version => 0.036 }, "Parse::KeywordX" => { file => "lib/Parse/KeywordX.pm", version => 0.036 }, }, "release_status" => "stable", "resources" => { bugtracker => { web => "http://rt.cpan.org/Dist/Display.html?Queue=Kavorka" }, homepage => "https://metacpan.org/release/Kavorka", license => ["http://dev.perl.org/licenses/"], repository => { type => "git", url => "git://github.com/tobyink/p5-kavorka.git", web => "https://github.com/tobyink/p5-kavorka", }, x_identifier => "http://purl.org/NET/cpan-uri/dist/Kavorka/project", x_IRC => "irc://irc.perl.org/#moops", }, "version" => 0.036, "x_contributors" => [ "Grzegorz Ro\x{17C}niecki (XAERXESS) ", "Aaron James Trevena (TEEJAY) ", "Piers Cawley (PDCAWLEY) ", "Thibaut Le Page (THILP) ", "Chris Tijerina (CAMSPI) ", ], }; 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; } } sub FixMakefile { return unless -d 'inc'; my $file = shift; local *MAKEFILE; open MAKEFILE, "< $file" or die "FixMakefile: Couldn't open $file: $!; bailing out"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; open MAKEFILE, "> $file" or die "FixMakefile: Couldn't open $file: $!; bailing out"; print MAKEFILE $makefile or die $!; close MAKEFILE or die $!; } my $mm = WriteMakefile(%WriteMakefileArgs); FixMakefile($mm->{FIRST_MAKEFILE} || 'Makefile'); exit(0); README000664001750001750 1113612425206147 12624 0ustar00taitai000000000000Kavorka-0.036NAME Kavorka - function signatures with the lure of the animal SYNOPSIS use Kavorka; fun maxnum (Num @numbers) { my $max = shift @numbers; for (@numbers) { $max = $_ if $max < $_; } return $max; } my $biggest = maxnum(42, 3.14159, 666); STATUS Kavorka is still at a very early stage of development; there are likely to be many bugs that still need to be shaken out. Certain syntax features are a little odd and may need to be changed in incompatible ways. DESCRIPTION Kavorka provides `fun` and `method` keywords for declaring functions and methods. It uses Perl 5.14's keyword API, so should work more reliably than source filters or Devel::Declare-based modules. The syntax provided by Kavorka is largely inspired by Perl 6, though it has also been greatly influenced by Method::Signatures and Function::Parameters. For information using the keywords exported by Kavorka: * Kavorka::Manual::Functions * Kavorka::Manual::Methods * Kavorka::Manual::MethodModifiers * Kavorka::Manual::MultiSubs Exports `-default` Exports `fun` and `method`. `-modifiers` Exports `before`, `after`, and `around`. `-allmodifiers` Exports `before`, `after`, `around`, `augment`, and `override`. `-all` Exports `fun`, `method`, `before`, `after`, `around`, `augment`, `override`, `classmethod`, `objectmethod`, and `multi`. For example: # Everything except objectmethod and multi... use Kavorka qw( -default -allmodifiers classmethod ); You can rename imported functions: use Kavorka method => { -as => 'meth' }; You can provide alternative implementations: # use My::Sub::Method instead of Kavorka::Sub::Method use Kavorka method => { implementation => 'My::Sub::Method' }; Or add traits to the default implementation: use Kavorka method => { traits => ['My::Sub::Role::Foo'] }; See Exporter::Tiny for more tips. Function Introspection API The coderef for any sub created by Kavorka can be passed to the `Kavorka->info` method. This returns a blessed object that does the Kavorka::Sub role. fun foo (:$x, :$y) { } my $info = Kavorka->info(\&foo); my $function_name = $info->qualified_name; my @named_params = $info->signature->named_params; say $named_params[0]->named_names->[0]; # says 'x' See Kavorka::Sub, Kavorka::Signature and Kavorka::Parameter for further details. If you're using Moose, consider using MooseX::KavorkaInfo to expose Kavorka method signatures via the meta object protocol. Kavorka::Manual::API provides more details and examples using the introspection API. CAVEATS * As noted in Kavorka::Manual::PrototypeAndAttributes, subroutine attributes don't work properly for anonymous functions. * This module is based on Parse::Keyword, which has a chronically broken implementation of closures. Kavorka uses PadWalker to attempt to work around the problem. This mostly seems to work, but you may experience some problems in edge cases, especially for anonymous functions and methods. * If importing Kavorka's method modifiers into Moo/Mouse/Moose classes, pay attention to load order: use Moose; use Kavorka -all; # ok If you do it this way, Moose's `before`, `after`, and `around` keywords will stomp on top of Kavorka's... use Kavorka -all; use Moose; # STOMP, STOMP, STOMP! :-( This can lead to delightfully hard to debug errors. BUGS Please report any bugs to . SUPPORT IRC: support is available through in the *#moops* channel on irc.perl.org . SEE ALSO Kavorka::Manual. Inspirations: , Function::Parameters, Method::Signatures. . AUTHOR Toby Inkster . COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 1677312425206153 13241 0ustar00taitai000000000000Kavorka-0.036This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.73. 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: SHA1 SHA1 104ad66933e2348e3695886421444220b1d0ed6c COPYRIGHT SHA1 0c1edf80bc191b2ca035311ec2b34f60293f1a27 CREDITS SHA1 4928615f93b3244a1d49eab3ff29ec6c9a356cc4 Changes SHA1 642accba7915d84fd2d6e679492d9e9609cb9870 INSTALL SHA1 34f5e12514b91055de4b164a1f2327ef5c30ba53 LICENSE SHA1 2ad16db54e3036b3b76249d3e66262ed758304f2 MANIFEST SHA1 7492bdea95c4cd8221081a3250316cf3a7859fbd META.json SHA1 9579d276a7f4084fbbfd29845ec4739d441523d7 META.yml SHA1 87a275564f6d352d7d2e86102ea347f0df83ab14 Makefile.PL SHA1 9d449ebadac1383bd5cc6ebb0867d3be0fe8bcdd README SHA1 27d353ca6292d6696297b524bcbf40598552ccc9 TODO SHA1 39bac3db859a6ce7311a36c43c2ac9ef1da35a19 dist.ini SHA1 02d100ab6c524c4f7f37c17ea13b10a66da55ca1 doap.ttl SHA1 8a04c0bf233591124933988c7d82d61b9ef24e35 examples/benchmarks-multisub.pl SHA1 ef645e46d5cc9a0124089e52128f17a93c8f305e examples/benchmarks-named.pl SHA1 d1981a947dac97ebd164f8d3e88aee14302ad7a1 examples/benchmarks-pos.pl SHA1 7959649ac1c5fefee81a4e96d51e6637a5f0a3ed examples/benchmarks.pl SHA1 a62688f2ed57d1170857be37beb7ef5aa7b1c751 examples/dancer2/example.pl SHA1 1b2bd5b733386f4737dde750d994d838e2e9c2cd examples/dancer2/lib/KavorkaX/Dancer2.pm SHA1 247a56668598da4dafeae97cfc5d22b6569059db examples/fibonacci.pl SHA1 04744decf0dca3a79997b74aa112121651e4d5cd examples/meta.pl SHA1 9637bbfb18f1f26a7dbaa385f41bb0d5a4f2efa1 lib/Kavorka.pm SHA1 4bc7c24f9fc80025faeb309ebfc8c281583fe361 lib/Kavorka/Manual.pod SHA1 555b4079a27ab1c91d6af040c486f602046d8690 lib/Kavorka/Manual/API.pod SHA1 e5f93c20b3818f049d72393bb010b86a3110e1d9 lib/Kavorka/Manual/ExtendingKavorka.pod SHA1 4d9a7e7cfc4d08ca4799f9843e8f7d7c040416f6 lib/Kavorka/Manual/Functions.pod SHA1 319828aa96ade226c6b2b7e905d88f24a6de785a lib/Kavorka/Manual/MethodModifiers.pod SHA1 a35e2807b58bafa26a9e20c40095d11c9f6d9105 lib/Kavorka/Manual/Methods.pod SHA1 e0d1242dd924330e47bedd359bc30d3faa8b85a0 lib/Kavorka/Manual/MultiSubs.pod SHA1 7f2c093963cf32649507df6e8f8aab08b68c3466 lib/Kavorka/Manual/PrototypeAndAttributes.pod SHA1 cb74e37fd6f5471d2b4422f6584fde333039158f lib/Kavorka/Manual/Signatures.pod SHA1 5ddea2700d7252c40ecbca36b3e033ef2d2e42d3 lib/Kavorka/MethodModifier.pm SHA1 66644183612228bac36028a98a22ffa653d09c18 lib/Kavorka/Multi.pm SHA1 05ef01008cbce30b2c287da40086a35e586ed7a4 lib/Kavorka/Parameter.pm SHA1 f2bea5478405be7cc7a642707b09dd11517c6ab8 lib/Kavorka/ReturnType.pm SHA1 14b70965f67fb69fd4d89d7804bfc3c29c80524e lib/Kavorka/Signature.pm SHA1 1eb65d43caecd05dc9444374bdadfd220e79e844 lib/Kavorka/Sub.pm SHA1 b859af9e2dd8cfb7eb007659efa5cf67f68738b9 lib/Kavorka/Sub/After.pm SHA1 6f0c2528358d4bcfbc9249e52a82782251ccd757 lib/Kavorka/Sub/Around.pm SHA1 8ab96209e79ae66cefa52be54c29f87ee87d685a lib/Kavorka/Sub/Augment.pm SHA1 ad4c069ae96da82213647b3f8ef84146f7cfd80c lib/Kavorka/Sub/Before.pm SHA1 e5dcdb7d1794e56466ff2872889f70441dd95625 lib/Kavorka/Sub/ClassMethod.pm SHA1 97a31892721be97e388632cc2d5be04e97b53671 lib/Kavorka/Sub/Fun.pm SHA1 f8224207bbace32a39c3c55cacae9c986db5a2b1 lib/Kavorka/Sub/Method.pm SHA1 640ef1abf485b46f743a12bf99b8f50dc5fde0b1 lib/Kavorka/Sub/ObjectMethod.pm SHA1 8e65bb3e14efa42d6defe182432d0983041e6d48 lib/Kavorka/Sub/Override.pm SHA1 9d167b1642a4c542bf45e89cb4897398c26a3b73 lib/Kavorka/TraitFor/Parameter/alias.pm SHA1 0b853592e4f5f83076ab45d013a7441d455e63e0 lib/Kavorka/TraitFor/Parameter/assumed.pm SHA1 1af5b752ada31b6560e17bdd237d229e8b20c364 lib/Kavorka/TraitFor/Parameter/locked.pm SHA1 b29bfc8d4c68082b1001e038f8a10408e1e39aa4 lib/Kavorka/TraitFor/Parameter/optional.pm SHA1 d3d0234f0b64a5cce167f3219296fa981e052250 lib/Kavorka/TraitFor/Parameter/ref_alias.pm SHA1 898e2f5e74d3cc0a771962f65940d9b94c2d88ec lib/Kavorka/TraitFor/Parameter/ro.pm SHA1 cf8b88b53898cf3dc6263c03a83db614da1148c8 lib/Kavorka/TraitFor/ReturnType/assumed.pm SHA1 ba20a12d42170789e81fe05980da791a5cba7982 lib/Kavorka/TraitFor/Sub/begin.pm SHA1 6c5050c35101e9938de62c0efc79c83c97751fdd lib/Kavorka/TraitFor/Sub/fresh.pm SHA1 2a996d5eb0034c9f356f5383a68552469f17a74c lib/Kavorka/TraitFor/Sub/override.pm SHA1 28fa3551d1bcd3039c38c871b70bf939d20ca896 lib/MooseX/KavorkaInfo.pm SHA1 c48d12c55743379f8be7fa10eb452eed72356bc4 lib/Parse/KeywordX.pm SHA1 b05e50b57a91fea179abb88586d6fc3b526302d6 t/01basic.t SHA1 bb5e6708f5dd581cbe1b8471bd3b351acfff8a94 t/02named-functions.t SHA1 e5fb41ad13b8af3c243beb5cc06e4b0396013832 t/03anon-functions.t SHA1 28938552c132e4637c3236bb25fa881133a84a79 t/04named-methods.t SHA1 0e301c0c5695d05aab4d3c5810b39393c15a6d0e t/05anon-methods.t SHA1 4f5e041f9d36ea6b2860425c34ddb61dbf4a1ebf t/10positional.t SHA1 1138280466bab9c954a11ea531f62124e5b563ea t/11named.t SHA1 999dfd8f1d7fc3ba31b87657d9fea84a0ad3d61c t/12invocant.t SHA1 6bfb20cbd2743379e53707a6b7819f43aac399cd t/13slurpy.t SHA1 1fa0e2d384d01e523bb7e235bdf6027e6731551d t/14underscores.t SHA1 37843e8b4e13dfa00a50337247111ed1892be750 t/20modifiers-moo.t SHA1 d12bcaa600407a63f398f010e7a171b667a5bb22 t/21modifiers-moose.t SHA1 2ab4e847d677003b167fc9431766224218461211 t/22modifiers-mouse.t SHA1 fbee4581bd4345a508178a01405c329fba722c36 t/23modifiers-tiny.t SHA1 75f4a899b846c42291db0909933ca1ffad588b3b t/24multimodifiers.t SHA1 db6f6e59fb4320c2490dc55b4f3946ced9788895 t/28modifiers-augment.t SHA1 d718ab697ca3ac642281c4a919f9a08b35f11cfe t/29modifiers-override.t SHA1 49f51deaa26188d21c92a084cd04a611f18ca9ce t/30multi.t SHA1 ff097b2ffb1b802ea659ed11af3af28e85f6ed84 t/31multimulti.t SHA1 61bbc8526a4aa5d69952095f73cc63a7a18c9ce0 t/32multiredefine.t SHA1 8f160e6515f44fbceb4a014fd30a6a653fc0cda1 t/33cacheinvalidationishard.t SHA1 325d99fc4d918b12924c2e1e6ceb8ce253caff36 t/50types.t SHA1 7023d8923b2c3ccfee1e2aa7f363e10641032d51 t/51coerce.t SHA1 7351c31e5c72f53eabaa142c9e94364b33a31b29 t/52typeexpr.t SHA1 8785f7875d77dfbabe8eb819ef98d6daa1f28ebd t/53typeexpr-moosextypes.t SHA1 ac98682b0e8cd0a1ccc2f4214b40cb7f77f12d39 t/54typefallback.t SHA1 0dbd318c41f15efdf3dc42903b291261cfd05d25 t/59valueconstraints.t SHA1 4380fd0d6dc6768920d984db651a0112bc039c90 t/60alias.t SHA1 ed9ffe86948fd6ea6527ad4de69ff3a8fb15dced t/61ro.t SHA1 922816f19d51188296820b3851daa13be508f1d8 t/62locked.t SHA1 a38646d44d7cc9e78b8d08c7c536e0b32dc231cf t/63freshoverride.t SHA1 bef8bb0301d6a24373e87af2f7e51fd9e6faf5f3 t/69traits.t SHA1 d536fbf1c8dadde73711e9bc44eb0cd08bc15048 t/70introspection.t SHA1 64ccfba06aa8213c4e072c3e5ca0e74416b89dfc t/71moosemeta.t SHA1 a376103aa976da43d8cac194d4d886729ff6585b t/80returntype.t SHA1 6d9eb33cbba0c261e5b31005a16711a966aac0db t/90closures.t SHA1 7a20731a5dcccbe4a1ece7659ed32e49aaff6f6f t/91lvalue.t SHA1 a14421fbb8440c5f056d4cfec230f9cbb1300e19 t/92weirdvars.t SHA1 d74c0d61ca394335e7467e2320d09c87379bfaaa t/93prototypes.t SHA1 29b1025f56932250f1ff6deb95c791ff9f3eda1c t/94bypassparsing.t SHA1 085fa1bbf4935af82633a2f5341974515a0bc7bf t/95rolesatisfaction.t SHA1 7b86433c7ec9eba112a254cfe9d9b505a2cf81ac t/98undefer.t SHA1 fa8a89aaac47bc2239a6857826c9be93d458df13 t/99threads.t SHA1 dc4107d57118b8ae504a264f5eadf62c11a962e7 t/lib/Local/Bad.pm -----BEGIN PGP SIGNATURE----- Version: GnuPG v1 iEUEARECAAYFAlRVDGsACgkQzr+BKGoqfTlhWQCY49xoBWpnyS99Ifa9c0p6Oq7q 1gCfQfd2HOPsXno8r0HTFnyzWGo4ntI= =5MJu -----END PGP SIGNATURE----- TODO000664001750001750 24212425206147 12370 0ustar00taitai000000000000Kavorka-0.036Calling Kavorka->info(\&sub) on a multisub returns undef because the candidate subs are Kavorka::Sub consumers, but the main entry point is not. This needs work. dist.ini000664001750001750 7112425206147 13324 0ustar00taitai000000000000Kavorka-0.036;;class='Dist::Inkt::Profile::TOBYINK' ;;name='Kavorka' doap.ttl000664001750001750 13710712425206152 13437 0ustar00taitai000000000000Kavorka-0.036@prefix cpan-uri: . @prefix dc: . @prefix doap: . @prefix doap-bugs: . @prefix doap-changeset: . @prefix doap-deps: . @prefix foaf: . @prefix rdfs: . @prefix xsd: . dc:title "the same terms as the perl 5 programming language system itself". a doap:Project; cpan-uri:x_IRC ; dc:contributor ; doap-bugs:issue , , ; doap-deps:develop-suggestion [ doap-deps:on "Dist::Inkt 0.001"^^doap-deps:CpanId ]; doap-deps:runtime-recommendation [ doap-deps:on "Type::Tiny::XS 0.010"^^doap-deps:CpanId; ]; doap-deps:runtime-requirement [ doap-deps:on "perl 5.014"^^doap-deps:CpanId ], [ doap-deps:on "Data::Alias"^^doap-deps:CpanId ], [ doap-deps:on "Type::Registry 0.032"^^doap-deps:CpanId; ], [ doap-deps:on "Type::Utils 0.032"^^doap-deps:CpanId ], [ doap-deps:on "Types::Standard 0.032"^^doap-deps:CpanId; ], [ doap-deps:on "match::simple"^^doap-deps:CpanId ], [ doap-deps:on "namespace::sweep 0.006"^^doap-deps:CpanId; ], [ doap-deps:on "Exporter::Tiny 0.026"^^doap-deps:CpanId; ], [ doap-deps:on "Module::Runtime 0"^^doap-deps:CpanId ], [ doap-deps:on "Moo 1.003001"^^doap-deps:CpanId ], [ doap-deps:on "PadWalker 0"^^doap-deps:CpanId ], [ doap-deps:on "Parse::Keyword 0.06"^^doap-deps:CpanId; ], [ doap-deps:on "Return::Type 0.004"^^doap-deps:CpanId ], [ doap-deps:on "Sub::Util"^^doap-deps:CpanId ], [ doap-deps:on "Type::Parser 0.032"^^doap-deps:CpanId; rdfs:comment "Fix for comma-delimited type lists."; ]; doap-deps:test-recommendation [ doap-deps:on "Moose 2.0000"^^doap-deps:CpanId ], [ doap-deps:on "Mouse 1.00"^^doap-deps:CpanId ], [ doap-deps:on "Class::Tiny"^^doap-deps:CpanId ], [ doap-deps:on "Role::Tiny 1.003000"^^doap-deps:CpanId; ], [ doap-deps:on "Class::Method::Modifiers 2.03"^^doap-deps:CpanId; ]; doap-deps:test-requirement [ doap-deps:on "Test::More 0.96"^^doap-deps:CpanId ], [ doap-deps:on "Test::Fatal"^^doap-deps:CpanId ], [ doap-deps:on "Test::Requires"^^doap-deps:CpanId ]; doap:bug-database ; doap:created "2013-09-23"^^xsd:date; doap:developer ; doap:download-page ; doap:homepage ; doap:license ; doap:maintainer ; doap:name "Kavorka"; doap:programming-language "Perl"; doap:release , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ; doap:repository [ a doap:GitRepository; doap:browse ; ]; doap:shortdesc "function signatures with the lure of the animal". a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Preview release"; dc:identifier "Kavorka-0.000_01"^^xsd:string; dc:issued "2013-10-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_02"^^xsd:string; dc:issued "2013-10-04"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Fix syntax error compiling functions using non-inlinable type constraints in the signature."; ], [ a doap-changeset:Bugfix; rdfs:label "Fix error finding the position to start slurping from in signatures that have a slurpy after zero positional parameters."; ], [ a doap-changeset:Tests; rdfs:label "Add some rudimentary tests for type constraints."; ], [ a doap-changeset:Documentation; rdfs:label "Include benchmarking script as an example."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_03"^^xsd:string; dc:issued "2013-10-05"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Error message for unknown named parameters isn't unintentionally always thrown for all named parameters except the first."; ], [ a doap-changeset:Change; rdfs:label "The `default` attribute of Kavorka::Signature::Parameter is now a coderef rather than a string."; ], [ a doap-changeset:Tests; rdfs:label "Add tests for the `method` keyword."; ], [ a doap-changeset:Tests; rdfs:label "Add tests for positional parameters."; ], [ a doap-changeset:Tests; rdfs:label "Add tests for named parameters."; ], [ a doap-changeset:Documentation; rdfs:label "Include my TODO file."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_04"^^xsd:string; dc:issued "2013-10-06"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Allow anonymous slurpy parameters."; ], [ a doap-changeset:Change; rdfs:label "Minor speed-ups."; ], [ a doap-changeset:Change; rdfs:label "Also populate the %_ hash for functions with a hash(ref) slurpy but zero named parameters."; ], [ a doap-changeset:Tests; rdfs:label "Add tests for invocants."; ], [ a doap-changeset:Tests; rdfs:label "Add tests for slurpy parameters."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_05"^^xsd:string; dc:issued "2013-10-07"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Add tests for non-inlinable type constraints."; ], [ a doap-changeset:Tests; rdfs:label "Add tests for type coercions."; ], [ a doap-changeset:Bugfix; rdfs:label "Fix off-by-one bug failing to populate a slurpy array/arrayref if it would only have one item."; ], [ a doap-changeset:Bugfix; rdfs:label "Fix warning assigning odd number of items to %_ which should have been fatal instead."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_05"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_06"^^xsd:string; dc:issued "2013-10-07"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Add tests for method modifiers in Moo."; ], [ a doap-changeset:Tests; rdfs:label "Add tests for method modifiers in Mouse."; ], [ a doap-changeset:Tests; rdfs:label "Add tests for method modifiers in Moose."; ], [ a doap-changeset:Tests; rdfs:label "Add tests for method modifiers in Class::Tiny/Role::Tiny."; ], [ a doap-changeset:Bugfix; rdfs:label "Fix installing of method modifiers into Moo::Role roles."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_06"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_07"^^xsd:string; dc:issued "2013-10-08"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Add tests for various traits."; ], [ a doap-changeset:Change; rdfs:label "Implemented the 'alias' trait."; ], [ a doap-changeset:Change; rdfs:label "Implemented the 'ro' trait."; ], [ a doap-changeset:Change; rdfs:label "Implemented the 'locked' trait."; ], [ a doap-changeset:Documentation; rdfs:label "Documented traits better."; ], [ a doap-changeset:Documentation; rdfs:label "Documented an 'rw' trait which is just a no-op."; ], [ a doap-changeset:Change; rdfs:label "Long overdue refactoring of the code-generating internals of Kavorka::Signature::Parameter."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_07"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_08"^^xsd:string; dc:issued "2013-10-08"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Add tests for introspection API."; ], [ a doap-changeset:Documentation; rdfs:label "Documented Kavorka::Signature::Parameter."; ], [ a doap-changeset:Documentation; rdfs:label "Documented Kavorka::Signature."; ], [ a doap-changeset:Documentation; rdfs:label "Documented Kavorka::Sub."; ], [ a doap-changeset:Documentation; rdfs:label "Improve 'Introspection API' section of documentation for Kavorka.pm itself."; ], [ a doap-changeset:Change; rdfs:label "Tidy up the Kavorka::Sub API."; ], [ a doap-changeset:Change; rdfs:label "Tidy up and improve the Kavorka::Signature API."; ], [ a doap-changeset:Change; rdfs:label "Function objects doing the Kavorka::Sub role now keep track of which keyword they were declared with."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_08"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_09"^^xsd:string; dc:issued "2013-10-08"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Tests for lvalue subs."; ], [ a doap-changeset:Change; rdfs:label "Better support for subroutine attributes."; ], [ a doap-changeset:Change; rdfs:label "Change parsing technique for named subs."; ], [ a doap-changeset:Documentation; rdfs:label "Document the yadayada operator."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_09"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_10"^^xsd:string; dc:issued "2013-10-09"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Minor documentation improvements."; ], [ a doap-changeset:Addition; rdfs:label "MooseX::KavorkaInfo provides Kavorka->info data through Moose meta objects."; ], [ a doap-changeset:Change; rdfs:label "Allow Function::Parameters-style type constraint expressions."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_10"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Kavorka-0.000_11"^^xsd:string; dc:issued "2013-10-09"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Fix MooseX::KavorkaInfo SYNOPSIS."; ], [ a doap-changeset:Documentation; rdfs:label "Provide an example script using MooseX::KavorkaInfo."; ], [ a doap-changeset:Documentation; rdfs:label "Document Kavorka's exports."; ], [ a doap-changeset:Change; rdfs:label "Throw an exception if people use method modifier keywords to define anonymous functions."; ], [ a doap-changeset:Tests; rdfs:label "Check that it's possible to define a method called `method`."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_11"^^xsd:string. a doap:Version; rdfs:label "First public release"; dc:identifier "Kavorka-0.001"^^xsd:string; dc:issued "2013-10-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.001"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.002"^^xsd:string; dc:issued "2013-10-11"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Refactor some of the code generation in Kavorka::Signature."; ], [ a doap-changeset:Addition; rdfs:label "Kavorka::Signature now provides args_min and args_max methods."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.002"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.003"^^xsd:string; dc:issued "2013-10-12"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Improve sanity checking for signatures."; ], [ a doap-changeset:Change; rdfs:label "Allow @_ and %_ to be used in signatures."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.004"^^xsd:string; dc:issued "2013-10-13"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Correct minor typo."; ], [ a doap-changeset:Addition; rdfs:label "Implement multi subs and multi methods."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.004"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.005"^^xsd:string; dc:issued "2013-10-13"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Fix error parsing `where` clauses."; ], [ a doap-changeset:Change; rdfs:label "$parameter->constraints is now an arrayref of coderefs rather than an arrayref of strings of Perl code."; ], [ a doap-changeset:Change; rdfs:label "Changed error message resulting from failed value constraint."; ], [ a doap-changeset:Documentation; rdfs:label "Included fibonnacci.pl example of using multi subs."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.006"^^xsd:string; dc:issued "2013-10-15"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Document interplay between multi subs and multiple inheritance."; ], [ a doap-changeset:Change; rdfs:label "Use invocant as starting point for searching for multi method candidates."; ], [ a doap-changeset:Tests; rdfs:label "Test cases for multi subs versus multiple inheritance."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.006"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.007"^^xsd:string; dc:issued "2013-10-16"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Allow named parameters to have multiple \"outside\" names."; ], [ a doap-changeset:Change; rdfs:label "Make the parentheses surrounding long named parameters optional."; ], [ a doap-changeset:Change; rdfs:label "Refactor Kavorka::Sub."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.008"^^xsd:string; dc:issued "2013-10-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Make subclassing Kavorka.pm itself a little easier."; ], [ a doap-changeset:Documentation; rdfs:label "Include an example of extending Kavorka to cover some Dancer2 concepts."; ], [ a doap-changeset:Documentation; rdfs:label "Minor documentation fixes."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.008"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.009"^^xsd:string; dc:issued "2013-10-22"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Minor fix to KavorkaX::Dancer2 example extension module."; ], [ a doap-changeset:Packaging; rdfs:label "Package my TODO list."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.009"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.010"^^xsd:string; dc:issued "2013-10-23"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Support 'my' and 'our' prefixes to variable names in signatures."; ], [ a doap-changeset:Change; rdfs:label "Allow package variables such as $Foo::Bar in signatures."; ], [ a doap-changeset:Change; rdfs:label "General refactoring of variable name parsing."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.010"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.011"^^xsd:string; dc:issued "2013-10-25"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Rename ${^NEXT} variable to $next for `around` method modifiers."; ], [ a doap-changeset:Change; rdfs:label "Support Perl 5.20 style :prototype(...) attribute."; ], [ a doap-changeset:Change; rdfs:label "Allow multiple method names to be modified with a single method modifier."; ], [ a doap-changeset:Documentation; rdfs:label "Split up documentation into a manual with bite-sized chunks."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.011"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.012"^^xsd:string; dc:issued "2013-10-26"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Various documentation improvements."; ], [ a doap-changeset:Change; rdfs:label "Optimization: compile dispatchers for multi subs on demand."; ], [ a doap-changeset:Change; rdfs:label "Optimization: avoid double type checks in multi subs."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.012"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.013"^^xsd:string; dc:issued "2013-10-27"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Compiled dispatchers introduced in Kavorka 0.012 are essentially a form of cache. No cache invalidation was in place, leading to issues when adding extra same-named multi method candidates to parent classes after a multi method had already been invoked in a child class. Cache invalidation now works."; ], [ a doap-changeset:Tests; rdfs:label "Test that definition of multi subs happens at runtime, and definition can continue even after the multi sub has been invoked."; ], [ a doap-changeset:Tests; rdfs:label "Test for cache invalidation of compiled multi sub dispatchers."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.013"^^xsd:string. a doap:Version; rdfs:label "Gunpowder, treason and plot"; dc:identifier "Kavorka-0.014"^^xsd:string; dc:issued "2013-11-05"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Update; rdfs:label "Work with (and indeed require Type::Tiny 0.032)."; ], [ a doap-changeset:Addition; rdfs:label "Return types, optionally with coercion."; ], [ a doap-changeset:Addition; rdfs:label "Lexical functions and methods."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.014"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.015"^^xsd:string; dc:issued "2013-11-07"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Most of the closure issues associated with Parse::Keyword are now worked around."; ], [ a doap-changeset:Bugfix; rdfs:label "$sub->signature now returns undef if no signature was given in the declaration."; ], [ a doap-changeset:Change; rdfs:label "Checking if @_ < 0 is silly; stop doing that."; ], [ a doap-changeset:Documentation; rdfs:label "Document that fun ($x, $y=$x) {...} doesn't work how you might expect it to, and some work-arounds."; ], [ a doap-changeset:Tests; rdfs:label "Tidy up some of the closure tests."; ], [ a doap-changeset:BackCompat; rdfs:label "Change the syntax of lexical functions and methods to include the `my` keyword in their declaration."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.015"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.016"^^xsd:string; dc:issued "2013-11-07"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Bypass the Internals::SvREADONLY prototype because handling of the ($;$) prototype changed in 5.16.0 and we were relying on the new behaviour."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.016"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.017"^^xsd:string; dc:issued "2013-11-18"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Extensibility via parameter traits."; ], [ a doap-changeset:Change; rdfs:label "Rename Kavorka::Signature::Parameter -> Kavorka::Parameter."; ], [ a doap-changeset:Change; rdfs:label "Rename Kavorka::Signature::ReturnType -> Kavorka::ReturnType."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.017"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.018"^^xsd:string; dc:issued "2013-11-18"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Allow non-Type::Tiny type constraints to be returned by type constraint expressions, provided they can be converted to Type::Tiny objects via Types::TypeTiny::to_TypeTiny."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.018"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.019"^^xsd:string; dc:issued "2013-11-23"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Provide an `override` keyword which will work in Moose/Mouse, but not Moo."; ], [ a doap-changeset:Change; rdfs:label "Allow named parameters to be passed in as a hashref rather than a hash."; ], [ a doap-changeset:Change; rdfs:label "Split out some of the Kavorka::Parameter features (aliases, locked hashrefs, read-only parameters) into parameter traits."; ], [ a doap-changeset:Addition; rdfs:label "Provide an `augment` keyword which will work in Moose/Mouse, but not Moo."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.019"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.020"^^xsd:string; dc:issued "2013-11-27"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Split out the assumed trait for return types as Kavorka::TraitFor::ReturnType::assumed."; ], [ a doap-changeset:Addition; rdfs:label "Kavorka::TraitFor::Parameter::assumed."; ], [ a doap-changeset:Change; rdfs:label "Can now use 'but' as another alias for 'is'/'does'."; ], [ a doap-changeset:Documentation; rdfs:label "Explain different ways to extend Kavorka."; ], [ a doap-changeset:Change; rdfs:label "Subs can now have traits."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.020"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.021"^^xsd:string; dc:issued "2013-11-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Disallow the `assumed` parameter trait for multi subs."; ], [ a doap-changeset:Addition; rdfs:label "Implement a `ref_alias` trait, inspired by Method::Signatures."; ], [ a doap-changeset:Documentation; rdfs:label "Rearrange some of the traits documentation."; ], [ a doap-changeset:Change; rdfs:label "Split out most of the implementation for the `optional` trait (except for special parsing rules) into Kavorka::TraitFor::ReturnType::optional."; ], [ a doap-changeset:Change; rdfs:label "Split out some sanity_check stuff into the trait modules."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.021"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.022"^^xsd:string; dc:issued "2013-12-16"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Kavorka::TraitFor::Sub::fresh."; ], [ a doap-changeset:Addition; rdfs:label "Kavorka::TraitFor::Sub::override."; ], [ a doap-changeset:Documentation; rdfs:label "Fix typos in Kavorka::Manual::MultiSubs."; doap-changeset:blame ; doap-changeset:fixes ; rdfs:seeAlso ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.022"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.023"^^xsd:string; dc:issued "2013-12-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Fix test case - should not depend on Moops!"; doap-changeset:fixes ; doap-changeset:thanks ; rdfs:seeAlso ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.023"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.024"^^xsd:string; dc:issued "2013-12-18"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "s/namespace::clean/namespace::sweep/"; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.024"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.025"^^xsd:string; dc:issued "2013-12-23"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Value constraints for parameters without type constraints were being ignored."; ], [ a doap-changeset:Addition; rdfs:label "Support non-block form of value constraints, taken from Perl 6 / Method::Signatures."; ], [ a doap-changeset:Tests; rdfs:label "Tests for value constraints."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.025"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.026"^^xsd:string; dc:issued "2014-01-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Allow keywords to detect when the keyword sub has been called in a way that bypasses the Perl keyword API's custom parsing (e.g. using a prototype, or as a coderef). By default, keywords croak when this is detected."; ], [ a doap-changeset:Change; rdfs:label "Method modifier keywords can now detect when the keyword sub has been called bypassing custom parsing, and act sanely rather than croaking."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.026"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.027"^^xsd:string; dc:issued "2014-01-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Minor change to the hook allowing keywords to deal with calls that bypass the Perl keyword API."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027"^^xsd:string. a doap:Version; rdfs:label "The 'perlsub-compat' Release"; dc:identifier "Kavorka-0.028"^^xsd:string; dc:issued "2014-02-21"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Make parsing of parameter defaults laxer so that an equals sign followed by no expression is allowed."; ], [ a doap-changeset:Change; rdfs:label "Allow attributes to *precede* signatures."; ], [ a doap-changeset:Tests; rdfs:label "Add test cases covering bare @ and % sigils."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.028"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.029"^^xsd:string; dc:issued "2014-02-26"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Kavorka::TraitFor::Sub::begin."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.029"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.030"^^xsd:string; dc:issued "2014-03-20"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Introduce `f` as an alternative to `fun`."; ], [ a doap-changeset:Tests; rdfs:label "Add test using Kavorka on threaded Perls."; doap-changeset:blame ; rdfs:seeAlso ; ], [ a doap-changeset:Bugfix; rdfs:label "Eliminate dependency on Devel::Pragma, which fixes Kavorka on threaded Perls."; doap-changeset:blame ; doap-changeset:fixes ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.030"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.031"^^xsd:string; dc:issued "2014-08-13"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Add `multi` to @EXPORT_OK."; doap-changeset:blame ; ], [ a doap-changeset:Bugfix, doap-changeset:Documentation; rdfs:label "Fix link to Kavorka::Manual::Signatures."; doap-changeset:blame ; ], [ a doap-changeset:Update; rdfs:label "Cope with changes to Exporter::Tiny; avoid triggering warnings."; ], [ a doap-changeset:Update; rdfs:label "Bump required version of Return::Type."; ], [ a doap-changeset:Documentation, doap-changeset:Update; rdfs:label "Update benchmarks given that Type::Tiny::XS is hellishly fast."; ], [ a doap-changeset:Packaging; rdfs:label "Recommend Type::Tiny::XS."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.031"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.032"^^xsd:string; dc:issued "2014-08-13"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Work around a bug in Moo(?) or maybe the Perl keyword API(?) by undeferring Moo's deferred subs."; doap-changeset:fixes ; doap-changeset:thanks ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.032"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.033"^^xsd:string; dc:issued "2014-08-22"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix, doap-changeset:Update; rdfs:label "Type::Registry::DWIM changed its API. (Kavorka probably shouldn't be using it anyway because it's an undocumented internal part of Type::Utils.)"; doap-changeset:thanks [ foaf:nick "SpiceMan" ]; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.033"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.034"^^xsd:string; dc:issued "2014-09-07"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Avoid triggering RT#98666."; ], [ a doap-changeset:Update; rdfs:label "Switch from Sub::Name+Sub::Identify to the shiny new Sub::Util."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.034"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.035"^^xsd:string; dc:issued "2014-09-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Make it easier to do weird things subclassing Kavorka::Multi."; ], [ a doap-changeset:Tests; rdfs:label "Add a test case for Sub::Defer-related weirdness."; rdfs:seeAlso ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.035"^^xsd:string. a doap:Version; dc:identifier "Kavorka-0.036"^^xsd:string; dc:issued "2014-11-01"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Avoid inadvertantly autovivifying things in Sub::Defer's big hash of deferred subs."; doap-changeset:blame ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.036"^^xsd:string. a foaf:Person; foaf:name "Chris Tijerina"; foaf:nick "CAMSPI"; foaf:page . a foaf:Person; foaf:name "Piers Cawley"; foaf:nick "PDCAWLEY"; foaf:page . a foaf:Person; foaf:name "Syohei Yoshida"; foaf:nick "SYOHEX"; foaf:page . a foaf:Person; foaf:name "Aaron James Trevena"; foaf:nick "TEEJAY"; foaf:page . a foaf:Person; foaf:name "Thibaut Le Page"; foaf:nick "THILP"; foaf:page . a foaf:Person; foaf:mbox ; foaf:name "Toby Inkster"; foaf:nick "TOBYINK"; foaf:page . a foaf:Person; foaf:name "Grzegorz Rożniecki"; foaf:nick "XAERXESS"; foaf:page . a doap-bugs:Issue; rdfs:label "Perhaps make `fun` and `method` install methods at compile time."; dc:created "2013-12-21T11:00:32Z"^^xsd:dateTime; dc:reporter _:B1; doap-bugs:id "91557"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Investigate compatibility with forthcoming native signatures"; dc:created "2014-02-01T08:10:12Z"^^xsd:dateTime; dc:reporter _:B1; doap-bugs:id "92634"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "segfault on joining multiple threads using Kavorka"; dc:created "2014-03-19T20:25:02Z"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox ]; doap-bugs:id "94015", "94015"^^xsd:string; doap-bugs:page , ; doap-bugs:status . a doap-bugs:Issue; doap-bugs:id "95786"^^xsd:string; doap-bugs:page . foaf:mbox_sha1sum "18b01a46900ed3428b71cacdf010d47c26cc6cff"; foaf:name "Jonathan Cast". _:B1 a foaf:Agent; foaf:mbox . benchmarks-multisub.pl000664001750001750 411212425206147 20052 0ustar00taitai000000000000Kavorka-0.036/examplesuse v5.14; use warnings; use Benchmark 'cmpthese'; { package Using_Kavorka; use Moose; use Kavorka 0.005 qw( multi method ); multi method fib ( Int $i where { $_ <= 1 } ) { return $i; } multi method fib ( Int $i ) { return $self->fib($i-1) + $self->fib($i-2); } } { package Using_MXMM; use Moose; use MooseX::MultiMethods; multi method fib ( Int $i where { $_ <= 1 } ) { return $i; } multi method fib ( Int $i ) { return $self->fib($i-1) + $self->fib($i-2); } } { package Using_Plain; use Moose; use Scalar::Util; sub fib { my $self = shift; my ($i) = @_; defined($i) && !ref($i) && $i =~ /\A-?[0-9]+\z/ or die; return $i if $i <= 1; return $self->fib($i-1) + $self->fib($i-2); } } cmpthese(-5, { Kavorka => q{ my $obj = Using_Kavorka->new; $obj->fib($_) for 0..10; }, MXMM => q{ my $obj = Using_MXMM->new; $obj->fib($_) for 0..10; }, Plain => q{ my $obj = Using_Plain->new; $obj->fib($_) for 0..10; }, }); =pod =encoding utf-8 =head1 PURPOSE Benchmarking the following multi method: multi method fib ( Int $i where { $_ <= 1 } ) { return $i; } multi method fib ( Int $i ) { return $self->fib($i-1) + $self->fib($i-2); } The code that invokes the multi method is: my $obj = $implementation->new; $obj->fib($_) for 0..10; Modules tested are: =over =item * L (of course) =item * L =item Plain old Perl 5 subs, for comparison. =back =head1 RESULTS Running C<< perl -Ilib examples/benchmarks-multisub.pl >>: Rate MXMM Kavorka Plain MXMM 0.861/s -- -89% -100% Kavorka 7.81/s 807% -- -97% Plain 276/s 32026% 3441% -- Kavorka is the faster multi-method implementation, though is significantly slower than avoiding multi-methods. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 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 benchmarks-named.pl000664001750001750 151112425206147 17272 0ustar00taitai000000000000Kavorka-0.036/examplesuse v5.14; use warnings; use Benchmark 'cmpthese'; package Using_FP { use Function::Parameters ':strict'; method foo ( :$x, :$y ) { return [ $x, $y ]; } } package Using_Kavorka { use Kavorka; method foo ( :$x, :$y ) { return [ $x, $y ]; } } cmpthese(-3, { Using_FP => q{ Using_FP->foo(x => 1, y => $_) for 0..99 }, Using_Kavorka_Hash => q{ Using_Kavorka->foo(x => 1, y => $_) for 0..99 }, Using_Kavorka_Hashref => q{ Using_Kavorka->foo({x => 1, y => $_ }) for 0..99 }, }); __END__ Rate Using_Kavorka_Hashref Using_Kavorka_Hash Using_FP Using_Kavorka_Hashref 270/s -- -10% -65% Using_Kavorka_Hash 302/s 12% -- -61% Using_FP 768/s 184% 155% -- benchmarks-pos.pl000664001750001750 103612425206147 17011 0ustar00taitai000000000000Kavorka-0.036/examplesuse v5.14; use warnings; use Benchmark 'cmpthese'; package Using_FP { use Function::Parameters ':strict'; method foo ( $x, $y ) { return [ $x, $y ]; } } package Using_Kavorka { use Kavorka; method foo ( $x, $y ) { return [ $x, $y ]; } } cmpthese(-3, { Using_FP => q{ Using_FP->foo(1, $_) for 0..99 }, Using_Kavorka => q{ Using_Kavorka->foo(1, $_) for 0..99 }, }); __END__ Rate Using_Kavorka Using_FP Using_Kavorka 1450/s -- -11% Using_FP 1637/s 13% -- benchmarks.pl000664001750001750 576212425206147 16224 0ustar00taitai000000000000Kavorka-0.036/examplesuse v5.14; use warnings; use Benchmark 'cmpthese'; package Using_FP_TT { use Function::Parameters ':strict'; use Types::Standard -types; method foo ( (Int) $x, (ArrayRef[Int]) $y ) { return [ $x, $y ]; } } package Using_FP_Moose { use Function::Parameters ':strict'; method foo ( Int $x, ArrayRef[Int] $y ) { return [ $x, $y ]; } } package Using_Kavorka { use Kavorka; method foo ( Int $x, ArrayRef[Int] $y ) { return [ $x, $y ]; } } package Using_MS { use Moose; use Method::Signatures; method foo ( Int $x, ArrayRef[Int] $y ) { return [ $x, $y ]; } } package Using_MXMS { use Moose; use MooseX::Method::Signatures; method foo ( $class : Int $x, ArrayRef[Int] $y ) { return [ $x, $y ]; } } package Using_TParams { use Types::Standard -types; use Type::Params 'compile'; sub foo { state $signature = compile( 1, Int, ArrayRef[Int] ); my ($self, $x, $y) = $signature->(@_); return [ $x, $y ]; } } cmpthese(-3, { map { my $class = "Using_$_"; $_ => qq[ $class\->foo(0, [1..10]) ]; } qw( FP_Moose FP_TT Kavorka TParams MS MXMS ) }); =pod =encoding utf-8 =head1 PURPOSE Benchmarking the following method call defined with several different modules: method foo ( Int $x, ArrayRef[Int] $y ) { return [ $x, $y ]; } Modules tested are: =over =item * L (of course) =item * L (not as sugary, but probably the fastest pure Perl method signature implementation on CPAN) =item * L plus L type constraints =item * L plus L type constraints =item * L =item * L =back In all cases, L is installed. This gives a speed boost to Kavorka, Type::Params, and one of the Function::Parameters examples. =head1 RESULTS =head2 Standard Results Running C<< perl -Ilib examples/benchmarks.pl >>: Rate MXMS MS FP_Moose TParams FP_TT Kavorka MXMS 654/s -- -91% -93% -98% -98% -98% MS 7129/s 990% -- -18% -78% -82% -83% FP_Moose 8719/s 1233% 22% -- -74% -78% -79% TParams 32905/s 4933% 362% 277% -- -17% -20% FP_TT 39648/s 5964% 456% 355% 20% -- -3% Kavorka 41008/s 6172% 475% 370% 25% 3% -- Kavorka is the winner. Yes, that's right, it's about 60 or so times faster than MooseX::Method::Signatures. Note that if L is loaded before L, then Method::Signatures will be able to use Mouse's type constraints instead of Moose's. In that case, the Method::Signatures results are much closer to Kavorka. (In the table above they'd be about 30000/s.) =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014 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 fibonacci.pl000664001750001750 130012425206147 16004 0ustar00taitai000000000000Kavorka-0.036/examplesuse v5.14; use Kavorka 0.004 qw( multi fun ); multi fun fib ( Int $i where { $_ <= 1 } ) { return $i; } multi fun fib ( Int $i ) { return fib($i-1) + fib($i-2); } say fib($_) for 0..9; =pod =encoding utf-8 =head1 PURPOSE Demonstration of the elegance of multi subs. multi fun fib ( Int $i where { $_ <= 1 } ) { return $i; } multi fun fib ( Int $i ) { return fib($i-1) + fib($i-2); } =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 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 meta.pl000664001750001750 64012425206147 15003 0ustar00taitai000000000000Kavorka-0.036/examplesuse v5.14; package Foo { use Moose; use MooseX::KavorkaInfo; use Kavorka qw( -default -modifiers ); method xxx (Int $x) { return $x ** 3 } } package Foo::Verbose { use Moose; use MooseX::KavorkaInfo; use Kavorka qw( -default -modifiers ); extends "Foo"; before xxx { warn "Called xxx" } } my $method = Foo::Verbose->meta->get_method("xxx"); say $method->signature->params->[1]->type->name; # says "Int" Kavorka.pm000664001750001750 2226112425206147 14447 0ustar00taitai000000000000Kavorka-0.036/libuse 5.014; use strict; use warnings; no warnings 'void'; use Carp (); use Exporter::Tiny (); use PadWalker (); use Parse::Keyword (); use Module::Runtime (); use Scalar::Util (); use Sub::Util (); package Kavorka; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; our @ISA = qw( Exporter::Tiny ); our @EXPORT = qw( fun method ); our @EXPORT_OK = qw( fun method after around before override augment classmethod objectmethod multi ); our %EXPORT_TAGS = ( modifiers => [qw( after around before )], allmodifiers => [qw( after around before override augment )], ); our %IMPLEMENTATION = ( after => 'Kavorka::Sub::After', around => 'Kavorka::Sub::Around', augment => 'Kavorka::Sub::Augment', before => 'Kavorka::Sub::Before', classmethod => 'Kavorka::Sub::ClassMethod', f => 'Kavorka::Sub::Fun', fun => 'Kavorka::Sub::Fun', func => 'Kavorka::Sub::Fun', function => 'Kavorka::Sub::Fun', method => 'Kavorka::Sub::Method', multi => 'Kavorka::Multi', objectmethod => 'Kavorka::Sub::ObjectMethod', override => 'Kavorka::Sub::Override', ); our %INFO; sub info { my $me = shift; my $code = $_[0]; $INFO{$code}; } sub guess_implementation { my $me = shift; $IMPLEMENTATION{$_[0]}; } sub compose_implementation { shift; require Moo::Role; Moo::Role->create_class_with_roles(@_); } sub _exporter_validate_opts { my $class = shift; $^H{'Kavorka/package'} = $_[0]{into}; $_[0]{replace} = 1 unless exists $_[0]{replace}; } sub _fqname ($;$) { my $name = shift; my ($package, $subname); $name =~ s{'}{::}g; if ($name =~ /::/) { ($package, $subname) = $name =~ m{^(.+)::(\w+)$}; } else { my $caller = @_ ? shift : $^H{'Kavorka/package'}; ($package, $subname) = ($caller, $name); } return wantarray ? ($package, $subname) : "$package\::$subname"; } sub _exporter_fail { my $me = shift; my ($name, $args, $globals) = @_; my $implementation = $args->{'implementation'} // $me->guess_implementation($name) // $me; my $into = $globals->{into}; Module::Runtime::use_package_optimistically($implementation); { my $traits = $globals->{traits} // $args->{traits}; $implementation = $me->compose_implementation($implementation, @$traits) if $traits; } $implementation->can('parse') or Carp::croak("No suitable implementation for keyword '$name'"); # Workaround for RT#95786 which might be caused by a bug in the Perl # interpreter. # Also RT#98666 is why we can't just call undefer_all. require Sub::Defer; for (keys %Sub::Defer::DEFERRED) { no warnings; Sub::Defer::undefer_sub($_) if $Sub::Defer::DEFERRED{$_} && $Sub::Defer::DEFERRED{$_}[0] =~ /\AKavorkaX?\b/; } # Kavorka::Multi (for example) needs to know what Kavorka keywords are # currently in scope. $^H{'Kavorka'} .= "$name=$implementation "; # This is the code that gets called at run-time. # my $code = Sub::Util::set_subname( "$me\::$name", sub { unless (Scalar::Util::blessed($_[0]) and $_[0]->DOES('Kavorka::Sub')) { return $implementation->bypass_custom_parsing($name, $into, \@_); } my $subroutine = shift; # Post-parse clean-up $subroutine->_post_parse(); # Store $subroutine for introspection $INFO{ $subroutine->body } = $subroutine; # Install sub my @r = wantarray ? $subroutine->install_sub : scalar($subroutine->install_sub); # Workarounds for closure issues in Parse::Keyword if ($subroutine->is_anonymous) { my $orig = $r[0]; my $caller_vars = PadWalker::peek_my(1); @r = Sub::Util::set_subname($subroutine->package."::__ANON__", sub { $subroutine->_poke_pads($caller_vars); goto $orig; }); &Scalar::Util::set_prototype($r[0], $_) for grep defined, prototype($orig); $INFO{ $r[0] } = $subroutine; Scalar::Util::weaken($INFO{ $r[0] }); } else { $subroutine->_poke_pads( PadWalker::peek_my(1) ); } # Prevents a cycle between %INFO and $subroutine. Scalar::Util::weaken($subroutine->{body}) unless Scalar::Util::isweak($subroutine->{body}); wantarray ? @r : $r[0]; }, ); # This joins up the code above with our custom parsing via # Parse::Keyword # Parse::Keyword::install_keyword_handler( $code => Sub::Util::set_subname( "$me\::parse_$name", sub { local $Carp::CarpLevel = $Carp::CarpLevel + 1; my $subroutine = $implementation->parse(keyword => $name); return ( sub { ($subroutine, $args) }, !! $subroutine->declared_name, ); }, ), ); # Symbol for Exporter::Tiny to export return ($name => $code); } 1; __END__ =pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive yada globals =head1 NAME Kavorka - function signatures with the lure of the animal =head1 SYNOPSIS use Kavorka; fun maxnum (Num @numbers) { my $max = shift @numbers; for (@numbers) { $max = $_ if $max < $_; } return $max; } my $biggest = maxnum(42, 3.14159, 666); =head1 STATUS Kavorka is still at a very early stage of development; there are likely to be many bugs that still need to be shaken out. Certain syntax features are a little odd and may need to be changed in incompatible ways. =head1 DESCRIPTION Kavorka provides C and C keywords for declaring functions and methods. It uses Perl 5.14's keyword API, so should work more reliably than source filters or L-based modules. The syntax provided by Kavorka is largely inspired by Perl 6, though it has also been greatly influenced by L and L. For information using the keywords exported by Kavorka: =over =item * L =item * L =item * L =item * L =back =head2 Exports =over =item C<< -default >> Exports C and C. =item C<< -modifiers >> Exports C, C, and C. =item C<< -allmodifiers >> Exports C, C, C, C, and C. =item C<< -all >> Exports C, C, C, C, C, C, C, C, C, and C. =back For example: # Everything except objectmethod and multi... use Kavorka qw( -default -allmodifiers classmethod ); You can rename imported functions: use Kavorka method => { -as => 'meth' }; You can provide alternative implementations: # use My::Sub::Method instead of Kavorka::Sub::Method use Kavorka method => { implementation => 'My::Sub::Method' }; Or add traits to the default implementation: use Kavorka method => { traits => ['My::Sub::Role::Foo'] }; See L for more tips. =head2 Function Introspection API The coderef for any sub created by Kavorka can be passed to the C<< Kavorka->info >> method. This returns a blessed object that does the L role. fun foo (:$x, :$y) { } my $info = Kavorka->info(\&foo); my $function_name = $info->qualified_name; my @named_params = $info->signature->named_params; say $named_params[0]->named_names->[0]; # says 'x' See L, L and L for further details. If you're using Moose, consider using L to expose Kavorka method signatures via the meta object protocol. L provides more details and examples using the introspection API. =head1 CAVEATS =over =item * As noted in L, subroutine attributes don't work properly for anonymous functions. =item * This module is based on L, which has a chronically broken implementation of closures. Kavorka uses L to attempt to work around the problem. This mostly seems to work, but you may experience some problems in edge cases, especially for anonymous functions and methods. =item * If importing Kavorka's method modifiers into Moo/Mouse/Moose classes, pay attention to load order: use Moose; use Kavorka -all; # ok If you do it this way, Moose's C, C, and C keywords will stomp on top of Kavorka's... use Kavorka -all; use Moose; # STOMP, STOMP, STOMP! :-( This can lead to delightfully hard to debug errors. =back =head1 BUGS Please report any bugs to L. =head1 SUPPORT B<< IRC: >> support is available through in the I<< #moops >> channel on L. =head1 SEE ALSO L. B<< Inspirations: >> L, L, L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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. 01basic.t000664001750001750 66212425206147 13560 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test that Kavorka compiles. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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_ok('Kavorka'); done_testing; 02named-functions.t000664001750001750 565012425206147 15614 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Create named functions with C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; fun foo { return { '@_' => \@_ }; } fun bar () { return { '@_' => \@_ }; } fun Example2::baz (my $x, $y) { return { '@_' => \@_, '$x' => \$x, '$y' => \$y }; } fun ::quux ($x, $y, ...) { return { '@_' => \@_, '$x' => \$x, '$y' => \$y }; } fun my $xyzzy ($x) { return { '$x' => \$x }; } fun XYZZY ($x) { return $xyzzy->($x); } ::ok( ::exception { $xyzzy = 42 }, 'cannot rebind the lexical function' ); { fun my $xyzzy () { 42 }; ::is($xyzzy->(), 42, 'can redefine lexical function in another scope'); } } is_deeply( Example::foo(), { '@_' => [] }, 'named function with no signature; called with empty list', ); is_deeply( Example::foo(1..4), { '@_' => [1..4] }, 'named function with no signature; called with arguments', ); is_deeply( Example::bar(), { '@_' => [] }, 'named function with empty signature', ); #line 68 like( exception { Example::bar(1..4) }, qr{\AExpected 0 parameters at \S+ line 69}, 'named function with empty signature throws exception if passed arguments', ); is_deeply( Example2::baz(1..2), { '@_' => [1..2], '$x' => \1, '$y' => \2 }, 'named function with positional parameters', ); #line 81 like( exception { Example2::baz(1..4) }, qr{\AExpected 2 parameters at \S+ line 82}, 'named function with positional parameters throws exception if passed too many arguments', ); #line 88 like( exception { Example2::baz(1) }, qr{\AExpected 2 parameters at \S+ line 89}, 'named function with positional parameters throws exception if passed too few arguments', ); #line 95 is( exception { Example2::baz(undef, undef) }, undef, 'an explicit undef satisfies positional parameters', ); is_deeply( quux(1..2), { '@_' => [1..2], '$x' => \1, '$y' => \2 }, 'named function with positional parameters and yadayada', ); #line 108 is( exception { quux(1..4) }, undef, 'named function with positional parameters and yadayada throws no exception if passed too many arguments', ); #line 115 like( exception { quux(1) }, qr{\AExpected at least 2 parameters at \S+ line 116}, 'named function with positional parameters and yadayada throws exception if passed too few arguments', ); #line 121 is( exception { quux(undef, undef) }, undef, 'an explicit undef satisfies positional parameters with yadayada', ); is_deeply( Example::XYZZY(42), { '$x' => \42 }, 'lexical subs', ); { package Example3; use Kavorka; fun xxx { } }; is_deeply( [ Example3::xxx(1..3) ], [], 'an empty function body returns nothing', ); done_testing; 03anon-functions.t000664001750001750 527312425206147 15465 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Create anonymous functions with C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; use Kavorka; my $foo = fun { return { '@_' => \@_ }; }; my ($bar, $baz) = ( fun () { return { '@_' => \@_ }; }, fun ($x, $y) { return { '@_' => \@_, '$x' => \$x, '$y' => \$y }; }, ); my $quux = fun ($x, $y, ...) { return { '@_' => \@_, '$x' => \$x, '$y' => \$y }; } ; is_deeply( $foo->(), { '@_' => [] }, 'anon function with no signature; called with empty list', ); is_deeply( $foo->(1..4), { '@_' => [1..4] }, 'anon function with no signature; called with arguments', ); is_deeply( $bar->(), { '@_' => [] }, 'anon function with empty signature', ); #line 68 like( exception { $bar->(1..4) }, qr{\AExpected 0 parameters}, 'anon function with empty signature throws exception if passed arguments', ); is_deeply( $baz->(1..2), { '@_' => [1..2], '$x' => \1, '$y' => \2 }, 'anon function with positional parameters', ); #line 81 like( exception { $baz->(1..4) }, qr{\AExpected 2 parameters}, 'anon function with positional parameters throws exception if passed too many arguments', ); #line 88 like( exception { $baz->(1) }, qr{\AExpected 2 parameters}, 'anon function with positional parameters throws exception if passed too few arguments', ); #line 95 is( exception { $baz->(undef, undef) }, undef, 'an explicit undef satisfies positional parameters', ); is_deeply( $quux->(1..2), { '@_' => [1..2], '$x' => \1, '$y' => \2 }, 'anon function with positional parameters and yadayada', ); #line 108 is( exception { $quux->(1..4) }, undef, 'anon function with positional parameters and yadayada throws no exception if passed too many arguments', ); #line 115 like( exception { $quux->(1) }, qr{\AExpected at least 2 parameters}, 'anon function with positional parameters and yadayada throws exception if passed too few arguments', ); #line 121 is( exception { $quux->(undef, undef) }, undef, 'an explicit undef satisfies positional parameters with yadayada', ); is_deeply( [ (fun{})->(1..3) ], [], 'an empty function body returns nothing', ); my @functions; my @subs; for my $i (0..2) { push @functions, fun ($x) { $i }; push @subs, sub { $i }; } is_deeply( [ $functions[0]->(7), $functions[1]->(7), $functions[2]->(7) ], [ $subs[0]->(7), $subs[1]->(7), $subs[2]->(7) ], 'closures work for anonymous functions', ); done_testing; 04named-methods.t000664001750001750 620212425206147 15243 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Create named functions with C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; method foo { return { '$self' => $self, '@_' => \@_ }; } method bar () { return { '$self' => $self, '@_' => \@_ }; } method Example2::baz ($x, $y) { return { '$self' => $self, '@_' => \@_, '$x' => \$x, '$y' => \$y }; } method ::quux ($x, $y, ...) { return { '$self' => $self, '@_' => \@_, '$x' => \$x, '$y' => \$y }; } method my $xyzzy ($x) { return { '$self' => $self, '$x' => \$x }; } method XYZZY ($x) { return $self->$xyzzy($x); } } is_deeply( Example->foo(), { '$self' => 'Example', '@_' => [] }, 'named method with no signature; called with empty list', ); is_deeply( Example->foo(1..4), { '$self' => 'Example', '@_' => [1..4] }, 'named method with no signature; called with arguments', ); is_deeply( Example->bar(), { '$self' => 'Example', '@_' => [] }, 'named method with empty signature', ); #line 68 like( exception { Example->bar(1..4) }, qr{\AExpected 0 parameters at \S+ line 69}, 'named method with empty signature throws exception if passed arguments', ); is_deeply( Example2->baz(1..2), { '$self' => 'Example2', '@_' => [1..2], '$x' => \1, '$y' => \2 }, 'named method with positional parameters', ); #line 81 like( exception { Example2->baz(1..4) }, qr{\AExpected 2 parameters at \S+ line 82}, 'named method with positional parameters throws exception if passed too many arguments', ); #line 88 like( exception { Example2->baz(1) }, qr{\AExpected 2 parameters at \S+ line 89}, 'named method with positional parameters throws exception if passed too few arguments', ); #line 95 is( exception { Example2->baz(undef, undef) }, undef, 'an explicit undef satisfies positional parameters', ); is_deeply( main->quux(1..2), { '$self' => 'main', '@_' => [1..2], '$x' => \1, '$y' => \2 }, 'named method with positional parameters and yadayada', ); #line 108 is( exception { main->quux(1..4) }, undef, 'named method with positional parameters and yadayada throws no exception if passed too many arguments', ); #line 115 like( exception { main->quux(1) }, qr{\AExpected at least 2 parameters at \S+ line 116}, 'named method with positional parameters and yadayada throws exception if passed too few arguments', ); #line 121 is( exception { main->quux(undef, undef) }, undef, 'an explicit undef satisfies positional parameters with yadayada', ); is_deeply( Example->XYZZY(42), { '$self' => 'Example', '$x' => \42 }, 'lexical methods', ); { package Example3; use Kavorka; method xxx { } }; is_deeply( [ Example3->xxx(1..3) ], [], 'an empty method body returns nothing', ); { package Example4; use Kavorka; use namespace::sweep; method method { 42 } } is_deeply( Example4->method, 42, 'can define a method called "method"', ); done_testing; 05anon-methods.t000664001750001750 530312425206147 15114 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Create anonymous methods with C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; use Kavorka; my $foo = method { return { '$self' => $self, '@_' => \@_ }; }; my ($bar, $baz) = ( method () { return { '$self' => $self, '@_' => \@_ }; }, method ($x, $y) { return { '$self' => $self, '@_' => \@_, '$x' => \$x, '$y' => \$y }; }, ); my $quux = method ($x, $y, ...) { return { '$self' => $self, '@_' => \@_, '$x' => \$x, '$y' => \$y }; } ; is_deeply( __PACKAGE__->$foo(), { '$self' => 'main', '@_' => [] }, 'anon method with no signature; called with empty list', ); is_deeply( __PACKAGE__->$foo(1..4), { '$self' => 'main', '@_' => [1..4] }, 'anon method with no signature; called with arguments', ); is_deeply( __PACKAGE__->$bar, { '$self' => 'main', '@_' => [] }, 'anon method with empty signature', ); #line 68 like( exception { __PACKAGE__->$bar(1..4) }, qr{\AExpected 0 parameters}, 'anon method with empty signature throws exception if passed arguments', ); is_deeply( __PACKAGE__->$baz(1..2), { '$self' => 'main', '@_' => [1..2], '$x' => \1, '$y' => \2 }, 'anon method with positional parameters', ); #line 81 like( exception { __PACKAGE__->$baz(1..4) }, qr{\AExpected 2 parameters}, 'anon method with positional parameters throws exception if passed too many arguments', ); #line 88 like( exception { __PACKAGE__->$baz(1) }, qr{\AExpected 2 parameters}, 'anon method with positional parameters throws exception if passed too few arguments', ); #line 95 is( exception { __PACKAGE__->$baz(undef, undef) }, undef, 'an explicit undef satisfies positional parameters', ); is_deeply( __PACKAGE__->$quux(1..2), { '$self' => 'main', '@_' => [1..2], '$x' => \1, '$y' => \2 }, 'anon method with positional parameters and yadayada', ); #line 108 is( exception { __PACKAGE__->$quux(1..4) }, undef, 'anon method with positional parameters and yadayada throws no exception if passed too many arguments', ); #line 115 like( exception { __PACKAGE__->$quux(1) }, qr{\AExpected at least 2 parameters}, 'anon method with positional parameters and yadayada throws exception if passed too few arguments', ); #line 121 is( exception { __PACKAGE__->$quux(undef, undef) }, undef, 'an explicit undef satisfies positional parameters with yadayada', ); is_deeply( [ __PACKAGE__->${ \ method{} }(1..3) ], [], 'an empty method body returns nothing', ); done_testing; 10positional.t000664001750001750 1077312425206147 14724 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test positional parameters: required versus optional; lexical versus localized versus anonymous; various types of defaults. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; fun foo ($x) { return { '@_' => \@_, '$x' => $x, }; } fun bar ($, $x) { return { '@_' => \@_, '$x' => $x, }; } fun baz ($x, $y) { return { '@_' => \@_, '$x' => $x, '$y' => $y, }; } fun quux (${^ONE}, $_) { return { '@_' => \@_, '${^ONE}' => ${^ONE}, '$_' => $_ }; } } is_deeply( Example::foo('A'), { '@_' => ['A'], '$x' => 'A' }, 'function with one positional parameter' ); is_deeply( Example::bar('A', 'B'), { '@_' => ['A', 'B'], '$x' => 'B' }, 'function with two positional parameters, the first of which is anonymous' ); is_deeply( Example::baz('A', 'B'), { '@_' => ['A', 'B'], '$x' => 'A', '$y' => 'B' }, 'function with two positional parameters' ); is_deeply( Example::quux('A', 'B'), { '@_' => ['A', 'B'], '${^ONE}' => 'A', '$_' => 'B' }, 'function with two positional parameters using localized global variables' ); { package Example2; use Kavorka; fun foo ($x?) { return { '@_' => \@_, '$x' => $x, }; } fun bar ($x = 42) { return { '@_' => \@_, '$x' => $x, }; } fun baz ($x //= 42) { return { '@_' => \@_, '$x' => $x, }; } fun quux ($x ||= 42) { return { '@_' => \@_, '$x' => $x, }; } fun xyzzy ($x=,$=,$y=) { return { '@_' => \@_, '$x' => $x, '$y' => $y }; } } is_deeply( Example2::foo(666), { '@_' => [666], '$x' => '666' }, 'optional positional parameter supplied' ); is_deeply( Example2::foo(undef), { '@_' => [undef], '$x' => undef }, 'optional positional parameter supplied undef' ); is_deeply( Example2::foo(), { '@_' => [], '$x' => undef }, 'optional positional parameter omitted' ); is_deeply( Example2::bar(666), { '@_' => [666], '$x' => '666' }, 'positional parameter with default supplied' ); is_deeply( Example2::bar(undef), { '@_' => [undef], '$x' => undef }, 'positional parameter with default supplied undef' ); is_deeply( Example2::bar(), { '@_' => [], '$x' => 42 }, 'positional parameter with default omitted' ); is_deeply( Example2::baz(666), { '@_' => [666], '$x' => '666' }, 'positional parameter with //=default supplied' ); is_deeply( Example2::baz(undef), { '@_' => [undef], '$x' => 42 }, 'positional parameter with //=default supplied undef' ); is_deeply( Example2::baz(0), { '@_' => [0], '$x' => 0 }, 'positional parameter with //=default supplied false' ); is_deeply( Example2::baz(), { '@_' => [], '$x' => 42 }, 'positional parameter with //=default omitted' ); is_deeply( Example2::quux(666), { '@_' => [666], '$x' => '666' }, 'positional parameter with ||=default supplied' ); is_deeply( Example2::quux(undef), { '@_' => [undef], '$x' => 42 }, 'positional parameter with ||=default supplied undef' ); is_deeply( Example2::quux(0), { '@_' => [0], '$x' => 42 }, 'positional parameter with ||=default supplied false' ); is_deeply( Example2::quux(), { '@_' => [], '$x' => 42 }, 'positional parameter with ||=default omitted' ); is_deeply( Example2::xyzzy(42), { '@_' => [42], '$x' => 42, '$y' => undef }, 'crazy bare =', ); is_deeply( Example2::xyzzy(42, 4), { '@_' => [42, 4], '$x' => 42, '$y' => undef }, 'crazy bare =', ); is_deeply( Example2::xyzzy(42, 4, 2), { '@_' => [42, 4, 2], '$x' => 42, '$y' => 2 }, 'crazy bare =', ); { package Example3; use Kavorka; fun foo ($x, @) { return { '@_' => \@_, '$x' => $x, }; } fun bar ($x, %) { return { '@_' => \@_, '$x' => $x, }; } fun baz ($x, ...) { return { '@_' => \@_, '$x' => $x, }; } } is_deeply( Example3::foo(42, quux => 'xyzzy'), { '@_' => [42, quux => 'xyzzy'], '$x' => 42 }, 'Signature ($x, @) works', ); is_deeply( Example3::bar(42, quux => 'xyzzy'), { '@_' => [42, quux => 'xyzzy'], '$x' => 42 }, 'Signature ($x, %) works', ); is_deeply( Example3::baz(42, quux => 'xyzzy'), { '@_' => [42, quux => 'xyzzy'], '$x' => 42 }, 'Signature ($x, ...) works', ); like( exception { Example3::bar(42, 'xyzzy') }, qr/^Odd number of elements in anonymous hash/, 'Signature ($x, %) can throw', ); is( exception { Example3::baz(42, 'xyzzy') }, undef, "Signature (\$x, ...) won't throw", ); done_testing; 11named.t000664001750001750 731312425206147 13604 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test named parameters: required versus optional; various types of defaults; long names. Tests that C<< %_ >> reflects named parameters. Checks that named parameters work with an odd or even number of leading positional parameters and/or invocants. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; our $zzz = 'package variable'; fun foo ($x, :$y) { return { '@_' => \@_, '%_' => \%_, '$x' => $x, '$y' => $y, }; } fun bar ($, $x, :$y) { return { '@_' => \@_, '%_' => \%_, '$x' => $x, '$y' => $y, }; } fun baz (:$x, :$y!) { return { '@_' => \@_, '%_' => \%_, '$x' => $x, '$y' => $y, }; } fun quux (:zzz($z)) { return { '@_' => \@_, '%_' => \%_, '$zzz' => $zzz, '$z' => $z }; } } #diag explain( Kavorka->info(\&Example::baz) ); is_deeply( Example::foo(666, y => 42), { '@_' => [666, y => 42], '%_' => { y => 42 }, '$x' => 666, '$y' => 42 }, 'single positional followed by a named parameter', ); is_deeply( Example::foo(666), { '@_' => [666], '%_' => { }, '$x' => 666, '$y' => undef }, 'single positional followed by a named parameter - named parameters are optional', ); is_deeply( Example::bar(999, 666, y => 42), { '@_' => [999, 666, y => 42], '%_' => { y => 42 }, '$x' => 666, '$y' => 42 }, 'two positionals followed by a named parameter', ); is_deeply( Example::bar(999, 666), { '@_' => [999, 666], '%_' => { }, '$x' => 666, '$y' => undef }, 'two positionals followed by a named parameter - named parameters are optional', ); is_deeply( Example::baz(x => 666, y => 42), { '@_' => [x => 666, y => 42], '%_' => { x => 666, y => 42 }, '$x' => 666, '$y' => 42 }, 'two named parameters', ); is_deeply( Example::baz({ x => 666, y => 42 }), { '@_' => [{ x => 666, y => 42 }], '%_' => { x => 666, y => 42 }, '$x' => 666, '$y' => 42 }, 'two named parameters (passed as hashref)', ); is_deeply( Example::baz(y => 42), { '@_' => [y => 42], '%_' => { y => 42 }, '$x' => undef, '$y' => 42 }, 'two named parameters - omit the optional one', ); like( exception { Example::baz(x => 666) }, qr{^Named parameter .y. is required}, 'two named parameters - omit the required one; throws', ); is_deeply( Example::quux(zzz => 42), { '@_' => [zzz => 42], '%_' => { zzz => 42 }, '$z' => 42, '$zzz' => 'package variable' }, 'long named parameter', ); like( exception { Example::quux(z => 666) }, qr{^Unknown named parameter: z}, 'long named parameter cannot be invoked with its short name', ); { package Example2; use Kavorka; fun xxx ( :foo( :bar(:baz($x) )) , ... ) { return $x; } fun yyy ( :foo( :bar(:baz(:$x) )) , ... ) { return $x; } fun zzz ( :foo :bar :baz :$x, ... ) { return $x; } fun www ( :foo :bar :baz $x, ... ) { return $x; } } is_deeply( [ Example2::www(foo => 40), Example2::www(bar => 41), Example2::www(baz => 42), Example2::www(x => 43) ], [ 40 .. 42, undef ], 'multi-named parameters' ); is_deeply( [ Example2::xxx(foo => 40), Example2::xxx(bar => 41), Example2::xxx(baz => 42), Example2::xxx(x => 43) ], [ 40 .. 42, undef ], 'multi-named parameters' ); is_deeply( [ Example2::yyy(foo => 40), Example2::yyy(bar => 41), Example2::yyy(baz => 42), Example2::yyy(x => 43) ], [ 40 .. 42, 43 ], 'multi-named parameters' ); is_deeply( [ Example2::zzz(foo => 40), Example2::zzz(bar => 41), Example2::zzz(baz => 42), Example2::zzz(x => 43) ], [ 40 .. 42, 43 ], 'multi-named parameters' ); done_testing; 12invocant.t000664001750001750 342012425206147 14335 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test invocants: renaming default invocant for C keyword; lexical versus localized variables; multiple invocants. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; method foo ($x?) { return { '@_' => \@_, '$self' => $self, }; } method bar ($foo: $x) { return { '@_' => \@_, '$foo' => $foo, '$x' => $x, }; } method baz (${^FOO}: $x) { return +{ '@_' => \@_, '${^FOO}' => ${^FOO}, '$x' => $x, }; } method quux ($self, $_: $x) { return { '@_' => \@_, '$self' => $self, '$_' => $_, '$x' => $x, }; } } is_deeply( Example->foo(42), { '@_' => [42], '$self' => 'Example', }, 'basic method with an invocant', ); ok( exception { Example::foo() }, 'basic method called without invocant throws exception', ); note "it would be nice if the exception mentioned a missing invocant!"; is_deeply( Example->bar(42), { '@_' => [42], '$foo' => 'Example', '$x' => 42 }, 'renaming invocant', ); is_deeply( Example->baz(42), { '@_' => [42], '${^FOO}' => 'Example', '$x' => 42 }, 'renaming invocant to a localized global', ); is_deeply( Example->quux({}, 42), { '@_' => [42], '$self' => 'Example', '$_' => {}, '$x' => 42 }, 'two invocants', ); { package Example2; use Kavorka; fun bar ($foo: $x) { return { '@_' => \@_, '$foo' => $foo, '$x' => $x, }; } } is_deeply( Example2->bar(42), { '@_' => [42], '$foo' => 'Example2', '$x' => 42 }, 'invocants work with `fun` keyword too', ); done_testing; 13slurpy.t000664001750001750 671212425206147 14062 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test slurpy parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; fun foo ($x, $y?, @z) { return { '@_' => \@_, '$x' => $x, '$y' => $y, '@z' => \@z, }; } fun bar ($, %z) { return { '@_' => \@_, '%_' => \%_, '%z' => \%z, }; } fun baz (:$x, :$y, %z) { return { '@_' => \@_, '%_' => \%_, '$x' => $x, '$y' => $y, '%z' => \%z }; } fun quux ($x, %) { return { '@_' => \@_, '%_' => \%_, '$x' => $x, }; } } is_deeply( Example::foo(1..5), { '@_' => [1..5], '$x' => 1, '$y' => 2, '@z' => [3..5] }, 'function with leading positional parameters and array slurpy' ); is_deeply( Example::foo(1), { '@_' => [1], '$x' => 1, '$y' => undef, '@z' => [] }, 'function with leading positional parameters and array slurpy - empty slurpy' ); is_deeply( Example::foo(1,2), { '@_' => [1,2], '$x' => 1, '$y' => 2, '@z' => [] }, 'function with leading positional parameters and array slurpy - empty slurpy' ); is_deeply( Example::foo(1..3), { '@_' => [1..3], '$x' => 1, '$y' => 2, '@z' => [3] }, 'function with leading positional parameters and array slurpy - only one item in slurpy' ); is_deeply( Example::bar(0, 1..4), { '@_' => [0..4], '%_' => +{1..4}, '%z' => +{1..4} }, 'function with leading positional parameter and hash slurpy' ); like( exception { Example::bar(0, 1..5) }, qr{^Odd number of elements}, 'exception passing odd number of items to slurpy hash', ); is_deeply( Example::baz(x => 42, a => 1, b => 2, c => 3), { '@_' => [qw/ x 42 a 1 b 2 c 3 /], '%_' => +{qw/ x 42 a 1 b 2 c 3 /}, '$x' => 42, '$y' => undef, '%z' => +{qw/ a 1 b 2 c 3 /} }, 'function with named parameters and slurpy hash' ); is_deeply( Example::baz({x => 42, a => 1, b => 2, c => 3 }), { '@_' => [{qw/ x 42 a 1 b 2 c 3 /}], '%_' => +{qw/ x 42 a 1 b 2 c 3 /}, '$x' => 42, '$y' => undef, '%z' => +{qw/ a 1 b 2 c 3 /} }, 'function with named parameters and slurpy hash (invoked with hashref)' ); is_deeply( Example::quux(42, a => 1, b => 2, c => 3), { '@_' => [qw/ 42 a 1 b 2 c 3 /], '%_' => +{qw/ a 1 b 2 c 3 /}, '$x' => 42, }, 'anon slurpy hash' ); { package Example2; use Kavorka; fun foo ($x, $y?, slurpy ArrayRef $z) { return { '@_' => \@_, '$x' => $x, '$y' => $y, '$z' => $z, }; } fun bar ($, slurpy HashRef $z) { return { '@_' => \@_, '%_' => \%_, '$z' => $z, }; } fun baz (:$x, :$y, slurpy HashRef $z) { return { '@_' => \@_, '%_' => \%_, '$x' => $x, '$y' => $y, '$z' => $z }; } } is_deeply( Example2::foo(1..5), { '@_' => [1..5], '$x' => 1, '$y' => 2, '$z' => [3..5] }, 'function with leading positional parameters and arrayref slurpy' ); is_deeply( Example2::bar(0, 1..4), { '@_' => [0..4], '%_' => +{1..4}, '$z' => +{1..4} }, 'function with leading positional parameter and hashref slurpy' ); like( exception { Example2::bar(0, 1..5) }, qr{^Odd number of elements}, 'exception passing odd number of items to slurpy hashref', ); is_deeply( Example2::baz(x => 42, a => 1, b => 2, c => 3), { '@_' => [qw/ x 42 a 1 b 2 c 3 /], '%_' => +{qw/ x 42 a 1 b 2 c 3 /}, '$x' => 42, '$y' => undef, '$z' => +{qw/ a 1 b 2 c 3 /} }, 'function with named parameters and slurpy hashref' ); done_testing; 14underscores.t000664001750001750 250512425206147 15055 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test that C<< @_ >> and C<< %_ >> work as slurpy parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; method foo (@_) { +{ '$self' => $self, '@_' => \@_ } } method bar (%_) { +{ '$self' => $self, '@_' => \@_, '%_' => \%_ } } method baz ($x, %_) { +{ '$self' => $self, '@_' => \@_, '$x' => $x, '%_' => \%_ } } method quux (:$x, %_) { +{ '$self' => $self, '@_' => \@_, '$x' => $x, '%_' => \%_ } } } is_deeply( Example->foo(1, 2, 3), +{ '$self' => 'Example', '@_' => [1, 2, 3] }, ); is_deeply( Example->bar(y => 1, z => 2), +{ '$self' => 'Example', '@_' => [ y => 1, z => 2 ], '%_' => +{ y => 1, z => 2 } }, ); is_deeply( Example->baz(0, y => 1, z => 2), +{ '$self' => 'Example', '@_' => [ 0, y => 1, z => 2 ], '$x' => 0, '%_' => +{ y => 1, z => 2 } }, ); is_deeply( Example->quux(x => 0, y => 1, z => 2), +{ '$self' => 'Example', '@_' => [ x => 0, y => 1, z => 2 ], '$x' => 0, '%_' => +{ x => 0, y => 1, z => 2 } }, ); done_testing; 20modifiers-moo.t000664001750001750 236212425206147 15270 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test method modifiers in L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; package Parent { use Moo; use Kavorka qw( -default -modifiers ); method process ( ScalarRef $n ) { $$n *= 3; } }; package Sibling { use Moo::Role; use Kavorka qw( -default -modifiers ); after process ( ScalarRef $n ) { $$n += 2; } }; package Child { use Moo; use Kavorka qw( -default -modifiers ); extends qw( Parent ); with qw( Sibling ); before process ( ScalarRef[Num] $n ) { $$n += 5; } }; my $thing_one = Child->new; my $n = 1; $thing_one->process(\$n); is($n, 20); package Grandchild { use Moo; use Kavorka qw( -default -modifiers ); extends qw( Child ); around process ( ScalarRef $n ) { my ($int, $rest) = split /\./, $$n; $rest ||= 0; $self->${^NEXT}(\$int); $$n = "$int\.$rest"; } }; my $thing_two = Grandchild->new; my $m = '1.2345'; $thing_two->process(\$m); is($m, '20.2345'); done_testing; 21modifiers-moose.t000664001750001750 252512425206147 15622 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test method modifiers in L. =head1 DEPENDENCIES Requires Moose 2.0000. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 { 'Moose' => '2.0000' }; use Test::Fatal; package Parent { use Moose; use Kavorka qw( -default -modifiers ); method process ( ScalarRef $n ) { $$n *= 3; } }; package Sibling { use Moose::Role; use Kavorka qw( -default -modifiers ); after process ( ScalarRef $n ) { $$n += 2; } }; package Child { use Moose; use Kavorka qw( -default -modifiers ); extends qw( Parent ); with qw( Sibling ); before process ( ScalarRef[Num] $n ) { $$n += 5; } }; my $thing_one = Child->new; my $n = 1; $thing_one->process(\$n); is($n, 20); package Grandchild { use Moose; use Kavorka qw( -default -modifiers ); extends qw( Child ); around process ( ScalarRef $n ) { my ($int, $rest) = split /\./, $$n; $rest ||= 0; $self->${^NEXT}(\$int); $$n = "$int\.$rest"; } }; my $thing_two = Grandchild->new; my $m = '1.2345'; $thing_two->process(\$m); is($m, '20.2345'); done_testing; 22modifiers-mouse.t000664001750001750 252112425206147 15625 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test method modifiers in L. =head1 DEPENDENCIES Requires Mouse 1.00. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 { 'Mouse' => '1.00' }; use Test::Fatal; package Parent { use Mouse; use Kavorka qw( -default -modifiers ); method process ( ScalarRef $n ) { $$n *= 3; } }; package Sibling { use Mouse::Role; use Kavorka qw( -default -modifiers ); after process ( ScalarRef $n ) { $$n += 2; } }; package Child { use Mouse; use Kavorka qw( -default -modifiers ); extends qw( Parent ); with qw( Sibling ); before process ( ScalarRef[Num] $n ) { $$n += 5; } }; my $thing_one = Child->new; my $n = 1; $thing_one->process(\$n); is($n, 20); package Grandchild { use Mouse; use Kavorka qw( -default -modifiers ); extends qw( Child ); around process ( ScalarRef $n ) { my ($int, $rest) = split /\./, $$n; $rest ||= 0; $self->${^NEXT}(\$int); $$n = "$int\.$rest"; } }; my $thing_two = Grandchild->new; my $m = '1.2345'; $thing_two->process(\$m); is($m, '20.2345'); done_testing; 23modifiers-tiny.t000664001750001750 357212425206147 15470 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test method modifiers in L plus L. =head1 DEPENDENCIES Requires Class::Tiny, Role::Tiny and Class::Method::Modifiers. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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; # Some of these export stuff that conflict with each other, so # do it in dummy namespaces. package Tmp1 { use Test::Requires { 'Class::Method::Modifiers' => '2.00' } }; package Tmp2 { use Test::Requires { 'Class::Tiny' => '0' } }; package Tmp3 { use Test::Requires { 'Role::Tiny' => '1.003000' } }; package Tmp4 { use Test::Requires { 'parent' => '0' } }; use Test::Fatal; package Parent { use Class::Tiny; use Class::Method::Modifiers; use Kavorka qw( -default -modifiers ); method process ( ScalarRef $n ) { $$n *= 3; } }; package Sibling { use Role::Tiny; use Kavorka qw( -default -modifiers ); after process ( ScalarRef $n ) { $$n += 2; } }; package Child { use Class::Tiny; use Class::Method::Modifiers; use Role::Tiny::With; use Kavorka qw( -default -modifiers ); use parent qw( -norequire Parent ); with qw( Sibling ); before process ( ScalarRef[Num] $n ) { $$n += 5; } }; my $thing_one = Child->new; my $n = 1; $thing_one->process(\$n); is($n, 20); package Grandchild { use Class::Tiny; use Class::Method::Modifiers; use Kavorka qw( -default -modifiers ); use parent qw( -norequire Child ); around process ( ScalarRef $n ) { my ($int, $rest) = split /\./, $$n; $rest ||= 0; $self->${^NEXT}(\$int); $$n = "$int\.$rest"; } }; my $thing_two = Grandchild->new; my $m = '1.2345'; $thing_two->process(\$m); is($m, '20.2345'); done_testing; 24multimodifiers.t000664001750001750 141712425206147 15557 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test modifying multiple methods simultaneously. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 Parent { use Moo; use Kavorka qw( -default -modifiers ); method foo { 1; } method bar { 2; } method baz { 3; }; }; package Child { use Moo; use Kavorka qw( -default -modifiers ); extends qw( Parent ); around foo, bar, baz { $self->${^NEXT} + 39; } }; is_deeply( [ map Child->$_, qw/ foo bar baz/ ], [ 40 .. 42 ], ); done_testing; 28modifiers-augment.t000664001750001750 243712425206147 16151 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test C modifier. =head1 DEPENDENCIES Requires Moose 2.0000. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 { 'Moose' => '2.0000' }; { package Document; use Moose; use Kavorka -all; has recipient => (is => 'ro'); method as_xml { sprintf "%s", (scalar(inner)//'') } } { package Greeting; use Moose; use Kavorka -all; extends 'Document'; augment as_xml { sprintf "%s", (scalar(inner)//'') } } { package Greeting::English; use Moose; use Kavorka -all; extends 'Greeting'; augment as_xml { sprintf "Hello %s", $self->recipient; } } my $obj1 = Document->new(recipient => "World"); is( $obj1->as_xml, "", ); my $obj2 = Greeting->new(recipient => "World"); is( $obj2->as_xml, "", ); my $obj3 = Greeting::English->new(recipient => "World"); is( $obj3->as_xml, "Hello World", ); done_testing(); 29modifiers-override.t000664001750001750 176512425206147 16334 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test C modifier. =head1 DEPENDENCIES Requires Moose 2.0000. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 { 'Moose' => '2.0000' }; { package Local::Class; use Moose; use Kavorka -all; my $x = 'a'; method foo { return $x++ } } { package Local::Subclass; use Moose; use Kavorka -all; extends 'Local::Class'; override foo { my $letter = super(); return uc $letter; } } { package Local::More; use Moose; use Kavorka -all; extends 'Local::Subclass'; override foo { my $letter = super(); return "X${letter}X"; } } my $obj = Local::More::->new; is($obj->foo, "XAX"); is($obj->foo, "XBX"); is($obj->foo, "XCX"); done_testing; 30multi.t000664001750001750 274112425206147 13653 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test multi methods. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka qw( multi fun method ); multi method foo (HashRef $x) { return 'HashRef'; } multi method foo (ArrayRef $y) { return 'ArrayRef'; } multi fun bar (HashRef $x) { return 'bar:HashRef'; } } { package Example2; use Kavorka qw( multi fun method ); BEGIN { our @ISA = qw(Example) }; multi method foo (ScalarRef $z) { return 'ScalarRef'; } multi fun bar (ScalarRef $z) :long(bar_sr) { return 'bar:ScalarRef'; } } is( Example->foo({}), 'HashRef' ); is( Example->foo([]), 'ArrayRef' ); like( exception { Example->foo(\1) }, qr{^Arguments to Example::foo did not match any known signature for multi sub}, ); is( Example2->foo({}), 'HashRef' ); is( Example2->foo([]), 'ArrayRef' ); is( Example2->foo(\1), 'ScalarRef' ); is( Example2::bar(\1), 'bar:ScalarRef' ); like( exception{ Example2::bar({}) }, qr{^Arguments to Example2::bar did not match any known signature for multi sub}, 'bar is a function; should not inherit multis', ); is( Example2::bar_sr(\1), 'bar:ScalarRef', 'can call function via long name' ); done_testing; 31multimulti.t000664001750001750 204012425206147 14717 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test multi methods with multiple inheritance. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package AAA; our @ISA = qw( BBB CCC ); } { package BBB; use Kavorka qw( multi method ); multi method foo (HashRef $x) { return 'HashRef'; } } { package CCC; use Kavorka qw( multi method ); multi method foo (ArrayRef $x) { return 'ArrayRef'; } } is( AAA->foo( {} ), 'HashRef' ); is( AAA->foo( [] ), 'ArrayRef' ); is( AAA->BBB::foo( {} ), 'HashRef' ); is( BBB::foo( AAA => {} ), 'HashRef' ); { local $TODO = "I don't think it's possible to detect whether the method has been invoked this way"; ok( exception { AAA->BBB::foo( {} ) } ); ok( exception { BBB::foo( AAA => {} ) } ); }; done_testing; 32multiredefine.t000664001750001750 154112425206147 15354 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test that multi methods can be further defined at run time. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; use Kavorka qw( multi fun ); multi fun foo (HashRef $x) { 'hash' } multi fun foo (ArrayRef $y) { 'array' } is( foo({}), 'hash', ); is( foo([]), 'array', ); like( exception { foo(\1) }, qr{^Arguments to main::foo did not match any known signature for multi sub}, ); multi fun foo (ScalarRef $y) { 'scalar' } is( foo({}), 'hash', ); is( foo([]), 'array', ); is( foo(\1), 'scalar', ); done_testing;33cacheinvalidationishard.t000664001750001750 240712425206147 17363 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Cache invalidation is hard. The optimized multi sub implementation is a form of caching. Test that optimizations are invalidated correctly. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka qw( multi method ); multi method foo (ArrayRef $x) { 'array' } } { package Example2; use Kavorka qw( multi method ); our @ISA = 'Example'; multi method foo (HashRef $x) { 'hash' } } is( Example2->foo({}), 'hash' ); is( Example2->foo([]), 'array' ); like( exception { Example2->foo(\1) }, qr{^Arguments to Example2::foo did not match any known signature for multi sub}, ); # Now we add a new implementation to Example, and check that the # optimized dispatcher in Example2 gets updated! { package Example; use Kavorka qw( multi method ); multi method foo (ScalarRef $x) { 'scalar' } } is( Example2->foo({}), 'hash' ); is( Example2->foo([]), 'array' ); is( Example2->foo(\1), 'scalar' ); done_testing; 50types.t000664001750001750 514512425206147 13670 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Check that type constraints work. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; use Type::Registry qw(t); BEGIN { t->add_types( -Standard ); t->alias_type( 'Int' => 'Count' ); t->add_type( t->Int->create_child_type(name => 'Int2', constraint => sub { 1 }) ); }; # We need to test a non-inlinable type constraint. ::ok( not t->Int2->can_be_inlined ); fun foo ( Int $x ) { return $x } fun bar ( Count $x ) { return $x } fun baz ( Int2 $x ) { return $x } fun foo_array ( Int @y ) { return \@y } fun bar_array ( Count @y ) { return \@y } fun baz_array ( Int2 @y ) { return \@y } fun foo_arrayref ( slurpy ArrayRef[Int] $z ) { return $z } fun bar_arrayref ( slurpy ArrayRef[Count] $z ) { return $z } fun baz_arrayref ( slurpy ArrayRef[Int2] $z ) { return $z } } is( Example::foo(42), 42 ); like( exception { Example::foo(3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int"}, ); is( Example::bar(42), 42 ); like( exception { Example::bar(3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int"}, ); is( Example::baz(42), 42 ); like( exception { Example::baz(3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int2"}, ); is_deeply( Example::foo_array(666,42), [666,42] ); like( exception { Example::foo_array(666,3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int"}, ); is_deeply( Example::bar_array(666,42), [666,42] ); like( exception { Example::bar_array(666,3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int"}, ); is_deeply( Example::baz_array(666,42), [666,42] ); like( exception { Example::baz_array(666,3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int2"}, ); is_deeply( Example::foo_arrayref(666,42), [666,42] ); like( exception { Example::foo_arrayref(666,3.14159) }, qr{^Reference \[.+\] did not pass type constraint "ArrayRef\[Int\]"}, ); is_deeply( Example::bar_arrayref(666,42), [666,42] ); like( exception { Example::bar_arrayref(666,3.14159) }, qr{^Reference \[.+\] did not pass type constraint "ArrayRef\[Int\]"}, ); is_deeply( Example::baz_arrayref(666,42), [666,42] ); like( exception { Example::baz_arrayref(666,3.14159) }, qr{^Reference \[.+\] did not pass type constraint "ArrayRef\[Int2\]"}, ); done_testing; 51coerce.t000664001750001750 1032012425206147 13774 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Check that type coercions work. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; use Type::Registry qw(t); BEGIN { t->add_types( -Standard ); t->add_type( t->Int->create_child_type(name => 'RoundedInt1') ); t->add_type( t->Int->create_child_type(name => 'RoundedInt2') ); t->RoundedInt1->coercion->add_type_coercions(t->Num, q { int($_) }); t->RoundedInt2->coercion->add_type_coercions(t->Num, sub { int($_) }); }; # We need to test a non-inlinable coercion. ::ok( not t->RoundedInt2->coercion->can_be_inlined ); fun foo ( RoundedInt1 $x ) { return $x } fun bar ( RoundedInt1 $x does coerce ) { return $x } fun baz ( RoundedInt2 $x does coerce ) { return $x } fun foo_array ( RoundedInt1 @y ) { return \@y } fun bar_array ( RoundedInt1 @y does coerce ) { return \@y } fun baz_array ( RoundedInt2 @y does coerce ) { return \@y } fun foo_arrayref ( slurpy ArrayRef[RoundedInt1] $z ) { return $z } fun bar_arrayref ( slurpy ArrayRef[RoundedInt1] $z does coerce ) { return $z } fun baz_arrayref ( slurpy ArrayRef[RoundedInt2] $z does coerce ) { return $z } } is( Example::foo(42), 42, 'type constraint with coercion, but parameter does not coerce - valid value' ); ok( exception { Example::foo(42.1) }, 'type constraint with coercion, but parameter does not coerce - invalid value' ); is( Example::bar(42), 42, 'type constraint with coercion - valid value' ); is( Example::bar(42.2), 42, 'type constraint with coercion - coercible value' ); ok( exception { Example::bar("Non-numeric") }, 'type constraint with coercion - invalid value' ); is( Example::baz(42), 42, 'type constraint with non-inlinable coercion - valid value' ); is( Example::baz(42.2), 42, 'type constraint with non-inlinable coercion - coercible value' ); ok( exception { Example::baz("Non-numeric") }, 'type constraint with non-inlinable coercion - invalid value' ); note "arrays..."; is_deeply( Example::foo_array(123, 42), [123, 42], 'type constraint with coercion, but parameter does not coerce - valid value' ); ok( exception { Example::foo_array(123, 42.1) }, 'type constraint with coercion, but parameter does not coerce - invalid value' ); is_deeply( Example::bar_array(123, 42), [123, 42], 'type constraint with coercion - valid value' ); is_deeply( Example::bar_array(123, 42.2), [123, 42], 'type constraint with coercion - coercible value' ); ok( exception { Example::bar_array("Non-numeric") }, 'type constraint with coercion - invalid value' ); is_deeply( Example::baz_array(123, 42), [123, 42], 'type constraint with non-inlinable coercion - valid value' ); is_deeply( Example::baz_array(123, 42.2), [123, 42], 'type constraint with non-inlinable coercion - coercible value' ); ok( exception { Example::baz_array("Non-numeric") }, 'type constraint with non-inlinable coercion - invalid value' ); note "arrayrefs..."; is_deeply( Example::foo_arrayref(123, 42), [123, 42], 'type constraint with coercion, but parameter does not coerce - valid value' ); ok( exception { Example::foo_arrayref(123, 42.1) }, 'type constraint with coercion, but parameter does not coerce - invalid value' ); is_deeply( Example::bar_arrayref(123, 42), [123, 42], 'type constraint with coercion - valid value' ); is_deeply( Example::bar_arrayref(123, 42.2), [123, 42], 'type constraint with coercion - coercible value' ); ok( exception { Example::bar_arrayref("Non-numeric") }, 'type constraint with coercion - invalid value' ); is_deeply( Example::baz_arrayref(123, 42), [123, 42], 'type constraint with non-inlinable coercion - valid value' ); is_deeply( Example::baz_arrayref(123, 42.2), [123, 42], 'type constraint with non-inlinable coercion - coercible value' ); ok( exception { Example::baz_arrayref("Non-numeric") }, 'type constraint with non-inlinable coercion - invalid value' ); done_testing; 52typeexpr.t000664001750001750 532012425206147 14401 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Check that type constraint expressions work. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; use Type::Registry qw(t); BEGIN { t->add_types( -Standard ); t->alias_type( 'Int' => 'Count' ); t->add_type( t->Int->create_child_type(name => 'Int2', constraint => sub { 1 }) ); }; # We need to test a non-inlinable type constraint. ::ok( not t->Int2->can_be_inlined ); fun foo ( (t->Int) $x ) { return $x } fun bar ( (t->Count) $x ) { return $x } fun baz ( (t->Int2) $x ) { return $x } fun foo_array ( (t->Int) @y ) { return \@y } fun bar_array ( (t->Count) @y ) { return \@y } fun baz_array ( (t->Int2) @y ) { return \@y } fun foo_arrayref ( slurpy (t->ArrayRef->parameterize(t->Int)) $z ) { return $z } fun bar_arrayref ( slurpy (t->ArrayRef->parameterize(t->Count)) $z ) { return $z } fun baz_arrayref ( slurpy (t->ArrayRef->parameterize(t->Int2)) $z ) { return $z } } is( Example::foo(42), 42 ); like( exception { Example::foo(3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int"}, ); is( Example::bar(42), 42 ); like( exception { Example::bar(3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int"}, ); is( Example::baz(42), 42 ); like( exception { Example::baz(3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int2"}, ); is_deeply( Example::foo_array(666,42), [666,42] ); like( exception { Example::foo_array(666,3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int"}, ); is_deeply( Example::bar_array(666,42), [666,42] ); like( exception { Example::bar_array(666,3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int"}, ); is_deeply( Example::baz_array(666,42), [666,42] ); like( exception { Example::baz_array(666,3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int2"}, ); is_deeply( Example::foo_arrayref(666,42), [666,42] ); like( exception { Example::foo_arrayref(666,3.14159) }, qr{^Reference \[.+\] did not pass type constraint "ArrayRef\[Int\]"}, ); is_deeply( Example::bar_arrayref(666,42), [666,42] ); like( exception { Example::bar_arrayref(666,3.14159) }, qr{^Reference \[.+\] did not pass type constraint "ArrayRef\[Int\]"}, ); is_deeply( Example::baz_arrayref(666,42), [666,42] ); like( exception { Example::baz_arrayref(666,3.14159) }, qr{^Reference \[.+\] did not pass type constraint "ArrayRef\[Int2\]"}, ); done_testing; 53typeexpr-moosextypes.t000664001750001750 145712425206147 17006 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Check that type constraint expressions may return MooseX::Types type constraint objects. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; use Test::Requires { 'MooseX::Types::Moose' => 0 }; { package Example; use Kavorka; use MooseX::Types::Moose qw(Int); fun foo ( (__PACKAGE__->can('Int')->()) $x ) { return $x } } is( Example::foo(42), 42 ); like( exception { Example::foo(3.14159) }, qr{^Value "3.14159" did not pass type constraint "Int"}, ); done_testing; 54typefallback.t000664001750001750 135212425206147 15165 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Unrecognized type constraints are assumed to be class names. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; use Test::Requires { 'DateTime' => 0 }; { package Example; use Kavorka; fun foo (DateTime $x) { return $x } } my $dt = DateTime->now; is( Example::foo($dt), $dt ); like( exception { Example::foo(42) }, qr{^Value "42" did not pass type constraint \(not isa DateTime\)}, ); done_testing; 59valueconstraints.t000664001750001750 265712425206147 16146 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Check that value constraints work. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; use Kavorka; use match::simple qw(match); fun foo (Int $x where [2,4,6,8] = 2, $y = 0) { return $x + $y; } fun bar (Int $x where { match $_, [2,4,6,8] } = 4, $y = 0) { return $x + $y; } fun baz ($x where { match $_, [2,4,6,8] } = 6, $y = 0) { return $x + $y; } subtest "smartmatch-style value constraint" => fun { is(foo(), 2); is(foo(8, 1), 9); like(exception { foo(1.1) }, qr/^Value "?1\.1"? did not pass type constraint "?Int"?/); like(exception { foo(111) }, qr/^\$x failed value constraint/); done_testing; }; subtest "block value constraint" => fun { is(bar(), 4); is(bar(8, 1), 9); like(exception { bar(1.1) }, qr/^Value "?1\.1"? did not pass type constraint "?Int"?/); like(exception { bar(111) }, qr/^\$x failed value constraint/); done_testing; }; subtest "value constraint with no type constraint" => fun { is(baz(), 6); is(baz(8), 8); like(exception { baz(1.1) }, qr/^\$x failed value constraint/); like(exception { baz(111) }, qr/^\$x failed value constraint/); done_testing; }; done_testing; 60alias.t000664001750001750 271012425206147 13611 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test the C trait. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; BEGIN { $INC{'Devel/Cover.pm'} and plan skip_all => "broken with Devel::Cover"; }; { package Example; use Kavorka; fun foo ($x is alias) { ++$x; } fun bar (Int $x is alias) { ++$x; } } my $x = 1; is(Example::foo($x), 2); is(Example::bar($x), 3); is(Example::foo($x), 4); is(Example::bar($x), 5); is($x, 5); { package Example2; use Kavorka; fun foo ($_ is alias) { ++ $_; } fun bar (Int $_ is alias) { ++ $_; } } my $y = 1; is(Example2::foo($y), 2); is(Example2::bar($y), 3); is(Example2::foo($y), 4); is(Example2::bar($y), 5); is($y, 5); { package Example3; use Kavorka; fun foo (:$z is alias) { ++$z; } fun bar (Int :$z is alias) { ++$z; } } my $z = 1; is(Example3::foo(z => $z), 2); is(Example3::bar(z => $z), 3); is(Example3::foo(z => $z), 4); is(Example3::bar(z => $z), 5); is($z, 5); { package Example4; use Kavorka; fun foo (:\%foo) { $foo{yyy} = 42; return $foo{xxx}; } } my $foo = { xxx => 666 }; is(Example4::foo(foo => $foo), 666); is_deeply($foo, { xxx => 666, yyy => 42 }); done_testing; 61ro.t000664001750001750 122412425206147 13140 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test the C trait. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; fun foo ($x but ro) { ++$x; } fun bar ($x is rw) { ++$x; } } like( exception { Example::foo(42) }, qr{^Modification of a read-only value attempted }, ); is( Example::bar(42), 43, ); done_testing; 62locked.t000664001750001750 236712425206147 13773 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test the C trait. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; fun foo ( $x is locked ) { $x->{foo} = 1; } fun bar ( %x but locked ) { $x{foo} = 1; } fun baz ( Dict[foo => Optional[Int], bar => Optional[ArrayRef]] $x is locked ) { $x->{foo} = 1; push @{ $x->{bar} ||= [] }, 1; } fun quux ( Dict[bar => Optional[ArrayRef]] $x does locked ) { $x->{foo} = 1; push @{ $x->{bar} ||= [] }, 1; } } like( exception { Example::foo({}) }, qr{^Attempt to access disallowed key 'foo' in a restricted hash}, ); is( Example::foo({ foo => 42 }), 1, ); like( exception { Example::bar() }, qr{^Attempt to access disallowed key 'foo' in a restricted hash}, ); is( Example::bar(foo => 42), 1, ); ok( !exception { Example::baz({}) }, ); like( exception { Example::quux({}) }, qr{^Attempt to access disallowed key 'foo' in a restricted hash}, ); done_testing; 63freshoverride.t000664001750001750 412312425206147 15372 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test the C and C traits for subs. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; package Example1 { use Moo; use Scalar::Util qw(blessed); } package R1 { use Moo::Role; use Kavorka; method blammo () { 2 } } package Example2 { use Moo; use Kavorka; extends 'Example1'; with 'R1'; ::like( ::exception { method blessed () is fresh { 1 } }, qr/^Method 'blessed' already exists in inheritance hierarchy; possible namespace pollution; not fresh/, "the `fresh` trait complains about overriding namespace pollution", ); ::is( ::exception { method blasted () is fresh { 1 } }, undef, "the `fresh` trait does not complain when installing a fresh, new method", ); } package Example3 { use Moo; use Kavorka; extends 'Example2'; ::like( ::exception { method blasted () is fresh { 1 } }, qr/^Method 'blasted' is inherited from 'Example2'; not fresh/, "the `fresh` trait complains about overriding methods in superclass", ); ::like( ::exception { method blammo () is fresh { 1 } }, qr/^Method 'blammo' is provided by role 'R1'; not fresh/, "the `fresh` trait complains about overriding methods already provided by a role", ); ::is( ::exception { method blasted () is override { 1 } }, undef, "the `override` trait does not complain when overriding methods in superclass", ); ::is( ::exception { method blammo () is override { 1 } }, undef, "the `override` trait does not complain when overriding methods already provided by a role", ); ::like( ::exception { method blighty () is override { 1 } }, qr/^Method 'blighty' does not exist in inheritance hierarchy; cannot override/, "the `override` trait complains when installing a fresh, new method", ); } done_testing; 69traits.t000664001750001750 341112425206147 14036 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test custom traits. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; use Kavorka; BEGIN { package Kavorka::TraitFor::Parameter::superbad; use Moo::Role; $INC{'Kavorka/TraitFor/Parameter/superbad.pm'} = __FILE__; }; BEGIN { package Kavorka::TraitFor::Sub::superbad; use Moo::Role; $INC{'Kavorka/TraitFor/Sub/superbad.pm'} = __FILE__; }; fun foo ($x but superbad) { 42; } fun bar ($x is superbad(boom)) { 42; } subtest "Parameter traits" => sub { my ($foo, $bar) = map Kavorka->info( 'main'->can($_) ), qw/ foo bar /; my ($foo_x, $bar_x) = map $_->signature->params->[0], $foo, $bar; ok $foo_x->DOES('Kavorka::TraitFor::Parameter::superbad'); ok $bar_x->DOES('Kavorka::TraitFor::Parameter::superbad'); is_deeply( $bar_x->traits->{superbad}, ['boom'], ); }; fun foo2 ($x) but superbad { 42; } fun bar2 ($x) is superbad(boom) { 42; } subtest "Sub traits" => sub { my ($foo, $bar) = map Kavorka->info( 'main'->can($_) ), qw/ foo2 bar2 /; ok $foo->DOES('Kavorka::TraitFor::Sub::superbad'); ok $bar->DOES('Kavorka::TraitFor::Sub::superbad'); is_deeply( $bar->traits->{superbad}, ['boom'], ); }; use Kavorka funny => { implementation => 'Kavorka::Sub::Fun', traits => [ 'Kavorka::TraitFor::Sub::superbad' ], }; funny foo3 () { 43 } subtest "Passing traits to import" => sub { my $foo = Kavorka->info( 'main'->can('foo3') ); ok $foo->DOES('Kavorka::TraitFor::Sub::superbad'); is foo3(), 43; }; done_testing; 70introspection.t000664001750001750 460312425206147 15424 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test the introspection API. This only tests a very limited subset of it; much of the API is used during signature injection, so already gets tested that way. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; fun Example::foo :(@) { return $_[1] } fun bar ($Debbie: $x, :$y, %z) { return $_[1] } } is(Example::foo(1, 2, y => 3, z => 4), 2, 'foo works'); is(Example::bar(1, 2, y => 3, z => 4), 'y', 'bar works'); my ($foo, $bar) = map Kavorka->info( Example->can($_) ), qw/ foo bar /; ok($foo->DOES('Kavorka::Sub'), q/$foo->DOES('Kavorka::Sub')/); is($foo->keyword, 'fun', '$foo->keyword'); is($foo->declared_name, 'Example::foo', '$foo->declared_name'); is($foo->qualified_name, 'Example::foo', '$foo->qualified_name'); is($foo->signature, undef, '$foo->signature') or diag explain($foo); is($foo->prototype, '@', '$foo->prototype'); ok($bar->DOES('Kavorka::Sub'), q/$bar->DOES('Kavorka::Sub')/); is($bar->keyword, 'fun', '$bar->keyword'); is($bar->declared_name, 'bar', '$bar->declared_name'); is($bar->qualified_name, 'Example::bar', '$bar->qualified_name');; is($bar->prototype, undef, '$bar->prototype'); my $sig = $bar->signature; ok($sig->DOES('Kavorka::Signature'), q/$bar->signature->DOES('Kavorka::Signature')/); is($sig->args_min, 1, '$bar->signature->args_min'); is($sig->args_max, undef, '$bar->signature->args_max'); is_deeply( [ map $_->name, $sig->invocants ], [ '$Debbie' ], q/$bar->signature->invocants/, ); is_deeply( [ map $_->name, $sig->positional_params ], [ '$x' ], q/$bar->signature->positional_params/, ); is_deeply( [ map @{ $_->named_names or die }, $sig->named_params ], [ 'y' ], q/$bar->signature->named_params/, ); is( $sig->slurpy_param->name, '%z', q/$bar->signature->slurpy_param/, ); { package ZZZZ; use Kavorka; my $info = Kavorka->info(fun ($x) { 42 }); ::is($info->package, 'ZZZZ', 'introspection of anon function - A'); ::is($info->signature->params->[0]->name, '$x', 'introspection of anon function - B'); ::is($info->(undef), 42, 'overload &{}'); } done_testing; 71moosemeta.t000664001750001750 304612425206147 14516 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test introspection via Moose meta objects. =head1 DEPENDENCIES Requires Moose 2.0000. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 { 'Moose' => '2.0000' }; use Test::Fatal; package Parent { use Moose; use MooseX::KavorkaInfo; use Kavorka qw( -default -modifiers ); method process ( ScalarRef $n ) { $$n *= 3; } }; subtest "method introspection" => sub { my $method = Parent->meta->get_method('process'); my $sig = $method->signature; is($method->declaration_keyword, 'method'); ok($sig->params->[0]->invocant); is($sig->params->[1]->type->name, 'ScalarRef'); }; package Sibling { use Moose::Role; use MooseX::KavorkaInfo; use Kavorka qw( -default -modifiers ); after process ( ScalarRef $n ) { $$n += 2; } }; package Child { use Moose; use MooseX::KavorkaInfo; use Kavorka qw( -default -modifiers ); extends qw( Parent ); with qw( Sibling ); before process ( ScalarRef[Num] $n ) { $$n += 5; } }; subtest "method introspection works through wrappers" => sub { my $method = Child->meta->get_method('process'); my $sig = $method->signature; is($method->declaration_keyword, 'method'); ok($sig->params->[0]->invocant); is($sig->params->[1]->type->name, 'ScalarRef'); }; done_testing; 80returntype.t000664001750001750 313712425206147 14747 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test return types. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 utf8; use warnings; use Test::More; use Test::Fatal; use Kavorka; note "simple type constraint"; fun add1 ($a, $b → Int) { return $a + $b; } is( add1(4,5), 9 ); is( add1(4.1,4.9), 9 ); like(exception { my $r = add1(4.1, 5) }, qr{did not pass type constraint "Int" at \S+ line 38}); is_deeply( [add1(4,5)], [9] ); like(exception { my @r = add1(4.1, 5) }, qr{did not pass type constraint "ArrayRef.Int." at \S+ line 41}); note "type constraint expression"; use Types::Standard (); use constant Rounded => Types::Standard::Int()->plus_coercions(Types::Standard::Num(), q[int($_)]); fun add2 ($a, $b --> (Rounded) does coerce) { return $a + $b; } is( add2(4,5), 9 ); is( add2(4.1,4.9), 9 ); is( add2(4.1,5), 9 ); note "type constraints for list and scalar contexts"; fun add3 ($a, $b → Int, ArrayRef[Int] is list) { wantarray ? ($a,$b) : ($a+$b); } is( add3(4,5), 9 ); is( add3(4.1,4.9), 9 ); like(exception { my $r = add3(4.1, 5) }, qr{did not pass type constraint "Int" at \S+ line 64}); is_deeply( [add3(4,5)], [4,5] ); like(exception { my @r = add3(4.1,4.9) }, qr{did not pass type constraint "ArrayRef.Int." at \S+ line 67}); like(exception { my @r = add3(4.1,5) }, qr{did not pass type constraint "ArrayRef.Int." at \S+ line 68}); done_testing; 90closures.t000664001750001750 435512425206147 14371 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Various tests of named and anonymous functions closing over variables. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; my $x; BEGIN { $x = 1 }; package Foo { use Kavorka; method new ($class: ...) { bless {}, $class; } method inc { ++$x } method dec { --$x } } subtest "Two functions closing over the same variable" => sub { my $foo = Foo->new; is($x, 1); is($foo->inc, 2); is($foo->inc, 3); is($x, 3); is($foo->dec, 2); is($foo->dec, 1); is($x, 1); }; package Goo { use Kavorka; method xyz { my @links; fun my $xxx { push @links, 42 }; $xxx->(); return \@links; } } subtest "Closing over a variable in a lexical function" => sub { is_deeply(Goo->xyz, [42]); is_deeply(Goo->xyz, [42]); is_deeply(Goo->xyz, [42]); }; package Hoo { use Kavorka; method xyz ($closeme) { my $f = fun ($vvv = $closeme) { $vvv }; return (\$closeme, $f); } } subtest "Closing over a variable in a default" => sub { my ($X1, $fourtytwo) = Hoo->xyz(42); is($fourtytwo->(666), 666); is($fourtytwo->(), 42); my ($X2, $sixsixsix) = Hoo->xyz(666); is($sixsixsix->(999), 999); is($sixsixsix->(), 666); $$X2 = 777; is($sixsixsix->(), 777); }; package Ioo { use Kavorka; method get_limit ($limit) { fun (Int $x where { $_ < $limit }) { 1 }; } } subtest "Closing over a variable in a where {} block" => sub { my $lim7 = Ioo->get_limit(7); ok $lim7->(6); ok exception { $lim7->(8) }; my $lim12 = Ioo->get_limit(12); ok $lim12->(8); ok exception { $lim12->(14) }; ok $lim7->(6); ok exception { $lim7->(8) }; }; package Joo { use Kavorka; method get_set ($x) { return ( fun () { $x }, fun ($y) { $x = $y }, ); } } subtest "Two anonymous functions closing over the same variable" => sub { my ($g, $s) = Joo->get_set(20); my ($g2, $s2) = Joo->get_set(666); is($g->(), 20); is($s->(21), 21); is($g->(), 21); is($s->($g->() * 2), 42); is($g->(), 42); is($g2->(), 666); }; done_testing; 91lvalue.t000664001750001750 117412425206147 14017 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Check C<:lvalue> works for C keyword. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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::Fatal; { package Example; use Kavorka; fun foo () :lvalue { $Example::FOO } } $Example::FOO = 42; is(Example::foo(), 42); Example::foo()++; is(Example::foo(), 43); is($Example::FOO, 43); done_testing; 92weirdvars.t000664001750001750 137212425206147 14536 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Check weird variables like localized globals. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 Kavorka; fun foo (our $x, ${^MYVAR}, $Mellow::Yellow) { bar(); } sub bar () { our $x; is($x, 42); is(${^MYVAR}, 666); is($Mellow::Yellow, 999); } sub baz () { our $x; is($x, undef); is(${^MYVAR}, undef); is($Mellow::Yellow, undef); } #diag(Kavorka->info(\&foo)->signature->injection); foo(42, 666, 999); baz(); done_testing; 93prototypes.t000664001750001750 246312425206147 14763 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Check prototypes and attributes work. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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 Kavorka; fun foo :($) { 1 } fun bar :prototype($) { 1 } my $baz = fun :($) { 1 }; my $quux = fun :prototype($) { 1 }; is(prototype(\&foo), '$'); is(prototype(\&bar), '$'); is(prototype($baz), '$'); is(prototype($quux), '$'); fun xyzzy :prototype($$$) ($X, $Y, $Z) { 1 } is(prototype(\&xyzzy), '$$$'); { use Attribute::Handlers; sub UNIVERSAL::Fooble :ATTR { }; } subtest "Can distinguish between early attributes and signatures" => sub { my $one = fun :Fooble ($x) { 1 }; my $two = fun :Fooble($x) { 2 }; is( Kavorka->info($one)->attributes->[0][0], 'Fooble', ); is( Kavorka->info($one)->attributes->[0][1], undef, ); is( Kavorka->info($one)->signature->params->[0]->name, '$x', ); is( Kavorka->info($two)->attributes->[0][0], 'Fooble', ); is( Kavorka->info($two)->attributes->[0][1], '$x', ); is( Kavorka->info($two)->signature, undef, ); }; done_testing; 94bypassparsing.t000664001750001750 244212425206147 15416 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Checks that it's possible to bypass Kavorka's use of the Perl keyword API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014 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::Fatal; package Parent { use Moo; use Kavorka qw( -default -modifiers ); method process ( ScalarRef $n ) { $$n *= 3; } }; package Sibling { use Moo::Role; use Kavorka qw( -default -modifiers ); &after(process => sub { ${$_[1]} += 2; }); }; package Child { use Moo; use Kavorka qw( -default -modifiers ); extends qw( Parent ); with qw( Sibling ); &before(process => sub { ${$_[1]} += 5; }); }; my $thing_one = Child->new; my $n = 1; $thing_one->process(\$n); is($n, 20); package Grandchild { use Moo; use Kavorka qw( -default -modifiers ); extends qw( Child ); &around(process => sub { my $orig = shift; my ($int, $rest) = split /\./, ${$_[1]}; $rest ||= 0; $_[0]->$orig(\$int); ${$_[1]} = "$int\.$rest"; }); }; my $thing_two = Grandchild->new; my $m = '1.2345'; $thing_two->process(\$m); is($m, '20.2345'); done_testing; 95rolesatisfaction.t000664001750001750 123512425206147 16102 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Test that Kavorka methods satisfy role requirements. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014 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::Fatal; my $e; package MyRole { use Moo::Role; requires qw(my_method); } package MyClass { use Moo; use Kavorka; $e = ::exception { with qw(MyRole) }; method my_method () but begin { return 42; } } is($e, undef); done_testing; 98undefer.t000664001750001750 167612425206147 14175 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Tests we don't trigger an annoying weird Sub::Defer edge case. =head1 AUTHOR Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014 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 lib qw( lib t/lib ); use Test::More; use Test::Requires { Moops => '0.033' }; use Test::Fatal; use Moops -strict; class Rectangle :ro { has height => (required => true); has width => (required => true); around BUILDARGS { my $params = $self->$next(@_); $params->{height} //= $params->{width}; $params->{width} //= $params->{height}; return $params; } } is( Rectangle->new(height => 12)->width, 12 ); is( Rectangle->new(width => 12)->height, 12 ); my $e = eval { require Local::Bad }; unlike($e, qr/^Eval went very, very wrong/); done_testing(); 99threads.t000664001750001750 226712425206147 14175 0ustar00taitai000000000000Kavorka-0.036/t=pod =encoding utf-8 =head1 PURPOSE Check that Kavorka can be used on threaded Perls. Doesn't test any actual functionality under threading; merely that Kavorka can be loaded, and threads can be created. =head1 AUTHOR Aaron James Trevena Eteejay@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014 by Aaron James Trevena. 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 Config; BEGIN { plan skip_all => "your perl does not support ithreads" unless $Config{useithreads}; }; use threads; { package ThreadedExample; use Kavorka; use Moo; method foo { return { '$self' => $self, '@_' => \@_ }; } } my $subref = sub { my $id = shift; note("id:$id"); return $id; }; my @threads; my @idents = qw/bar1 bar2 bar3 bar4 bar5 bar6/; foreach my $foo_id (@idents) { push @threads, threads->create($subref, $foo_id); } my @results; for my $thread (@threads) { note("joining thread $thread"); push @results, $thread->join; } is_deeply( [ sort @results ], [ sort @idents ], 'expected return values', ); done_testing; example.pl000664001750001750 32612425206147 17027 0ustar00taitai000000000000Kavorka-0.036/examples/dancer2#!/usr/bin/env perl use Dancer2; use KavorkaX::Dancer2; hook after { $response->content( uc($response->content) ); } prefix /:greeting { GET, HEAD /:name { return "Why, $greeting there $name"; } } dance; Manual.pod000664001750001750 170412425206147 16011 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka=pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive yada globals =head1 NAME Kavorka::Manual - how to obtain the lure of the animal =head1 DESCRIPTION TODO =head1 BUGS Please report any bugs to L. =head1 SUPPORT B<< IRC: >> support is available through in the I<< #moops >> channel on L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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. MethodModifier.pm000664001750001750 676512425206147 17341 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorkause 5.014; use strict; use warnings; use Kavorka::Parameter (); use Role::Tiny (); my $DETECT_OO = do { my %_detect_oo; # memoize sub { my $pkg = $_[0]; return $_detect_oo{$pkg} if exists $_detect_oo{$pkg}; if ($pkg->can("meta")) { my $meta = $pkg->meta; return $_detect_oo{$pkg} = "Moo::Role" if 'Role::Tiny'->is_role($pkg) && ref($meta) eq "Moo::HandleMoose::FakeMetaClass"; return $_detect_oo{$pkg} = "Moo" if ref($meta) eq "Moo::HandleMoose::FakeMetaClass"; return $_detect_oo{$pkg} = "Mouse" if $meta->isa("Mouse::Meta::Module"); return $_detect_oo{$pkg} = "Moose" if $meta->isa("Moose::Meta::Class"); return $_detect_oo{$pkg} = "Moose" if $meta->isa("Moose::Meta::Role"); } return $_detect_oo{$pkg} = "Role::Tiny" if 'Role::Tiny'->is_role($pkg); return $_detect_oo{$pkg} = ""; } }; my $INSTALL_MM = sub { my ($modification, $names, $code) = @_; for my $name (@$names) { my ($package, $method) = ($name =~ /\A(.+)::(\w+)\z/); my $OO = $package->$DETECT_OO; if ($OO eq 'Moose') { require Moose::Util; my $installer = sprintf('add_%s_method_modifier', $modification); Moose::Util::find_meta($package)->$installer($method, $code); } elsif ($OO eq 'Mouse') { require Mouse::Util; my $installer = sprintf('add_%s_method_modifier', $modification); Mouse::Util::find_meta($package)->$installer($method, $code); } elsif ($OO eq 'Role::Tiny') { require Class::Method::Modifiers; push @{$Role::Tiny::INFO{$package}{modifiers}||=[]}, [ $modification, $method, $code ]; } elsif ($OO eq 'Moo::Role') { require Class::Method::Modifiers; push @{$Role::Tiny::INFO{$package}{modifiers}||=[]}, [ $modification, $method, $code ]; $OO->_maybe_reset_handlemoose($package); } elsif ($OO eq 'Moo') { require Class::Method::Modifiers; require Moo::_Utils; Moo::_Utils::_install_modifier($package, $modification, $method, $code); } else { require Class::Method::Modifiers; Class::Method::Modifiers::install_modifier($package, $modification, $method, $code); } } }; package Kavorka::MethodModifier; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Parse::Keyword {}; use Parse::KeywordX; use Scalar::Util qw(reftype); use Moo::Role; with 'Kavorka::Sub'; use namespace::sweep; requires 'method_modifier'; has more_names => (is => 'ro', default => sub { [] }); sub bypass_custom_parsing { my $class = shift; my ($keyword, $caller, $args) = @_; my $coderef = pop @$args; reftype($coderef) eq reftype(sub {}) or croak('Not a valid coderef'); my @qnames = map { /::/ ? $_ : sprintf('%s::%s', $caller, $_) } map { !ref($_) ? $_ : reftype($_) eq reftype([]) ? @$_ : croak("Not an array or string: $_") } @$args; $INSTALL_MM->( $class->method_modifier, \@qnames, $coderef, ); } after parse_subname => sub { my $self = shift; lex_read_space; while (lex_peek eq ',') { lex_read(1); lex_read_space; push @{$self->more_names}, scalar Kavorka::_fqname(parse_name('method', 1)); lex_read_space; } }; sub allow_anonymous { 0 } sub allow_lexical { 0 } sub default_invocant { my $self = shift; return ( 'Kavorka::Parameter'->new( name => '$self', traits => { invocant => 1 }, ), ); } sub install_sub { my $self = shift; my $code = $self->body; my $modification = $self->method_modifier; my @names = $self->qualified_name or die; push @names, @{$self->more_names}; $INSTALL_MM->($modification, \@names, $code); } 1; Multi.pm000664001750001750 1201712425206147 15537 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorkause 5.014; use strict; use warnings; use Sub::Util (); package Kavorka::Multi; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Parse::Keyword {}; use Parse::KeywordX; use Moo; with 'Kavorka::Sub'; use namespace::sweep; has multi_type => (is => 'ro', required => 1); has declared_long_name => (is => 'rwp'); has qualified_long_name => (is => 'rwp'); around parse => sub { my $next = shift; my $class = shift; lex_read_space; my $type = parse_name('keyword', 0); lex_read_space; $class->multi_parse($next, $type, @_); }; sub multi_parse { my $class = shift; my ($parse_method, $keyword, @args) = @_; my $implementation; if ($^H{Kavorka} =~ /\b$keyword=(\S+)/) { $implementation = $1; } else { Carp::croak("Could not resolve keyword '$keyword'"); } return $class->$parse_method(@args, multi_type => $implementation); } after parse_attributes => sub { my $self = shift; my @attr = @{$self->attributes}; my @filtered; $_->[0] eq 'long' ? ($self->_set_declared_long_name($_->[1]), $self->_set_qualified_long_name(scalar Kavorka::_fqname $_->[1])) : push(@filtered, $_) for @attr; @{$self->attributes} = @filtered; }; after parse_signature => sub { my $self = shift; my $sig = $self->signature; for my $param (@{$sig->params}) { Carp::croak("Type constraints for parameters cannot be 'assumed' in a multi sub") if $param->traits->{assumed}; } $self->signature->_set_nobble_checks(1); }; sub allow_anonymous { 0 } sub allow_lexical { 0 } sub default_attributes { my $code = $_[0]->multi_type->can('default_attributes'); goto $code; } sub default_invocant { my $code = $_[0]->multi_type->can('default_invocant'); goto $code; } sub forward_declare { my $code = $_[0]->multi_type->can('forward_declare'); goto $code; } sub invocation_style { $_[0]->multi_type->invocation_style or Carp::croak("No invocation style defined"); } our %DISPATCH_TABLE; our %DISPATCH_STYLE; our %INVALIDATION; sub __gather_candidates { my ($pkg, $subname, $args) = @_; if ($DISPATCH_STYLE{$pkg}{$subname} eq 'fun') { return @{$DISPATCH_TABLE{$pkg}{$subname}}; } require mro; my $invocant = ref($args->[0]) || $args->[0]; return map @{$DISPATCH_TABLE{$_}{$subname} || [] }, @{ $invocant->mro::get_linear_isa }; } sub __dispatch { my ($pkg, $subname) = @{ +shift }; for my $c ( __gather_candidates($pkg, $subname, \@_) ) { my @copy = @_; next unless $c->signature->check(@copy); my $body = $c->body; goto $body; } Carp::croak("Arguments to $pkg\::$subname did not match any known signature for multi sub"); } sub __compile { my ($pkg, $subname) = @_; my @candidates = __gather_candidates($pkg, $subname, [$pkg]); my @coderefs = map $_->body, @candidates; my $slowpath = ''; if ($DISPATCH_STYLE{$pkg}{$subname} ne 'fun') { my $this = [$pkg, $subname]; push @{ $INVALIDATION{"$_\::$subname"} ||= [] }, $this for @{ $pkg->mro::get_linear_isa }; $slowpath = sprintf( 'if ((ref($_[0]) || $_[0]) ne %s) { unshift @_, [%s, %s]; goto \\&Kavorka::Multi::__dispatch }', B::perlstring($pkg), B::perlstring($pkg), B::perlstring($subname), ); } my $compiled = join q[] => ( map { my $sig = $candidates[$_]->signature; $sig && $sig->nobble_checks ? sprintf( "\@tmp = \@_; if (%s) { unshift \@_, \$Kavorka::Signature::NOBBLE; goto \$coderefs[%d] }\n", $candidates[$_]->signature->inline_check('@tmp'), $_, ) : $sig ? sprintf( "\@tmp = \@_; if (%s) { goto \$coderefs[%d] }\n", $candidates[$_]->signature->inline_check('@tmp'), $_, ) : sprintf('goto \$coderefs[%d];', $_); } 0 .. $#candidates, ); my $error = "Carp::croak(qq/Arguments to $pkg\::$subname did not match any known signature for multi sub/);"; Sub::Util::set_subname( "$pkg\::$subname", eval("package $pkg; sub { $slowpath; my \@tmp; $compiled; $error }"), ); } sub __defer_compile { my ($pkg, $subname) = @_; return Sub::Util::set_subname( "$pkg\::$subname" => sub { no strict "refs"; no warnings "redefine"; *{"$pkg\::$subname"} = (my $compiled = __compile($pkg, $subname)); goto $compiled; }, ); } sub install_sub { my $self = shift; my ($pkg, $subname) = ($self->qualified_name =~ /^(.+)::(\w+)$/); unless ($DISPATCH_TABLE{$pkg}{$subname}) { $DISPATCH_TABLE{$pkg}{$subname} = []; $DISPATCH_STYLE{$pkg}{$subname} = $self->invocation_style; } $DISPATCH_STYLE{$pkg}{$subname} eq $self->invocation_style or Carp::croak("Two different invocation styles used for $subname"); { # A placeholder dispatcher that will replace itself with a more # efficient optimized (compiled) dispatcher. no strict "refs"; no warnings "redefine"; *{"$pkg\::$subname"} = __defer_compile($pkg, $subname); # Invalidate previously optimized dispatchers in subclasses of $pkg *{join '::', @$_} = __defer_compile(@$_) for @{ delete($INVALIDATION{"$pkg\::$subname"}) || [] }; } my $long = $self->qualified_long_name; if (defined $long) { no strict 'refs'; *$long = $self->body; } push @{ $DISPATCH_TABLE{$pkg}{$subname} }, $self; } 1; Parameter.pm000664001750001750 4210712425206147 16370 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorkause 5.014; use strict; use warnings; package Kavorka::Parameter; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; our @CARP_NOT = qw( Kavorka::Signature Kavorka::Sub Kavorka ); use Carp qw( croak ); use Text::Balanced qw( extract_codeblock extract_bracketed ); use Parse::Keyword {}; use Parse::KeywordX; use Moo; use namespace::sweep; has package => (is => 'ro'); has type => (is => 'ro'); has name => (is => 'ro'); has constraints => (is => 'ro', default => sub { +[] }); has named => (is => 'ro', default => sub { 0 }); has named_names => (is => 'ro', default => sub { +[] }); has position => (is => 'rwp'); has default => (is => 'ro'); has default_when => (is => 'ro'); has ID => (is => 'rwp'); has traits => (is => 'ro', default => sub { +{} }); has sigil => (is => 'lazy', builder => sub { substr(shift->name, 0, 1) }); has kind => (is => 'lazy', builder => 1); sub readonly { !!shift->traits->{ro} } sub ro { !!shift->traits->{ro} } sub rw { !shift->traits->{ro} } sub alias { !!shift->traits->{alias} } sub copy { !shift->traits->{alias} } sub slurpy { !!shift->traits->{slurpy} } sub optional { !!shift->traits->{optional} } sub invocant { !!shift->traits->{invocant} } sub coerce { !!shift->traits->{coerce} } sub locked { !!shift->traits->{locked} } our @PARAMS; sub BUILD { my $self = shift; my $id = scalar(@PARAMS); $self->_set_ID($id); $PARAMS[$id] = $self; my $traits = $self->traits; exists($traits->{rw}) and !exists($traits->{ro}) and ($traits->{ro} = !$traits->{rw}); exists($traits->{ro}) and !exists($traits->{rw}) and ($traits->{rw} = !$traits->{ro}); exists($traits->{copy}) and !exists($traits->{alias}) and ($traits->{alias} = !$traits->{copy}); exists($traits->{alias}) and !exists($traits->{copy}) and ($traits->{copy} = !$traits->{alias}); $traits->{$_} || delete($traits->{$_}) for keys %$traits; # traits handled natively state $native_traits = { coerce => 1, copy => 1, invocant => 1, rw => 1, slurpy => 1, }; my @custom_traits = map "Kavorka::TraitFor::Parameter::$_", grep !exists($native_traits->{$_}), keys %$traits; 'Moo::Role'->apply_roles_to_object($self, @custom_traits) if @custom_traits; } sub _build_kind { my $self = shift; local $_ = $self->name; /::/ ? 'global' : /\A[\$\@\%](?:\W|_\z)/ ? 'magic' : 'my'; } my $variable_re = qr{ [\$\%\@] (?: \{\^[A-Z]+\} | \w* ) }x; sub parse { state $deparse = do { require B::Deparse; 'B::Deparse'->new }; my $class = shift; my %args = @_; lex_read_space; my %traits = ( invocant => 0, _optional => 1, ); if (lex_peek(6) eq 'slurpy') { lex_read(6); lex_read_space; $traits{slurpy} = 1; } my $type; my $peek = lex_peek(1000); if ($peek =~ /\A[^\W0-9]/ and not $peek =~ /\A(my|our)\b/) { my $reg = do { require Type::Registry; require Type::Utils; my $tmp = 'Type::Registry::DWIM'->new; $tmp->{'~~chained'} = $args{package}; $tmp->{'~~assume'} = 'make_class_type'; $tmp; }; require Type::Parser; ($type, my($remaining)) = Type::Parser::extract_type($peek, $reg); my $len = length($peek) - length($remaining); lex_read($len); lex_read_space; } elsif ($peek =~ /\A\(/) { lex_read(1); lex_read_space; my $expr = parse_listexpr or croak('Could not parse type constraint expression as listexpr'); lex_read_space; lex_peek eq ')' or croak("Expected ')' after type constraint expression"); lex_read(1); lex_read_space; require Types::TypeTiny; $type = Types::TypeTiny::to_TypeTiny( scalar $expr->() ); $type->isa('Type::Tiny') or croak("Type constraint expression did not return a blessed type constraint object"); } my ($named, $parens, $varname, $varkind, @paramname) = (0, 0); # :foo( ... ) if (lex_peek(2) =~ /\A\:\w/) { $named = 2; $traits{_optional} = 1; while (lex_peek(2) =~ /\A\:\w/) { lex_read(1); push @paramname, parse_name('named parameter name', 0); if (lex_peek eq '(') { lex_read(1); $parens++; } lex_read_space; } } # Allow colon before "my"/"our" - just shift it to the correct position my $saw_colon; if (lex_peek eq ':') { $saw_colon++; lex_read(1); lex_read_space; } if (lex_peek eq '\\') { $traits{ref_alias} = 1; lex_read(1); lex_read_space; } if (lex_peek(3) =~ /\A(my|our)/) { $varkind = $1; lex_read(length $varkind); lex_read_space; } if (lex_peek eq '\\') { croak("cannot be a double-ref-alias") if $traits{ref_alias}++; lex_read(1); lex_read_space; } lex_stuff(':') if $saw_colon; # re-insert colon $peek = lex_peek; # :$foo if ($peek eq ':') { lex_read(1); lex_read_space; $varname = parse_variable; $named = 1; $traits{_optional} = 1; push @paramname, substr($varname, 1); lex_read_space; } # $foo elsif ($peek eq '$' or $peek eq '@' or $peek eq '%') { $varname = parse_variable(1); $traits{_optional} = 0 unless @paramname; lex_read_space; } undef($peek); for (1 .. $parens) { lex_peek(1) eq ')' ? lex_read(1) : croak("Expected close parentheses after named parameter name"); lex_read_space; } if (lex_peek eq '!') { $traits{optional} = 0; lex_read(1); lex_read_space; } elsif (lex_peek eq '?') { $traits{optional} = 1; lex_read(1); lex_read_space; } my (@constraints, $default, $default_when); while (lex_peek(5) eq 'where') { lex_read(5); lex_read_space; push @constraints, parse_block_or_match; lex_read_space; } while (lex_peek(5) =~ m{ \A (is|does|but) \s }xsm) { lex_read(length($1)); lex_read_space; my ($name, undef, $args) = parse_trait; $traits{$name} = $args; lex_read_space; } if (lex_peek(5) =~ m{ \A ( (?: [/]{2} | [|]{2} )?= ) }x) { $default_when = $1; lex_read(length($1)); lex_read_space; $default = lex_peek(5) =~ m{ \A (?: when\b | [,)] ) }x ? sub { (); } : parse_arithexpr; lex_read_space; $traits{_optional} = 1; } $traits{optional} //= $traits{_optional}; delete($traits{_optional}); $traits{slurpy} = 1 if defined($varname) && !$traits{ref_alias} && $varname =~ /\A[\@\%]/; return $class->new( %args, type => $type, name => $varname, constraints => \@constraints, named => !!$named, named_names => \@paramname, default => $default, default_when => $default_when, traits => \%traits, ((kind => $varkind) x!!(defined $varkind)), ); } sub sanity_check { my $self = shift; my $traits = $self->traits; my $name = $self->name; if ($self->named) { length($_) || croak("Bad name for parameter $name") for @{ $self->named_names or die }; croak("Bad parameter $name") if $self->invocant; croak("Bad parameter $name") if $self->slurpy; } if ($self->kind eq 'my') { croak("Bad name for lexical variable: $name") if $name =~ /(::|\^)/; } else { croak("Bad name for package variable: $name") if length($name) < 2; } croak("Bad parameter $name") if $self->invocant && $self->slurpy; } sub injection { my $self = shift; my ($sig) = @_; my $var = $self->name; my $is_dummy = 0; if (length($var) == 1) { $var .= 'tmp'; $is_dummy = 1; } my ($val, $condition) = $self->_injection_extract_and_coerce_value($sig); my $code = $self->_injection_assignment($sig, $var, $val) . $self->_injection_conditional_type_check($sig, $condition, $var); $is_dummy ? "{ $code }" : $code; } sub _injection_assignment { my $self = shift; my ($sig, $var, $val) = @_; my $kind = $self->kind; sprintf( '%s %s = %s;', ( $kind eq 'our' ? "our $var; local" : $kind eq 'my' ? 'my' : 'local' ), $var, $val, ); } sub _injection_conditional_type_check { my $self = shift; my ($sig, $condition, $var) = @_; my $sigil = $self->sigil; my $type = ($sigil eq '@') ? sprintf('for (%s) { %s }', $var, $self->_injection_type_check('$_')) : ($sigil eq '%') ? sprintf('for (values %s) { %s }', $var, $self->_injection_type_check('$_')) : ($condition eq '1') ? sprintf('%s;', $self->_injection_type_check($var)) : sprintf('if (%s) { %s }', $condition, $self->_injection_type_check($var)); return '' if $type =~ /\{ \}\z/; return sprintf( 'unless ($____nobble_checks) { %s };', $type, ) if $sig->nobble_checks; return $type; } sub _injection_extract_and_coerce_value { my $self = shift; my ($sig) = @_; $self->coerce or return $self->_injection_extract_value(@_); my $type = $self->type or croak("Parameter ${\ $self->name } cannot coerce without a type constraint"); $type->has_coercion or croak("Parameter ${\ $self->name } cannot coerce because type constraint has no coercions defined"); my ($val, $condition) = $self->_injection_extract_value(@_); my $coerce_variable = sub { my $variable = shift; if ($type->coercion->can_be_inlined) { $type->coercion->inline_coercion($variable), } else { sprintf( '$%s::PARAMS[%d]->{type}->coerce(%s)', __PACKAGE__, $self->ID, $variable, ); } }; my $sigil = $self->sigil; if ($sigil eq '@') { $val = sprintf( '(map { %s } %s)', $coerce_variable->('$_'), $val, ); } elsif ($sigil eq '%') { $val = sprintf( 'do { my %%tmp = %s; for (values %%tmp) { %s }; %%tmp }', $val, $coerce_variable->('$_'), ); } elsif ($sigil eq '$' and $type->coercion->can_be_inlined) { $val = sprintf( 'do { my $tmp = %s; %s}', $val, $coerce_variable->('$tmp'), ); } elsif ($sigil eq '$') { $val = $coerce_variable->($val); } wantarray ? ($val, $condition) : $val; } sub _injection_default_value { my $self = shift; my ($fallback) = @_; return sprintf('$%s::PARAMS[%d]{default}->()', __PACKAGE__, $self->ID) if $self->default; return $fallback if defined $fallback; return sprintf( 'Carp::croak(sprintf q/Named parameter `%%s` is required/, %s)', B::perlstring($self->named_names->[0]), ) if $self->named; return sprintf( 'Carp::croak(q/Invocant %s is required/)', $self->name, ) if $self->invocant; return sprintf( 'Carp::croak(q/Positional parameter %d is required/)', $self->position, ); } sub _injection_extract_value { my $self = shift; my ($sig) = @_; my $condition; my $val; my $slurpy_style = ''; if ($self->slurpy) { if ($self->sigil eq '%' or ($self->sigil eq '$' and $self->type and do { require Types::Standard; $self->type->is_a_type_of(Types::Standard::HashRef()) })) { my @names = map(@{$_->named ? $_->named_names : []}, @{$sig->params}); if (@names) { croak("Cannot alias slurpy hash for a function with named parameters") if $self->alias; my $delete = $_->name eq '%_' ? '' : sprintf( 'delete $tmp{$_} for (%s);', join(q[,], map B::perlstring($_), @names), ); my $ix = 1 + $sig->last_position; $val = sprintf( 'do { use warnings FATAL => qw(all); my %%tmp = ($#_==%d && ref($_[%d]) eq q(HASH)) ? %%{$_[%d]} : @_[ %d .. $#_ ]; %s %%tmp ? %%tmp : (%s) }', ($ix) x 4, $delete, $self->_injection_default_value('()'), ); } else { $val = sprintf( 'do { use warnings FATAL => qw(all); my %%tmp = @_[ %d .. $#_ ]; %%tmp ? @_[ %d .. $#_ ] : (%s) }', $sig->last_position + 1, $sig->last_position + 1, $self->_injection_default_value('()'), ); } $condition = 1; $slurpy_style = '%'; } else { croak("Cannot have a slurpy array for a function with named parameters") if $sig->has_named; $val = sprintf( '($#_ >= %d) ? @_[ %d .. $#_ ] : (%s)', $sig->last_position + 1, $sig->last_position + 1, $self->_injection_default_value('()'), ); $condition = 1; $slurpy_style = '@'; } if ($self->sigil eq '$') { $val = $slurpy_style eq '%' ? "+{ $val }" : "[ $val ]"; $slurpy_style = '$'; } } elsif ($self->named) { no warnings 'uninitialized'; my $when = +{ '//=' => 'defined', '||=' => '!!', '=' => 'exists', }->{ $self->default_when } || 'exists'; $val = join '', map( sprintf('%s($_{%s}) ? $_{%s} : ', $when, $_, $_), map B::perlstring($_), @{$self->named_names} ), $self->_injection_default_value(); $condition = join ' or ', map( sprintf('%s($_{%s})', $when, $_), map B::perlstring($_), @{$self->named_names} ); } elsif ($self->invocant) { $val = sprintf('@_ ? shift(@_) : %s', $self->_injection_default_value()); $condition = 1; } else { no warnings 'uninitialized'; my $when = +{ '//=' => 'defined($_[%d])', '||=' => '!!($_[%d])', '=' => '($#_ >= %d)', }->{ $self->default_when } || '($#_ >= %d)'; my $pos = $self->position; $val = sprintf($when.' ? $_[%d] : %s', $pos, $pos, $self->_injection_default_value()); $condition = sprintf($when, $self->position); } $condition = 1 if $self->_injection_default_value('@@') ne '@@'; wantarray ? ($val, $condition) : $val; } sub _injection_type_check { my $self = shift; my ($var) = @_; my $check = ''; if ( my $type = $self->type ) { my $can_xs = $INC{'Mouse/Util.pm'} && Mouse::Util::MOUSE_XS() && ($type->{_is_core} or $type->is_parameterized && $type->parent->{_is_core}); if (!$can_xs and $type->can_be_inlined) { $check .= sprintf( '%s;', $type->inline_assert($var), ); } else { $check .= sprintf( '$%s::PARAMS[%d]->{type}->assert_valid(%s);', __PACKAGE__, $self->ID, $var, ); } } for my $i (0 .. $#{$self->constraints}) { $check .= sprintf( 'do { local $_ = %s; $%s::PARAMS[%d]->{constraints}[%d]->() } or Carp::croak(sprintf("%%s failed value constraint", %s, %d));', $var, __PACKAGE__, $self->ID, $i, B::perlstring($var), $i, ); } return $check; } 1; __END__ =pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive booleans globals =head1 NAME Kavorka::Parameter - a single parameter in a function signature =head1 DESCRIPTION Kavorka::Parameter is a class where each instance represents a parameter in a function signature. This class is used to help parse the function signature, and also to inject Perl code into the final function. Instances of this class are also returned by Kavorka's function introspection API. =head2 Introspection API A parameter instance has the following methods: =over =item C An opaque numeric identifier for this parameter. =item C Returns the package name the parameter was declared in. =item C A L object representing the type constraint for the parameter, or undef. =item C The name of the variable associated with this parameter, including its sigil. =item C An arrayref of additional constraints upon the value. These are given as coderefs. =item C A boolean indicating whether this is a named parameter. =item C An arrayref of names for this named parameter. =item C The position for a positional parameter. =item C A coderef supplying the default value for this parameter. =item C The string "=", "//=" or "||=". =item C A hashref, where the keys represent names of parameter traits, and the values are booleans. =item C The sigil of the variable for this parameter. =item C Returns "our" for package variables; "global" for namespace-qualified package variables (i.e. containing "::"); "magic" for C<< $_ >> and escape char variables like C<< ${^HELLO} >>; "my" otherwise. =item C, C A boolean indicating whether this variable will be read-only. =item C A boolean indicating whether this variable will be read-write. =item C A boolean indicating whether this variable is a locked hash(ref). =item C A boolean indicating whether this variable will be an alias. =item C A boolean indicating whether this variable will be a copy (non-alias). =item C A boolean indicating whether this variable is slurpy. =item C A boolean indicating whether this variable is optional. =item C A boolean indicating whether this variable is an invocant. =item C A boolean indicating whether this variable should coerce. =back =head2 Other Methods =over =item C An internal method used to parse a parameter. Only makes sense to use within a L parser. =item C The string of Perl code to inject for this parameter. =item C Tests that the parameter is sane. (For example it would not be sane to have an invocant that is an optional parameter.) =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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. ReturnType.pm000664001750001750 474012425206147 16552 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorkause 5.014; use strict; use warnings; package Kavorka::ReturnType; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; our @CARP_NOT = qw( Kavorka::Signature Kavorka::Sub Kavorka ); use Carp qw( croak ); use Parse::Keyword {}; use Parse::KeywordX qw(parse_trait); use Moo; use namespace::sweep; has package => (is => 'ro'); has type => (is => 'ro'); has traits => (is => 'ro', default => sub { +{} }); sub coerce { !!shift->traits->{coerce} } sub list { !!shift->traits->{list} } sub assumed { !!shift->traits->{assumed} } sub BUILD { my $self = shift; # traits handled natively state $native_traits = { coerce => 1, list => 1, scalar => 1, }; my @custom_traits = map "Kavorka::TraitFor::ReturnType::$_", grep !exists($native_traits->{$_}), keys %{$self->traits}; 'Moo::Role'->apply_roles_to_object($self, @custom_traits) if @custom_traits; } sub parse { my $class = shift; my %args = @_; lex_read_space; my %traits = (); my $type; my $peek = lex_peek(1000); if ($peek =~ /\A[^\W0-9]/) { my $reg = do { require Type::Registry; require Type::Utils; my $tmp = 'Type::Registry::DWIM'->new; $tmp->{'~~chained'} = $args{package}; $tmp->{'~~assume'} = 'Type::Tiny::Class'; $tmp; }; require Type::Parser; ($type, my($remaining)) = Type::Parser::extract_type($peek, $reg); my $len = length($peek) - length($remaining); lex_read($len); lex_read_space; } elsif ($peek =~ /\A\(/) { lex_read(1); lex_read_space; my $expr = parse_listexpr or croak('Could not parse type constraint expression as listexpr'); lex_read_space; lex_peek eq ')' or croak("Expected ')' after type constraint expression"); lex_read(1); lex_read_space; require Types::TypeTiny; $type = Types::TypeTiny::to_TypeTiny( scalar $expr->() ); $type->isa('Type::Tiny') or croak("Type constraint expression did not return a blessed type constraint object"); } else { croak("Expected return type!"); } undef($peek); while (lex_peek(5) =~ m{ \A (is|does|but) \s }xsm) { lex_read(length($1)); lex_read_space; my ($name, undef, $args) = parse_trait; $traits{$name} = $args; lex_read_space; } return $class->new( %args, type => $type, traits => \%traits, ); } sub sanity_check { my $self = shift; croak("Return type cannot coerce and be assumed") if $self->assumed && $self->coerce; (); } sub _effective_type { my $self = shift; $self->type; } 1; Signature.pm000664001750001750 2632012425206147 16410 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorkause 5.014; use strict; use utf8; use warnings; use Kavorka::Parameter (); use Kavorka::ReturnType (); package Kavorka::Signature; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; our @CARP_NOT = qw( Kavorka::Sub Kavorka ); use Carp qw( croak ); use Parse::Keyword {}; use Parse::KeywordX; use Moo; use namespace::sweep; has package => (is => 'ro'); has _is_dummy => (is => 'ro'); has params => (is => 'ro', default => sub { +[] }); has return_types => (is => 'ro', default => sub { +[] }); has has_invocants => (is => 'rwp', default => sub { +undef }); has has_named => (is => 'rwp', default => sub { +undef }); has has_slurpy => (is => 'rwp', default => sub { +undef }); has yadayada => (is => 'rwp', default => sub { 0 }); has parameter_class => (is => 'ro', default => sub { 'Kavorka::Parameter' }); has return_type_class => (is => 'ro', default => sub { 'Kavorka::ReturnType' }); has last_position => (is => 'lazy'); has args_min => (is => 'lazy'); has args_max => (is => 'lazy'); has checker => (is => 'lazy'); has nobble_checks => (is => 'rwp', default => sub { 0 }); sub parse { my $class = shift; my $self = $class->new(@_); lex_read_space; my $found_colon = 0; my $arr = $self->params; my $_class = 'parameter_class'; if (lex_peek(4) =~ /\A(\xE2\x86\x92|-->)/) { lex_read(length $1); $arr = $self->return_types; $_class = 'return_type_class'; lex_read_space; } my $skip = 0; while (lex_peek ne ')') { if (lex_peek(3) eq '...') { $self->_set_yadayada(1); lex_read(3); lex_read_space; ++$skip && next if lex_peek(4) =~ /\A(\xE2\x86\x92|-->)/; croak("After yada-yada, expected right parenthesis") unless lex_peek eq ")"; next; } $skip ? ($skip = 0) : push(@$arr, $self->$_class->parse(package => $self->package)); lex_read_space; my $peek = lex_peek; if ($found_colon and $peek eq ':') { croak("Cannot have two sets of invocants - unexpected colon!"); } elsif ($peek eq ':') { $_->traits->{invocant} = 1 for @{$self->params}; $self->_set_has_invocants( scalar @{$self->params} ); lex_read(1); } elsif ($peek eq ',') { lex_read(1); } elsif ($peek eq ')') { last; } elsif (lex_peek(4) =~ /\A(\xE2\x86\x92|-->)/) { lex_read(length $1); $arr = $self->return_types; $_class = 'return_type_class'; } else { use Data::Dumper; print Dumper($self); croak("Unexpected characters in signature (${\ lex_peek(8) })"); } lex_read_space; } $self->sanity_check; return $self; } # XXX - check not allowed optional parameters and named parameters in same sig sub sanity_check { my $self = shift; my $has_invocants = 0; my $has_slurpy = 0; my $has_named = 0; for my $p (reverse @{ $self->params or croak("Huh?") }) { $has_named++ if $p->named; $has_slurpy++ if $p->slurpy; if ($p->invocant) { $has_invocants++; next; } elsif ($has_invocants) { $has_invocants++; $p->traits->{invocant} = 1; # anything prior to an invocant is also an invocant! } } $self->_set_has_invocants($has_invocants); $self->_set_has_named($has_named); $self->_set_has_slurpy($has_slurpy); croak("Cannot have more than one slurpy parameter") if $has_slurpy > 1; my $i = 0; my $zone = 'invocant'; my %already; for my $p (@{ $self->params }) { my $p_type = $p->invocant ? 'invocant' : $p->named ? 'named' : $p->slurpy ? 'slurpy' : $p->optional ? 'optional' : 'positional'; $p->sanity_check($self); $p->_set_position($i++) unless $p->invocant || $p->slurpy || $p->named; my $name = $p->name; croak("Parameter $name occurs twice in signature") if length($name) > 1 && $already{$name}++; if ($name eq '@_') { croak("Cannot have slurpy named \@_ after positional parameters") if $self->positional_params; croak("Cannot have slurpy named \@_ after named parameters") if $self->named_params; } next if $p_type eq $zone; # Zone transitions if ($zone eq 'invocant' || $zone eq 'positional' and $p_type eq 'positional' || $p_type eq 'named' || $p_type eq 'slurpy' || $p_type eq 'optional') { $zone = $p_type; next; } elsif ($zone eq 'optional' || $zone eq 'named' and $p_type eq 'slurpy') { $zone = $p_type; next; } croak("Found $p_type parameter ($name) after $zone; forbidden"); } $_->sanity_check for @{ $self->return_types }; (); } sub _build_last_position { my $self = shift; my ($last) = reverse( $self->positional_params ); return -1 unless $last; return $last->position; } sub injection { my $self = shift; join q[] => ( $self->_injection_nobble, $self->_injection_invocants, $self->_injection_parameter_count, $self->_injection_positional_params, $self->_injection_hash_underscore, $self->_injection_named_params, $self->_injection_slurpy_param, '();', ); } our $NOBBLE = bless(do { my $x = 1; \$x }, 'Kavorka::Signature::NOBBLE'); sub _injection_nobble { my $self = shift; return unless $self->nobble_checks; sprintf('my $____nobble_checks = (ref($_[0]) eq "Kavorka::Signature::NOBBLE") ? ${+shift} : 0;'); } sub _injection_parameter_count { my $self = shift; my $min = $self->args_min; my $max = $self->args_max; my @lines; return sprintf( 'Carp::croak("Expected %d parameter%s") if @_ != %d;', $min, $min==1 ? '' : 's', $min, ) if defined($min) && defined($max) && $min==$max; push @lines, sprintf( 'Carp::croak("Expected at least %d parameter%s") if @_ < %d;', $min, $min==1 ? '' : 's', $min, ) if defined $min && $min > 0; push @lines, sprintf( 'Carp::croak("Expected at most %d parameter%s") if @_ > %d;', $max, $max==1 ? '' : 's', $max, ) if defined $max; return @lines; } sub _build_args_min { my $self = shift; 0 + scalar grep !$_->optional, $self->positional_params; } sub _build_args_max { my $self = shift; return if $self->has_named || $self->has_slurpy || $self->yadayada; 0 + scalar $self->positional_params; } sub _injection_hash_underscore { my $self = shift; my $slurpy = $self->slurpy_param; if ($self->has_named or $slurpy && $slurpy->name =~ /\A\%/ or $slurpy && $slurpy->name =~ /\A\$/ && $slurpy->type->is_a_type_of(Types::Standard::HashRef())) { require Data::Alias; my $ix = 1 + $self->last_position; my $str = sprintf( 'local %%_; { use warnings FATAL => qw(all); Data::Alias::alias(%%_ = ($#_==%d && ref($_[%d]) eq q(HASH)) ? %%{$_[%d]} : @_[ %d .. $#_ ]) };', ($ix) x 4, ); unless ($slurpy or $self->yadayada) { my @allowed_names = map +($_=>1), map @{$_->named_names}, $self->named_params; $str .= sprintf( '{ my %%OK = (%s); ', join(q[,], map(sprintf('%s=>1,', B::perlstring $_), @allowed_names)), ); $str .= '$OK{$_}||Carp::croak("Unknown named parameter: $_") for sort keys %_ };'; } return $str; } return; } sub _injection_invocants { my $self = shift; map($_->injection($self), $self->invocants); } sub _injection_positional_params { my $self = shift; map($_->injection($self), $self->positional_params); } sub _injection_named_params { my $self = shift; map($_->injection($self), $self->named_params); } sub _injection_slurpy_param { my $self = shift; map($_->injection($self), grep defined, $self->slurpy_param); } sub named_params { my $self = shift; grep $_->named, @{$self->params}; } sub positional_params { my $self = shift; grep !$_->named && !$_->invocant && !$_->slurpy, @{$self->params}; } sub slurpy_param { my $self = shift; my ($s) = grep $_->slurpy, @{$self->params}; $s; } sub invocants { my $self = shift; grep $_->invocant, @{$self->params}; } sub check { my $checker = shift->checker; goto $checker; } sub _build_checker { my $self = shift; eval sprintf( 'sub { eval { %s; 1 } }', $self->injection, ); } sub inline_check { my $self = shift; my ($arr) = @_; my $tmp = $self->nobble_checks; $self->_set_nobble_checks(0); my $inline = sprintf( 'do { local @_ = %s; eval { %s; 1 } }', $arr, $self->injection, ); $self->_set_nobble_checks($tmp) if $tmp; return $inline; } 1; __END__ =pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive yadayada =head1 NAME Kavorka::Signature - a function signature =head1 DESCRIPTION Kavorka::Signature is a class where each instance represents a function signature. This class is used to parse the function signature, and also to inject Perl code into the final function. Instances of this class are also returned by Kavorka's function introspection API. =head2 Introspection API A signature instance has the following methods. Each method which returns parameters, returns an instance of L. =over =item C Returns the package name the parameter was declared in. =item C Returns an arrayref of parameters. =item C Returns an arrayref of declared return types. =item C, C Returns a boolean/list of invocant parameters. =item C Returns a list of positional parameters. =item C, C Returns a boolean/list of named parameters. =item C, C Returns a boolean indicating whether there is a slurpy parameter in this signature / returns the slurpy parameter. =item C Indicates whether the yadayada operator was encountered in the signature. =item C The numeric index of the last positional parameter. =item C, C The minimum/maximum number of arguments expected by the function. Invocants are not counted. If there are any named or slurpy arguments, of the yada yada operator was used in the signature, then C will be undef. =item C<< check(@args) >> Check whether C<< @args >> (which should include any invocants) would satisfy the signature. =item C<< checker >> Returns a coderef which acts like C<< check(@args) >>. =item C<< inline_check($varname) >> Returns a string of Perl code that acts like an inline check, given the name of an array variable, such as C<< '@foo' >>. =back =head2 Other Methods =over =item C An internal method used to parse a signature. Only makes sense to use within a L parser. =item C A class to use for parameters when parsing the signature. =item C A class to use for return types when parsing the signature. =item C The string of Perl code to inject for this signature. =item C Tests that the signature is sane. (For example it would not be sane to have a slurpy parameter prior to a positional one.) =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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. Sub.pm000664001750001750 3407712425206147 15210 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorkause 5.014; use strict; use warnings; use Kavorka::Signature (); use Sub::Util (); package Kavorka::Sub; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Text::Balanced qw( extract_bracketed ); use Parse::Keyword {}; use Parse::KeywordX; use Carp; our @CARP_NOT = qw(Kavorka); use Moo::Role; use namespace::sweep; use overload ( q[&{}] => sub { shift->body }, q[bool] => sub { 1 }, q[""] => sub { shift->qualified_name // '__ANON__' }, q[0+] => sub { 1 }, fallback => 1, ); has keyword => (is => 'ro'); has signature_class => (is => 'lazy', default => sub { 'Kavorka::Signature' }); has package => (is => 'ro'); has declared_name => (is => 'rwp'); has signature => (is => 'rwp'); has traits => (is => 'lazy', default => sub { +{} }); has prototype => (is => 'rwp'); has attributes => (is => 'lazy', default => sub { [] }); has body => (is => 'rwp'); has qualified_name => (is => 'rwp'); has _unwrapped_body => (is => 'rwp'); has _pads_to_poke => (is => 'lazy'); has _tmp_name => (is => 'lazy'); sub allow_anonymous { 1 } sub allow_lexical { 1 } sub is_anonymous { !defined( shift->declared_name ) } sub is_lexical { (shift->declared_name || '') =~ /\A\$/ } sub invocation_style { +undef } sub default_attributes { return; } sub default_invocant { return; } sub forward_declare_sub { return; } sub bypass_custom_parsing { my $class = shift; my ($keyword, $caller, $args) = @_; croak("Attempt to call keyword '$keyword' bypassing prototype not supported"); } sub install_sub { my $self = shift; my $code = $self->body; if ($self->is_anonymous) { # no installation } elsif ($self->is_lexical) { require PadWalker; PadWalker::peek_my(2)->{ $self->declared_name } = \$code; } else { my $name = $self->qualified_name; no strict 'refs'; *{$name} = $code; } $code; } sub inject_attributes { my $self = shift; no warnings; # Perl 5.21+ sprintf emits warnings for redundant arguments join(' ', map sprintf($_->[1] ? ':%s(%s)' : ':%s', @$_), @{ $self->attributes }), } sub inject_prelude { my $self = shift; $self->signature->injection; } sub parse { my $class = shift; my $self = $class->new(@_, package => compiling_package); lex_read_space; # sub name $self->parse_subname; unless ($self->is_anonymous or $self->is_lexical) { my $qualified = Kavorka::_fqname($self->declared_name); $self->_set_qualified_name($qualified); $self->forward_declare_sub; } # Thanks to Perl 5.20 subs, we have to allow attributes before # the signature too. lex_read_space; $self->parse_attributes if lex_peek eq ':' && lex_peek(2) ne ':('; # signature $self->parse_signature; my $sig = $self->signature; unless ($sig->has_invocants) { my @defaults = $self->default_invocant; unshift @{$sig->params}, @defaults; $sig->_set_has_invocants(scalar @defaults); } # traits $self->parse_traits; my $traits = $self->traits; if (keys %$traits) { # traits handled natively (none so far) state $native_traits = {}; my @custom_traits = map "Kavorka::TraitFor::Sub::$_", grep !exists($native_traits->{$_}), keys %$traits; 'Moo::Role'->apply_roles_to_object($self, @custom_traits) if @custom_traits; } # prototype and attributes $self->parse_prototype; $self->parse_attributes; push @{$self->attributes}, $self->default_attributes; # body $self->parse_body; $self; } sub parse_subname { my $self = shift; my $peek = lex_peek(2); my $saw_my = 0; if ($peek =~ /\A(?:\w|::)/) # normal sub { my $name = parse_name('subroutine', 1); if ($name eq 'my') { lex_read_space; $saw_my = 1 if lex_peek eq '$'; } if ($saw_my) { $peek = lex_peek(2); } else { $self->_set_declared_name($name); return; } } if ($peek =~ /\A\$[^\W0-9]/) # lexical sub { carp("'${\ $self->keyword }' should be '${\ $self->keyword } my'") unless $saw_my; lex_read(1); $self->_set_declared_name('$' . parse_name('lexical subroutine', 0)); croak("Keyword '${\ $self->keyword }' does not support defining lexical subs") unless $self->allow_lexical; return; } croak("Keyword '${\ $self->keyword }' does not support defining anonymous subs") unless $self->allow_anonymous; (); } sub parse_signature { my $self = shift; lex_read_space; # default signature my $dummy = 0; if (lex_peek ne '(') { $dummy = 1; lex_stuff('(...)'); } lex_read(1); my $sig = $self->signature_class->parse(package => $self->package, _is_dummy => $dummy); lex_peek eq ')' or croak('Expected ")" after signature'); lex_read(1); lex_read_space; $self->_set_signature($sig); (); } sub parse_prototype { my $self = shift; lex_read_space; my $peek = lex_peek(1000); if ($peek =~ / \A \: \s* \( /xsm ) { lex_read(1); lex_read_space; $peek = lex_peek(1000); my $extracted = extract_bracketed($peek, '()'); lex_read(length $extracted); $extracted =~ s/(?: \A\( | \)\z )//xgsm; $self->_set_prototype($extracted); } (); } sub parse_traits { my $self = shift; lex_read_space; while (lex_peek(5) =~ m{ \A (is|does|but) \s }xsm) { lex_read(length($1)); lex_read_space; my ($name, undef, $args) = parse_trait; $self->traits->{$name} = $args; lex_read_space; } (); } sub parse_attributes { my $self = shift; lex_read_space; if (lex_peek eq ':') { lex_read(1); lex_read_space; } else { return; } while (lex_peek(4) =~ /\A([^\W0-9]\w+)/) { my $parsed = [parse_trait]; lex_read_space; if ($parsed->[0] eq 'prototype') { $self->_set_prototype($parsed->[1]); } else { push @{$self->attributes}, $parsed; } if (lex_peek eq ':') { lex_read(1); lex_read_space; } } (); } sub _build__tmp_name { state $i = 0; "Kavorka::Temp::f" . ++$i; } sub parse_body { my $self = shift; lex_read_space; lex_peek(1) eq '{' or croak("expected block!"); lex_read(1); if ($self->is_anonymous) { lex_stuff(sprintf("{ %s", $self->inject_prelude)); # Parse the actual code my $code = parse_block(0) or Carp::croak("cannot parse block!"); # Set up prototype &Scalar::Util::set_prototype($code, $self->prototype); # Fix sub name $code = Sub::Util::set_subname(join('::', $self->package, '__ANON__'), $code); # Set up attributes - this doesn't much work my $attrs = $self->attributes; if (@$attrs) { require attributes; no warnings; attributes->import( $self->package, $code, map($_->[0], @$attrs), ); } # And keep the coderef $self->_set_body($code); } else { state $i = 0; my $lex = ''; if ($self->is_lexical) { $lex = sprintf( '&Internals::SvREADONLY(\\(my %s = \&%s), 1);', $self->declared_name, $self->_tmp_name, ); } # Here instead of parsing the body we'll leave it to plain old # Perl. We'll pick it up later from this name in _post_parse lex_stuff( sprintf( "%s sub %s %s { no warnings 'closure'; %s", $lex, $self->_tmp_name, $self->inject_attributes, $self->inject_prelude, ) ); $self->{argh} = $self->_tmp_name; } (); } sub _post_parse { my $self = shift; if ($self->{argh}) { no strict 'refs'; my $code = $self->is_lexical ? \&{$self->{argh}} : \&{ delete $self->{argh} }; Sub::Util::set_subname( $self->is_anonymous || $self->is_lexical ? join('::', $self->package, '__ANON__') : $self->qualified_name, $code, ); &Scalar::Util::set_prototype($code, $self->prototype); $self->_set_body($code); } $self->_apply_return_types; $self->_set_signature(undef) if $self->signature && $self->signature->_is_dummy; (); } sub _apply_return_types { my $self = shift; my @rt = @{ $self->signature ? $self->signature->return_types : [] }; if (@rt) { my @scalar = grep !$_->list, @rt; my @list = grep $_->list, @rt; my $scalar = (@scalar == 0) ? undef : (@scalar == 1) ? $scalar[0] : croak("Multiple scalar context return types specified for function"); my $list = (@list == 0) ? undef : (@list == 1) ? $list[0] : croak("Multiple list context return types specified for function"); return if (!$scalar || $scalar->assumed) && (!$list || $list->assumed); require Return::Type; my $wrapped = Return::Type->wrap_sub( $self->body, scalar => ($scalar ? $scalar->_effective_type : undef), list => ($list ? $list->_effective_type : undef), coerce_scalar => ($scalar ? $scalar->coerce : 0), coerce_list => ($list ? $list->coerce : $scalar ? $scalar->coerce : 0), ); $self->_set__unwrapped_body($self->body); $self->_set_body($wrapped); } (); } sub _build__pads_to_poke { my $self = shift; my @pads = $self->_unwrapped_body // $self->body; for my $param (@{ $self->signature ? $self->signature->params : [] }) { push @pads, $param->default if $param->default; push @pads, @{ $param->constraints }; } \@pads; } sub _poke_pads { my $self = shift; my ($vars) = @_; for my $code (@{$self->_pads_to_poke}) { my $closed_over = PadWalker::closed_over($code); ref($vars->{$_}) && ($closed_over->{$_} = $vars->{$_}) for keys %$closed_over; PadWalker::set_closed_over($code, $closed_over); } (); } 1; __END__ =pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive =head1 NAME Kavorka::Sub - a function that has been declared =head1 DESCRIPTION Kavorka::Sub is a role which represents a function declared using L. Classes implementing this role are used to parse functions, and also to inject Perl code into them. Instances of classes implementing this role are also returned by Kavorka's function introspection API. =head2 Introspection API A function instance has the following methods. =over =item C The keyword (e.g. C) used to declare the function. =item C Returns the package name the parameter was declared in. Not necessarily the package it will be installed into... package Foo; fun UNIVERSAL::quux { ... } # will be installed into UNIVERSAL =item C Returns a boolean indicating whether this is an anonymous coderef. =item C The declared name of the function (if any). =item C The name the function will be installed as, based on the package and declared name. =item C An instance of L, or undef. =item C A hashref of traits. =item C The function prototype as a string. =item C The function attributes. The structure returned by this method is subject to change. =item C The function body as a coderef. Note that this coderef I have had the signature code injected into it. =back =head2 Other Methods =over =item C, C, C, C, C, C, C Internal methods used to parse a subroutine. It only makes sense to call these from a L parser, but may make sense to override them in classes consuming the Kavorka::Sub role. =item C Returns a boolean indicating whether this keyword allows functions to be anonymous. The implementation defined in this role returns true. =item C A class to use for signatures. =item C Returns a list of attributes to add to the sub when it is parsed. It would make sense to override this in classes implementing this role, however attributes don't currently work properly anyway. The implementation defined in this role returns the empty list. =item C Returns a list invocant parameters to add to the signature if no invocants are specified in the signature. It makes sense to override this for keywords which have implicit invocants, such as C. (See L for an example.) The implementation defined in this role returns the empty list. =item C Method called at compile time to forward-declare the sub, if that behaviour is desired. The implementation defined in this role does nothing, but L actually does some forward declaration. =item C Method called at run time to install the sub into the symbol table. This makes sense to override if the sub shouldn't be installed in the normal Perlish way. For example L overrides it. =item C Returns a string "fun" or "method" depending on whether subs are expected to be invoked as functions or methods. May return undef if neither is really the case (e.g. as with method modifiers). =item C Returns a string of Perl code along the lines of ":foo :bar(1)" which is injected into the Perl token stream to be parsed as the sub's attributes. (Only used for named subs.) =item C Returns a string of Perl code to inject into the body of the sub. =item C A I that is called when people attempt to use the keyword while bypassing the Perl keyword API's custom parsing. Examples of how they can do that are: use Kavorka 'method'; &method(...); __PACKAGE__->can("method")->(...); The default implementation of C is to croak, but this can be overridden in cases where it may be possible to do something useful. (L does this.) It is passed the name of the keyword, the name of the package that the keyword was installed into, and an arrayref representing C<< @_ >>. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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. KavorkaInfo.pm000664001750001750 670412425206147 16461 0ustar00taitai000000000000Kavorka-0.036/lib/MooseXuse 5.014; use strict; use warnings; use Moose (); use Kavorka (); use Kavorka::Signature (); use Sub::Util (); { package MooseX::KavorkaInfo::DummyInfo; use Moose; with 'Kavorka::Sub'; } { package MooseX::KavorkaInfo; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; sub import { my $meta = Class::MOP::class_of(scalar caller); Moose::Util::MetaRole::apply_metaroles( for => $meta, role_metaroles => { method => ['MooseX::KavorkaInfo::Trait::Method'], }, class_metaroles => { method => ['MooseX::KavorkaInfo::Trait::Method'], wrapped_method => ['MooseX::KavorkaInfo::Trait::WrappedMethod'], }, ); } } { package MooseX::KavorkaInfo::Trait::Method; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moose::Role; has _info => ( is => 'ro', lazy => 1, builder => '_build_info', handles => { declaration_keyword => 'keyword', signature => 'signature', }, ); sub _build_info { my $self = shift; Kavorka->info( $self->body ) or MooseX::KavorkaInfo::DummyInfo->new( keyword => 'sub', qualified_name => Sub::Util::subname( $self->body ), body => $self->body, signature => 'Kavorka::Signature'->new(params => [], yadayada => 1), ); } } { package MooseX::KavorkaInfo::Trait::WrappedMethod; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moose::Role; with 'MooseX::KavorkaInfo::Trait::Method'; around _build_info => sub { my $orig = shift; my $self = shift; Kavorka->info( $self->get_original_method->body ) or MooseX::KavorkaInfo::DummyInfo->new( keyword => 'sub', body => $self->body, signature => 'Kavorka::Signature'->new(params => [], yadayada => 1), ); }; } 1; __END__ =pod =encoding utf-8 =head1 NAME MooseX::KavorkaInfo - make Kavorka->info available through Moose meta objects =head1 SYNOPSIS package Foo { use Moose; use MooseX::KavorkaInfo; use Kavorka qw( -default -modifiers ); method xxx (Int $x) { return $x ** 3 } } package Foo::Verbose { use Moose; use MooseX::KavorkaInfo; use Kavorka qw( -default -modifiers ); extends "Foo"; before xxx { warn "Called xxx" } } my $method = Foo::Verbose->meta->get_method("xxx"); say $method->signature->params->[1]->type->name; # says "Int" =head1 DESCRIPTION MooseX::KavorkaInfo adds two extra methods to the Moose::Meta::Method meta objects associated with a class. It "sees through" method modifiers to inspect the original method declaration. =head2 Methods =over =item C Returns a L object. =item C Returns a string indicating what keyword the method was declared with. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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. KeywordX.pm000664001750001750 572112425206147 15661 0ustar00taitai000000000000Kavorka-0.036/lib/Parseuse 5.014; use strict; use warnings; use Exporter::Tiny (); package Parse::KeywordX; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Text::Balanced qw( extract_bracketed ); use PadWalker qw( closed_over set_closed_over peek_my ); use Parse::Keyword {}; our @ISA = qw( Exporter::Tiny ); our @EXPORT = qw( parse_name parse_variable parse_trait parse_block_or_match ); #### From p5-mop-redux sub read_tokenish () { my $token = ''; if ((my $next = lex_peek) =~ /[\$\@\%]/) { $token .= $next; lex_read; } while ((my $next = lex_peek) =~ /\S/) { $token .= $next; lex_read; last if ($next . lex_peek) =~ /^\S\b/; } return $token; } #### From p5-mop-redux sub parse_name { my ($what, $allow_package, $stop_at_single_colon) = @_; my $name = ''; # XXX this isn't quite right, i think, but probably close enough for now? my $start_rx = qr/^[\p{ID_Start}_]$/; my $cont_rx = qr/^\p{ID_Continue}$/; my $char_rx = $start_rx; while (1) { my $char = lex_peek; last unless length $char; if ($char =~ $char_rx) { $name .= $char; lex_read; $char_rx = $cont_rx; } elsif ($allow_package && $char eq ':') { if (lex_peek(3) !~ /^::(?:[^:]|$)/) { return $name if $stop_at_single_colon; die("Not a valid $what name: $name" . read_tokenish); } $name .= '::'; lex_read(2); } else { last; } } die("Not a valid $what name: " . read_tokenish) unless length $name; ($name =~ /\A::/) ? "main$name" : $name; } sub parse_variable { my $allow_bare_sigil = $_[0]; my $sigil = lex_peek(1); ($sigil eq '$' or $sigil eq '@' or $sigil eq '%') ? lex_read(1) : die("Not a valid variable name: " . read_tokenish); my $name = $sigil; my $escape_char = 0; if (lex_peek(2) eq '{^') { lex_read(2); $name .= '{^'; $name .= parse_name('escape-char variable', 0); lex_peek(1) eq '}' ? ( lex_read(1), ($name .= '}') ) : die("Expected closing brace after escape-char variable"); return $name; } if (lex_peek =~ /[\w:]/) { $name .= parse_name('variable', 1, 1); return $name; } if ($allow_bare_sigil) { return $name; } die "Expected variable name"; } sub parse_trait { my $name = parse_name('trait', 0); #lex_read_space; my $extracted; if (lex_peek eq '(') { my $peek = lex_peek(1000); $extracted = extract_bracketed($peek, '()'); lex_read(length $extracted); lex_read_space; $extracted =~ s/(?: \A\( | \)\z )//xgsm; } my $evaled = 1; if (defined $extracted) { my $ccstash = compiling_package; $evaled = eval("package $ccstash; no warnings; no strict; local \$SIG{__WARN__}=sub{die}; [$extracted]"); } ($name, $extracted, $evaled); } sub parse_block_or_match { lex_read_space; return parse_block(@_) if lex_peek eq '{'; require match::simple; my $___term = parse_arithexpr(@_); eval <<"CODE" or die("could not eval implied match::simple comparison: $@"); sub { local \$_ = \@_ ? \$_[0] : \$_; match::simple::match(\$_, \$___term->()); }; CODE } 1; API.pod000664001750001750 146112425206147 16422 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Manual=pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive yada globals =head1 NAME Kavorka::Manual::API - the introspection API =head1 DESCRIPTION TODO =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-2014 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. ExtendingKavorka.pod000664001750001750 571512425206147 21263 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Manual=pod =encoding utf-8 =for stopwords invocant invocants =head1 NAME Kavorka::Manual::ExtendingKavorka - extending Kavorka with traits and new keywords =head1 DESCRIPTION =head2 Traits Many of the code constructs handled by Kavorka allow a list of traits to be given. Subs can have traits: method xyz ($x, $y, $z) is friendly { ... } So can parameters within signatures: method xyz ($x is hot, $y does warm, $z but cool) { ... } And return types: method get_age (Date $date → Num $age is years) { ... } When a trait is used which isn't natively handled by L, L or L, Kavorka will attempt to load a L to handle the trait. These will be loaded from the following namespaces, as appropriate: =over =item * C<< Kavorka::TraitFor::Sub::* >> =item * C<< Kavorka::TraitFor::Parameter::* >> =item * C<< Kavorka::TraitFor::ReturnType::* >> =back For example, C. =head2 Trait Parameters Although none of Kavorka's native traits make use of this syntax, traits can be followed by trait parameters in parentheses: BEGIN { package Kavorka::TraitFor::Parameter::debug; use Moo::Role; around injection => sub { my $next = shift; my $self = shift; my $code = $self->$next(@_); $code .= sprintf( "printf STDERR %s, %s, %s;", B::perlstring($self->traits->{debug}[0]), B::perlstring($self->name), $self->name, ); return $code; }; } use Kavorka; fun foo ( $x but debug("%s is %s\n") ) { ## Injected: ## printf STDERR "%s is %s\n", "\$x", $x; return $x; } foo(42); # says to STDERR: '$x is 42' =head2 Keywords Traits are not applied to subs until I they've been parsed, which means that traits cannot, say, alter how the signature is parsed, because the signature occurs before the traits. For more advanced control over the parsing and behaviour of subs, you would need to create a new keyword. A keyword is just a L class which consumes the L role. L and L are simple examples of such keyword classes. People can use your new keyword like this: use Kavorka yourkeyword => { implementation => "Your::Class" }; =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-2014 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. Functions.pod000664001750001750 640712425206147 17766 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Manual=pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive yada globals =head1 NAME Kavorka::Manual::Functions - fun keyword =head1 DESCRIPTION Kavorka provides the C keyword for the purpose of defining functions (as against methods, etc). The anatomy of a function: =over =item 1. The keyword introducing the function. =item 2. The function name (optional). =item 3. The signature (optional). =item 4. Traits (optional). =item 5. The prototype (optional). =item 6. The attribute list (optional). =item 7. The function body. =back Example: # (1) (2) (3) (4) (5) (6) (7) fun foobar ($foo, $bar) is cool :($$) :cached { return $foo + $bar } # (1) (6) my $f = fun { return $_[0] + $_[1] }; =head2 The Keyword This requires very little explanation. If you're no fun, and don't like the name C, you can export it with a different name: use Kavorka fun => { -as => 'function' }; =head2 The Function Name If present, it specifies the name of the function being defined. If no name is present, the declaration is an expression that evaluates to a reference to the function in question. Functions are automatically forward-declared; a la sub foobar ($$); but are installed into the symbol table at run-time. So this works: if ($ENV{DEBUG}) { fun foobar { ... } } else { fun foobar { ... } } It is possible to install the function at compile time using the C L: fun foobar but begin { ... } It is possible to define lexical functions using a lexical variable for a function name: fun my $add ($x, $y) { $x + $y; } my $sum = $add->(20, 22); =head2 The Signature See L. =head2 Traits See L. =head2 The Prototype See L. =head2 The Attributes Attributes may alternatively be provided I<< before the signature >>. See L. =head2 The Function Body This is more or less what you'd expect from the function body you'd write with L, however the lexical variables for parameters are pre-declared and pre-populated. =head2 C<< f >>, C<< func >>, and C<< function >> These are all aliases for C<< fun >>, though not exported by default. use v5.14; use Kavorka qw( function f ); function make_plusser (Num $x = 1) { return f(Num $y) { $x + $y }; } my $plusser = make_plusser(); say $plusser->(41); # says 42 =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-2014 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. MethodModifiers.pod000664001750001750 656012425206147 21100 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Manual=pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive yada globals =head1 NAME Kavorka::Manual::MethodModifiers - before/after/around keywords =head1 DESCRIPTION Kavorka provides the C, C and C keywords for method modifiers. Method modifiers should work in L, L, L and L classes and roles. In other classes they will fall back to using L. The keywords C and C are also available, but will only work in classes backed by a framework that supports these modifiers (i.e. L or L, but I L). The anatomy of a method modifier: =over =item 1. The keyword introducing the method. =item 2. The method names. =item 3. The signature (optional). =item 4. Traits (optional). =item 5. The prototype (optional). =item 6. The attribute list (optional). =item 7. The modifier body. =back Example: # (1) (2) (3) (4) (5) (6) (7) after foobar ($foo) is cool :($) :cached { $self->log("foobar $foo") } =head2 The Keyword By default, these keywords are exported. They must be exported by request: use Kavorka qw( before after around ); use Kavorka qw( -modifiers ); =head2 The Method Names These are the names of the methods being wrapped. Multiple names may be separated by colons: after foo, bar, baz { ... } =head2 The Signature See L. The C and C keywords have a default invocant called C<< $self >>, but it does not have a type constraint, so can equally be used for class or object methods. The C modifier defines two invocants called C<< $next >> and C<< $self >>. (C<< ${^NEXT} >> is also available as an alias for C<< $next >> for backwards compatibility with Moops::MethodModifiers.) Beware using type constraints for method modifiers (which are essentially wrappers); constraints will be checked at each level of wrapping which will slow down method calls. =head2 Traits See L. =head2 The Prototype See L. Note however that prototypes are fairly useless for methods. =head2 The Attributes Attributes may alternatively be provided I<< before the signature >>. See L. Note that this applies the attribute to the modifier code, and not to the method being modified. =head2 The Modifier Body This is more or less what you'd expect from the modifier body you'd write with L, however the lexical variables for parameters are pre-declared and pre-populated, and invocants have been shifted off C<< @_ >>. =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-2014 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. Methods.pod000664001750001750 1143512425206147 17436 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Manual=pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive yada globals =head1 NAME Kavorka::Manual::Methods - method/classmethod/objectmethod keywords =head1 DESCRIPTION Kavorka provides the C, C and C keywords for the purpose of defining methods. The anatomy of a method: =over =item 1. The keyword introducing the method. =item 2. The method name (optional). =item 3. The signature (optional). =item 4. Traits (optional). =item 5. The prototype (optional). =item 6. The attribute list (optional). =item 7. The method body. =back Example: # (1) (2) (3) (4) (5) (6) (7) method foobar ($foo) is cool :($) :cached { return $foo + $self->bar } # (1) (6) my $m = method { return $_[0] + $self->bar }; =head2 The Keyword By default, only the C keyword is exported. The others can be exported by request: use Kavorka qw( method classmethod objectmethod ); =head2 The Method Name If present, it specifies the name of the method being defined. If no name is present, the declaration is an expression that evaluates to a reference to the method in question. Although methods are compiled at compile-time (and variables are closed over then), methods are installed into the class at run-time. So this works: if ($ENV{DEBUG}) { method foobar { ... } } else { method foobar { ... } } It is possible to add the method to the class at compile time using the C L: method foobar but begin { ... } This may be useful for role composition, if roles are composed before methods are defined, but the roles require certain methods to exist in your class. It is possible to define lexical (i.e. truly private) methods using a lexical variable for a method name: objectmethod get_name () { return $self->{name}; } objectmethod my $set_name (Str $new) { $self->{name} = $new; } $obj->$set_name("Bob"); $obj->get_name; # Bob See also: L. =head2 The Signature See L. The C keyword has a default invocant called C<< $self >>, but it does not have a type constraint, so can equally be used for class or object methods. The C keyword works the same, but does define a type constraint for C<< $self >>, requiring it to be a blessed object. The C keyword defines an invocant called C<< $class >> which has a type constraint requiring it to be a string. In any case, it is perfectly possible to define your own name and type constraint for the invocant: method foo ( ClassName $me: Int $foo ) { ... } =head2 Traits See L. Two traits for methods are bundled with Kavorka: C and C. The C trait will throw an exception if the method you are defining already exists in the inheritance hierarchy for this class. The idea of this trait is to increase safety when subclassing. Suppose a future release of your parent class adds a new method with the same name as one of yours, but differing functionality; your method would normally override the one in the parent class. With the C trait, an exception would be thrown, giving you opportunity to resolve the conflict. The C trait does the opposite; it will throw an exception if the method being defined I<< does not >> already exist. =head2 The Prototype See L. Note however that prototypes are fairly useless for methods. =head2 The Attributes Attributes may alternatively be provided I<< before the signature >>. See L. The C, C and C keywords automatically add the C<< :method >> attribute to methods. =head2 The Method Body This is more or less what you'd expect from the method body you'd write with L, however the lexical variables for parameters are pre-declared and pre-populated, and invocants have been shifted off C<< @_ >>. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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. MultiSubs.pod000664001750001750 704112425206147 17740 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Manual=pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive yada globals =head1 NAME Kavorka::Manual::MultiSubs - multi subs and multi methods =head1 DESCRIPTION Kavorka supports multi methods and multi subs: multi method process (ArrayRef $x) { say "here" } multi method process (HashRef $x) { say "there" } __PACKAGE__->process( [] ); # here __PACKAGE__->process( {} ); # there Multi subs and multi methods must be named (cannot be anonymous coderefs). This feature is shared with Perl 6 signatures, though Kavorka does not support some of Perl 6's more advanced features such as multi method prototypes. (Though method modifiers should more or less work with multi methods!) Kavorka includes both type constraints and value constraints in the dispatch decision, while Perl 6 only uses type constraints. =head2 Multi methods versus multi subs The word after C (i.e. C in the above example) can be any Kavorka keyword that has been set up in the current lexical scope, provided the implementation class provides a non-undef C method (see L). If the C is "fun" (like L), then the signature of each candidate function in package is checked in the order in which they were defined, and the first matching candidate is dispatched to. If the C is "method" (like L), then if no successful candidate is found in the current class, candidates in superclasses are also considered. =head2 Long names It is possible to define alternative "long names" for the candidates of a multi method or multi sub using the C<:long> attribute: multi fun process (ArrayRef $x) :long(process_array) { say "here"; } multi fun process (HashRef $x) :long(process_hash) { say "there"; } process($a); # multi dispatch process_array($b); # single dispatch process_hash($c); # single dispatch (Actually, C<< :long >> isn't a real attribute; we just borrow the syntax. If you try to use L' introspection stuff, you won't find it.) Prototypes, subroutine attributes, etc. declared on the multi subs will appear on the "long name" subs, but not the multi sub. =head2 Definition at run time Multi subs and multi methods are added to the symbol at run time (like methods, see L). This means that it's possible to partly define a multi sub, call it, then further define it, before calling it again. use Kavorka qw( multi fun ); use Try::Tiny; multi fun plus_one (Int $x) { $x + 1 } try { plus_one(41); # 42 plus_one(1.1); # throws }; multi fun plus_one (Num $x) { $x + 1 } plus_one(41); # 42 plus_one(1.1); # 2.1 =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014 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. PrototypeAndAttributes.pod000664001750001750 310512425206147 22505 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Manual=pod =encoding utf-8 =for stopwords invocant invocants lexicals unintuitive yada globals =head1 NAME Kavorka::Manual::PrototypeAndAttributes - the more rarely used features of Perl subroutines =head1 DESCRIPTION =head2 The Prototype Like with the L keyword, a prototype may be provided for functions. Method dispatch ignores this, so it's only likely to be useful for C, and even then, rarely. Like L, Kavorka uses C<< :(...) >> to indicate a prototype. This avoids ambiguity between signatures, prototypes and attributes. For compatibility with Perl 5.20, the special attribute C<< :prototype(...) >> is supported as an alternative mechanism for expressing prototypes. =head2 The Attributes Attributes are parsed as per L. For anonymous functions, some attributes (e.g. C<:lvalue>) may be applied too late to take effect. Attributes should mostly work for named functions though. =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-2014 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. Signatures.pod000664001750001750 4104112425206147 20153 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Manual=pod =encoding utf-8 =begin stopwords invocant invocants lexicals unintuitive yada globals ro rw boolification rightwards scalarref smartmatch smartmatch-like superset =end stopwords =head1 NAME Kavorka::Manual::Signatures - experience the lure of the animal =head1 DESCRIPTION The signature consists of a list of parameters for the function. Kavorka signatures are a superset of the sub signature syntax introduced in Perl 5.20 (well, 5.19.9 to be exact). See L. Each parameter is a variable name which will be available within the body of the function. Variable names are assumed to be lexicals unless they look like punctuation variables or escape-character global variables, in which case they'll be implicitly localized within the function. Parameters are separated with commas, however if one of the commas is replaced by a colon, all parameters to the left are assumed to be invocants and are shifted off C<< @_ >>. If no invocants are explicitly listed as part of the signature, the module implementing the keyword may assume a default invocant - for example, C assumes an invocant called C<< $self >> while C assumes two invocants called C<< $next >> and C<< $self >>. =head2 Positional parameters Parameters which are not explicitly named, slurpy or invocants, are positional. For example: method foo ( $x, $y ) { ... } Is roughly equivalent to: sub foo { my $self = shift; die "Expected two parameters" unless @_ == 2; my ($x, $y) = @_; ... } This feature is shared with Perl 5.20 signatures, Perl 6 signatures, L, and L. =head2 Invocants Invocants are a type of positional parameter, which instead of being copied from the C<< @_ >> array are shifted off it. Invocants are always required, and cannot have defaults. Some keywords (such as C<< method >> and C<< classmethod >>) provide a standard invocant for you (respectively C<< $self >> and C<< $class >>). You may specify invocants in the signature manually, in which case the default provided by the keyword is ignored. # The invocant is called $me instead of $self method ($me: $x, $y?) { ... } This feature is shared with Perl 6 signatures, L, and L. Unique to Kavorka is the ability to specify multiple invocants. =head2 Named parameters Parameters can be named by preceding them with a colon: method foo ( :$x, :$y ) { ... } The method would be called like this: $object->foo( x => 1, y => 2 ); Or this: $object->foo({ x => 1, y => 2 }); This feature is shared with Perl 6 signatures, L, and L. Positional parameters (if any) must precede named parameters. If you have any named parameters, they will also be made available in the magic global hash C<< %_ >>. If you pass a I (rather than a I) of named parameters, then C<< %_ >> will be an alias for the referenced hash. =head2 Long name parameters Named parameters can be given a different name "inside" and "outside" the function: fun bar ( :public_house($pub) ) { ... } The function would be called like this: bar( public_house => "Rose & Crown" ); ... But within the function, the variable would be named C<< $pub >>. This feature is shared with Perl 6 signatures. Long named parameters will be available in C<< %_ >> under their "outside" name, not their "inside" name. A function can have multiple long names: fun xxx ( :foo(:bar(:baz($x))) ) { ... } This unwieldy syntax is borrowed from Perl 6 signatures. Kavorka provides an experimental shortcut - you may omit the parentheses: fun xxx ( :foo :bar :baz $x ) { ... } =head2 Global variables The variables established by Kavorka are normally plain old lexicals (C variables). However, you can instead make them into localised package variables (C variables): fun xxx ( Int our $x ) { ... } Variables containing "::", the special globals C<< $_ >>, C<< @_ >>, and C<< %_ >>, and variables named like C<< ${^HELLO} >> are automatically localized. (The other special punctuation variables listed in L are not supported.) =head2 Optional and required parameters A trailing exclamation mark makes an attribute required. A trailing question mark makes an attribute optional. This feature is shared with Perl 6 signatures and L. In the absence of explicit indicators, positional parameters will be required unless a default is provided for them, and named parameters will be optional. You can not use named parameters and optional positional parameters in the same signature. For long named parameters, the trailing indicator should appear after the close parentheses: fun xxx ( :foo($x)! ) { ... } fun xxx ( :foo($x!) ) { ... } # NO! =head2 Slurpy parameters The final parameter in the signature may be an array or hash, which will consume all remaining arguments: fun foo ( $x, $y, %z ) { ... } foo(1..4); # %z is (3 => 4) This feature is shared with Perl 6 signatures, L, and L. A slurpy array may not be used if the signature contains any named parameters. Unique to Kavorka is the ability to specify slurpy arrayrefs or hashrefs. fun foo ( $x, $y, slurpy HashRef $z ) { ... } foo(1..4); # $z is { 3 => 4 } For slurpy references you should specify a type constraint (see L) so that Kavorka can create the correct type of reference. The variables C<< @_ >> and C<< %_ >> I<< may >> be used as slurpy parameters, I<< but only if their use as a parameter does not interfere with their usual meaning >>. # ok fun foo ( @_ ) { ...; } # disallowed because the @_ array would usually include $x fun bar ( $x, @_ ) { ...; } # ok because the invocant $x would usually be shifted off @_ fun baz ( $x: @_ ) { ...; } =head2 Type constraints Type constraints may be specified for each parameter in the signature: fun foo ( Int $x, HTTP::Tiny $y ) { ... } This feature is shared with Perl 6 signatures, L, and L. Type constraints are parsed as per C from L, which should mostly do what you mean. Type constraints for slurpy hashes and arrays are applied to each value in the hash or each item in the array. Type constraints for slurpy references are instead applied to the reference as a whole. Therefore the following are roughly equivalent: fun foo ( Str %z ) { my $z = \%z; ... } fun foo ( slurpy HashRef[Str] $z ) { ... } Type constraints may be surrounded with parentheses, in which case, instead of parsing them with C, they'll be evaluated (at compile time) as an expression which is expected to return a blessed L object, or any other value that L can coerce to a Type::Tiny object. use Types::Standard qw( LaxNum StrictNum ); fun foo ( ($ENV{AUTOMATED_TESTING} ? StrictNum : LaxNum) $x ) { ...; } This feature is shared with L. =head2 Value constraints Value constraints can be used to further constrain values. Value constraints are specified using the C keyword followed by a block. fun foo ( Int $even where { $_ % 2 == 0 } ) Multiple C blocks may be provided: fun foo ( Int $even where { $_ % 2 == 0 } where { $_ > 0 } ) This feature is shared with Perl 6 signatures and L. A smartmatch-like shortcut is supported: # This is a shortcut: # method foo ( Int $x where TERM ) { ... } # For this: # use match::simple (); method foo ( Int $x where { match::simple::match($_, TERM) } ) { ... } However, the use of any lexical variables within the term is currently broken. =head2 Defaults Defaults may be provided using an equals sign: fun foo ( $greeting = "Hello world" ) { ... } This feature is shared with Perl 5.20 signatures, Perl 6 signatures, L, and L. Kavorka will use the default if the argument is not given when the function is invoked. If an explicit undef is passed to the function when it is called, this is accepted as the value for the parameter, and the default is not used. If instead you want the default to take effect when an explicit undef is passed to the function, use C<< //= >>: fun foo ( $greeting //= "Hello world" ) { ... } This feature is shared with L. Kavorka doesn't support Method::Signatures' C keyword. C<< ||= >> is also supported for setting defaults. It kicks in when any false value (undef, zero, the empty string, or objects overloading boolification to return false) is passed to the function, though this is rarely of much use. Slurpy parameters may take defaults: fun foo ( @bar = (1, 2, 3) ) { ... } For slurpy references, the syntax is a little unintuitive: fun foo ( slurpy ArrayRef $bar = (1, 2, 3) ) { ... } B<< Caveat: >> unlike Perl 5.20 signatures, the following B<< does not work >>: fun foo ($x, $y = $x) { ... } The lexical variable C<< $x >> has scope in the body of the sub, but not within the signature itself, so it cannot be used as the default value for C<< $y >>. This can be worked around by making C<< $x >> a package variable: fun foo (our $x, $y = our $x) { ... } Or simply set the default manually in the body of the function. fun foo ($x, $y?) { $y = $x if @_ == 1; ...; } You hadn't forgotten how to do that already, had you? =head2 Traits Traits may be added to each parameter using the C keyword: fun foo ( $greeting is polite = "Hello world" ) { ... } fun bar ( $baz is quux is xyzzy ) { ... } This feature is shared with Perl 6 signatures and L. The keywords C and C are also available which are simply aliases for C. Many traits are recognized by Kavorka natively. If you use an unrecognized trait, such as C, Kavorka will attempt to load it as a Moo::Role (see L). The traits Kavorka understands natively are: =head3 alias This makes your lexical variable into an alias for an item within the C<< @_ >> array. fun increment (Int $i is alias) { ++$i } my $count = 0; increment($count); increment($count); increment($count); say $count; # says 3 But please don't use this for parameters with coercions! This feature is shared with L. =head3 assumed Switches off the type constraint check, though the original type constraint is still visible through the introspection API. fun increment (Int $i is alias but assumed) { ++$i } my $count = 1.1; increment($count); # called incorrectly but will not die This can be used to switch off slow type constraint checks while keeping the original type constraint in the signature to express your intent. This trait cannot be used in multi subs, where the type check is instrumental in deciding which candidate sub to dispatch to. It I be used in conjunction with the C trait, in which case the type constraint I be checked to determine whether coercion is necessary, but no type check will be performed on the result of the coercion. =head3 coerce See L below. =head3 copy This is the opposite of alias, and is the default. It makes the lexical variable a (very shallow) copy of the argument from C<< @_ >>. That is, it's equivalent to doing: my $param = $_[$i]; # whereas the `alias` trait does this... Data::Alias::alias(my $param = $_[$i]); =head3 locked This locks hash(ref) keys - see L. For references this trait has the unfortunate side-effect of leaving the hashref locked I the function too! This trait has special support for the C type constraint from L, including optional keys in the list of allowed keys, unless the type constraint includes a C component. fun foo (HashRef $x is locked) { $x->{foo} = 1; } my $var1 = { foo => 42 }; foo($var1); say $var1->{foo}; # says 1 my $var2 = { bar => 42 }; foo($var2); # dies =head3 optional The C and C syntax is just a shortcut for applying or not applying this trait. fun foo ($x is optional) { ... } # These two declarations fun foo ($x?) { ... } # are equivalent. =head3 ref_alias The C trait allows you to pass an arrayref, hashref or scalarref to the function, and have it available as a plain array, hash or scalar. For example: fun get_key_from_hash(%h is ref_alias, $key) { return $h{$key}; } my %data = ( foo => 42 ); get_key_from_hash(\%data, 'foo'); # returns 42 It's the only useful way to define non-slurpy hash or array parameters within a signature. A backslash before the variable name can be used as a shortcut for this trait: fun get_key_from_hash(\%h, $key) { return $h{$key}; } This feature is shared with L. =head3 ro This makes the parameter a (shallow) read-only variable. fun foo ($x is ro) { $x++ } foo(42); # dies This feature is shared with Perl 6 signatures. =head3 rw This is the default, so is a no-op, but if you have a mixture of read-only and read-write variables, it may aid clarity to explicitly add C to the read-write ones. =head3 slurpy The slurpy prefix to the type constraint is just a shortcut for a trait. fun foo ( ArrayRef $bar is slurpy ) { ... } # These two declarations fun foo ( slurpy ArrayRef $bar ) { ... } # are equivalant =head2 Type coercion Coercion can be enabled for a parameter using the C trait. use Types::Path::Tiny qw(AbsPath); method print_to_file ( AbsFile $file does coerce, Str @lines ) { $file->spew(@lines); } This feature is shared with L. =head2 The Yada Yada Normally passing additional parameters to a function declared with a signature will throw an exception: fun foo ($x) { return $x; } foo(1, 2); # error - too many arguments Adding the yada yada operator to the end of the signature allows the function to accept extra trailing parameters: fun foo ($x, ...) { return $x; } foo(1, 2); # ok This feature is shared with L. See also L. =head2 Return types After a Unicode rightwards arrow character (C<< → >>) or the ASCII equivalent (C<< --> >>), you may list return type constraints. For a function which takes three values and returns an integer: fun foo ($a, $b, $c → Int) { ... } It is possible to include a return type for functions which take no parameters: fun foo (→ Int) { ... } For a function which returns a list in list context, you can use the C and C traits to specify return types for each context. fun foo ($a → Int is scalar, ArrayRef[Int] is list) { ... } Note that the list of returned values is validated as if it were an arrayref (or a hashref if that seems more appropriate). If no type constraint is provided for list context, then the type constraint is assumed to be an arrayref of whatever type constraint was given for scalar context. Return types can be coerced: fun foo ($a → Int does coerce) { ... } Return types are implemented using L which adds a wrapper around your function. Although this wrapper should be invisible to C (thanks to L), it does add some overhead to your function calls, so return types are a feature to use conservatively. If a return type has the C trait, it will I be checked at run time; we just assume the function is doing its job properly and returning an appropriate value. This avoids the overhead of checking return types at run time, but still includes the return type constraint in the introspection API. fun plus_one (Int $x → Int but assumed) { # No need to check return type. # If $x is an Int, then $x+1 must be too! return $x + 1; } =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-2014 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. After.pm000664001750001750 31612425206147 16176 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Subuse 5.014; use strict; use warnings; package Kavorka::Sub::After; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo; with 'Kavorka::MethodModifier'; sub method_modifier { 'after' } 1; Around.pm000664001750001750 112612425206147 16405 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Subuse 5.014; use strict; use warnings; package Kavorka::Sub::Around; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo; with 'Kavorka::MethodModifier'; sub default_invocant { my $self = shift; return ( 'Kavorka::Parameter'->new( name => '$next', traits => { invocant => 1 }, ), 'Kavorka::Parameter'->new( name => '$self', traits => { invocant => 1 }, ), ); } sub method_modifier { 'around' } around inject_prelude => sub { my $next = shift; my $self = shift; return join '' => ( '*{^NEXT} = \\$_[0];', $self->$next(@_), ); }; 1; Augment.pm000664001750001750 32212425206147 16532 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Subuse 5.014; use strict; use warnings; package Kavorka::Sub::Augment; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo; with 'Kavorka::MethodModifier'; sub method_modifier { 'augment' } 1; Before.pm000664001750001750 32012425206147 16332 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Subuse 5.014; use strict; use warnings; package Kavorka::Sub::Before; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo; with 'Kavorka::MethodModifier'; sub method_modifier { 'before' } 1; ClassMethod.pm000664001750001750 64712425206147 17352 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Subuse 5.014; use strict; use warnings; use Kavorka::Parameter (); use Types::Standard (); package Kavorka::Sub::ClassMethod; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo; extends 'Kavorka::Sub::Method'; sub default_invocant { my $self = shift; return ( 'Kavorka::Parameter'->new( name => '$class', traits => { invocant => 1 }, type => Types::Standard::Str, ), ); } 1; Fun.pm000664001750001750 53512425206147 15670 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Subuse 5.014; use strict; use warnings; package Kavorka::Sub::Fun; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo; with 'Kavorka::Sub'; sub invocation_style { 'fun' } sub forward_declare { my $self = shift; my $name = $self->qualified_name; eval sprintf("sub %s %s;", $name, $self->inject_prototype) if defined $name; } 1; Method.pm000664001750001750 71512425206147 16360 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Subuse 5.014; use strict; use warnings; use Kavorka::Parameter (); package Kavorka::Sub::Method; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo; with 'Kavorka::Sub'; sub invocation_style { 'method' } sub default_attributes { return ( ['method'], ); } sub default_invocant { my $self = shift; return ( 'Kavorka::Parameter'->new( as_string => '$self:', name => '$self', traits => { invocant => 1 }, ), ); } 1; ObjectMethod.pm000664001750001750 65212425206147 17507 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Subuse 5.014; use strict; use warnings; use Kavorka::Parameter (); use Types::Standard (); package Kavorka::Sub::ObjectMethod; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo; extends 'Kavorka::Sub::Method'; sub default_invocant { my $self = shift; return ( 'Kavorka::Parameter'->new( name => '$self', traits => { invocant => 1 }, type => Types::Standard::Object, ), ); } 1; Override.pm000664001750001750 32412425206147 16713 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/Subuse 5.014; use strict; use warnings; package Kavorka::Sub::Override; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo; with 'Kavorka::MethodModifier'; sub method_modifier { 'override' } 1; Bad.pm000664001750001750 24012425206147 14765 0ustar00taitai000000000000Kavorka-0.036/t/lib/Localuse v5.14; use warnings; package Local::Bad; use Kavorka; sub create { my ($class, $config) = @_; return $foo->bar($config); } method delete { ... } 1; Dancer2.pm000664001750001750 1232412425206147 21210 0ustar00taitai000000000000Kavorka-0.036/examples/dancer2/lib/KavorkaXuse v5.14; my @methods = qw( GET HEAD POST PATCH DELETE OPTIONS PUT ); my $methods = join('|', map quotemeta, @methods); # Wire up KavorkaX::Dancer2 to be able to export not only # Dancer-specific keywords, but also Kavorka built-ins. # package KavorkaX::Dancer2 { use Moo; extends qw( Kavorka ); our @EXPORT = ( @methods, qw( ANY prefix hook ), @Kavorka::EXPORT ); our @EXPORT_OK = ( @methods, qw( ANY prefix hook ), @Kavorka::EXPORT_OK ); our %EXPORT_TAGS = ( 'http' => [ @methods, qw( ANY ) ], 'dancer' => [ @methods, qw( prefix hook ) ], %Kavorka::EXPORT_TAGS, ); our %IMPLEMENTATION = ( prefix => 'KavorkaX::Dancer2::Sub::Prefix', hook => 'KavorkaX::Dancer2::Sub::Hook', ); sub guess_implementation { my $me = shift; my ($name) = @_; $IMPLEMENTATION{$name} or $me->SUPER::guess_implementation(@_) or 'KavorkaX::Dancer2::Sub::HTTP'; } } # A role used by most of the KavorkaX::Dancer2 keywords. # Instead of the sub name being a bareword, allows it to # be a URL route or regexp. Stashes the sub name in the # http_route attribute instead of declared_name attribute # to protect it from attempts at package-qualification! # package KavorkaX::Dancer2::RoutingSub { use Parse::Keyword; use Text::Balanced qw( extract_quotelike ); use Moo::Role; with qw( Kavorka::Sub ); has http_route => (is => 'rwp'); sub is_anonymous { 1 } sub install_sub { die; } sub parse_subname { my $self = shift; $self->_set_declared_name('__ANON__'); lex_read_space; my $peek = lex_peek(1000); my $route; # Quoted if ($peek =~ /\A(qr\b|qq\b|q\b|'|")/) { my ($quote) = extract_quotelike($peek); lex_read(length $quote); defined($quote) or Carp::croak("extract_quotelike failed!"); $route = eval($quote); } # Bare elsif ($peek =~ /\A(\S+)\s/) { $route = $1; lex_read(length $route); } $self->_set_http_route($route); lex_read_space; (); } sub http_route_variables { my $self = shift; my $route = $self->http_route; return if ref($route); return if !defined($route); $route =~ m{:(\w+)}g; } } # A role used for GET, HEAD, etc. Allows comma-separated # keywords when parsing the sub, injects a prelude that # sets of lexical variables for variables found in the URL # route, and performs suitable installation of the route. # package KavorkaX::Dancer2::Sub::HTTP { use Parse::Keyword; use Moo; with qw( KavorkaX::Dancer2::RoutingSub ); has http_methods => (is => 'ro', default => sub { [] }); sub install_sub { my $self = shift; my $app = $self->package->can('dancer_app')->(); for my $method (map lc, @{$self->http_methods}) { $app->add_route( method => $method, regexp => $self->http_route, code => $self->body, options => {}, ); } (); } around parse => sub { my $next = shift; my $class = shift; # This allows GET,HEAD /foo { ... } my @more_methods; lex_read_space; while (lex_peek eq ',') { lex_read(1); lex_read_space; Carp::Croak("Not a valid HTTP Method: ".lex_peek(12)) unless lex_peek(12) =~ /\A($methods)/; push @more_methods, $1; lex_read( length $more_methods[-1] ); lex_read_space; } my $self = $class->$next(@_); my $kw = $self->keyword; push @{$self->http_methods}, (lc $kw eq 'any') ? @methods : lc($kw); push @{$self->http_methods}, @more_methods; return $self; }; sub http_prefix_variables { my $self = shift; my $route = $KavorkaX::Dancer2::PREFIX; return if ref($route); return if !defined($route); $route =~ m{:(\w+)}g; } around inject_prelude => sub { my $next = shift; my $self = shift; my $prelude = $self->$next(@_); for my $var ( $self->http_route_variables ) { $prelude .= sprintf('my $%s = params->{%s};', $var, B::perlstring($var)); } for my $var ( $self->http_prefix_variables ) { $prelude .= sprintf('$%s = params->{%s};', $var, B::perlstring($var)); } $prelude .= '();'; return $prelude; }; } package KavorkaX::Dancer2::Sub::Prefix { use Parse::Keyword; use Moo; with qw( KavorkaX::Dancer2::RoutingSub ); sub install_sub { my $self = shift; my $app = $self->package->can('dancer_app')->(); return $app->lexical_prefix( $self->http_route, $self->body, ); } around inject_prelude => sub { my $next = shift; my $self = shift; my $prelude = $self->$next(@_); for my $var ( $self->http_route_variables ) { $prelude .= sprintf('my $%s;', $var); } $prelude .= '();'; return $prelude; }; around parse_body => sub { my $next = shift; my $self = shift; local $KavorkaX::Dancer2::PREFIX = $self->http_route; $self->$next(@_); }; } package KavorkaX::Dancer2::Sub::Hook { use Parse::Keyword; use Moo; with qw( Kavorka::Sub ); sub is_anonymous { 1 } sub install_sub { my $self = shift; my $app = $self->package->can('dancer_app')->(); return $app->add_hook( Dancer2::Core::Hook->new( name => $self->declared_name, code => $self->body, ), ); } around inject_prelude => sub { my $next = shift; my $self = shift; my $prelude = $self->$next(@_); if ($self->declared_name eq 'after') { $prelude .= 'my $response = shift;();'; } return $prelude; }; } 1; alias.pm000664001750001750 173412425206147 21174 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/Parameteruse 5.014; use strict; use warnings; package Kavorka::TraitFor::Parameter::alias; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; around _injection_assignment => sub { my $next = shift; my $self = shift; my ($sig, $var, $val) = @_; if ($self->kind eq 'my') { require Data::Alias; return sprintf('Data::Alias::alias(my %s = do { %s });', $var, $val); } elsif ($self->kind eq 'our') { (my $glob = $var) =~ s/\A./*/; return sprintf('our %s; local %s = \\do { %s };', $var, $glob, $val); } else { (my $glob = $var) =~ s/\A./*/; return sprintf('local %s = \\do { %s };', $glob, $val); } }; after sanity_check => sub { my $self = shift; my $traits = $self->traits; my $name = $self->name; croak("Parameter $name cannot be an alias and coerce") if $traits->{coerce}; croak("Parameter $name cannot be an alias and a copy") if $traits->{copy}; croak("Parameter $name cannot be an alias and locked") if $traits->{locked}; }; 1; assumed.pm000664001750001750 33712425206147 21522 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/Parameteruse 5.014; use strict; use warnings; package Kavorka::TraitFor::Parameter::assumed; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; around _injection_conditional_type_check => sub { q() }; 1; locked.pm000664001750001750 201112425206147 21331 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/Parameteruse 5.014; use strict; use warnings; package Kavorka::TraitFor::Parameter::locked; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; use Hash::Util; use Types::Standard qw(Dict); around _injection_assignment => sub { my $next = shift; my $self = shift; my ($sig, $var, $val) = @_; my $str = $self->$next(@_); state $_FIND_KEYS = sub { return unless $_[0]; my ($dict) = grep { $_->is_parameterized and $_->has_parent and $_->parent->strictly_equals(Dict) } $_[0], $_[0]->parents; return unless $dict; return if ref($dict->parameters->[-1]) eq q(HASH); my @keys = sort keys %{ +{ @{ $dict->parameters } } }; return unless @keys; \@keys; }; my $legal_keys = $_FIND_KEYS->($self->type); my $quoted_keys = $legal_keys ? join(q[,], q[], map B::perlstring($_), @$legal_keys) : ''; my $ref_var = $self->sigil eq '$' ? $var : "\\$var"; $str .= "&Hash::Util::unlock_hash($ref_var);"; $str .= "&Hash::Util::lock_keys($ref_var $quoted_keys);"; return $str; }; 1; optional.pm000664001750001750 64612425206147 21711 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/Parameteruse 5.014; use strict; use warnings; package Kavorka::TraitFor::Parameter::optional; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; around _injection_default_value => sub { my $next = shift; my $self = shift; @_ = ('undef') unless @_; $self->$next(@_); }; after sanity_check => sub { my $self = shift; my $name = $self->name; croak("Bad parameter $name") if $self->invocant; }; 1; ref_alias.pm000664001750001750 123212425206147 22021 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/Parameteruse 5.014; use strict; use warnings; package Kavorka::TraitFor::Parameter::ref_alias; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; around _injection_assignment => sub { my $next = shift; my $self = shift; my ($sig, $var, $val) = @_; if ($self->kind eq 'my') { require Data::Alias; return sprintf('Data::Alias::alias(my %s = %s{ +do { %s } });', $var, $self->sigil, $val); } elsif ($self->kind eq 'our') { (my $glob = $var) =~ s/\A./*/; return sprintf('our %s; local %s = do { %s };', $var, $glob, $val); } else { (my $glob = $var) =~ s/\A./*/; return sprintf('local %s = do { %s };', $glob, $val); } }; 1; ro.pm000664001750001750 106112425206147 20514 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/Parameteruse 5.014; use strict; use warnings; package Kavorka::TraitFor::Parameter::ro; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; around _injection_assignment => sub { my $next = shift; my $self = shift; my ($sig, $var, $val) = @_; my $str = $self->$next(@_); $str .= sprintf( '&Internals::SvREADONLY(\\%s, 1);', $var, ); return $str; }; after sanity_check => sub { my $self = shift; my $traits = $self->traits; my $name = $self->name; croak("Parameter $name cannot be rw and ro") if $traits->{rw}; }; 1; assumed.pm000664001750001750 35312425206147 21721 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/ReturnTypeuse 5.014; use strict; use warnings; package Kavorka::TraitFor::ReturnType::assumed; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; use Types::Standard qw(Any); around _effective_type => sub { Any }; 1; begin.pm000664001750001750 56112425206147 17755 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/Subuse 5.014; use strict; use warnings; package Kavorka::TraitFor::Sub::begin; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; use namespace::sweep; around _build__tmp_name => sub { my $next = shift; my $self = shift; return $self->$next(@_) unless defined $self->invocation_style; $self->qualified_name or $self->$next(@_); }; 1; fresh.pm000664001750001750 227612425206147 20025 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/Subuse 5.014; use strict; use warnings; package Kavorka::TraitFor::Sub::fresh; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; use Types::Standard qw(Any); use Sub::Util (); use Carp qw(croak); use namespace::sweep; my $stash_name = sub { Sub::Util::subname($_[0]) =~ m/^(.+)::(.+?)$/ ? $1 : undef; }; before install_sub => sub { my $self = shift; croak("The 'fresh' trait cannot be applied to lexical methods") if $self->is_lexical; croak("The 'fresh' trait cannot be applied to anonymous methods") if $self->is_anonymous; croak("The 'fresh' trait may only be applied to methods") if $self->invocation_style ne 'method'; my ($pkg, $name) = ($self->qualified_name =~ /^(.+)::(\w+)$/); my $existing = $pkg->can($name) or return; my $existing_source = $stash_name->($existing); if ($pkg->isa($existing_source) or $existing_source eq 'UNIVERSAL') { croak("Method '$name' is inherited from '$existing_source'; not fresh"); } if ($pkg->DOES($existing_source)) { croak("Method '$name' is provided by role '$existing_source'; not fresh"); } croak("Method '$name' already exists in inheritance hierarchy; possible namespace pollution; not fresh"); }; 1; override.pm000664001750001750 137012425206147 20527 0ustar00taitai000000000000Kavorka-0.036/lib/Kavorka/TraitFor/Subuse 5.014; use strict; use warnings; package Kavorka::TraitFor::Sub::override; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.036'; use Moo::Role; use Types::Standard qw(Any); use Carp qw(croak); use namespace::sweep; before install_sub => sub { my $self = shift; croak("The 'override' trait cannot be applied to lexical methods") if $self->is_lexical; croak("The 'override' trait cannot be applied to anonymous methods") if $self->is_anonymous; croak("The 'override' trait may only be applied to methods") if $self->invocation_style ne 'method'; my ($pkg, $name) = ($self->qualified_name =~ /^(.+)::(\w+)$/); return if $pkg->can($name); croak("Method '$name' does not exist in inheritance hierarchy; cannot override"); }; 1;