List-Objects-WithUtils-2.028003000755000764000031 012701513023 15063 5ustar00avenjat000000000000Changes100644000764000031 2730512701513023 16466 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003Revision history for Perl module List::Objects::WithUtils 2.028003 2016-04-07 - Minor hash->get optimization 2.028002 2016-04-04 - Fix hash->random_kv & hash->random_key to return explicit undef when called on empty lists - array->tuples with a type specified will no longer fail type checks/coercions on incomplete tuples - Various optimizations wrt array->tuples, hash->set 2.028001 2016-01-25 - Add hash->random_kv / random_key / random_value 2.027002 2016-01-12 - Use perl-5.20+ hash slice syntax for hash->sliced if available - Add documentation regarding installing '$a'/'$b' from custom types - Expand test coverage 2.027001 2016-01-08 - Add array->squished 2.026001 2016-01-07 - Add array->pick - Add array->repeated - Add array->roll 2.025001 2015-11-26 - Allow use of any Type::API-conforming object with array_of/hash_of 2.024001 2015-11-23 - Add support for returning blessed array-type objects from array->tuples - Minor array->rotate optimization - Minor constructor optimizations 2.023002 2015-11-17 - Fix array->nsect without arguments 2.023001 2015-11-13 - Add array->part_to_hash (Inspired by YANICK in List::MoreUtils PR#15) - Documentation fixes; explicitly document array->zip alias for array->mesh 2.022001 2015-07-16 - array->indexes without arguments returns the complete list of available indexes - Drop List::MoreUtils support 2.021003 2015-02-27 - 'use strictures 2;' for saner fatal warning behavior 2.021002 2015-01-25 - Fix autoboxed []->rotate_in_place - Minor array->natatime optimizations 2.021001 2014-12-05 - Add hash->kv_grep 2.020001 2014-12-01 - Support $a/$b variables for use with hash->kv_map - Add simple Moo attribute example to examples/ 2.019001 2014-11-30 - Support $a/$b variables for use with hash->kv_sort - Kill 'used only once' warnings for $a/$b for all array and hash types 2.018001 2014-11-30 - Support $a/$b variables for use with array->sort/reduce/foldr 2.017002 2014-11-06 - cpanfile fixes; explicitly require autobox 2.017001 2014-11-06 - Add array->foldr($sub), alias array->foldl to array->reduce - Switch to 'cpanfile' dependency management 2.016001 2014-10-13 - Add TO_ZPL for Text::ZPL compatibility 2.015001 2014-09-08 - Add hash->get_path - Reorganize Role::Hash POD 2.014002 2014-07-23 - Fix hash->inverted test 2.014001 2014-07-22 - Add hash->inverted - Alias array->size -> array->count 2.013001 2014-07-01 - Add array->exists($idx) (requested by TOBYINK) - Add array->defined($idx) - Pass requested index/key to ->get_or_else() builder subs 2.012001 2014-06-26 - Add array->get_or_else / hash->get_or_else - Fix array->insert($pos => @vals) - Add ->untyped method for use in method chains involving typed objects 2.011002 2014-06-24 - Fix array->has_any(sub { !defined }) 2.011001 2014-06-22 - Add array->nsect, array->ssect - Optimize hash->set 2.010002 2014-04-16 - Fix array->sliced to avoid backfilling undefs if requesting position(s) past the end of the array - Fix array->insert to backfill undefs if inserting to a position past the end of the array - Fix array->rotate on an empty array - Fix array->delete_when to localize *_ (not $_) for consistency - Expand regression tests for empty array behavior 2.010001 2014-03-19 - Drop List::MoreUtils from required dependencies. List::MoreUtils is used almost everywhere, but is not in core and was a bit abandoned the last few years. It has been adopted upstream, which is wonderful, but the development versions are taking List::MoreUtils in directions I don't understand; rather than the small module providing fast XS implementations of simple and common list operations that I'm used to, this is turning into some sort of behemoth containing confusing "implementation sets" and depending upon half of CPAN. Not good, do not want. Users with 0.3x versions of List::MoreUtils will still get faster implementations of the following array operations: indexes uniq first_index last_index last_where items_after items_after_incl items_before items_before_incl Users with 0.4 development versions of List::MoreUtils will fall back to pure-Perl implementations for now. 2.009001 2014-03-05 - Add hash->iter - POD fixes 2.008002 2014-01-12 - Fix hash->kv_map on 5.8.x/5.10.0 2.008001 2014-01-11 - Add hash->kv_map - Fix autoboxed []->tuples(), []->validated() 2.007001 2013-12-28 - Add array->rotator(), array->visit() - Add hash->maybe_set() 2.006001 2013-12-26 - Add array->intersection(), array->diff(), hash->diff() 2.005001 2013-12-22 - Add array->indexes() (from List::MoreUtils) - Add array->last_index, array->last_where - array->first moved to array->first_where; backwards compatible ->first remains for now, but may be eventually placed in a warn-then-remove deprecation cycle. - Add array->first_index (same as ->firstidx); these changes should add some sanity to first/last method naming (first_where, first_index, last_where, last_index) 2.004003 2013-12-19 - Run non-XS List::UtilsBy tests if Test::Without::Module is available 2.004002 2013-12-17 - Use List::UtilsBy::XS if available (TOBYINK rt#91461) 2.004001 2013-12-15 - Add array->rotate(), array->rotate_in_place() - Optimize hash->new() 2.003001 2013-12-14 - Add hash->intersection() - Minor optimizations - Fix unnecessary List::Objects::Types dep in some tests 2.002005 2013-12-13 - Fix single-arg array->splice() 2.002004 2013-12-06 - Minor low-level behavior changes; bring Role::Hash in line with Role::Array blessed_or_pkg & ->copy - Test coverage improvements 2.002003 2013-12-06 - Bad import args now die rather than warn - Optimize methods returning arrays - hash->new() matches array->new() behavior - Test coverage improvements 2.002002 2013-11-22 - Drop Hash::Util in favor of tied immutable hashes; these now work just like immutable array types (and no longer throw an exception on unknown key fetches) 2.002001 2013-10-27 - Add ->is_mutable / ->is_immutable methods - Add array->kv() - Add array->elements() (This is the same as '->all', but it's natural for people coming from Moose and similar to the perl6 'elems' method.) 2.001001 2013-10-03 - Import all constructor functions by default (via 'use List::Objects::WithUtils') - Add 'immhash' immutable hashes - Add 'immarray_of' and 'immhash_of' immutable type-checking lists - New array methods: delete_when(), end(), inflate() - hash()->clear returns the hash object - Immutable array behavior should now work consistently across any perl version; no longer mucking about with Internals::SvREADONLY - Immutable & type-checking behavior moved to roles - Role::WithJunctions moved to Role::Array::WithJunctions - t/ reorganized to be slightly more managable 1.012001 2013-09-16 - Add hash->kv_sort() 1.011001 2013-09-08 - Depend on newer Type::Tie (we need SPLICE) 1.011000 2013-09-05 - Add 'hash_of' (List::Objects::WithUtils::Hash::Typed) (Toby Inkster - github PR #3) These hashes perform type-checking on their values via Type::Tie. - List::Objects::WithUtils/Lowu now accept ':functions' import tag (':all' without autobox) - Array::Type now uses a Type::Tie tied array (Toby Inkster - github PR #2) This is faster (no more overload or method overrides), and allows for 'push @$typedarr, $foo' with type coercion/checking. 1.010002 2013-09-04 - Fix array->tuples() to skip adding unnecessary undefs - Fix immarray->tuples() 1.010001 2013-09-01 - Fix array_of() assertions on non-coercible types 1.010000 2013-09-01 - Add 'array_of' (List::Objects::WithUtils::Array::Typed) These array-type objects perform Type::Tiny-compatible type-checking against their elements (when constructed and when elements are added). - Add array()->tuples (with Type::Tiny support) - Add array()->validated($type) 1.009005 2013-09-01 - Add array()->mapval (borrowed from Data::Munge) - Drop minimum Perl prereq to perl-5.6 1.009004 2013-08-23 - Pass tests on 5.19.3 - carp() on unknown import tags 1.009003 2013-08-10 - Fix ->flatten(_all) on 5.8 1.009002 2013-08-09 - No code changes. Fix 'Changes' to match CPAN::Changes::Spec, courtesy of Sergey Romanov -> https://github.com/avenj/list-objects-withutils/pull/1 1.009001 2013-08-09 - Fix ->flatten(_all) behavior regarding ARRAY-type objects; consumers of List::Objects::WithUtils::Role::Array are flattened, other ARRAY-type objects should be left alone.` 1.009000 2013-08-02 - Add array()->random - POD fixes 1.008000 2013-07-06 - Add array()->flatten($depth) 1.007000 2013-06-30 - Backwards incompatible change; the return value of hash->set() is now the object, in order to be consistent with array->set() - Fix hash->get(@keys) return value - Add array()->flatten_all - Reorganize Role::Array POD 1.006001 2013-06-22 - Fix ->inflate() on autoboxed hashes; add test for same. 1.006000 2013-06-22 - Add hash->inflate() to simplify creating little struct-like objects out of hashes. - Add a ->TO_JSON method to array and hash objects. (Serializing these objects to JSON is a pretty common use case for me.) 1.005000 2013-06-21 - Turn junctions into List::Objects::WithUtils::Array subclasses, allowing easier junction manipulation. - Minor ->sort() optimization. 1.004000 2013-06-19 - Implement streamlined junctions. This removes Sub::Exporter from the dependency chain; additionally, we do not need the extra methods - and probably do not want the smart-match support - provided by Perl6::Junction and Syntax::Keyword::Junction. 1.003001 2013-06-16 - Missing dep on 'parent' 1.003000 2013-06-16 - Add 'use Lowu;' shortcut to import all available functionality. - Add autoboxing support via List::Objects::WithUtils::Autobox and make autoboxing available via "use List::Objects::WithUtils 'autobox'" (as well as the 'use Lowu;' shortcut) - More flexible import() in List::Objects::WithUtils; allows for exporting selected functionality to designated target packages. - Added 'all'/':all' import tags to List::Objects::WithUtils; bare import list still just enables array/immarray/hash, 'all' adds autoboxing. - Add array()->export to line up with hash()->export. - POD improvements. 1.002002 2013-06-15 - Fix CarpLevel for unimplemented immutable array object methods 1.002001 2013-06-03 - Simplify read-only array constructor - Cleanups / test tweaks 1.002000 2013-06-03 - Add immarray() immutable array objects - Add hash->copy() to match array->copy() - Add array->head(), array->tail() methods - POD, test fixups 1.001001 2013-06-02 - Sanity check ->mesh() arguments. - Other minor cleanups. 1.001000 2013-06-02 - Add array->part() 1.000003 2013-06-02 - Add array->mesh() 1.000002 2013-05-19 - Documentation tweaks. 1.000001 2013-05-10 - Minor documentation fix (->natatime's iterator returns a list, not an ARRAY) 1.000000 2013-05-05 - Documentation shuffle. - No functional changes. 0.003000 2013-03-16 - Add hash->sliced() 0.002004 2013-03-14 - Documentation fixes. 0.002003 2013-03-10 - Fix missing POD for array->natatime with coderef callback. 0.002002 2013-03-10 - POD cleanups, some small fixes. - New release tests and rectify missing test for array->join 0.002001 2013-03-10 - Missing dependency in dist.ini 0.002000 2013-03-10 - Add Junctions via Role::WithJunctions ( array->any_items / array->all_items ) 0.001001 2013-03-10 - Initial release LICENSE100644000764000031 4365212701513023 16203 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003This software is copyright (c) 2016 by Jon Portnoy. 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) 2016 by Jon Portnoy. 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) 2016 by Jon Portnoy. 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 dist.ini100644000764000031 263712701513023 16620 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003name = List-Objects-WithUtils author = Jon Portnoy license = Perl_5 copyright_holder = Jon Portnoy copyright_year = 2016 version = 2.028003 [@Basic] [MetaJSON] [@Git] allow_dirty = Changes allow_dirty = dist.ini allow_dirty = README.mkdn allow_dirty = cpanfile add_files_in = Changes add_files_in = dist.ini add_files_in = README.mkdn add_files_in = cpanfile tag_format = '%v' tag_message = 'dist %v' untracked_files = warn [MetaResources] repository.url = git://github.com/avenj/list-objects-withutils.git repository.web = git://github.com/avenj/list-objects-withutils repository.type = git [ConfirmRelease] [CheckChangeLog] [PkgVersion] die_on_existing_version = 1 ;; Fixes off-by-one src lines: ;die_on_line_insertion = 1 [ReadmeFromPod] [ReadmeMarkdownFromPod] [PromptIfStale] phase = release check_all_plugins = 1 check_all_prereqs = 1 skip = overload skip = strict [CheckIssues] ;[CheckExtraTests] [PodCoverageTests] [PodSyntaxTests] [Test::NoTabs] [Test::CPAN::Changes] [Test::DistManifest] ; No404s is annoying because it skips if AUTOMATED_TESTING is set ; (regardless of RELEASE_TESTING, which screws up my 'dzil test --all' ; workflow) ; LinkCheck has open bugs but "seems to work" [Test::Pod::LinkCheck] ;[Test::Pod::No404s] [Test::Portability] [Test::ReportPrereqs] [Test::Synopsis] ;[Test::UnusedVars] [Prereqs::FromCPANfile] [Run::AfterBuild] run = cp %d%pREADME.mkdn . cpanfile100644000764000031 156412701513023 16656 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003requires "autobox" => "0"; requires "Carp" => "0"; requires "Exporter" => "0"; requires "overload" => "0"; requires "parent" => "0"; requires "strictures" => "2"; requires "Scalar::Util" => "0"; requires "List::Util" => "1.33"; requires "Class::Method::Modifiers" => "0"; requires "Module::Runtime" => "0.013"; requires "Role::Tiny" => "1.003"; requires "Type::Tie" => "0.004"; recommends "Type::Tiny" => "0.022"; requires "List::UtilsBy" => "0.09"; recommends "List::UtilsBy::XS" => "0.03"; on 'test' => sub { requires "Test::More" => "0.88"; recommends "JSON::PP" => "0"; recommends "Test::Without::Module" => "0"; }; on 'develop' => sub { recommends "Text::ZPL" => "0"; }; META.yml100644000764000031 157012701513023 16420 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003--- abstract: 'List objects, kitchen sink included' author: - 'Jon Portnoy ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' Test::More: '0.88' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.044, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: List-Objects-WithUtils recommends: List::UtilsBy::XS: '0.03' Type::Tiny: '0.022' requires: Carp: '0' Class::Method::Modifiers: '0' Exporter: '0' List::Util: '1.33' List::UtilsBy: '0.09' Module::Runtime: '0.013' Role::Tiny: '1.003' Scalar::Util: '0' Type::Tie: '0.004' autobox: '0' overload: '0' parent: '0' strictures: '2' resources: repository: git://github.com/avenj/list-objects-withutils.git version: '2.028003' MANIFEST100644000764000031 1512712701513023 16323 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.044. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README.mkdn bench/constructors.pl bench/profile/array.pl cpanfile dist.ini examples/blog-post-list-objects.mkdn examples/calc.pl examples/cheap_accessors.pl examples/lotto.pl examples/moo_attributes.pl examples/pairs_to_objs.pl examples/typed_autovivification.pl lib/List/Objects/WithUtils.pm lib/List/Objects/WithUtils/Array.pm lib/List/Objects/WithUtils/Array/Immutable.pm lib/List/Objects/WithUtils/Array/Immutable/Typed.pm lib/List/Objects/WithUtils/Array/Junction.pm lib/List/Objects/WithUtils/Array/Typed.pm lib/List/Objects/WithUtils/Autobox.pm lib/List/Objects/WithUtils/Hash.pm lib/List/Objects/WithUtils/Hash/Immutable.pm lib/List/Objects/WithUtils/Hash/Immutable/Typed.pm lib/List/Objects/WithUtils/Hash/Inflated.pm lib/List/Objects/WithUtils/Hash/Inflated/RW.pm lib/List/Objects/WithUtils/Hash/Typed.pm lib/List/Objects/WithUtils/Role/Array.pm lib/List/Objects/WithUtils/Role/Array/Immutable.pm lib/List/Objects/WithUtils/Role/Array/TiedRO.pm lib/List/Objects/WithUtils/Role/Array/Typed.pm lib/List/Objects/WithUtils/Role/Array/WithJunctions.pm lib/List/Objects/WithUtils/Role/Hash.pm lib/List/Objects/WithUtils/Role/Hash/Immutable.pm lib/List/Objects/WithUtils/Role/Hash/TiedRO.pm lib/List/Objects/WithUtils/Role/Hash/Typed.pm lib/Lowu.pm t/00-report-prereqs.dd t/00-report-prereqs.t t/00_load/all.t t/00_load/all_typetinyish.t t/00_load/autobox.t t/00_load/autobox_subclass.t t/00_load/badopts.t t/00_load/bare.t t/00_load/failed_require.t t/00_load/functions.t t/00_load/hashopts.t t/00_load/lowu.t t/00_load/selective.t t/00_load/targeted.t t/01_array/all.t t/01_array/bisect.t t/01_array/clear.t t/01_array/copy.t t/01_array/count.t t/01_array/defined.t t/01_array/delete.t t/01_array/delete_when.t t/01_array/diff.t t/01_array/end.t t/01_array/exists.t t/01_array/first_index.t t/01_array/first_where.t t/01_array/flatten.t t/01_array/flatten_all.t t/01_array/folds.t t/01_array/get.t t/01_array/get_or_else.t t/01_array/grep.t t/01_array/has_any.t t/01_array/head.t t/01_array/indexes.t t/01_array/inflate.t t/01_array/insert.t t/01_array/intersection.t t/01_array/is_empty.t t/01_array/items_after.t t/01_array/items_after_incl.t t/01_array/items_before.t t/01_array/items_before_incl.t t/01_array/join.t t/01_array/kv.t t/01_array/last_index.t t/01_array/last_where.t t/01_array/map.t t/01_array/mapval.t t/01_array/mesh.t t/01_array/natatime.t t/01_array/nsect.t t/01_array/nsort_by.t t/01_array/part.t t/01_array/part_to_hash.t t/01_array/pick.t t/01_array/pop.t t/01_array/push.t t/01_array/random.t t/01_array/repeated.t t/01_array/reverse.t t/01_array/roll.t t/01_array/rotate.t t/01_array/rotate_in_place.t t/01_array/rotator.t t/01_array/set.t t/01_array/shift.t t/01_array/shuffle.t t/01_array/sliced.t t/01_array/sort.t t/01_array/sort_by.t t/01_array/splice.t t/01_array/squished.t t/01_array/ssect.t t/01_array/subclassed.t t/01_array/tail.t t/01_array/tuples.t t/01_array/type.t t/01_array/unbless.t t/01_array/uniq.t t/01_array/uniq_by.t t/01_array/unshift.t t/01_array/utilsby_no_xs.t t/01_array/visit.t t/02_hash/array_type.t t/02_hash/clear.t t/02_hash/copy.t t/02_hash/defined.t t/02_hash/delete.t t/02_hash/diff.t t/02_hash/exists.t t/02_hash/export.t t/02_hash/get.t t/02_hash/get_or_else.t t/02_hash/get_path.t t/02_hash/inflate.t t/02_hash/intersection.t t/02_hash/inverted.t t/02_hash/is_empty.t t/02_hash/iter.t t/02_hash/keys.t t/02_hash/kv.t t/02_hash/kv_grep.t t/02_hash/kv_map.t t/02_hash/kv_sort.t t/02_hash/maybe_set.t t/02_hash/random_key.t t/02_hash/random_kv.t t/02_hash/random_value.t t/02_hash/set.t t/02_hash/sliced.t t/02_hash/subclassed.t t/02_hash/unbless.t t/02_hash/values.t t/03_junctions/all.t t/03_junctions/any.t t/03_junctions/subclasses.t t/04_immutable/immarray.t t/04_immutable/immhash.t t/05_typed/array_of.t t/05_typed/hash_of.t t/05_typed/tuples.t t/05_typed/validated.t t/06_immutable_typed/immarray_of.t t/06_immutable_typed/immhash_of.t t/07_json/json.t t/08_zpl/zpl.t t/09_autobox_array/all.t t/09_autobox_array/bisect.t t/09_autobox_array/clear.t t/09_autobox_array/copy.t t/09_autobox_array/count.t t/09_autobox_array/defined.t t/09_autobox_array/delete.t t/09_autobox_array/delete_when.t t/09_autobox_array/diff.t t/09_autobox_array/end.t t/09_autobox_array/exists.t t/09_autobox_array/first_index.t t/09_autobox_array/first_where.t t/09_autobox_array/flatten.t t/09_autobox_array/flatten_all.t t/09_autobox_array/folds.t t/09_autobox_array/get.t t/09_autobox_array/get_or_else.t t/09_autobox_array/grep.t t/09_autobox_array/has_any.t t/09_autobox_array/head.t t/09_autobox_array/indexes.t t/09_autobox_array/inflate.t t/09_autobox_array/insert.t t/09_autobox_array/intersection.t t/09_autobox_array/items_after.t t/09_autobox_array/items_after_incl.t t/09_autobox_array/items_before.t t/09_autobox_array/items_before_incl.t t/09_autobox_array/join.t t/09_autobox_array/kv.t t/09_autobox_array/last_index.t t/09_autobox_array/last_where.t t/09_autobox_array/map.t t/09_autobox_array/mapval.t t/09_autobox_array/mesh.t t/09_autobox_array/natatime.t t/09_autobox_array/nsect.t t/09_autobox_array/nsort_by.t t/09_autobox_array/part.t t/09_autobox_array/part_to_hash.t t/09_autobox_array/pop.t t/09_autobox_array/push.t t/09_autobox_array/random.t t/09_autobox_array/reverse.t t/09_autobox_array/rotate.t t/09_autobox_array/rotate_in_place.t t/09_autobox_array/rotator.t t/09_autobox_array/set.t t/09_autobox_array/shift.t t/09_autobox_array/shuffle.t t/09_autobox_array/sliced.t t/09_autobox_array/sort.t t/09_autobox_array/sort_by.t t/09_autobox_array/splice.t t/09_autobox_array/ssect.t t/09_autobox_array/tail.t t/09_autobox_array/tuples.t t/09_autobox_array/uniq.t t/09_autobox_array/uniq_by.t t/09_autobox_array/unshift.t t/09_autobox_array/utilsby_no_xs.t t/09_autobox_array/visit.t t/09_autobox_hash/array_type.t t/09_autobox_hash/clear.t t/09_autobox_hash/copy.t t/09_autobox_hash/defined.t t/09_autobox_hash/delete.t t/09_autobox_hash/diff.t t/09_autobox_hash/exists.t t/09_autobox_hash/get.t t/09_autobox_hash/get_or_else.t t/09_autobox_hash/get_path.t t/09_autobox_hash/inflate.t t/09_autobox_hash/intersection.t t/09_autobox_hash/inverted.t t/09_autobox_hash/iter.t t/09_autobox_hash/keys.t t/09_autobox_hash/kv.t t/09_autobox_hash/kv_grep.t t/09_autobox_hash/kv_map.t t/09_autobox_hash/kv_sort.t t/09_autobox_hash/maybe_set.t t/09_autobox_hash/set.t t/09_autobox_hash/sliced.t t/09_autobox_hash/values.t t/author-no-tabs.t t/author-pod-coverage.t t/author-pod-syntax.t t/release-cpan-changes.t t/release-dist-manifest.t t/release-pod-linkcheck.t t/release-portability.t t/release-synopsis.t xt/reverse_dependencies.t META.json100644000764000031 423612701513023 16572 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003{ "abstract" : "List objects, kitchen sink included", "author" : [ "Jon Portnoy " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.044, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "List-Objects-WithUtils", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "recommends" : { "Text::ZPL" : "0" }, "requires" : { "Pod::Coverage::TrustPod" : "0", "Test::CPAN::Changes" : "0.19", "Test::More" : "0.88", "Test::NoTabs" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Pod::LinkCheck" : "0", "Test::Synopsis" : "0" } }, "runtime" : { "recommends" : { "List::UtilsBy::XS" : "0.03", "Type::Tiny" : "0.022" }, "requires" : { "Carp" : "0", "Class::Method::Modifiers" : "0", "Exporter" : "0", "List::Util" : "1.33", "List::UtilsBy" : "0.09", "Module::Runtime" : "0.013", "Role::Tiny" : "1.003", "Scalar::Util" : "0", "Type::Tie" : "0.004", "autobox" : "0", "overload" : "0", "parent" : "0", "strictures" : "2" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900", "JSON::PP" : "0", "Test::Without::Module" : "0" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "git://github.com/avenj/list-objects-withutils.git", "web" : "git://github.com/avenj/list-objects-withutils" } }, "version" : "2.028003" } README.mkdn100644000764000031 3272012701513023 17000 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003# NAME List::Objects::WithUtils - List objects, kitchen sink included # SYNOPSIS ## A small sample; consult the description, below, for links to ## extended documentation # Import all object constructor functions: # array immarray array_of immarray_of # hash immhash hash_of immhash_of use List::Objects::WithUtils; # Import all of the above plus autoboxing: use List::Objects::WithUtils ':all'; # Same as above, but shorter: use Lowu; # Most methods returning lists return new objects; chaining is easy: array(qw/ aa Ab bb Bc bc /) ->grep(sub { /^b/i }) ->map(sub { uc }) ->uniq ->all; # ( 'BB', 'BC' ) # Useful utilities from other list modules are available: my $want_idx = array( +{ id => '400', user => 'bob' }, +{ id => '600', user => 'suzy' }, +{ id => '700', user => 'fred' }, )->first_index(sub { $_->{id} > 500 }); my $itr = array( 1 .. 7 )->natatime(3); while ( my @nextset = $itr->() ) { ... } my $meshed = array(qw/ a b c d /) ->mesh( array(1 .. 4) ) ->all; # ( 'a', 1, 'b', 2, 'c', 3, 'd', 4 ) my ($evens, $odds) = array( 1 .. 20 ) ->part(sub { $_[0] & 1 }) ->all; my $sorted = array( +{ name => 'bob', acct => 1 }, +{ name => 'fred', acct => 2 }, +{ name => 'suzy', acct => 3 }, )->sort_by(sub { $_->{name} }); # array() objects are mutable: my $mutable = array(qw/ foo bar baz /); $mutable->insert(1, 'quux'); $mutable->delete(2); # ... or use immarray() immutable arrays: my $static = immarray( qw/ foo bar baz / ); $static->set(0, 'quux'); # dies $static->[0] = 'quux'; # dies push @$static, 'quux'; # dies # Construct a hash: my $hash = hash( foo => 'bar', snacks => 'cake' ); # You can set multiple keys in one call: $hash->set( foobar => 'baz', pie => 'cherry' ); # ... which is useful for merging in another (plain) hash: my %foo = ( pie => 'pumpkin', snacks => 'cheese' ); $hash->set( %foo ); # ... or another hash object: my $second = hash( pie => 'key lime' ); $hash->set( $second->export ); # Retrieve one value as a simple scalar: my $snacks = $hash->get('snacks'); # ... or retrieve multiple values as an array-type object: my $vals = $hash->get('foo', 'foobar'); # Take a hash slice of keys, return a new hash object # consisting of the retrieved key/value pairs: my $slice = $hash->sliced('foo', 'pie'); # Arrays inflate to hash objects: my $items = array( qw/ foo bar baz/ )->map(sub { $_ => 1 })->inflate; if ($items->exists('foo')) { # ... } # Hashes inflate to simple objects with accessors: my $obj = $hash->inflate; $snacks = $obj->snacks; # Methods returning multiple values typically return new array-type objects: my @match_keys = $hash->keys->grep(sub { m/foo/ })->all; my @match_vals = $hash->values->grep(sub { m/bar/ })->all; my @sorted_pairs = hash( foo => 2, bar => 3, baz => 1) ->kv ->sort_by(sub { $_->[1] }) ->all; # ( [ baz => 1 ], [ foo => 2 ], [ bar => 3 ] ) # Perl6-inspired Junctions: if ( $hash->keys->any_items == qr/snacks/ ) { # ... hash has key(s) matching /snacks/ ... } if ( $hash->values->all_items > 10 ) { # ... all hash values greater than 10 ... } # Type-checking arrays via Type::Tiny: use Types::Standard -all; my $int_arr = array_of Int() => 1 .. 10; # Type-checking hashes: use Types::Standard -all; my $int_hash = hash_of Int() => (foo => 1, bar => 2); # Native list types can be autoboxed: use List::Objects::WithUtils 'autobox'; my $foo = [ qw/foo baz bar foo quux/ ]->uniq->sort; my $bar = +{ a => 1, b => 2, c => 3 }->values->sort; # Autoboxing is lexically scoped like normal: { no List::Objects::WithUtils::Autobox; [ 1 .. 10 ]->shuffle; # dies } # DESCRIPTION A set of roles and classes defining an object-oriented interface to Perl hashes and arrays with useful utility methods, junctions, type-checking ability, and optional autoboxing. Originally derived from [Data::Perl](https://metacpan.org/pod/Data::Perl). ## Uses The included objects are useful as-is but are largely intended for use as data container types for attributes. This lends a more natural object-oriented syntax; these are particularly convenient in combination with delegated methods, as in this example: package Some::Thing; use List::Objects::WithUtils; use Moo; has items => ( is => 'ro', builder => sub { array }, handles => +{ add_items => 'push', get_items => 'all', items_where => 'grep', }, ); # ... later ... my $thing = Some::Thing->new; $thing->add_items(@more_items); # Operate on all positive items: for my $item ($thing->items_where(sub { $_ > 0 })->all) { ... } [List::Objects::Types](https://metacpan.org/pod/List::Objects::Types) provides [Type::Tiny](https://metacpan.org/pod/Type::Tiny)-based types & coercions matching the list objects provided by this distribution. These integrate nicely with typed or untyped list objects: package Accounts; use List::Objects::Types -types; use Moo 2; has usergroups => ( is => 'ro', # +{ $group => [ [ $usr => $id ], ... ] } # Coerced to objects all the way down: isa => TypedHash[ TypedArray[ArrayObj] ], coerce => 1, builder => sub { +{} }, ); # ... later ... my $users_in_grp = $accts->usergroups ->get($some_group) ->grep(sub { $_[0]->get(0) }); ## Objects ### Arrays **array** ([List::Objects::WithUtils::Array](https://metacpan.org/pod/List::Objects::WithUtils::Array)) provides basic mutable ARRAY-type objects. Behavior is defined by [List::Objects::WithUtils::Role::Array](https://metacpan.org/pod/List::Objects::WithUtils::Role::Array); look there for documentation on available methods. **immarray** is imported from [List::Objects::WithUtils::Array::Immutable](https://metacpan.org/pod/List::Objects::WithUtils::Array::Immutable) and operates much like an **array**, except methods that mutate the list are not available; using immutable arrays promotes safer programming patterns. **array\_of** provides [Type::Tiny](https://metacpan.org/pod/Type::Tiny)-compatible type-checking array objects that can coerce and check their values as they are added; see [List::Objects::WithUtils::Array::Typed](https://metacpan.org/pod/List::Objects::WithUtils::Array::Typed). **immarray\_of** provides immutable type-checking arrays; see [List::Objects::WithUtils::Array::Immutable::Typed](https://metacpan.org/pod/List::Objects::WithUtils::Array::Immutable::Typed). ### Hashes **hash** is the basic mutable HASH-type object imported from [List::Objects::WithUtils::Hash](https://metacpan.org/pod/List::Objects::WithUtils::Hash); see [List::Objects::WithUtils::Role::Hash](https://metacpan.org/pod/List::Objects::WithUtils::Role::Hash) for documentation. **immhash** provides immutable (restricted) hashes; see [List::Objects::WithUtils::Hash::Immutable](https://metacpan.org/pod/List::Objects::WithUtils::Hash::Immutable). **hash\_of** provides [Type::Tiny](https://metacpan.org/pod/Type::Tiny)-compatible type-checking hash objects; see [List::Objects::WithUtils::Hash::Typed](https://metacpan.org/pod/List::Objects::WithUtils::Hash::Typed). **immhash\_of** provides immutable type-checking hashes; see [List::Objects::WithUtils::Hash::Immutable::Typed](https://metacpan.org/pod/List::Objects::WithUtils::Hash::Immutable::Typed). ## Importing A bare import list (`use List::Objects::WithUtils;`) will import all of the object constructor functions described above; they can also be selectively imported, e.g.: use List::Objects::WithUtils 'array_of', 'hash_of'; Importing **autobox** lexically enables [List::Objects::WithUtils::Autobox](https://metacpan.org/pod/List::Objects::WithUtils::Autobox), which provides [List::Objects::WithUtils::Array](https://metacpan.org/pod/List::Objects::WithUtils::Array) or [List::Objects::WithUtils::Hash](https://metacpan.org/pod/List::Objects::WithUtils::Hash) methods for native ARRAY and HASH types. Importing **all** or **:all** will import all of the object constructors and additionally turn **autobox** on; `use Lowu;` is a shortcut for importing **all**. ## Debugging Most methods belonging to these objects are heavily micro-optimized -- at the cost of useful error handling. Since there are few built-in argument checks, a mistake in your code can frequently lead to slightly cryptic errors from the perl side: > my $pos; # whoops, I'm still undefined later: > if ($arr->exists($pos)) { ... } Use of uninitialized value in numeric le (<=) at $useless_lib_lineno ... in which case [Devel::Confess](https://metacpan.org/pod/Devel::Confess) is likely to improve your quality of life by providing a real backtrace: $ perl -d:Confess my_app.pl Use of uninitialized value in numeric le (<=) at ... [...]::Array::exists(ARRAY(0x8441068), undef) called at ... ## Subclassing The importer for this package is somewhat flexible; a subclass can override import to pass import tags and a target package by feeding this package's `import()` a HASH: # Subclass and import to target packages (see Lowu.pm f.ex): package My::Defaults; use parent 'List::Objects::WithUtils'; sub import { my ($class, @params) = @_; $class->SUPER::import( +{ import => [ 'autobox', 'array', 'hash' ], to => scalar(caller) } ) } Functionality is mostly defined by Roles. For example, it's easy to create your own array class with new methods: package My::Array::Object; use Role::Tiny::With; # Act like List::Objects::WithUtils::Array: with 'List::Objects::WithUtils::Role::Array', 'List::Objects::WithUtils::Role::Array::WithJunctions'; # One way to add your own functional interface: use Exporter 'import'; our @EXPORT = 'my_array'; sub my_array { __PACKAGE__->new(@_) } # ... add/override methods ... ... in which case you may want to also define your own hash subclass that overrides `array_type` to produce your preferred arrays: package My::Hash::Object; use Role::Tiny::With; with 'List::Objects::WithUtils::Role::Hash'; use Exporter 'import'; our @EXPORT = 'my_hash'; sub my_hash { __PACKAGE__->new(@_) } sub array_type { 'My::Array::Object' } # ... add/override methods ... # SEE ALSO [List::Objects::WithUtils::Role::Array](https://metacpan.org/pod/List::Objects::WithUtils::Role::Array) for documentation on the basic set of `array()` methods. [List::Objects::WithUtils::Role::Array::WithJunctions](https://metacpan.org/pod/List::Objects::WithUtils::Role::Array::WithJunctions) for documentation on `array()` junction-returning methods. [List::Objects::WithUtils::Array::Immutable](https://metacpan.org/pod/List::Objects::WithUtils::Array::Immutable) for more on `immarray()` immutable arrays. [List::Objects::WithUtils::Array::Typed](https://metacpan.org/pod/List::Objects::WithUtils::Array::Typed) for more on `array_of()` type-checking arrays. [List::Objects::WithUtils::Array::Immutable::Typed](https://metacpan.org/pod/List::Objects::WithUtils::Array::Immutable::Typed) for more on `immarray_of()` immutable type-checking arrays. [List::Objects::WithUtils::Role::Hash](https://metacpan.org/pod/List::Objects::WithUtils::Role::Hash) for documentation regarding `hash()` methods. [List::Objects::WithUtils::Hash::Immutable](https://metacpan.org/pod/List::Objects::WithUtils::Hash::Immutable) for more on `immhash()` immutable hashes. [List::Objects::WithUtils::Hash::Typed](https://metacpan.org/pod/List::Objects::WithUtils::Hash::Typed) for more on `hash_of()` type-checking hashes. [List::Objects::WithUtils::Hash::Immutable::Typed](https://metacpan.org/pod/List::Objects::WithUtils::Hash::Immutable::Typed) for more on `immhash_of()` immutable type-checking hashes. [List::Objects::WithUtils::Autobox](https://metacpan.org/pod/List::Objects::WithUtils::Autobox) for details on autoboxing. The [Lowu](https://metacpan.org/pod/Lowu) module for a convenient importer shortcut. [List::Objects::Types](https://metacpan.org/pod/List::Objects::Types) for relevant [Type::Tiny](https://metacpan.org/pod/Type::Tiny) types. [MoopsX::ListObjects](https://metacpan.org/pod/MoopsX::ListObjects) for integration with [Moops](https://metacpan.org/pod/Moops) class-building sugar. # AUTHOR Jon Portnoy <avenj@cobaltirc.org> Licensed under the same terms as Perl. The original Array and Hash roles were derived from [Data::Perl](https://metacpan.org/pod/Data::Perl) by Matthew Phillips (CPAN: MATTP), haarg, and others. Immutable array objects were originally inspired by [Const::Fast](https://metacpan.org/pod/Const::Fast) by Leon Timmermans (CPAN: LEONT), but now use `tie`. Junctions are adapted from [Perl6::Junction](https://metacpan.org/pod/Perl6::Junction) by Carl Franks (CPAN: CFRANKS) Most of the type-checking code and other useful additions were contributed by Toby Inkster (CPAN: TOBYINK) A significant portion of this code simply wraps other widely-used modules, especially: [List::Util](https://metacpan.org/pod/List::Util) [List::UtilsBy](https://metacpan.org/pod/List::UtilsBy) [Type::Tiny](https://metacpan.org/pod/Type::Tiny) Inspiration for a few pieces comes from the "classic" (version 0.33) [List::MoreUtils](https://metacpan.org/pod/List::MoreUtils). lib000755000764000031 012701513023 15552 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003Lowu.pm100644000764000031 157112701513023 17202 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/libpackage Lowu; $Lowu::VERSION = '2.028003'; use strictures 2; use parent 'List::Objects::WithUtils'; sub import { my ($class, @funcs) = @_; @funcs = 'all' unless @funcs; $class->SUPER::import( +{ import => [ @funcs ], to => scalar(caller), } ) } print qq[I'm not sorry, on account of all the typing I've saved myself ;-)\n] unless caller; 1; =pod =for Pod::Coverage import =head1 NAME Lowu - Shortcut for importing all of List::Objects::WithUtils =head1 SYNOPSIS # Same as: # use List::Objects::WithUtils ':all'; use Lowu; =head1 DESCRIPTION A short-to-type way to get all of L, including autoboxing. If you like, you can specify params as if calling C: # Get array() and immarray() only: use Lowu 'array', 'immarray'; =head1 AUTHOR Jon Portnoy =cut Makefile.PL100644000764000031 360412701513023 17121 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.044. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "List objects, kitchen sink included", "AUTHOR" => "Jon Portnoy ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "List-Objects-WithUtils", "LICENSE" => "perl", "NAME" => "List::Objects::WithUtils", "PREREQ_PM" => { "Carp" => 0, "Class::Method::Modifiers" => 0, "Exporter" => 0, "List::Util" => "1.33", "List::UtilsBy" => "0.09", "Module::Runtime" => "0.013", "Role::Tiny" => "1.003", "Scalar::Util" => 0, "Type::Tie" => "0.004", "autobox" => 0, "overload" => 0, "parent" => 0, "strictures" => 2 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "Test::More" => "0.88" }, "VERSION" => "2.028003", "test" => { "TESTS" => "t/*.t t/00_load/*.t t/01_array/*.t t/02_hash/*.t t/03_junctions/*.t t/04_immutable/*.t t/05_typed/*.t t/06_immutable_typed/*.t t/07_json/*.t t/08_zpl/*.t t/09_autobox_array/*.t t/09_autobox_hash/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Class::Method::Modifiers" => 0, "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "List::Util" => "1.33", "List::UtilsBy" => "0.09", "Module::Runtime" => "0.013", "Role::Tiny" => "1.003", "Scalar::Util" => 0, "Test::More" => "0.88", "Type::Tie" => "0.004", "autobox" => 0, "overload" => 0, "parent" => 0, "strictures" => 2 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); 02_hash000755000764000031 012701513023 16473 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/tkv.t100644000764000031 46512701513023 17425 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash( baz => undef, foo => 'bar' ); my $kv = $hr->kv; my @sorted = $kv->sort_by(sub { $_->[0] })->all; is_deeply \@sorted, [ [ baz => undef ], [ foo => 'bar' ], ], 'kv ok'; done_testing; 08_zpl000755000764000031 012701513023 16363 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/tzpl.t100644000764000031 134412701513023 17517 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/08_zpl BEGIN { unless (eval {; require Text::ZPL; 1 } && !$@ ) { require Test::More; Test::More::plan(skip_all => 'these tests require Text::ZPL' ); } } use Test::More; use strict; use warnings FATAL => 'all'; use Text::ZPL; use List::Objects::WithUtils; { my $obj = hash(foo => 'bar'); ok my $res = encode_zpl($obj), 'encoded hash'; my $hash = decode_zpl($res); is_deeply $hash, +{ foo => 'bar' }, 'round-tripped hash'; } { my $obj = hash( foo => hash(bar => 1), bar => array(1,2) ); ok my $res = encode_zpl($obj), 'encoded (deep) hash'; my $hash = decode_zpl($res); is_deeply $hash, +{ foo => +{ bar => 1 }, bar => [ 1, 2 ], }, 'round-tripped (deep) hash'; } done_testing; 01_array000755000764000031 012701513023 16665 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/tkv.t100644000764000031 51712701513023 17615 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array qw/foo bar baz quux/; is_deeply [ $arr->kv->all ], [ [ 0 => 'foo' ], [ 1 => 'bar' ], [ 2 => 'baz' ], [ 3 => 'quux' ], ], 'array kv ok'; ok array->kv->is_empty, 'empty array kv ok'; done_testing; set.t100644000764000031 71012701513023 17571 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash; ok $hr->set( snacks => 'tasty') == $hr, 'set returned self'; ok $hr->get('snacks') eq 'tasty', 'set ok (1)'; $hr->set( foo => 'bar' ); ok $hr->get('foo') eq 'bar', 'set ok (2)'; $hr->set( a => 1, b => 2, c => 3 ); is_deeply +{ $hr->export }, +{ a => 1, b => 2, c => 3, snacks => 'tasty', foo => 'bar' }, 'multi-key set ok'; done_testing; get.t100644000764000031 51412701513023 17557 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(a => 1, b => 2, c => 3, d => 4 ); ok $hr->get('b') == 2, 'get ok'; my $results = $hr->get('b', 'c'); ok $results->has_any(sub { $_ == 2 }) && $results->has_any(sub { $_ == 3 }), 'multi-key get ok'; done_testing; 00_load000755000764000031 012701513023 16465 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/tall.t100644000764000031 104312701513023 17560 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils ':all'; ok __PACKAGE__->can( 'array' ), 'array ok'; ok __PACKAGE__->can( 'immarray' ), 'immarray ok'; ok __PACKAGE__->can( 'array_of' ), 'array_of ok'; ok __PACKAGE__->can( 'immarray_of' ), 'immarray_of ok'; ok __PACKAGE__->can( 'hash' ), 'hash ok'; ok __PACKAGE__->can( 'immhash' ), 'immhash ok'; ok __PACKAGE__->can( 'hash_of' ), 'hash_of ok'; ok __PACKAGE__->can( 'immhash_of' ), 'immhash_of ok'; cmp_ok []->count, '==', 0, 'autobox ok'; done_testing; set.t100644000764000031 57712701513023 17776 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array; $arr->set( 1 => 'bar' ); is_deeply [ $arr->all ], [ undef, 'bar' ], 'set on empty list ok'; $arr = array(1, 2, 3); my $set = $arr->set( 1 => 'foo' ); ok $arr == $set, 'set returned self'; is_deeply [ $arr->all ], [ 1, 'foo', 3 ], 'set ok'; done_testing; pop.t100644000764000031 50112701513023 17764 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok !defined array->pop, 'empty array pop ok'; my $arr = array( 1 .. 3 ); my $popped = $arr->pop; ok $popped == 3, 'pop returned correct value'; is_deeply [ $arr->all ], [ 1, 2 ], 'pop removed correct value'; done_testing; get.t100644000764000031 54512701513023 17755 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok !defined array->get(1), 'empty array get ok'; my $arr = array(1 .. 3); cmp_ok $arr->get(0), '==', 1, 'get 0 ok'; cmp_ok $arr->get(1), '==', 2, 'get 1 ok'; cmp_ok $arr->get(2), '==', 3, 'get 2 ok'; ok !defined $arr->get(3), 'get 3 undef ok'; done_testing; end.t100644000764000031 32512701513023 17740 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1, 2, 3 ); ok $arr->end == 2, 'end ok'; ok array->end == -1, 'empty array end ok'; done_testing; all.t100644000764000031 60312701513023 17741 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array; is_deeply [ $arr->all ], [], 'empty array all() ok'; $arr->push( 1 .. 5 ); is_deeply [ $arr->all ], [ 1 .. 5 ], 'array all() ok'; is_deeply [ $arr->export ], [ 1 .. 5 ], 'array export() ok'; is_deeply [ $arr->elements ], [ 1 .. 5 ], 'array elements() ok'; done_testing; map.t100644000764000031 72212701513023 17750 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok array->map(sub { 1 })->is_empty, 'empty array map ok'; my $arr = array( qw/ a b c / ); my $upper = $arr->map(sub { uc }); is_deeply [ $upper->all ], [ qw/ A B C / ], 'map ok'; is_deeply [ $arr->all ], [ qw/ a b c / ], 'original intact'; $arr->map(sub { $_ = uc }); is_deeply [ $arr->all ], [ qw/ A B C / ], 'list-mutating map ok'; done_testing; 07_json000755000764000031 012701513023 16526 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/tjson.t100644000764000031 246112701513023 20027 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/07_json BEGIN { unless (eval {; require JSON::PP; 1 } && !$@ ) { require Test::More; Test::More::plan(skip_all => 'these tests require JSON::PP' ); } } use Test::More; use strict; use warnings FATAL => 'all'; use JSON::PP; use List::Objects::WithUtils; my $js = JSON::PP->new; $js->convert_blessed(1); { my $obj = array(1,2,3); ok my $res = $js->encode($obj), 'encoded array'; my $arr = $js->decode($res); is_deeply $arr, [ 1, 2, 3 ], 'round-tripped array'; } { my $obj = immarray(1,2,3); ok my $res = $js->encode($obj), 'encoded immarray'; my $arr = $js->decode($res); is_deeply $arr, [ 1, 2, 3 ], 'round-tripped immarray'; } { my $obj = array( 1, 2, array(3, 4) ); ok my $res = $js->encode($obj), 'encoded (deep) array'; my $arr = $js->decode($res); is_deeply $arr, [ 1, 2, [ 3, 4 ] ], 'round-tripped (deep) array'; } { my $obj = hash(foo => 'bar'); ok my $res = $js->encode($obj), 'encoded hash'; my $hash = $js->decode($res); is_deeply $hash, +{ foo => 'bar' }, 'round-tripped hash'; } { my $obj = hash( foo => hash(bar => 1), bar => array(1,2) ); ok my $res = $js->encode($obj), 'encoded (deep) hash'; my $hash = $js->decode($res); is_deeply $hash, +{ foo => +{ bar => 1 }, bar => [ 1, 2 ], }, 'round-tripped (deep) hash'; } done_testing; diff.t100644000764000031 103112701513023 17723 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $first = hash(a => 1, b => 2, c => 3, d => 4); my $second = +{a => 1, b => 2, x => 1, y => 2}; my $diff = $first->diff($second); is_deeply [ $diff->sort->all ], [ qw/c d x y/ ], 'two-hash diff ok' or diag explain $diff; my $third = hash(a => 1, b => 2, c => 3, e => 1); $diff = $third->diff($first, $second); is_deeply [ $diff->sort->all ], [ qw/c d e x y/ ], 'three-hash diff ok' or diag explain $diff; done_testing iter.t100644000764000031 57412701513023 17751 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hs = hash( foo => 1, bar => 2, baz => 3, ); my $iter = $hs->iter; my %result; while (my ($k, $v) = $iter->()) { $result{$k} = $v } is_deeply +{ %result }, +{ foo => 1, bar => 2, baz => 3 }, 'iter() ok'; ok !hash->iter->(), 'empty hash iter() ok'; done_testing copy.t100644000764000031 37712701513023 17761 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash( foo => 1, bar => 2 ); my $copy = $hr->copy; ok $copy->get('foo') == 1, 'copy ok'; ok $hr->untyped->get('foo') == 1, 'untyped ok'; done_testing; keys.t100644000764000031 33312701513023 17752 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash( foo => 1, bar => 2 ); is_deeply [ $hr->keys->sort->all ], [ qw/bar foo/ ], 'keys() ok'; done_testing; bare.t100644000764000031 76212701513023 17710 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils; ok __PACKAGE__->can( 'array' ), 'array ok'; ok __PACKAGE__->can( 'immarray' ), 'immarray ok'; ok __PACKAGE__->can( 'array_of' ), 'array_of ok'; ok __PACKAGE__->can( 'immarray_of' ), 'immarray_of ok'; ok __PACKAGE__->can( 'hash' ), 'hash ok'; ok __PACKAGE__->can( 'immhash' ), 'immhash ok'; ok __PACKAGE__->can( 'hash_of' ), 'hash_of ok'; ok __PACKAGE__->can( 'immhash_of' ), 'immhash_of ok'; done_testing; lowu.t100644000764000031 113112701513023 17774 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok __PACKAGE__->can( 'array' ), 'array ok'; ok __PACKAGE__->can( 'immarray' ), 'immarray ok'; ok __PACKAGE__->can( 'array_of' ), 'array_of ok'; ok __PACKAGE__->can( 'immarray_of' ), 'immarray_of ok'; ok __PACKAGE__->can( 'hash' ), 'hash ok'; ok __PACKAGE__->can( 'immhash' ), 'immhash ok'; ok __PACKAGE__->can( 'hash_of' ), 'hash_of ok'; ok __PACKAGE__->can( 'immhash_of' ), 'immhash_of ok'; isa_ok []->copy, 'List::Objects::WithUtils::Array', 'autoboxed copy ok'; cmp_ok []->count, '==', 0, 'autoboxed count ok'; done_testing; examples000755000764000031 012701513023 16622 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003calc.pl100644000764000031 345712701513023 20232 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/examples#!/usr/bin/env perl # An "almost-RPN-ish" calculator ... use feature 'say'; use Lowu; if (@ARGV) { say calc(join ' ', @ARGV)->join(" "); exit 0 } [ qq[Hi! I'm a RPN-ish calculator.], qq[ - The stack only persists for a single expression.], qq[ - Operations reduce the stack recursively.], qq[ - Commands (anywhere in an expression):], qq[ 'q' quits], qq[ 'p' prints the current stack], qq[ 'pFORMAT applies FORMAT to each stack element via (s)printf], ]->map(sub { say $_ }); STDOUT->autoflush(1); while (1) { print "Enter an expression:\n", "> "; my $expr = ; say "result: " . calc($expr)->join(" ") } sub calc { my $stack = []; for my $item (split ' ', shift) { if ($item eq 'q' || $item eq 'quit') { exit 0 } if ($item eq 'p' || $item eq 'print') { say "stack: " . $stack->join(" "); next } if (my ($format) = $item =~ /\Ap(?:rint)?(\S+)\Z/) { $stack->map(sub { say sprintf $format, $_ }); next } if ($item =~ /\A[0-9]+\Z/) { $stack->push($item); next } next unless $stack->has_any; unless ($stack->count > 1) { warn "Not enough stack elements to perform operations\n"; next } if ($item eq '+') { $stack = array( $stack->reduce(sub { shift() + shift() }) ); next } if ($item eq '-') { $stack = array( $stack->reduce(sub { shift() - shift() }) ); next } if ($item eq '*') { $stack = array( $stack->reduce(sub { shift() * shift() }) ); next } if ($item eq '/') { $stack = array( $stack->reduce(sub { shift() / shift() }) ); next } if ($item eq '^' || $item eq '**') { $stack = array( $stack->reduce(sub { shift() ** shift() }) ); next } warn "Unknown token: $item\n" } $stack } diff.t100644000764000031 216412701513023 20125 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; is_deeply [ array(1 .. 3)->diff([ 3, 2, 1 ])->all ], [ ], 'zero element diff ok'; my $first = array(qw/a b c d e /); my $second = [qw/a b c x y /]; my $diff = $first->diff($second); is_deeply [ $diff->sort->all ], [ qw/d e x y / ], 'two-array diff ok' or diag explain $diff; my $third = array(qw/a b c x z /); $diff = $first->diff($second, $third); is_deeply [ $diff->sort->all ], [ qw/d e x y z/ ], 'three-array diff ok' or diag explain $diff; $diff = array(1 .. 3)->diff( array('2') ); is_deeply [ $diff->sort(sub { $_[0] <=> $_[1] })->all ], [ 1, 3 ], 'uneven array diff ok' or diag explain $diff; $diff = array(1 .. 3)->diff(array); is_deeply [ $diff->sort(sub { $_[0] <=> $_[1] })->all ], [ 1 .. 3 ], 'diff against empty array ok' or diag explain $diff; $diff = array->diff( [ 1 .. 3 ] ); is_deeply [ $diff->sort(sub { $_[0] <=> $_[1] })->all ], [ 1 .. 3 ], 'diff from empty array ok' or diag explain $diff; ok array->diff(array)->is_empty, 'empty arrays diff ok'; done_testing mesh.t100644000764000031 217312701513023 20151 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(qw/ a b c d/); my $meshed = $arr->mesh( array(1, 2, 3, 4) ); is_deeply [ $meshed->all ], [ a => 1, b => 2, c => 3, d => 4 ], 'mesh on even lists ok'; $meshed = $arr->mesh([1,2]); is_deeply [ $meshed->all ], [ 'a', 1, 'b', 2, 'c', undef, 'd', undef ], 'mesh on uneven lists ok'; my @holey; $#holey = 9; $meshed = array( 1 .. 10 )->mesh( array(@holey) ); is_deeply [ $meshed->all ], [ 1, undef, 2, undef, 3, undef, 4, undef, 5, undef, 6, undef, 7, undef, 8, undef, 9, undef, 10, undef ], 'mesh with undef-filled list ok'; my @first = ( 1, 2 ); my @second = qw/ foo bar baz/; $meshed = array( 'x' )->mesh( array(@first), \@second ); is_deeply [ $meshed->all ], [ 'x', 1, 'foo', undef, 2, 'bar', undef, undef, 'baz' ], 'mesh on mixed object/ref arrays ok'; eval {; array('foo')->mesh('bar') }; ok $@ =~ /ARRAY/, 'mesh with bad args dies' or diag explain $@; ok array->mesh([], [])->is_empty, 'meshing empty arrays ok'; ok array->zip([], [])->is_empty, 'zip alias for mesh ok'; done_testing; grep.t100644000764000031 66512701513023 20136 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; is_deeply [ array->grep(sub { 1 })->all ], [ ], 'empty array grep ok'; my $arr = array(qw/ a b c b /); my $found = $arr->grep(sub { $_ eq 'b' }); is_deeply [ $found->all ], [ ('b') x 2 ], 'grep on topicalizer ok'; $found = $arr->grep(sub { $_[0] eq 'b' }); is_deeply [ $found->all ], [ ('b') x 2 ], 'grep on arg ok'; done_testing; part.t100644000764000031 204612701513023 20162 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my ($evens, $odds) = array( 1 .. 6 )->part(sub { $_ & 1 })->all; is_deeply [ $evens->all ], [ 2,4,6 ], 'part() with args picked evens ok'; is_deeply [ $odds->all ], [ 1,3,5 ], 'part() with args picked odds ok'; my $parts_n = do { my $i = 0; array(1 .. 12)->part(sub { $i++ % 3 }); }; ok( $parts_n->count == 3, 'part() created 3 arrays' ); is_deeply [ $parts_n->get(0)->all ], [ 1, 4, 7, 10 ], 'part() first array ok'; is_deeply [ $parts_n->get(1)->all ], [ 2, 5, 8, 11 ], 'part() second array ok'; is_deeply [ $parts_n->get(2)->all ], [ 3, 6, 9, 12 ], 'part() third array ok'; my $parts_single = array(1 .. 12)->part(sub { 3 }); ok( $parts_single->get(0)->count == 0, 'part() 0 empty ok' ); ok( $parts_single->get(1)->count == 0, 'part() 1 empty ok' ); ok( $parts_single->get(2)->count == 0, 'part() 2 empty ok' ); is_deeply [ $parts_single->get(3)->all ], [ 1 .. 12 ], 'part() 3 filled ok'; done_testing; push.t100644000764000031 40712701513023 20152 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(0); my $pushed = $arr->push( 1 .. 3 ); ok $pushed == $arr, 'push returned self'; is_deeply [ $arr->all ], [ 0 .. 3 ], 'push ok'; done_testing; copy.t100644000764000031 56512701513023 20152 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 5 ); my $copy = $arr->copy; ok $copy != $arr, 'copy returned new obj ok'; is_deeply [ $copy->all ], [ $arr->all ], 'copy ok'; is_deeply [ $arr->untyped->all ], [ $arr->all ], 'untyped ok'; ok array->copy->is_empty, 'empty array copy ok'; done_testing; roll.t100644000764000031 120412701513023 20157 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings; use List::Objects::WithUtils 'array'; my $arr = array('a' .. 'f'); my %as_hash = (map {; $_ => 1 } $arr->all ); my $rolled = $arr->roll(3); ok $rolled->count == 3, 'rolled three items'; for my $item ($rolled->all) { ok exists $as_hash{$item}, "rolled item '$item' ok"; } $rolled = $arr->roll(8); ok $rolled->count == 8, 'rolled more than size of array'; for my $item ($rolled->all) { ok exists $as_hash{$item}, "rolled item '$item' ok"; } $rolled = array->roll(3); ok $rolled->grep(sub { !defined }) && $rolled->count == 3, 'roll on empty array ok' or diag explain $rolled; done_testing tail.t100644000764000031 111712701513023 20143 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(qw/ a b c /); my $last = $arr->tail; ok $last eq 'c', 'scalar tail ok'; my ($tail, $remains) = $arr->tail; ok $tail eq 'c', 'list tail first item ok'; is_deeply [ $remains->all ], [ qw/ a b / ], 'list tail second item ok'; ok !defined array->tail , 'empty array scalar tail undef ok'; ($tail, $remains) = array->tail; ok !defined $tail, 'empty array list tail first item undef ok'; ok $remains->is_empty, 'empty array list tail second item is_empty ok'; done_testing; join.t100644000764000031 57212701513023 20135 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok array->join eq '', 'empty array join ok'; my $arr = array(1 .. 3); cmp_ok $arr->join, 'eq', '1,2,3', 'join without params ok'; cmp_ok $arr->join('-'), 'eq', '1-2-3', 'join with params ok'; cmp_ok $arr->join(''), 'eq', '123', 'join with empty string ok'; done_testing; type.t100644000764000031 23512701513023 20153 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok !array->type, 'array() has empty ->type'; done_testing; head.t100644000764000031 115412701513023 20114 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(qw/ a b c /); my $first = $arr->head; ok $first eq 'a', 'scalar head ok'; my ($head, $tail) = $arr->head; isa_ok $tail, 'List::Objects::WithUtils::Array'; ok $head eq 'a', 'list head first item ok'; is_deeply [ $tail->all ], [ qw/ b c / ], 'list head second item ok'; ok !defined array->head, 'empty array head undef ok'; ($head, $tail) = array->head; ok !defined $head, 'empty array list head first item undef ok'; ok $tail->is_empty, 'empty array list head second item is_empty'; done_testing; uniq.t100644000764000031 44512701513023 20151 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1, 2, 2, 3, 4, 5, 5 ); my $uniq = $arr->uniq; is_deeply [ $uniq->sort->all ], [ 1, 2, 3, 4, 5 ], 'uniq ok'; ok array->uniq->is_empty, 'empty array uniq ok'; done_testing; sort.t100644000764000031 155212701513023 20204 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok array->sort->is_empty, 'empty array sort ok'; my $arr = array(4, 2, 3, 1); my $sorted = $arr->sort(sub { $_[0] <=> $_[1] }); is_deeply [ $sorted->all ], [ 1, 2, 3, 4 ], 'sort with positional args ok'; $sorted = $arr->sort; is_deeply [ $sorted->all ], [ 1, 2, 3, 4 ], 'sort with default sub ok'; is_deeply [ $arr->sort(undef)->all ], [ $arr->sort->all ], 'sort non-subroutine (false) arg ok'; eval {; $arr->sort(1) }; ok $@, 'sort non-subroutine (true) arg dies ok'; my $warned; $SIG{__WARN__} = sub { $warned = shift }; $sorted = $arr->sort(sub { $a <=> $b }); is_deeply [ $sorted->all ], [ 1, 2, 3, 4 ], 'sort with named args ok'; ok !$warned, 'using $a/$b produced no warnings' or fail 'using $a/$b produced warning: '.$warned; done_testing; pick.t100644000764000031 123312701513023 20137 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings; use List::Objects::WithUtils 'array'; my $arr = array('a' .. 'f'); my %as_hash = ( map {; $_ => 1 } $arr->all ); my $picked = $arr->pick(4); ok $picked->count == 4, 'picked 3 items'; ok $picked->uniq->count == 4, 'items are unique'; for my $item ($picked->all) { ok exists $as_hash{$item}, "picked item '$item' ok"; } my $all = $arr->pick(6); is_deeply +{ map {; $_ => 1 } $all->all }, \%as_hash, 'pick (exact element count) ok'; $all = $arr->pick(7); is_deeply +{ map {; $_ => 1 } $all->all }, \%as_hash, 'pick (gt element count) ok'; ok array->pick(3)->is_empty, 'pick on empty array ok'; done_testing clear.t100644000764000031 33512701513023 20067 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(foo => 1, bar => 2); ok $hr->clear == $hr, 'clear returned self'; ok $hr->is_empty, 'clear ok'; done_testing; lotto.pl100644000764000031 271012701513023 20460 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/examples#!/usr/bin/env perl use strict; use warnings FATAL => 'all'; use Lowu; my $selected = []; while ($selected->count < 6) { if ($selected->count == 5) { print " > Selected balls: ", $selected->join('-'), "\n"; my $eball; do { print "Select an extra ball between 1 and 35: "; $eball = ; chomp $eball; } until $eball and $eball > 0 and $eball < 35; $selected->push($eball); last } my $ball; do { my $current = $selected->count; print " > $current balls selected: ", $selected->join('-'), "\n"; print "Select a ball between 1 and 59: "; $ball = ; chomp $ball; } until $ball and $ball > 0 and $ball < 59 and $selected->all_items != $ball; $selected->push($ball); } print " > You selected ", $selected->sliced(0 .. 4)->join('-'), " (", $selected->get(5), ")\n"; my $balls = [ 1 .. 59 ] ->shuffle ->sliced( 1 .. 5 ); my $extra = [ 1 .. 35 ] ->random; print "! Drew: ", $balls->join('-'), ' ', $extra, "\n"; my $hits = $selected->sliced(0 .. 4) ->grep(sub { $balls->any_items == $_[0] }); my $did_hit; if ($hits->has_any) { print "!! You hit on ", $hits->count, " balls: ", $hits->join(', '), "\n"; ++$did_hit } if ($selected->get(0) == $extra) { print "!! You hit on the extra ball ($extra)!\n"; ++$did_hit } print " >> Better luck next time :(\n" unless $did_hit; nsect.t100644000764000031 242312701513023 20327 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 10 ); my $halved = $arr->nsect(2); isa_ok $halved, 'List::Objects::WithUtils::Array', 'nsect returned array obj'; ok $halved->count == 2, 'nsect(2) returned two items'; ok $halved->get(0)->count == $halved->get(1)->count, 'nsect(2) on even set returned even sets'; is_deeply [ $halved->get(0)->all ], [ 1 .. 5 ], 'nsect(2) first set ok' or diag explain $halved; is_deeply [ $halved->get(1)->all ], [ 6 .. 10 ], 'nsect(2) second set ok' or diag explain $halved; my $thrice = $arr->nsect(3); is_deeply [ $thrice->get(0)->all ], [ 1 .. 4 ], 'nsect(3) first set ok' or diag explain $thrice; is_deeply [ $thrice->get(1)->all ], [ 5 .. 7 ], 'nsect(3) second set ok' or diag explain $thrice; is_deeply [ $thrice->get(2)->all ], [ 8 .. 10 ], 'nsect(4) third set ok' or diag explain $thrice; my $zeroarg = array(1..10)->nsect; isa_ok $zeroarg, 'List::Objects::WithUtils::Array'; ok $zeroarg->is_empty, 'zero arg nsect produced empty array obj' or diag explain $zeroarg; my $too_many = array(1..3)->nsect(5); ok $too_many->count == 3, 'total sections limited to array count'; ok array->nsect(3)->is_empty, 'nsect on empty array returns empty array'; done_testing; ssect.t100644000764000031 126212701513023 20334 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 10 ); my $threeper = $arr->ssect(3); ok $threeper->count == 4, 'ssect(3) returned four items'; is_deeply [ $threeper->get(0)->all ], [ 1 .. 3 ], 'ssect(3) first set ok' or diag explain $threeper; is_deeply [ $threeper->get(3)->all ], [ 10 ], 'ssect(3) last set ok' or diag explain $threeper; my $zeroarg = array(1..10)->ssect; isa_ok $zeroarg, 'List::Objects::WithUtils::Array'; ok $zeroarg->is_empty, 'zero arg ssect produced empty array obj' or diag explain $zeroarg; ok array->ssect(3)->is_empty, 'ssect on empty array produced empty array'; done_testing; shift.t100644000764000031 50112701513023 20303 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok !defined array->shift, 'empty array shift ok'; my $arr = array( 1 .. 3 ); my $shifted = $arr->shift; ok $shifted == 1, 'shifted value ok'; is_deeply [ $arr->all ], [ 2, 3 ], 'shift removed correct value'; done_testing; visit.t100644000764000031 60312701513023 20327 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(1,2,3); my $res = []; array->visit(sub { push @$res, $_ }); is_deeply $res, [], 'empty array visit ok'; my $ret = $arr->visit(sub { push @$res, $_ }); ok $ret == $arr, 'visit returned invocant'; is_deeply $res, [ 1, 2, 3 ], 'visit ok' or diag explain $res; done_testing folds.t100644000764000031 153612701513023 20326 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $sum = sub { $_[0] + $_[1] }; my $arr = array(1 .. 3); cmp_ok $arr->reduce($sum), '==', 6, 'reduce with positional args ok'; cmp_ok array(1)->reduce($sum), '==', 1, 'array with one element reduce ok'; ok !defined array->reduce($sum), 'empty array reduce ok'; cmp_ok array(6, 3, 2)->reduce(sub { $a / $b }), '==', 1, 'reduce folds left (with named args)'; cmp_ok array(6, 3, 2)->foldl(sub { $a / $b }), '==', 1, 'foldl folds left'; cmp_ok array(6, 3, 2)->fold_left(sub { $a / $b }), '==', 1, 'fold_left alias ok'; cmp_ok array(2, 3, 6)->foldr(sub { $b / $a }), '==', 1, 'foldr folds right'; cmp_ok array(2, 3, 6)->fold_right(sub { $b / $a }), '==', 1, 'fold_right alias ok'; ok !defined array->foldr($sum), 'empty array foldr ok'; done_testing; clear.t100644000764000031 44312701513023 20261 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 10 ); ok $arr->clear == $arr, 'clear() returned self'; ok $arr->is_empty, 'array is_empty after clear'; ok array->clear->is_empty, 'empty array clear() ok'; done_testing; count.t100644000764000031 41112701513023 20316 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array; ok $arr->count == 0, 'count returned 0 on empty array'; $arr->push( 1, 2, 3); ok $arr->count == 3, 'count returned correct item count'; done_testing; export.t100644000764000031 35412701513023 20323 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash( foo => 'bar', baz => undef ); is_deeply +{ $hr->export }, +{ foo => 'bar', baz => undef }, 'export ok'; done_testing; sliced.t100644000764000031 100112701513023 20253 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(a => 1, b => 2, c => 3, d => 4); my $slice = $hr->sliced('a', 'c', 'z'); ok $slice->keys->count == 2, 'sliced key count ok' or diag explain $slice; ok $slice->get('a') == 1, 'sliced get ok'; ok !$slice->exists('z'), 'nonexistant key ignored'; ok !$slice->get('b'), 'unspecified key ignored'; is_deeply +{ $slice->export }, +{ $hr->slice(qw/a c z/)->export }, 'slice alias ok'; done_testing; kv_map.t100644000764000031 152112701513023 20274 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hs = hash( foo => 1, bar => 2, baz => 3, ); my @res; my $returned = $hs->kv_map( sub { push @res, @_; ($_[0], $_[1] + 1) } ); is_deeply +{ @res }, $hs->unbless, 'kv_map (positional) input ok'; is_deeply $returned->inflate->unbless, +{ foo => 2, bar => 3, baz => 4 }, 'kv_map (positional) retval ok'; my $warned; $SIG{__WARN__} = sub { $warned = shift }; $returned = $hs->kv_map( sub { push @res, $a, $b; ($a, $b + 1) } ); is_deeply +{ @res }, $hs->unbless, 'kv_map (named) input ok'; is_deeply $returned->inflate->unbless, +{ foo => 2, bar => 3, baz => 4 }, 'kv_map (named) retval ok'; ok !$warned, '$a/$b vars produced no warning' or fail 'using $a/$b produced warning: '.$warned; done_testing exists.t100644000764000031 34412701513023 20320 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(foo => 1, baz => 2); ok $hr->exists('foo'), 'exists ok'; ok !$hr->exists('bar'), 'negative exists ok'; done_testing; delete.t100644000764000031 60212701513023 20240 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(foo => 1, baz => 2, bar => 3, quux => 4); $hr->delete('quux'); ok !$hr->get('quux'), 'delete ok'; my $deleted = $hr->delete('foo', 'baz'); ok $deleted->count == 2, 'deleted 2 elements'; is_deeply +{ $hr->export }, +{ bar => 3 }, 'delete (multi-key) ok'; done_testing; values.t100644000764000031 34012701513023 20274 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(foo => 1, bar => 2, baz => 3); is_deeply [ $hr->values->sort->all ], [ 1 .. 3 ], 'values ok'; done_testing; t000755000764000031 012701513023 15247 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003author-no-tabs.t100644000764000031 2030012701513023 20452 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::NoTabs 0.15 use Test::More 0.88; use Test::NoTabs; my @files = ( 'lib/List/Objects/WithUtils.pm', 'lib/List/Objects/WithUtils/Array.pm', 'lib/List/Objects/WithUtils/Array/Immutable.pm', 'lib/List/Objects/WithUtils/Array/Immutable/Typed.pm', 'lib/List/Objects/WithUtils/Array/Junction.pm', 'lib/List/Objects/WithUtils/Array/Typed.pm', 'lib/List/Objects/WithUtils/Autobox.pm', 'lib/List/Objects/WithUtils/Hash.pm', 'lib/List/Objects/WithUtils/Hash/Immutable.pm', 'lib/List/Objects/WithUtils/Hash/Immutable/Typed.pm', 'lib/List/Objects/WithUtils/Hash/Inflated.pm', 'lib/List/Objects/WithUtils/Hash/Inflated/RW.pm', 'lib/List/Objects/WithUtils/Hash/Typed.pm', 'lib/List/Objects/WithUtils/Role/Array.pm', 'lib/List/Objects/WithUtils/Role/Array/Immutable.pm', 'lib/List/Objects/WithUtils/Role/Array/TiedRO.pm', 'lib/List/Objects/WithUtils/Role/Array/Typed.pm', 'lib/List/Objects/WithUtils/Role/Array/WithJunctions.pm', 'lib/List/Objects/WithUtils/Role/Hash.pm', 'lib/List/Objects/WithUtils/Role/Hash/Immutable.pm', 'lib/List/Objects/WithUtils/Role/Hash/TiedRO.pm', 'lib/List/Objects/WithUtils/Role/Hash/Typed.pm', 'lib/Lowu.pm', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/00_load/all.t', 't/00_load/all_typetinyish.t', 't/00_load/autobox.t', 't/00_load/autobox_subclass.t', 't/00_load/badopts.t', 't/00_load/bare.t', 't/00_load/failed_require.t', 't/00_load/functions.t', 't/00_load/hashopts.t', 't/00_load/lowu.t', 't/00_load/selective.t', 't/00_load/targeted.t', 't/01_array/all.t', 't/01_array/bisect.t', 't/01_array/clear.t', 't/01_array/copy.t', 't/01_array/count.t', 't/01_array/defined.t', 't/01_array/delete.t', 't/01_array/delete_when.t', 't/01_array/diff.t', 't/01_array/end.t', 't/01_array/exists.t', 't/01_array/first_index.t', 't/01_array/first_where.t', 't/01_array/flatten.t', 't/01_array/flatten_all.t', 't/01_array/folds.t', 't/01_array/get.t', 't/01_array/get_or_else.t', 't/01_array/grep.t', 't/01_array/has_any.t', 't/01_array/head.t', 't/01_array/indexes.t', 't/01_array/inflate.t', 't/01_array/insert.t', 't/01_array/intersection.t', 't/01_array/is_empty.t', 't/01_array/items_after.t', 't/01_array/items_after_incl.t', 't/01_array/items_before.t', 't/01_array/items_before_incl.t', 't/01_array/join.t', 't/01_array/kv.t', 't/01_array/last_index.t', 't/01_array/last_where.t', 't/01_array/map.t', 't/01_array/mapval.t', 't/01_array/mesh.t', 't/01_array/natatime.t', 't/01_array/nsect.t', 't/01_array/nsort_by.t', 't/01_array/part.t', 't/01_array/part_to_hash.t', 't/01_array/pick.t', 't/01_array/pop.t', 't/01_array/push.t', 't/01_array/random.t', 't/01_array/repeated.t', 't/01_array/reverse.t', 't/01_array/roll.t', 't/01_array/rotate.t', 't/01_array/rotate_in_place.t', 't/01_array/rotator.t', 't/01_array/set.t', 't/01_array/shift.t', 't/01_array/shuffle.t', 't/01_array/sliced.t', 't/01_array/sort.t', 't/01_array/sort_by.t', 't/01_array/splice.t', 't/01_array/squished.t', 't/01_array/ssect.t', 't/01_array/subclassed.t', 't/01_array/tail.t', 't/01_array/tuples.t', 't/01_array/type.t', 't/01_array/unbless.t', 't/01_array/uniq.t', 't/01_array/uniq_by.t', 't/01_array/unshift.t', 't/01_array/utilsby_no_xs.t', 't/01_array/visit.t', 't/02_hash/array_type.t', 't/02_hash/clear.t', 't/02_hash/copy.t', 't/02_hash/defined.t', 't/02_hash/delete.t', 't/02_hash/diff.t', 't/02_hash/exists.t', 't/02_hash/export.t', 't/02_hash/get.t', 't/02_hash/get_or_else.t', 't/02_hash/get_path.t', 't/02_hash/inflate.t', 't/02_hash/intersection.t', 't/02_hash/inverted.t', 't/02_hash/is_empty.t', 't/02_hash/iter.t', 't/02_hash/keys.t', 't/02_hash/kv.t', 't/02_hash/kv_grep.t', 't/02_hash/kv_map.t', 't/02_hash/kv_sort.t', 't/02_hash/maybe_set.t', 't/02_hash/random_key.t', 't/02_hash/random_kv.t', 't/02_hash/random_value.t', 't/02_hash/set.t', 't/02_hash/sliced.t', 't/02_hash/subclassed.t', 't/02_hash/unbless.t', 't/02_hash/values.t', 't/03_junctions/all.t', 't/03_junctions/any.t', 't/03_junctions/subclasses.t', 't/04_immutable/immarray.t', 't/04_immutable/immhash.t', 't/05_typed/array_of.t', 't/05_typed/hash_of.t', 't/05_typed/tuples.t', 't/05_typed/validated.t', 't/06_immutable_typed/immarray_of.t', 't/06_immutable_typed/immhash_of.t', 't/07_json/json.t', 't/08_zpl/zpl.t', 't/09_autobox_array/all.t', 't/09_autobox_array/bisect.t', 't/09_autobox_array/clear.t', 't/09_autobox_array/copy.t', 't/09_autobox_array/count.t', 't/09_autobox_array/defined.t', 't/09_autobox_array/delete.t', 't/09_autobox_array/delete_when.t', 't/09_autobox_array/diff.t', 't/09_autobox_array/end.t', 't/09_autobox_array/exists.t', 't/09_autobox_array/first_index.t', 't/09_autobox_array/first_where.t', 't/09_autobox_array/flatten.t', 't/09_autobox_array/flatten_all.t', 't/09_autobox_array/folds.t', 't/09_autobox_array/get.t', 't/09_autobox_array/get_or_else.t', 't/09_autobox_array/grep.t', 't/09_autobox_array/has_any.t', 't/09_autobox_array/head.t', 't/09_autobox_array/indexes.t', 't/09_autobox_array/inflate.t', 't/09_autobox_array/insert.t', 't/09_autobox_array/intersection.t', 't/09_autobox_array/items_after.t', 't/09_autobox_array/items_after_incl.t', 't/09_autobox_array/items_before.t', 't/09_autobox_array/items_before_incl.t', 't/09_autobox_array/join.t', 't/09_autobox_array/kv.t', 't/09_autobox_array/last_index.t', 't/09_autobox_array/last_where.t', 't/09_autobox_array/map.t', 't/09_autobox_array/mapval.t', 't/09_autobox_array/mesh.t', 't/09_autobox_array/natatime.t', 't/09_autobox_array/nsect.t', 't/09_autobox_array/nsort_by.t', 't/09_autobox_array/part.t', 't/09_autobox_array/part_to_hash.t', 't/09_autobox_array/pop.t', 't/09_autobox_array/push.t', 't/09_autobox_array/random.t', 't/09_autobox_array/reverse.t', 't/09_autobox_array/rotate.t', 't/09_autobox_array/rotate_in_place.t', 't/09_autobox_array/rotator.t', 't/09_autobox_array/set.t', 't/09_autobox_array/shift.t', 't/09_autobox_array/shuffle.t', 't/09_autobox_array/sliced.t', 't/09_autobox_array/sort.t', 't/09_autobox_array/sort_by.t', 't/09_autobox_array/splice.t', 't/09_autobox_array/ssect.t', 't/09_autobox_array/tail.t', 't/09_autobox_array/tuples.t', 't/09_autobox_array/uniq.t', 't/09_autobox_array/uniq_by.t', 't/09_autobox_array/unshift.t', 't/09_autobox_array/utilsby_no_xs.t', 't/09_autobox_array/visit.t', 't/09_autobox_hash/array_type.t', 't/09_autobox_hash/clear.t', 't/09_autobox_hash/copy.t', 't/09_autobox_hash/defined.t', 't/09_autobox_hash/delete.t', 't/09_autobox_hash/diff.t', 't/09_autobox_hash/exists.t', 't/09_autobox_hash/get.t', 't/09_autobox_hash/get_or_else.t', 't/09_autobox_hash/get_path.t', 't/09_autobox_hash/inflate.t', 't/09_autobox_hash/intersection.t', 't/09_autobox_hash/inverted.t', 't/09_autobox_hash/iter.t', 't/09_autobox_hash/keys.t', 't/09_autobox_hash/kv.t', 't/09_autobox_hash/kv_grep.t', 't/09_autobox_hash/kv_map.t', 't/09_autobox_hash/kv_sort.t', 't/09_autobox_hash/maybe_set.t', 't/09_autobox_hash/set.t', 't/09_autobox_hash/sliced.t', 't/09_autobox_hash/values.t', 't/author-no-tabs.t', 't/author-pod-coverage.t', 't/author-pod-syntax.t', 't/release-cpan-changes.t', 't/release-dist-manifest.t', 't/release-pod-linkcheck.t', 't/release-portability.t', 't/release-synopsis.t' ); notabs_ok($_) foreach @files; done_testing; sliced.t100644000764000031 117212701513023 20456 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 7 ); my $sliced = $arr->sliced(0, 2); is_deeply [ $sliced->all ], [ 1, 3 ], 'sliced (2 element) ok'; $sliced = $arr->sliced(0, 2, 4); is_deeply [ $sliced->all ], [ 1, 3, 5 ], 'sliced (3 element) ok'; is_deeply [ $arr->slice(0, 2, 4)->all ], [ $sliced->all ], 'slice alias ok'; my $empty = array; is_deeply [ $empty->sliced(2, 4)->all ], [ undef, undef ], 'sliced (nonexistant elements) ok'; ok $empty->is_empty, 'empty array intact after slice ok' or diag explain $empty; done_testing rotate.t100644000764000031 214112701513023 20506 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(1 .. 4); my $left = $arr->rotate; is_deeply [ $left->all ], [ 2, 3, 4, 1 ], 'rotate default opts ok'; is_deeply [ $arr->all ], [ 1, 2, 3, 4 ], 'original array intact'; is_deeply [ $arr->rotate(left => 1)->all ], [ 2, 3, 4, 1 ], 'rotate leftwards ok'; is_deeply [ $arr->rotate(right => 1)->all ], [ 4, 1, 2, 3 ], 'rotate rightwards ok'; $arr = array(1 .. 2); $left = $arr->rotate; is_deeply [ $left->all ], [ 2, 1 ], 'rotated leftwards once'; $left = $left->rotate; is_deeply [ $left->all ], [ 1, 2 ], 'rotated full-circle (left)'; my $right = $arr->rotate(right => 1); is_deeply [ $right->all ], [ 2, 1 ], 'rotated rightwards once'; $right = $right->rotate; is_deeply [ $right->all ], [ 1, 2 ], 'rotated full-circle (right)'; ok array->rotate(left => 1)->is_empty, 'empty array rotate left ok'; ok array->rotate(right => 1)->is_empty, 'empty array rotate right ok'; eval {; $arr->rotate(left => 1, right => 1) }; like $@, qr/direction/, 'bad opts die ok'; done_testing mapval.t100644000764000031 74212701513023 20455 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 3 ); my $mapval = $arr->mapval(sub { ++$_ }); is_deeply [ $mapval->all ], [ 2, 3, 4 ], 'mapval ok'; is_deeply [ $arr->all ], [ 1, 2, 3 ], 'original intact'; $mapval = $arr->mapval(sub { $_[0]++ }); is_deeply [ $mapval->all ], [ 2, 3, 4 ], 'mapval on $_[0] ok'; ok array->mapval(sub { 1 })->is_empty, 'empty array mapval ok'; done_testing; exists.t100644000764000031 201612701513023 20530 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(1 .. 3); ok $arr->exists(0), 'array exists ok'; ok $arr->exists(1), 'array exists(1) ok'; ok $arr->exists(2), 'array exists(2) ok'; ok !$arr->exists(3), '!array exists(3) ok'; ok !$arr->exists(4), '!array exists(4) ok'; ok $arr->exists(-1), 'array exists(-1) ok'; ok $arr->exists(-2), 'array exists(-2) ok'; ok $arr->exists(-3), 'array exists(-3) ok'; ok !$arr->exists(-4), 'array !exists(-4) ok'; ok !array->exists(0), 'empty array !exists(0) ok'; ok !array->exists(1), 'empty array !exists(1) ok'; ok !array->exists(-1), 'empty array !exists(-1) ok'; ok array(1)->exists(0), 'single-element array exists(0) ok'; ok !array(1)->exists(1), 'single-element array !exists(1) ok'; ok !array(1)->exists(2), 'single-element array !exists(2) ok'; ok array(1)->exists(-1), 'single-element array exists(-1) ok'; ok !array(1)->exists(-2), 'single-element array exists(-2) ok'; done_testing tuples.t100644000764000031 210512701513023 20524 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; # also see t/05_typed/tuples.t use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 7 ); my $tuples = $arr->tuples(2); is_deeply [ $tuples->all ], [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ], [ 7 ] ], 'tuples (pairs, odd elements) ok'; my $default = $arr->tuples; is_deeply [ $default->all ], [ $tuples->all ], 'tuples default 2 ok'; is_deeply [ array(1 .. 6)->tuples->all ], [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ], 'tuples (pairs, even elements) ok'; is_deeply [ array(1 .. 6)->tuples(6)->all ], [ [ 1 .. 6 ] ], 'tuples (all) ok'; ok array->tuples(2)->is_empty, 'empty array tuples ok'; eval {; $arr->tuples(0) }; like $@, qr/positive/, 'tuples < 1 dies ok'; my $withbless = array(1..4)->tuples(2, undef, 'bless'); ok $withbless->count == 2, 'tuples (pairs, blessed) produced 2 tuples'; for (0,1) { isa_ok $withbless->get($_), 'List::Objects::WithUtils::Array', "tuple ($_)"; } is_deeply [ $withbless->all ], [ [ 1, 2 ], [ 3, 4 ] ], 'tuples (pairs, blessed) ok'; done_testing; bisect.t100644000764000031 113312701513023 20461 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 10 ); my $pair = $arr->bisect(sub { $_ >= 5 }); isa_ok $pair, 'List::Objects::WithUtils::Array', 'bisect returned array obj'; ok $pair->count == 2, 'bisect() returned two items'; isa_ok $pair->get(0), 'List::Objects::WithUtils::Array'; isa_ok $pair->get(1), 'List::Objects::WithUtils::Array'; is_deeply [ $pair->get(0)->all ], [ 5 .. 10 ]; is_deeply [ $pair->get(1)->all ], [ 1 .. 4 ]; ok array()->bisect(sub {})->count == 2, 'bisect always returns two arrays'; done_testing; delete.t100644000764000031 55112701513023 20435 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 4 ); my $deleted = $arr->delete(2); cmp_ok $deleted, '==', 3, 'delete returned correct value'; is_deeply [ $arr->all ], [ 1, 2, 4 ], 'value was deleted'; eval {; array->delete(1) }; ok $@, 'trying to delete nonexistant dies'; done_testing; random.t100644000764000031 43412701513023 20453 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok !defined array->random, 'empty array random ok'; my $arr = array(qw/ foo bar /); my $random = $arr->random; ok $random eq 'foo' || $random eq 'bar', 'random() ok'; done_testing; insert.t100644000764000031 222012701513023 20512 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array; my $insert = $arr->insert(0 => 1); ok $insert == $arr, 'insert returned self ok'; is_deeply [ $arr->all ], [ 1 ], 'insert first position on empty list ok'; $arr->insert(4 => 2); is_deeply [ $arr->all ], [ 1, undef, undef, undef, 2 ], 'insert pre-filled nonexistant elems ok'; $arr->insert(3 => 3); is_deeply [ $arr->all ], [ 1, undef, undef, 3, undef, 2 ], 'insert to middle ok'; $arr->insert(5 => 5); is_deeply [ $arr->all ], [ 1, undef, undef, 3, undef, 5, 2 ], 'insert next-to-last ok'; $arr->insert( 7 => 7 ); is_deeply [ $arr->all ], [ 1, undef, undef, 3, undef, 5, 2, 7 ], 'insert last ok'; $arr->insert( 9 => 9 ); is_deeply [ $arr->all ], [ 1, undef, undef, 3, undef, 5, 2, 7, undef, 9 ], 'insert one-off last ok'; $arr->insert( 0 => 0 ); is_deeply [ $arr->all ], [ 0, 1, undef, undef, 3, undef, 5, 2, 7, undef, 9 ], 'insert first ok'; $arr->insert( 2 => 0, 1, 2 ); is_deeply [ $arr->all ], [ 0, 1, 0, 1, 2, undef, undef, 3, undef, 5, 2, 7, undef, 9 ], 'insert multiple ok'; done_testing; splice.t100644000764000031 117712701513023 20477 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(qw/ a b c d /); my $spliced = $arr->splice(2); is_deeply [ $arr->all ], [ qw/ a b / ], 'single arg splice modified orig ok'; is_deeply [ $spliced->all ], [ qw/ c d / ], 'single arg splice ok'; $arr = array(qw/ a b c d /); $spliced = $arr->splice(1, 3); is_deeply [ $arr->all ], [ 'a' ], '2-arg splice modified orig ok'; is_deeply [ $spliced->all ], [ qw/ b c d / ], '2-arg splice ok'; $spliced->splice(2, 1, 'e'); is_deeply [ $spliced->all ], [ qw/ b c e / ], '3-arg splice ok'; done_testing; 05_typed000755000764000031 012701513023 16700 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/ttuples.t100644000764000031 261312701513023 20543 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/05_typed BEGIN { unless ( eval {; require List::Objects::Types; 1 } && !$@ && eval {; require Types::Standard; 1 } && !$@ ) { require Test::More; Test::More::plan(skip_all => 'these tests require List::Objects::Types and Types::Standard' ); } } # also see t/01_array/tuples.t use Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::Types -all; use Types::Standard -all; use List::Objects::WithUtils 'array'; my $arr = array(qw/ foo bar baz quux /); my $tuples = $arr->tuples(2 => Str); is_deeply [ $tuples->all ], [ [ foo => 'bar' ], [ baz => 'quux' ] ], 'tuples with Str check ok'; eval {; $tuples = $arr->tuples(2, Int) }; ok $@ =~ /type/i, 'Int check failed with type err' or diag explain $@; $arr = array( [], [], [], [] ); $tuples = $arr->tuples(2, ArrayObj); ok $tuples->shift->[0]->count == 0, 'ArrayObj coerced in tuple'; $arr = immarray(1.4, 1.6, 2.1, 2.2, 2.5); $tuples = $arr->tuples(2, Int->plus_coercions(Num, sub { int })); ok $tuples->is_immutable, 'tuples on immutable list produced immutable list'; is_deeply [ $tuples->all ], [ [1,1], [2,2], [2] ], 'type coercion on uneven tuples ok'; eval {; $tuples = $arr->tuples(3, 'foo') }; ok $@ =~ /Type::Tiny/, 'bad type dies ok'; { use Lowu; $tuples = [ 1 .. 4 ]->tuples(2, Int); is_deeply [ $tuples->all ], [ [ 1, 2 ], [ 3, 4 ] ], 'autoboxed ->tuples ok'; } done_testing; kv_grep.t100644000764000031 107412701513023 20457 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hs = hash( foo => 1, bar => 2, baz => 3, ); my $res = $hs->kv_grep(sub { $_[1] > 1 }); is_deeply $res->unbless, +{ bar => 2, baz => 3 }, 'kv_grep (positional args) ok'; my $warned; $SIG{__WARN__} = sub { $warned = shift }; $res = $hs->kv_grep(sub { $b > 1 }); is_deeply $res->unbless, +{ bar => 2, baz => 3 }, 'kv_grep (named args) ok'; ok !$warned, '$a/$b vars produced no warning' or fail 'using $a/$b produced warning: '.$warned; done_testing unbless.t100644000764000031 120212701513023 20466 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(foo => 1, bar => 2); my $ref = $hr->unbless; ok ref $ref eq 'HASH', 'unbless returned HASH'; is_deeply $ref, +{ foo => 1, bar => 2 }, 'unbless ok'; $ref = $hr->damn; ok ref $ref eq 'HASH', 'damn returned HASH'; is_deeply $ref, +{ foo => 1, bar => 2 }, 'damn ok'; $ref = $hr->TO_JSON; ok ref $ref eq 'HASH', 'TO_JSON returned HASH'; is_deeply $ref, +{ foo => 1, bar => 2 }, 'TO_JSON ok'; $ref = $hr->TO_ZPL; ok ref $ref eq 'HASH', 'TO_ZPL returned HASH'; is_deeply $ref, +{ foo => 1, bar => 2 }, 'TO_ZPL ok'; done_testing; inflate.t100644000764000031 301112701513023 20435 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $obj = hash(foo => 'bar', baz => 'quux')->inflate; ok $obj->foo eq 'bar'; ok $obj->baz eq 'quux'; my $cref = $obj->can('foo'); ok ref $cref eq 'CODE', 'can() on inflated obj returned code ref'; ok $obj->$cref eq 'bar', 'can() coderef works'; ok !$obj->can('cake'), 'negative can() ok'; my $isa = $obj->can('isa'); ok ref $isa eq 'CODE', 'can() fetched UNIVERSAL method ok'; ok $isa->($obj, 'List::Objects::WithUtils::Hash::Inflated'), 'autoloaded isa ok'; { local $@; eval {; $obj->set }; ok $@, 'nonexistant key dies ok'; } { local $@; eval {; $obj->foo('bar') }; ok $@, 'read-only inflated hash setter attempt dies ok'; } { local $@; my $pkg = ref $obj; eval {; $pkg->foo }; like $@, qr/class method/, 'attempt to call class method dies ok'; } my %deflated = $obj->DEFLATE; ok $deflated{foo} eq 'bar', 'deflated HASH looks ok'; my $rwobj = hash(foo => 1, baz => 2)->inflate(rw => 1); ok $rwobj->foo == 1, 'rw inflated obj ok'; ok $rwobj->foo('bar') eq 'bar', 'rw inflated obj setter ok'; ok $rwobj->foo eq 'bar', 'rw inflated obj set attrib ok'; { local $@; eval {; $rwobj->set }; like $@, qr/object method/, 'nonexistant key dies ok (rw)'; } { local $@; eval {; $rwobj->foo(qw/bar baz/) }; like $@, qr/Multiple arguments/i, 'multiple args setter dies ok'; } { local $@; my $pkg = ref $rwobj; eval {; $pkg->foo }; like $@, qr/class method/, 'attempt to call class method on rw dies ok'; } done_testing; defined.t100644000764000031 43612701513023 20401 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(foo => 1, baz => undef); ok $hr->defined('foo'), 'defined ok'; ok !$hr->defined('baz'), 'negative defined ok'; ok !$hr->defined('bar'), 'nonexistant defined ok'; done_testing; kv_sort.t100644000764000031 170412701513023 20511 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(map {; $_ => 1 } qw/d b c a/); is_deeply [ $hr->kv_sort->all ], [ [ a => 1 ], [ b => 1 ], [ c => 1 ], [ d => 1 ] ], 'kv_sort default ok'; is_deeply [ $hr->kv_sort(undef)->all ], [ $hr->kv_sort->all ], 'kv_sort non-subroutine (false) arg ok'; eval {; $hr->kv_sort(1) }; ok $@, 'kv_sort non-subroutine (true) arg dies ok'; is_deeply [ $hr->kv_sort(sub { $_[1] cmp $_[0] })->all ], [ [ d => 1 ], [ c => 1 ], [ b => 1 ], [ a => 1 ], ], 'kv_sort with positional args ok'; my $warned; $SIG{__WARN__} = sub { $warned = shift }; is_deeply [ $hr->kv_sort(sub { $b cmp $a })->all ], [ [ d => 1 ], [ c => 1 ], [ b => 1 ], [ a => 1 ], ], 'kv_sort with named args ok'; ok !$warned, 'using $a/$b produced no warnings' or fail 'using $a/$b produced warning: '.$warned; done_testing; autobox.t100644000764000031 41012701513023 20446 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; { use List::Objects::WithUtils 'autobox'; cmp_ok []->count, '==', 0, 'autobox import ok'; } { use List::Objects::WithUtils -autobox; cmp_ok []->count, '==', 0, '-autobox import ok'; } done_testing; badopts.t100644000764000031 53412701513023 20430 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; require List::Objects::WithUtils; eval {; List::Objects::WithUtils->import([]) }; like $@, qr/Expected a list of imports/i, 'bad import croaks ok'; eval {; List::Objects::WithUtils->import(qw/array foo/) }; like $@, qr/Unknown import parameter/i, 'bad function croaks ok'; done_testing; uniq_by.t100644000764000031 71112701513023 20637 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_array# (also see utilsby_no_xs.t) use Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( { id => 1 }, { id => 2 }, { id => 1 }, { id => 3 }, { id => 3 }, ); my $uniq = $arr->uniq_by(sub { $_->{id} }); is_deeply [ $uniq->all ], [ { id => 1 }, { id => 2 }, { id => 3 }, ], 'uniq_by ok'; ok array->uniq_by(sub { $_->foo })->is_empty, 'empty array uniq_by ok'; done_testing; shuffle.t100644000764000031 72112701513023 20626 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(1, 2, 3); my $shuffled = $arr->shuffle; ok $shuffled->has_any(sub { $_ == 1 }) && $shuffled->has_any(sub { $_ == 2 }) && $shuffled->has_any(sub { $_ == 3 }) && $shuffled->count == 3, 'shuffle() ok'; is_deeply [ $arr->all ], [ 1, 2, 3 ], 'original array intact'; ok array->shuffle->is_empty, 'empty array shuffle ok'; done_testing; has_any.t100644000764000031 64612701513023 20622 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array; ok !$arr->has_any, 'negative bare has_any ok'; $arr->push(qw/ a b c /); ok $arr->has_any, 'bare has_any ok'; ok $arr->has_any(sub { /b/ }), 'has_any ok'; ok !$arr->has_any(sub { /d/ }), 'negative has_any ok'; ok array(1, 2, undef)->has_any(sub { !defined }), 'has_any search for undef ok'; done_testing; reverse.t100644000764000031 53612701513023 20651 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok array->reverse->is_empty, 'empty array reverse ok'; my $arr = array( 1, 2, 3); my $reverse = $arr->reverse; is_deeply [ $reverse->all ], [ 3, 2, 1 ], 'reverse ok'; is_deeply [ $arr->all ], [ 1, 2, 3 ], 'original intact'; done_testing; flatten.t100644000764000031 236012701513023 20650 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; is_deeply [ array->flatten ], [ ], 'empty array flatten with no args ok'; is_deeply [ array->flatten(1) ], [ ], 'empty array flatten-to-depth ok'; my $arr = array( 1, 2, [ 3, 4, [ 5, 6 ], 7 ] ); is_deeply [ $arr->flatten ], [ $arr->all ], 'flatten with no args same as all() ok'; is_deeply [ $arr->flatten(0) ], [ $arr->all ], 'flatten to depth 0 same as all() ok'; is_deeply [ $arr->flatten(-1) ], [ $arr->all ], 'flatten to negative depth same as all() ok'; is_deeply [ $arr->flatten(1) ], [ 1, 2, 3, 4, [ 5, 6 ], 7 ], 'flatten to depth 1 ok'; is_deeply [ $arr->flatten(2) ], [ 1, 2, 3, 4, 5, 6, 7 ], 'flatten to depth 2 ok'; $arr = array( 1, 2, [ 3, 4, [ 5, 6 ] ], [ 7, 8, [ 9, 10 ] ], ); is_deeply [ $arr->flatten(1) ], [ 1, 2, 3, 4, [ 5, 6 ], 7, 8, [ 9, 10 ] ], 'flatten complex array ok'; { package My::ArrayType; use strict; use warnings FATAL => 'all'; sub new { bless [1], shift } } my $foo = My::ArrayType->new; $arr = array( array(1, 2, 3), $foo, [ 4, 5, 6 ], ); is_deeply [ $arr->flatten(1) ], [ 1, 2, 3, $foo, 4, 5, 6 ], 'flatten skipped ARRAY-type obj ok'; done_testing; sort_by.t100644000764000031 112512701513023 20672 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_array# (also see utilsby_no_xs.t) use Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; if ($List::Objects::WithUtils::Role::Array::UsingUtilsByXS) { diag "\nUsing List::UtilsBy::XS\n" } else { diag "\nUsing List::UtilsBy (XS not found)\n" } my $arr = array( +{ id => 'c' }, +{ id => 'a' }, +{ id => 'b' }, ); my $sorted = $arr->sort_by(sub { $_->{id} }); is_deeply [ $sorted->all ], [ +{ id => 'a' }, +{ id => 'b' }, +{ id => 'c' } ], 'sort_by ok'; ok array->sort_by(sub { $_->foo })->is_empty, 'empty array sort_by ok'; done_testing; unshift.t100644000764000031 52612701513023 20655 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(4); my $unshifted = $arr->unshift( 1 .. 3 ); ok $unshifted == $arr, 'unshift returned self'; is_deeply [ $arr->all ], [ 1 .. 4 ], 'unshift ok'; ok array->unshift(1)->count == 1, 'unshift to empty array ok'; done_testing; unbless.t100644000764000031 121612701513023 20665 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(1 .. 3); my $ref = $arr->unbless; ok ref $ref eq 'ARRAY', 'unbless returned ARRAY'; is_deeply $ref, [ 1 .. 3 ], 'unbless ok'; ok ref array->unbless eq 'ARRAY', 'empty array unbless ok'; $ref = $arr->damn; ok ref $ref eq 'ARRAY', 'damn returned ARRAY'; is_deeply $ref, [ 1 .. 3 ], 'damn ok'; $ref = $arr->TO_JSON; ok ref $ref eq 'ARRAY', 'TO_JSON returned ARRAY'; is_deeply $ref, [ 1 .. 3 ], 'TO_JSON ok'; $ref = $arr->TO_ZPL; ok ref $ref eq 'ARRAY', 'TO_ZPL returned ARRAY'; is_deeply $ref, [ 1 .. 3 ], 'TO_ZPL ok'; done_testing; inflate.t100644000764000031 62512701513023 20617 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( foo => 1, bar => 2 ); my $hash = $arr->inflate; ok $hash->does('List::Objects::WithUtils::Role::Hash'), 'inflate ok'; ok $hash->get('foo') == 1 && $hash->get('bar') == 2, 'inflated hash looks ok'; $hash = array->inflate; ok $hash->is_empty, 'empty array inflate ok'; done_testing; defined.t100644000764000031 45412701513023 20573 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(1, undef, 3); ok $arr->defined(0), 'defined(0) ok'; ok !$arr->defined(1), '!defined(1) ok'; ok $arr->defined(2), 'defined(2) ok'; ok !$arr->defined(3), '!defined(3) ok'; done_testing indexes.t100644000764000031 117412701513023 20654 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok !array->indexes(sub { 1 })->has_any, 'empty indexes ok'; my $arr = array(qw/foo bar baz/); my $idx = $arr->indexes(sub { $_ eq 'bar' }); is_deeply [ $idx->all ], [ 1 ], 'indexes (single) ok'; is_deeply [ $idx->all ], [ $arr->indices(sub { $_ eq 'bar' })->all ], 'indices alias ok'; $arr = array( 1 .. 10 ); $idx = $arr->indexes(sub { $_ % 2 == 0 }); is_deeply [ $idx->all ], [ 1, 3, 5, 7, 9 ], 'indexes (multiple) ok'; $idx = $arr->indexes; is_deeply [ $idx->all ], [ 0 .. 9 ], 'indexes (no arguments) ok'; done_testing rotator.t100644000764000031 51312701513023 20663 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $empty = array->rotator; ok !defined $empty->(), 'empty rotator ok'; my $rotator = array(1, 2, 3)->rotator; my @vals = map {; $rotator->() } 1 .. 7; is_deeply [ @vals ], [ 1, 2, 3, 1, 2, 3, 1 ], 'rotator ok'; done_testing 03_junctions000755000764000031 012701513023 17565 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/tany.t100644000764000031 711512701513023 20705 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/03_junctionsuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok array()->any_items->isa('List::Objects::WithUtils::Array'), 'subclass ok'; # == ok array(2, 3.0)->any_items == 2, '=='; ok array(2, 3.0)->any_items == 3, '=='; ok not( array(2, 3.0)->any_items == 4 ), 'negative =='; # != ok array(3, 4.0)->any_items != 4, '!='; ok array(4, 5.0)->any_items != 4, '!='; ok not( array(3, 3.0)->any_items != 3 ), 'negative !='; # >= ok array(3, 4, 5)->any_items >= 5, '>='; ok array(3, 4, 5)->any_items >= 2, '>='; ok 6 >= array(3, 4, 5)->any_items, '>= switched'; ok 3 >= array(3, 4, 5)->any_items, '>= switched'; ok not( array(3, 4, 5)->any_items >= 6 ), 'negative >='; ok not( 2 >= array(3, 4, 5)->any_items ), 'negative >= switched'; # > ok array(3, 4, 5)->any_items > 2, '>'; ok array(3, 4, 5)->any_items > 3, '>'; ok 6 > array(3, 4, 5)->any_items, '> switched'; ok 4 > array(3, 4, 5)->any_items, '> switched'; ok not( array(3, 4, 5)->any_items > 6 ), 'negative >'; ok not( 2 > array(3, 4, 5)->any_items ), 'negative > switched'; # <= ok array(3, 4, 5)->any_items <= 5, '<='; ok array(3, 4, 5)->any_items <= 6, '<='; ok 5 <= array(3, 4, 5)->any_items, '<= switched'; ok 2 <= array(3, 4, 5)->any_items, '<= switched'; ok not( array(3, 4, 5)->any_items <= 2 ), 'negative <='; ok not( 6 <= array(3, 4, 5)->any_items ), 'negative <= switched'; # < ok array(3, 4, 5)->any_items < 6, '<'; ok array(3, 4, 5)->any_items < 4, '<'; ok 2 < array(3, 4, 5)->any_items, '< switched'; ok 4 < array(3, 4, 5)->any_items, '< switched'; ok not( array(3, 4, 5)->any_items < 2 ), 'negative <'; ok not( 6 < array(3, 4, 5)->any_items ), 'negative < switched'; # eq ok array(qw/ g h /)->any_items eq 'g', 'eq'; ok not( array(qw/ g h /)->any_items eq 'z' ), 'negative eq'; # ne ok array( qw/ g h /)->any_items ne 'g', 'ne'; ok not( array(qw/ a a /)->any_items ne 'a' ), 'negative ne'; # ge ok array(qw/ g h /)->any_items ge 'f', 'ge'; ok array(qw/ g h /)->any_items ge 'g', 'ge'; ok 'i' ge array(qw/ g h /)->any_items, 'ge switched'; ok 'g' ge array(qw/ g f /)->any_items, 'ge switched'; ok not( array(qw/ g h/)->any_items ge 'i' ), 'negative ge'; ok not( 'f' ge array(qw/ g h /)->any_items ), 'negative ge switched'; # gt ok array(qw/ g h /)->any_items gt 'f', 'gt'; ok array(qw/ g h /)->any_items gt 'g', 'gt'; ok 'i' gt array(qw/ h g /)->any_items, 'gt switched'; ok 'h' gt array(qw/ h g /)->any_items, 'gt switched'; ok not( array(qw/ g h /)->any_items gt 'i' ), 'negative gt'; ok not( 'g' gt array(qw/ g h /)->any_items ), 'negative gt switched'; ok not( 'f' gt array(qw/ g h /)->any_items ), 'negative gt switched'; # le ok array(qw/ g h /)->any_items le 'i', 'le'; ok array(qw/ g f /)->any_items le 'g', 'le'; ok 'f' le array(qw/ g h /)->any_items, 'le switched'; ok 'g' le array(qw/ h g /)->any_items, 'le switched'; ok not( array(qw/ g h /)->any_items le 'f' ), 'negative le'; ok not( 'i' le array(qw/ g h /)->any_items ), 'negative le switched'; # lt ok array(qw/ g h /)->any_items lt 'i', 'lt'; ok array(qw/ h g /)->any_items lt 'h', 'lt'; ok 'f' lt array(qw/ g h /)->any_items, 'lt switched'; ok 'g' lt array(qw/ h g /)->any_items, 'lt switched'; ok not( array(qw/ g h /)->any_items lt 'f' ), 'negative lt'; ok not( 'i' lt array(qw/ g h /)->any_items ), 'negative lt switched'; # regex ok array(3, 'b')->any_items == qr/\d+/, '== regex'; ok array(3, 4, 'a')->any_items != qr/\d/, '!= regex'; ok not(array(3,4,'a')->any_items == qr/b/), 'negated regex'; # bool ok array(2, 0)->any_items, 'bool with zero'; ok array('', 'a')->any_items, 'bool with empty str'; ok !array(undef, 0)->any_items, 'negative bool'; done_testing; all.t100644000764000031 1013312701513023 20700 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/03_junctionsuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; ok array()->all_items->does('List::Objects::WithUtils::Role::Array'); # == ok array(3, 3.0)->all_items == 3, '=='; ok array(3, 3 )->all_items == 3, '=='; ok array(3, 3.0, 3)->all_items == 3, '=='; ok not( array(2, 3)->all_items == 3 ), 'negative =='; ok not( array(2, 3, 3)->all_items == 3 ), 'negative =='; # != ok array(3, 4, 5)->all_items != 2, '!='; ok array(3, 3, 5)->all_items != 2, '!='; ok array(3, 3, 3.0)->all_items != 2, '!='; ok not( array(3, 4, 5)->all_items != 3 ), 'negative !='; ok not( array(3, 3.0)->all_items != 3 ), 'negative !='; # >= ok array(3, 4, 5)->all_items >= 2, '>='; ok array(3, 4, 5)->all_items >= 3, '>='; ok 6 >= array(3, 4, 5)->all_items, '>= switched'; ok 5 >= array(3, 4, 5)->all_items, '>= switched'; ok not( array(3, 4, 5)->all_items >= 5 ), 'negative >='; ok not( 2 >= array(3, 4, 5)->all_items ), 'negative >= switched'; # > ok array(3, 4, 5)->all_items > 2, '>'; ok 6 > array(3, 4, 5)->all_items, '> switched'; ok not( array(3, 4, 5)->all_items > 4 ), 'negative >'; ok not( 2 > array(3, 4, 5)->all_items ), 'negative > switched'; # <= ok array(3, 4, 5)->all_items <= 5, '<='; ok array(3, 4, 5)->all_items <= 6, '<='; ok 2 <= array(3, 4, 5)->all_items, '<= switched'; ok 3 <= array(3, 4, 5)->all_items, '<= switched'; ok not( array(3, 4, 5)->all_items <= 2 ), 'negative <='; ok not( 6 <= array(3, 4, 5)->all_items ), 'negative <= switched'; # < ok array(3, 4, 5)->all_items < 6, '<'; ok 2 < array(3, 4, 5)->all_items, '< switched'; ok not( array(3, 4, 5)->all_items < 5 ), 'negative <'; ok not( array(3, 4, 5)->all_items < 2 ), 'negative <'; ok not( 5 < array(3, 4, 5)->all_items ), 'negative < switched'; ok not( 6 < array(3, 4, 5)->all_items ), 'negative < switched'; # eq ok array('a', 'a')->all_items eq 'a', 'eq'; ok not( array('a', 'b')->all_items eq 'a' ), 'negative eq'; # ne ok array('a', 'b')->all_items ne 'c', 'ne'; ok not( array('a', 'b')->all_items ne 'a' ), 'negative ne'; # ge ok array('g', 'h')->all_items ge 'g', 'ge'; ok array('g', 'h')->all_items ge 'f', 'ge'; ok 'i' ge array('g', 'h')->all_items, 'ge switched'; ok 'h' ge array('g', 'h')->all_items, 'ge switched'; ok not( array('g', 'h')->all_items ge 'i' ), 'negative ge'; ok not( 'f' ge array('g', 'h')->all_items ), 'negative ge switched'; # gt ok array('g', 'h')->all_items gt 'f', 'gt'; ok 'i' gt array('g', 'h')->all_items, 'gt switched'; ok not( array('a', 'h')->all_items gt 'e' ), 'negative gt'; ok not( array('g', 'h')->all_items gt 'g' ), 'negative gt'; ok not( 'f' gt array('g', 'h')->all_items ), 'negative gt switched'; ok not( 'g' gt array('g', 'h')->all_items ), 'negative gt switched'; # le ok array('g', 'h')->all_items le 'i', 'le'; ok array('g', 'h')->all_items le 'h', 'le'; ok 'f' le array('g', 'h')->all_items, 'le switched'; ok 'g' le array('g', 'h')->all_items, 'le switched'; ok not( array('g', 'h')->all_items le 'f'), 'negative le'; ok not( 'i' le array('g', 'h')->all_items ), 'negative le switched'; # lt ok array('g', 'h')->all_items lt 'i', 'lt'; ok 'f' lt array('g', 'h')->all_items, 'lt switched'; ok not( array('b', 'h')->all_items lt 'a' ), 'negative lt'; ok not( array('g', 'h')->all_items lt 'f' ), 'negative lt'; ok not( 'h' lt array('g', 'h')->all_items ), 'negative lt switched'; ok not( 'i' lt array('g', 'h')->all_items ), 'negative lt switched'; # regex ok array(3, 10)->all_items == qr/\d+/, '== regex'; ok qr/^[ab]$/ == array('a', 'b')->all_items, '== regex switched'; ok not( array(2, 3, 'c')->all_items == qr/\d+/ ), 'negative == regex'; ok not( qr/\d/ == array('a', 'b', 1)->all_items ), 'negative == regex switched'; ok array(3, 4, 5)->all_items != qr/[a-z]/, '!= regex'; ok array('a', 'b', 'c')->all_items != qr/\d/, '!= regex'; ok not( array(3, 4, 5)->all_items != qr/4/ ), 'negative != regex'; ok not( qr/4/ != array(3, 4, 5)->all_items ), 'negative != regex switched'; # bool ok array( 2, 2 )->all_items, 'bool'; ok !array( 2, 0 )->all_items, 'negative bool'; ok !array( '', 'a' )->all_items, 'negative bool'; ok !array( 'a', undef, 'b' )->all_items, 'negative bool'; done_testing; hash_of.t100644000764000031 400112701513023 20627 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/05_typed BEGIN { unless (eval {; require Types::Standard; 1 } && !$@) { require Test::More; Test::More::plan(skip_all => 'these tests require Types::Standard' ); } } { package AlwaysTrue; sub new { bless [], shift } sub check { 1 } } { package AlwaysFalse; sub new { bless [], shift } sub check { 0 } sub get_message { "failed type constraint" } } use Test::More; use strict; use warnings FATAL => 'all'; use Types::Standard -all; # hash_of { use List::Objects::WithUtils 'hash', 'hash_of'; my $h = hash_of Int() => (foo => 1, bar => 2); ok $h->type == Int, 'type returned Int ok'; ok !hash->type, 'plain HashObj has no type ok'; my $customtype = hash_of( AlwaysTrue->new, foo => 1, bar => 2 ); ok $customtype->keys->count == 2, 'non-TT type ok (true)'; eval {; $customtype = hash_of( AlwaysFalse->new, foo => 1 ) }; ok $@ =~ /constraint/, 'non-TT type ok (false)' or diag explain $@; eval {; my $bad = hash_of( Int() => qw/foo 1 bar baz/) }; ok $@ =~ /constraint/, 'array_of invalid type died ok' or diag explain $@; eval {; $h->set(baz => 3.14159) }; ok $@ =~ /type/, 'invalid type set died ok'; ok $h->set(baz => 3), 'valid type set ok'; ok $h->keys->count == 3, 'count ok after set'; my $copy = $h->copy; isa_ok $copy, 'List::Objects::WithUtils::Hash::Typed'; ok $copy->type == $h->type, 'copy has same type ok'; is_deeply +{ $copy->export }, +{ $h->export }, 'copy ok'; my $untyped = $h->untyped; isa_ok $untyped, 'List::Objects::WithUtils::Hash'; ok !$untyped->type, 'untyped has no type ok'; ok $untyped->set(baz => 'quux'), 'untyped dropped type ok'; } # tied hash { use List::Objects::WithUtils 'hash_of'; my $h = hash_of Int() => (foo => 1, bar => 2); eval {; $h->{foo} = 'bar' }; ok $@ =~ /type/, 'invalid type set died ok'; } { my $warned; local $SIG{__WARN__} = sub { $warned = shift }; my $h = hash_of Int() => (a => 1, b => 2, c => 3); $h->kv_sort(sub { $a cmp $b }); ok !$warned, 'hash_of imported $a/$b vars ok'; } done_testing; is_empty.t100644000764000031 30712701513023 20631 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; ok hash->is_empty, 'is_empty ok'; ok !hash(foo => 1)->is_empty, 'negative is_empty ok'; done_testing; inverted.t100644000764000031 133712701513023 20644 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash', 'array'; my $hr = hash( a => 1, b => 1, c => 2, d => 3, ); my $inv = $hr->inverted; ok $inv->keys->count == 3, 'correct key count in inverted hash' or diag explain $hr; for my $idx (1,2,3) { ok $inv->get($idx)->does('List::Objects::WithUtils::Role::Array'), "key $idx isa array obj"; ok $inv->get($idx)->has_any, "key $idx has elements"; } is_deeply +{ map {; $_ => 1 } $inv->get(1)->all }, +{ map {; $_ => 1 } qw/a b/ }, 'inverted multiples ok'; is_deeply [ $inv->get(2)->export ], [ 'c' ], 'inverted single ok'; is_deeply [ $inv->get(3)->export ], [ 'd' ], 'inverted single ok (2)'; done_testing get_path.t100644000764000031 225112701513023 20613 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $someref = +{}; my $hr = hash( scalar => 1, hash => +{ a => 1, b => +{ x => 10 }, }, hashobj => hash( c => $someref, d => [], e => [ 1, { z => 9 }, ], ), ); cmp_ok $hr->get_path('scalar'), '==', 1, 'shallow get_path ok'; cmp_ok $hr->get_path(qw/hash b x/), '==', 10, 'deep get_path ok'; cmp_ok $hr->get_path(qw/hashobj c/), '==', $someref, 'hash obj get_path ok'; ok !defined $hr->get_path(qw/hashobj c foo/), 'nonexistant element at end of path returned undef'; ok !defined $hr->get_path(qw/foo bar baz/), 'nonexistant element at start of path returned undef'; my @item = $hr->get_path(qw/foo bar baz/); ok @item == 1 && !defined $item[0], 'get_path returned explicit undef'; cmp_ok $hr->get_path( 'hashobj', 'e', [1], 'z' ), '==', 9, 'get_path with array elements ok'; ok !$hr->exists('foo'), 'no autoviv ok'; eval {; $hr->get_path(qw/hashobj d foo /) }; ok $@, 'attempting to access array as hash dies'; eval {; $hr->get_path(hashobj => c => [1]) }; ok $@, 'attempting to access hash as array dies'; done_testing hashopts.t100644000764000031 51512701513023 20624 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils +{ import => [ qw/ array hash / ], }; ok __PACKAGE__->can( 'array' ), 'hashopts imported array ok'; ok __PACKAGE__->can( 'hash' ), 'hashopts imported hash ok'; ok not( __PACKAGE__->can( 'immarray' ) ), 'immarray not imported'; done_testing; targeted.t100644000764000031 115612701513023 20614 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; { package My::Defaults; use strict; use warnings FATAL => 'all'; use parent 'List::Objects::WithUtils'; sub import { my ($class) = @_; $class->SUPER::import( +{ import => [ 'autobox', 'immarray' ], to => 'My::Target', } ) } } { package My::Target; use strict; use warnings FATAL => 'all'; use Test::More; BEGIN { My::Defaults->import } ok __PACKAGE__->can('immarray'), 'immarray ok'; ok not( __PACKAGE__->can('array') ), 'omitted array ok'; cmp_ok []->count, '==', 0, 'autobox ok'; } done_testing; release-synopsis.t100644000764000031 31612701513023 21061 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::Synopsis; all_synopsis_ok(); bench000755000764000031 012701513023 16063 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003constructors.pl100644000764000031 214312701513023 21330 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/benchuse strict; use warnings; use feature 'say'; use Types::Standard 'Num'; use List::Objects::WithUtils; use Benchmark 'cmpthese', 'timethese'; say " >>> array types <<<"; my @values = ( 1 .. 100 ); my $basic = sub { my $arr = array @values }; my $immutable = sub { my $arr = immarray @values }; my $typed = sub { my $arr = array_of Num() => @values }; my $typed_immutable = sub { my $arr = immarray_of Num() => @values }; my $results = timethese( 100_000 => +{ array => $basic, immarray => $immutable, array_of => $typed, immarray_of => $typed_immutable, } ); cmpthese($results); say " >>> hash types <<<"; my $ltr = 'a'; my %hsh = map {; $ltr++ => $_ } 1 .. 100; $basic = sub { my $hash = hash %hsh }; $immutable = sub { my $hash = immhash %hsh }; $typed = sub { my $hash = hash_of Num() => %hsh }; $typed_immutable = sub { my $hash = immhash_of Num() => %hsh }; my $hash_results = timethese( 100_000 => +{ hash => $basic, immhash => $immutable, hash_of => $typed, immhash_of => $typed_immutable, } ); cmpthese($hash_results); squished.t100644000764000031 161312701513023 21040 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings; use Lowu 'array'; my $arr = array(qw/a b b c d c c e b/); my $squished = $arr->squished; is_deeply [ $squished->all ], [ qw/a b c d c e b/ ], 'squished ok'; is_deeply [ $arr->squish->all ], [ $squished->all ], 'squish alias ok'; $arr = array('a', 'b', undef, 'b', undef, undef, 'c'); is_deeply [ $arr->squished->all ], [ 'a', 'b', undef, 'b', undef, 'c' ], 'squished with (middle) undefs ok'; $arr = array(undef, undef, 'a', 'b'); is_deeply [ $arr->squished->all ], [ undef, 'a', 'b' ], 'squished with (leading) undefs ok'; $arr = array(undef, 'a', 'a', 'b'); is_deeply [ $arr->squished->all ], [ undef, 'a', 'b' ], 'squished with leading single undef ok'; $arr = array('a', 'b', 'c'); is_deeply [ $arr->squished->all ], [ 'a', 'b', 'c' ], 'squished (no squished values) ok'; ok array->squished->is_empty, 'squished on empty array ok'; done_testing is_empty.t100644000764000031 33612701513023 21025 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array; ok $arr->is_empty, 'is_empty ok'; $arr->push(1); ok !$arr->is_empty, 'negative is_empty ok'; done_testing; nsort_by.t100644000764000031 65412701513023 21036 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_array# (also see utilsby_no_xs.t) use Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( +{ id => 2 }, +{ id => 1 }, +{ id => 3 }, ); my $sorted = $arr->nsort_by(sub { $_->{id} }); is_deeply [ $sorted->all ], [ +{ id => 1 }, +{ id => 2 }, +{ id => 3 } ], 'nsort_by ok'; ok array->nsort_by(sub { $_->foo })->is_empty, 'empty array nsort_by ok'; done_testing; natatime.t100644000764000031 105612701513023 21016 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 7 ); my $itr = $arr->natatime(3); is_deeply [ $itr->() ], [1, 2, 3], 'natatime itr() 1 ok'; is_deeply [ $itr->() ], [4, 5, 6], 'natatime itr() 2 ok'; is_deeply [ $itr->() ], [7], 'natatime itr() 3 ok'; ok !$itr->(), 'last itr returned false'; my $counted; $arr->natatime(3, sub { ++$counted }); is $counted, 3, 'natatime with coderef ok'; $itr = array->natatime(2); ok !defined $itr->(), 'empty array itr returned undef'; done_testing; repeated.t100644000764000031 55612701513023 20771 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings; use Lowu 'array'; my $arr = array( 'a', 'b', 'c', 'b', 'e', 'c', 'b' ); my $rep = $arr->repeated; is_deeply [ $rep->sort->all ], [qw/b c/], 'repeated ok'; $rep = array('a', 'b', 'c')->repeated; ok $rep->is_empty, 'repeated with zero repeats ok'; ok array->repeated->is_empty, 'repeated on empty array ok'; done_testing array_of.t100644000764000031 637712701513023 21044 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/05_typed BEGIN { unless (eval {; require Types::Standard; 1 } && !$@) { require Test::More; Test::More::plan(skip_all => 'these tests require Types::Standard' ); } } { package AlwaysTrue; sub new { bless [], shift } sub check { 1 } } { package AlwaysFalse; sub new { bless [], shift } sub check { 0 } sub get_message { "failed type constraint" } } use Test::More; use strict; use warnings FATAL => 'all'; use Types::Standard -all; # array_of { use List::Objects::WithUtils 'array', 'array_of'; my $arr = array_of Int() => 1 .. 3; ok $arr->type == Int, 'type returned Int ok'; ok !array->type, 'plain ArrayObj has no type ok'; my $customtype = array_of( AlwaysTrue->new, 1 .. 3 ); ok $customtype->count == 3, 'non-TT type ok (true)'; eval {; $customtype = array_of( AlwaysFalse->new, 1 .. 3 ) }; ok $@ =~ /constraint/, 'non-TT type ok (false)' or diag explain $@; $arr->rotate_in_place; is_deeply [ $arr->all ], [ 2, 3, 1 ], 'rotate_in_place ok'; { my $warned; local $SIG{__WARN__} = sub { $warned++ }; $arr->sort(sub { $a <=> $b }); ok !$warned, 'array_of imported $a/$b vars ok'; } eval {; my $bad = array_of( Int() => qw/foo 1 2/) }; ok $@ =~ /constraint/, 'array_of invalid type died ok' or diag explain $@; eval {; $arr->push('foo') }; ok $@ =~ /type/, 'invalid type push died ok'; ok $arr->push(4 .. 6), 'valid type push ok'; ok $arr->count == 6, 'count ok after push'; eval {; $arr->unshift('bar') }; ok $@ =~ /type/, 'invalid type unshift died ok'; ok $arr->unshift(7 .. 9), 'valid type unshift ok'; ok $arr->count == 9, 'count ok after unshift'; eval {; $arr->set(0 => 'foo') }; ok $@ =~ /type/, 'invalid type set died ok'; ok $arr->set(0 => 0), 'valid type set ok'; eval {; $arr->insert(0 => 'foo') }; ok $@ =~ /type/, 'invalid type insert died ok'; ok $arr->insert(0 => 1), 'valid type insert ok'; eval {; $arr->splice(0, 1, 'foo') }; ok $@ =~ /type/, 'invalid type splice died ok'; ok $arr->splice(0, 1, 2), 'valid type splice ok'; ok $arr->splice(0, 1), 'splice without value ok'; eval {; $arr->map(sub { 'foo' }) }; ok $@ =~ /type/, 'invalid reconstruction died ok'; my $mapped; ok $mapped = $arr->map(sub { 1 }), 'valid type reconstruction ok'; isa_ok $mapped, 'List::Objects::WithUtils::Array::Typed'; ok $arr->type == $mapped->type, 'reconstructed obj has same type'; my $copy = $arr->copy; ok $copy->type == $arr->type, 'copy has same type ok'; is_deeply [ $copy->export ], [ $arr->export ], 'copy ok'; my $untyped = $arr->untyped; isa_ok $untyped, 'List::Objects::WithUtils::Array'; ok !$untyped->type, 'untyped has no type ok'; ok $untyped->push('foo'), 'untyped dropped type ok'; } # tied array { use List::Objects::WithUtils 'array_of'; my $arr = array_of Int() => 1 .. 3; eval {; push @$arr, 'foo' }; ok $@ =~ /type/, 'invalid type push died ok'; push @$arr, 4 .. 6; ok $arr->count == 6, 'count ok after push'; eval {; unshift @$arr, 'bar' }; ok $@ =~ /type/, 'invalid type unshift died ok'; unshift @$arr, 7 .. 9; ok $arr->count == 9, 'count ok after unshift'; eval {; $arr->[0] = 'foo' }; ok $@ =~ /type/, 'invalid type set died ok'; $arr->[0] = 42; is $arr->[0], 42, 'valid type set ok'; } done_testing; random_kv.t100644000764000031 66712701513023 20771 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings; use Lowu 'hash'; my $hs = hash(a => 1, b => 2, c => 3); my $kv = $hs->random_kv; cmp_ok ref $kv, 'eq', 'ARRAY', 'random_kv returned ARRAY'; my ($key, $val) = @$kv; ok $hs->exists($key), 'randomly retrieved key exists'; cmp_ok $hs->get($key), '==', $val, 'retrieved value matches key'; my @r = hash->random_kv; ok @r == 1 && !defined $r[0], 'empty hash returns undef random_kv'; done_testing maybe_set.t100644000764000031 53612701513023 20754 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hash = hash(foo => 1, bar => 2, baz => 3); ok $hash->maybe_set(foo => 3, bar => 4, quux => 5) == $hash, 'maybe_set returned self ok'; is_deeply +{ $hash->export }, +{ foo => 1, bar => 2, baz => 3, quux => 5 }, 'maybe_set ok'; done_testing selective.t100644000764000031 42312701513023 20754 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array', 'hash'; ok __PACKAGE__->can( 'array' ), 'array ok'; ok __PACKAGE__->can( 'hash' ), 'hash ok'; ok not( __PACKAGE__->can( 'immarray' ) ), 'immarray not imported'; done_testing; functions.t100644000764000031 77712701513023 21015 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils ':functions'; ok __PACKAGE__->can( 'array' ), 'array ok'; ok __PACKAGE__->can( 'immarray' ), 'immarray ok'; ok __PACKAGE__->can( 'array_of' ), 'array_of ok'; ok __PACKAGE__->can( 'immarray_of' ), 'immarray_of ok'; ok __PACKAGE__->can( 'hash' ), 'hash ok'; ok __PACKAGE__->can( 'immhash' ), 'immhash ok'; ok __PACKAGE__->can( 'hash_of' ), 'hash_of ok'; ok __PACKAGE__->can( 'immhash_of' ), 'immhash_of ok'; done_testing; author-pod-syntax.t100644000764000031 50312701513023 21160 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); 00-report-prereqs.t100644000764000031 1273112701513023 21027 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.024 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do 't/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; if ( $source && $HAS_CPAN_META ) { if ( my $meta = eval { CPAN::Meta->load_file($source) } ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } } else { $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if $mod eq 'perl'; next if grep { $_ eq $mod } @exclude; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( @dep_errors ) { diag join("\n", "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n", "The following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass; # vim: ts=4 sts=4 sw=4 et: profile000755000764000031 012701513023 17523 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/bencharray.pl100644000764000031 501312701513023 21335 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/bench/profile#!/usr/bin/env perl # for feeding NYTProf use strict; use warnings; use Devel::Hide 'List::UtilsBy::XS'; use List::Objects::WithUtils; my $arr = array 1 .. 1000; sub main { # bisect my $pair = $arr->bisect(sub { $_ >= 500 }); # copy my $copy = $arr->copy; # count my $count = $arr->count; # defined 1 if $arr->defined(1); # diff array(1 .. 3)->diff([ 5,4,3,2,1 ]); # end my $lastidx = $arr->end; # exists 1 if $arr->exists(10); # first_index my $firstidx = $arr->first_index(sub { $_ == 10 }); # first_where my $first = $arr->first_where(sub { $_ == 10 }); # flatten_all my $flat = array([1, 2, [ 3, 4 ] ])->flatten_all; # flatten $flat = array(1, 2, [ 3, 4, [ 5, 6 ] ])->flatten(1); $flat = array(1, 2, [ 3, 4, [ 5, 6, [ 7, 8 ] ] ])->flatten(2); # folds my $res = $arr->foldr(sub { $a + $b }); $res = $arr->foldl(sub { $a + $b }); # get_or_else $res = $arr->get_or_else(9999 => sub { 1 }); # grep $res = $arr->grep(sub { $_ > 500 }); # has_any 1 if $arr->has_any; 1 if $arr->has_any(sub { $_ > 500 }); # head $res = $arr->head; my ($head, $tail) = $arr->head; # indexes $res = $arr->indexes(sub { $_ > 500 }); # inflate my $hash = array(foo => 1, bar => 2, baz => 3)->inflate; # intersection $res = array(qw/a b c d/)->intersection([qw/c d e f/]); # items_after_incl $res = $arr->items_after_incl(sub { $_ > 500 }); # items_after $res = $arr->items_after(sub { $_ > 500 }); # items_before_incl $res = $arr->items_before_incl(sub { $_ > 500 }); # items_before $res = $arr->items_before(sub { $_ > 500 }); # join $res = $arr->join(' '); # kv $res = $arr->kv; # last_index $res = $arr->last_index(sub { $_ < 400 }); # last_where $res = $arr->last_where(sub { $_ < 400 }); # map $res = $arr->map(sub { $_ + 1 }); # mapval $res = $arr->mapval(sub { $_ + 1 }); # mesh $res = array(1 .. 4)->mesh(['a' .. 'd']); # natatime my $itr = $arr->natatime(100); 1 while $itr->(); # nsect $res = $arr->nsect(2); # nsort_by $res = $arr->nsort_by(sub { $_ }); # part $res = $arr->part(sub { $_ & 1 }); # random $res = $arr->random; # reverse $res = $arr->reverse; # rotate_in_place $arr->rotate_in_place; # rotate $res = $arr->rotate; # shuffle $res = $arr->shuffle; # sliced $res = $arr->sliced(1 .. 10); # sort_by $res = $arr->sort_by(sub { $_ }); # sort $res = $arr->sort; # splice $res = $arr->splice(2); # ssect $res = $arr->ssect(3); # tuples $res = $arr->tuples(2); # uniq $res = array(1 .. 100, 1 .. 30)->uniq; # visit $arr->visit(sub { $_++ }); } main for 1 .. 10000; validated.t100644000764000031 141412701513023 21162 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/05_typed BEGIN { unless (eval {; require Types::Standard; 1 } && !$@) { require Test::More; Test::More::plan(skip_all => 'these tests require Types::Standard' ); } } use Test::More; use strict; use warnings FATAL => 'all'; use Types::Standard -all; use List::Objects::WithUtils 'array'; my $arr = array(qw/ foo bar baz quux/); my $valid = $arr->validated(Str); is_deeply [ $valid->all ], [ qw/ foo bar baz quux / ], 'validated(Str) returned array ok'; eval {; $valid = $arr->validated(Int) }; ok $@ =~ /type/i, 'validated(Int) failed with type error' or diag explain $@; { use Lowu; my $valid = [qw/foo bar baz quux/]->validated(Str); is_deeply [ $valid->all ], [ qw/foo bar baz quux/ ], 'autoboxed validated(Str) ok'; } done_testing; array_type.t100644000764000031 27412701513023 21162 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; ok hash->array_type eq 'List::Objects::WithUtils::Array', 'array_type ok'; done_testing; subclassed.t100644000764000031 52412701513023 21131 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; { package My::Hash; use strict; use warnings FATAL => 'all'; use parent 'List::Objects::WithUtils::Hash'; } my $foo = My::Hash->new(foo => 1, bar => 2); isa_ok $foo->sliced('foo', 'bar'), 'My::Hash', 'subclassed hash ok'; done_testing; random_key.t100644000764000031 46012701513023 21130 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings; use Lowu 'hash'; my $hs = hash(a => 1, b => 2, c => 3, d => 4); my $key = $hs->random_key; ok $hs->exists($key), 'random_key returned key from hash'; my @r = hash->random_key; ok @r == 1 && !defined $r[0], 'empty hash returns undef random_key'; done_testing 09_autobox_hash000755000764000031 012701513023 20243 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/tkv.t100644000764000031 43512701513023 21172 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{ baz => undef, foo => 'bar' }; my $kv = $hr->kv; my @sorted = $kv->sort_by(sub { $_->[0] })->all; is_deeply \@sorted, [ [ baz => undef ], [ foo => 'bar' ], ], 'boxed kv ok'; done_testing; 00-report-prereqs.dd100644000764000031 521112701513023 21126 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/tdo { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0' } }, 'develop' => { 'recommends' => { 'Text::ZPL' => '0' }, 'requires' => { 'Pod::Coverage::TrustPod' => '0', 'Test::CPAN::Changes' => '0.19', 'Test::More' => '0.88', 'Test::NoTabs' => '0', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Pod::LinkCheck' => '0', 'Test::Synopsis' => '0' } }, 'runtime' => { 'recommends' => { 'List::UtilsBy::XS' => '0.03', 'Type::Tiny' => '0.022' }, 'requires' => { 'Carp' => '0', 'Class::Method::Modifiers' => '0', 'Exporter' => '0', 'List::Util' => '1.33', 'List::UtilsBy' => '0.09', 'Module::Runtime' => '0.013', 'Role::Tiny' => '1.003', 'Scalar::Util' => '0', 'Type::Tie' => '0.004', 'autobox' => '0', 'overload' => '0', 'parent' => '0', 'strictures' => '2' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900', 'JSON::PP' => '0', 'Test::Without::Module' => '0' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'Test::More' => '0.88' } } }; $x; }09_autobox_array000755000764000031 012701513023 20436 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/tkv.t100644000764000031 40712701513023 21364 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [qw/foo bar baz quux/]; is_deeply [ $arr->kv->all ], [ [ 0 => 'foo' ], [ 1 => 'bar' ], [ 2 => 'baz' ], [ 3 => 'quux' ], ], 'boxed array kv ok'; done_testing; last_where.t100644000764000031 76712701513023 21341 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(qw/ a ba bb c /); ok $arr->last_where(sub { /^a$/ }) eq 'a', 'last_where (start) ok'; ok $arr->last_where(sub { /^b/ }) eq 'bb', 'last_where (middle) ok'; ok $arr->last_where(sub { /^c$/ }) eq 'c', 'last_where (end) ok'; ok !$arr->last_where(sub { /d/ }), 'negative last_where ok'; ok !defined array->last_where(sub { 1 }), 'last_where on empty array returned undef'; done_testing; last_index.t100644000764000031 63112701513023 21324 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(qw/ a ba bb c /); ok $arr->lastidx(sub { /^b/ }) == 2, 'lastidx ok'; ok $arr->last_index(sub { /^b/ }) == 2, 'last_index alias ok'; ok $arr->last_index(sub { /d/ }) == -1, 'negative last_index ok'; ok array->last_index(sub { 1 }) == -1, 'last_index on empty array ok'; done_testing; subclassed.t100644000764000031 50212701513023 21317 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; { package My::List; use strict; use warnings FATAL => 'all'; require List::Objects::WithUtils::Array; use parent 'List::Objects::WithUtils::Array'; } my $foo = My::List->new; isa_ok $foo->map(sub { $_ }), 'My::List', 'subclassed obj map ok'; done_testing; get_or_else.t100644000764000031 130112701513023 21302 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'hash'; my $hr = hash(a => 1, b => 2, c => 3, d => 4 ); ok $hr->get_or_else('b') == 2, 'single-arg get_or_else ok'; ok !$hr->get_or_else('e'), 'single-arg negative get_or_else ok'; cmp_ok $hr->get_or_else(b => 9), '==', 2, 'get_or_else found item ok'; cmp_ok $hr->get_or_else(e => 'foo'), 'eq', 'foo', 'get_or_else defaulted to scalar ok'; my ($invoc, $key); cmp_ok $hr->get_or_else(e => sub { ($invoc, $key) = @_; 'foo' }), 'eq', 'foo', 'get_or_else executed coderef ok'; cmp_ok $invoc, '==', $hr, 'get_or_else coderef invocant ok'; cmp_ok $key, 'eq', 'e', 'get_or_else coderef key ok'; done_testing; set.t100644000764000031 55012701513023 21343 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{}; ok $hr->set( snacks => 'tasty') == $hr, 'boxed set returned self'; ok $hr->get('snacks') eq 'tasty', 'boxed set ok'; $hr->set( a => 1, b => 2, c => 3 ); is_deeply +{ $hr->export }, +{ a => 1, b => 2, c => 3, snacks => 'tasty' }, 'boxed multi-key set ok'; done_testing; get.t100644000764000031 47112701513023 21331 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{a => 1, b => 2, c => 3, d => 4}; ok $hr->get('b') == 2, 'boxed get ok'; my $results = $hr->get('b', 'c'); ok $results->has_any(sub { $_ == 2 }) && $results->has_any(sub { $_ == 3 }), 'boxed multi-key get ok'; done_testing; author-pod-coverage.t100644000764000031 56512701513023 21435 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); release-portability.t100644000764000031 53512701513023 21537 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; eval 'use Test::Portability::Files'; plan skip_all => 'Test::Portability::Files required for testing portability' if $@; run_tests(); set.t100644000764000031 55412701513023 21542 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = []; $arr->set( 1 => 'bar' ); is_deeply [ $arr->all ], [ undef, 'bar' ], 'boxed set on empty list ok'; $arr = [1, 2, 3]; my $set = $arr->set( 1 => 'foo' ); ok $arr == $set, 'boxed set returned self'; is_deeply [ $arr->all ], [ 1, 'foo', 3 ], 'boxed set ok'; done_testing; pop.t100644000764000031 45712701513023 21547 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok !defined []->pop, 'boxed empty array pop ok'; my $arr = [ 1 .. 3 ]; my $popped = $arr->pop; ok $popped == 3, 'boxed pop returned correct value'; is_deeply [ $arr->all ], [ 1, 2 ], 'boxed pop removed correct value'; done_testing; get.t100644000764000031 50712701513023 21524 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok !defined []->get(1), 'boxed empty array get ok'; my $arr = [1 .. 3]; cmp_ok $arr->get(0), '==', 1, 'get 0 ok'; cmp_ok $arr->get(1), '==', 2, 'get 1 ok'; cmp_ok $arr->get(2), '==', 3, 'get 2 ok'; ok !defined $arr->get(3), 'get 3 undef ok'; done_testing; end.t100644000764000031 27412701513023 21514 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1, 2, 3 ]; ok $arr->end == 2, 'boxed end ok'; ok []->end == -1, 'empty boxed array end ok'; done_testing; all.t100644000764000031 57412701513023 21521 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = []; is_deeply [ $arr->all ], [], 'boxed empty array all() ok'; $arr->push( 1 .. 5 ); is_deeply [ $arr->all ], [ 1 .. 5 ], 'boxed array all() ok'; is_deeply [ $arr->export ], [ 1 .. 5 ], 'boxed array export() ok'; is_deeply [ $arr->elements ], [ 1 .. 5 ], 'boxed array elements() ok'; done_testing; map.t100644000764000031 70012701513023 21515 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok []->map(sub { 1 })->is_empty, 'boxed empty array map ok'; my $arr = [ qw/ a b c / ]; my $upper = $arr->map(sub { uc }); is_deeply [ $upper->all ], [ qw/ A B C / ], 'boxed map ok'; is_deeply [ $arr->all ], [ qw/ a b c / ], 'original intact'; $arr->map(sub { $_ = uc }); is_deeply [ $arr->all ], [ qw/ A B C / ], 'boxed list-mutating map ok'; done_testing; delete_when.t100644000764000031 151612701513023 21500 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1, 2, 1, 1, 3, 4, 1 ); my $deleted = $arr->delete_when(sub { $_ == 1 }); is_deeply [ $deleted->all ], [ (1) x 4 ], 'delete_when returned correct values'; is_deeply [ $arr->all ], [ 2, 3, 4 ], 'delete_when deleted correct values'; $arr->delete_when(sub { $_[0] == 2 }); is_deeply [ $arr->all ], [ 3, 4 ], 'delete_when using @_ ok'; $deleted = $arr->delete_when(sub { $_ == 10 }); is_deeply [ $arr->all ], [ 3, 4 ], 'delete_when deleted nothing ok'; is_deeply [ $deleted->all ], [], 'delete_when deleted nothing ok'; $arr = array; $deleted = $arr->delete_when(sub { $_ == 2 }); ok $deleted->is_empty, 'delete_when on empty list ok'; ok $arr->is_empty, 'delete_when on empty list left list alone'; done_testing; flatten_all.t100644000764000031 140112701513023 21473 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; is_deeply [ array->flatten_all ], [ ], 'empty array flatten_all ok'; my $arr = array( 1, 2, [ 3, 4, [ 5, 6 ], 7 ] ); is_deeply [ $arr->flatten_all ], [ 1, 2, 3, 4, 5, 6, 7 ], 'flatten_all on refs ok'; $arr = array( 1, 2, array(3, 4, array(5, 6) ), 7 ); is_deeply [ $arr->flatten_all ], [ 1, 2, 3, 4, 5, 6, 7 ], 'flatten_all on objs ok'; { package My::ArrayType; use strict; use warnings FATAL => 'all'; sub new { bless [1], shift } } my $foo = My::ArrayType->new; $arr = array( array(1, 2, 3), $foo, [ 4, 5, 6 ], ); is_deeply [ $arr->flatten_all ], [ 1, 2, 3, $foo, 4, 5, 6 ], 'flatten_all skipped ARRAY-type obj ok'; done_testing; items_after.t100644000764000031 64612701513023 21502 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 7 ); my $after = $arr->items_after(sub { $_ == 3 }); is_deeply [ $after->all ], [ 4 .. 7 ], 'items_after ok'; ok $arr->items_after(sub { $_ > 10 })->is_empty, 'items_after empty resultset ok'; ok array->items_after(sub { $_ == 1 })->is_empty, 'items_after on empty array ok'; done_testing; get_or_else.t100644000764000031 120412701513023 21476 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 3 ); cmp_ok $arr->get_or_else(0), '==', 1, 'get_or_else existing element ok'; ok !$arr->get_or_else(3), 'get_or_else nonexistant element without default'; cmp_ok $arr->get_or_else(3 => 'foo'), 'eq', 'foo', 'get_or_else defaults to scalar ok'; my ($invoc, $pos); cmp_ok $arr->get_or_else(3 => sub { ($invoc, $pos) = @_; 'foo' }), 'eq', 'foo', 'get_or_else with coderef ok'; cmp_ok $invoc, '==', $arr, 'get_or_else coderef invocant ok'; cmp_ok $pos, '==', 3, 'get_or_else coderef index ok'; done_testing; first_index.t100644000764000031 77112701513023 21515 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(qw/ a ba bb c /); my $firstidx = $arr->firstidx(sub { /^b/ }); ok $firstidx == 1, 'firstidx ok'; ok $arr->first_index(sub { /^b/ }) == $firstidx, 'first_index alias ok'; ok $arr->first_index(sub { /c/ }) == 3, 'firstidx ok'; ok $arr->first_index(sub { /d/ }) == -1, 'negative first_index ok'; ok array->first_index(sub { 1 }) == -1, 'first_index on empty array ok'; done_testing; first_where.t100644000764000031 60312701513023 21512 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(qw/ a ba bb c /); my $first = $arr->first_where(sub { /^b/ }); ok $first eq 'ba', 'first_where ok'; ok $arr->first(sub { /^b/ }) eq $first, 'backwards compat ok'; ok !defined array->first_where(sub { 1 }), 'first_where on empty array returns undef'; done_testing; 04_immutable000755000764000031 012701513023 17531 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/timmhash.t100644000764000031 221612701513023 21505 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/04_immutableuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils; ok hash->is_mutable, 'hash is_mutable'; ok !immhash->is_mutable, 'immhash ! is_mutable'; ok !hash->is_immutable, 'hash ! is_immutable'; ok immhash->is_immutable, 'immhash is_immutable'; my $imm = immhash( foo => 1, bar => 2 ); for my $method (@List::Objects::WithUtils::Role::Hash::Immutable::ImmutableMethods) { local $@; eval {; $imm->$method }; like $@, qr/implemented/, "$method dies" } eval {; $imm->{baz} = 'quux' }; like $@, qr/read-only/, 'attempt to add key died' or diag explain $@; eval {; $imm->{foo} = 2 }; like $@, qr/read-only/, 'attempt to modify existing died'; eval {; delete $imm->{bar} }; like $@, qr/read-only/, 'attempt to delete key died'; eval {; %$imm = () }; like $@, qr/read-only/, 'attempt to clear hash died'; ok $imm->get('foo') == 1 && $imm->get('bar') == 2, 'hash ok after attempted clear'; ok !$imm->get('nonexistant'), 'retrieving nonexistant key ok'; { my $warned; local $SIG{__WARN__} = sub { $warned = shift }; $imm->kv_sort(sub { $a cmp $b }); ok !$warned, 'immhash imported $a/$b vars ok'; } done_testing; intersection.t100644000764000031 150412701513023 21526 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array', 'hash'; my $first = hash( map {; $_ => 1 } qw/ a b c d e / ); my $second = hash( map {; $_ => 1 } qw/ c d x y / ); my $third = +{ map {; $_ => 1 } qw/ a b c d e f g / }; my $intersects = $first->intersection($second, $third); ok $intersects->count == 2, '2 keys in intersection' or diag explain $intersects; is_deeply [ $intersects->sort->all ], [ qw/ c d / ], 'intersection looks ok' or diag explain $intersects; my $firstarr = array(1 .. 10); my $secondarr = array(5 .. 8, 12, 14, 15); $intersects = $firstarr->map(sub { $_ => 1 })->inflate ->intersection( $secondarr->map(sub { $_ => 1 })->inflate ); is_deeply [ $intersects->sort->all ], [ 5 .. 8 ], 'intersection from array looks ok'; done_testing; random_value.t100644000764000031 51312701513023 21453 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/02_hashuse Test::More; use strict; use warnings; use Lowu 'hash'; my $hs = hash(a => 1, b => 2, c => 3, d => 4); my $rev = $hs->inverted; my $val = $hs->random_value; ok $rev->exists($val), 'random_value exists in hash'; my @r = hash->random_value; ok @r == 1 && !defined $r[0], 'empty hash returns undef random_value'; done_testing diff.t100644000764000031 47712701513023 21470 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $first = +{a => 1, b => 2, c => 3, d => 4}; my $second = +{a => 1, b => 2, x => 1, y => 2}; my $diff = $first->diff($second); is_deeply [ $diff->sort->all ], [ qw/c d x y/ ], 'boxed two-hash diff ok' or diag explain $diff; done_testing iter.t100644000764000031 46712701513023 21522 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hs = +{ foo => 1, bar => 2, baz => 3, }; my $iter = $hs->iter; my %result; while (my ($k, $v) = $iter->()) { $result{$k} = $v } is_deeply +{ %result }, +{ foo => 1, bar => 2, baz => 3 }, 'boxed iter() ok'; done_testing copy.t100644000764000031 27012701513023 21521 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{ foo => 1, bar => 2 }; my $copy = $hr->copy; ok $copy->get('foo') == 1, 'boxed copy ok'; done_testing; keys.t100644000764000031 30212701513023 21516 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{ foo => 1, bar => 2 }; is_deeply [ $hr->keys->sort->all ], [ qw/bar foo/ ], 'boxed keys ok'; done_testing; release-cpan-changes.t100644000764000031 52112701513023 21517 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More 0.96 tests => 2; use_ok('Test::CPAN::Changes'); subtest 'changes_ok' => sub { changes_file_ok('Changes'); }; done_testing(); xt000755000764000031 012701513023 15437 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003reverse_dependencies.t100644000764000031 30512701513023 22123 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/xtuse strict; use warnings; BEGIN { $ENV{PERL_TEST_DM_LOG_DIR} = 'xt/log' if -d 'xt/log'; } use Test::DependentModules 'test_all_dependents'; test_all_dependents('List::Objects::WithUtils'); diff.t100644000764000031 103312701513023 21670 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; is_deeply [ [1 .. 3]->diff([ 3, 2, 1 ])->all ], [ ], 'zero element diff ok'; my $first = [qw/a b c d e /]; my $second = [qw/a b c x y /]; my $diff = $first->diff($second); is_deeply [ $diff->sort->all ], [ qw/d e x y / ], 'boxed two-array diff ok' or diag explain $diff; $diff = [1 .. 3]->diff(array); is_deeply [ $diff->sort(sub { $_[0] <=> $_[1] })->all ], [ 1 .. 3 ], 'boxed diff against empty array ok' or diag explain $diff; done_testing mesh.t100644000764000031 36412701513023 21702 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [qw/ a b c d/]; my $meshed = $arr->mesh( array(1, 2, 3, 4) ); is_deeply [ $meshed->all ], [ a => 1, b => 2, c => 3, d => 4 ], 'boxed mesh ok'; done_testing; grep.t100644000764000031 64312701513023 21703 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; is_deeply [ []->grep(sub { 1 })->all ], [ ], 'boxed empty array grep ok'; my $arr = [qw/ a b c b /]; my $found = $arr->grep(sub { $_ eq 'b' }); is_deeply [ $found->all ], [ ('b') x 2 ], 'boxed grep on topicalizer ok'; $found = $arr->grep(sub { $_[0] eq 'b' }); is_deeply [ $found->all ], [ ('b') x 2 ], 'boxed grep on arg ok'; done_testing; part.t100644000764000031 32112701513023 21705 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my ($evens, $odds) = [ 1 .. 6 ]->part(sub { $_ & 1 })->all; is_deeply [ $evens->all ], [ 2,4,6 ], 'boxed part ok'; done_testing; push.t100644000764000031 36212701513023 21723 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [0]; my $pushed = $arr->push( 1 .. 3 ); ok $pushed == $arr, 'boxed push returned self'; is_deeply [ $arr->all ], [ 0 .. 3 ], 'boxed push ok'; done_testing; copy.t100644000764000031 45612701513023 21722 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 5 ]; my $copy = $arr->copy; ok $copy != $arr, 'boxed copy returned new obj ok'; is_deeply [ $copy->all ], [ $arr->all ], 'copy ok'; is_deeply [ $arr->untyped->all ], [ $arr->all ], 'boxed untyped ok'; done_testing; tail.t100644000764000031 50612701513023 21675 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [qw/ a b c /]; my $last = $arr->tail; ok $last eq 'c', 'scalar tail ok'; my ($tail, $remains) = $arr->tail; ok $tail eq 'c', 'list tail first item ok'; is_deeply [ $remains->all ], [ qw/ a b / ], 'list tail second item ok'; done_testing; join.t100644000764000031 52612701513023 21705 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok []->join eq '', 'empty array join ok'; my $arr = [1 .. 3]; cmp_ok $arr->join, 'eq', '1,2,3', 'join without params ok'; cmp_ok $arr->join('-'), 'eq', '1-2-3', 'join with params ok'; cmp_ok $arr->join(''), 'eq', '123', 'join with empty string ok'; done_testing; head.t100644000764000031 60512701513023 21645 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [qw/ a b c /]; my $first = $arr->head; ok $first eq 'a', 'boxed scalar head ok'; my ($head, $tail) = $arr->head; isa_ok $tail, 'List::Objects::WithUtils::Array'; ok $head eq 'a', 'boxed list head first item ok'; is_deeply [ $tail->all ], [ qw/ b c / ], 'boxed list head second item ok'; done_testing; uniq.t100644000764000031 40712701513023 21720 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1, 2, 2, 3, 4, 5, 5 ]; my $uniq = $arr->uniq; is_deeply [ $uniq->sort->all ], [ 1, 2, 3, 4, 5 ], 'boxed uniq ok'; ok []->uniq->is_empty, 'empty array uniq ok'; done_testing; sort.t100644000764000031 103712701513023 21753 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok []->sort->is_empty, 'boxed empty array sort ok'; my $arr = [4, 2, 3, 1]; my $sorted = $arr->sort(sub { $_[0] <=> $_[1] }); is_deeply [ $sorted->all ], [ 1, 2, 3, 4 ], 'boxed sort ok'; my $warned; $SIG{__WARN__} = sub { $warned = shift }; $sorted = $arr->sort(sub { $a <=> $b }); is_deeply [ $sorted->all ], [ 1, 2, 3, 4 ], 'boxed sort ok'; ok !$warned, 'using $a/$b produced no warnings' or fail 'using $a/$b produced warning: '.$warned; done_testing; part_to_hash.t100644000764000031 101612701513023 21663 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $hs = array(qw/ann andy bob fred frankie/) ->part_to_hash(sub { ucfirst substr $_, 0, 1 }); isa_ok $hs, 'List::Objects::WithUtils::Hash'; ok $hs->keys->count == 3, 'part_to_hash created 3 keys'; for (qw/A B F/) { isa_ok $hs->get($_), 'List::Objects::WithUtils::Array', "part '$_'"; } is_deeply +{ $hs->export }, +{ A => [qw/ann andy/], B => ['bob'], F => [qw/fred frankie/] }, 'parts look ok'; done_testing; intersection.t100644000764000031 177012701513023 21725 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $first = array( qw/ a b c d e / ); my $second = array( qw/ c d x y / ); my $third = [ qw/ a b c d e f g / ]; my $intersects = $first->intersection($second, $third); ok $intersects->count == 2, '2 items in intersection' or diag explain $intersects; is_deeply [ $intersects->sort->all ], [ qw/ c d / ], 'intersection looks ok' or diag explain $intersects; $intersects = $first->intersection($second); ok $intersects->count == 2, '2 items in intersection'; is_deeply [ $intersects->sort->all ], [ qw/ c d / ], 'intersection (one array) looks ok'; ok $first->intersection( [ 1, 2, 3 ] )->is_empty, 'empty intersection ok'; my $dupes = array( qw/ z z c d / ); $intersects = $dupes->intersection($first); is_deeply [ $intersects->sort->all ], [ qw/ c d / ], 'intersection (dupes in one array) ok'; ok array->intersection(array)->is_empty, 'empty array(s) intersection ok'; done_testing items_before.t100644000764000031 73212701513023 21637 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 7 ); my $before = $arr->items_before(sub { $_ == 4 }); is_deeply [ $before->all ], [ 1 .. 3 ], 'items_before ok'; ok array->items_before(sub { $_ == 4 })->is_empty, 'empty array items_before ok'; $before = array(1..3)->items_before(sub { $_ == 1 }); ok $before->is_empty, 'non-matching items_before ok' or diag explain $before; done_testing; immarray.t100644000764000031 354212701513023 21703 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/04_immutableuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils; ok array->is_mutable, 'array is_mutable'; ok !immarray->is_mutable, 'immarray !is_mutable'; ok !array->is_immutable, 'array !is_immutable'; ok immarray->is_immutable, 'immarray is_immutable'; my $imm = immarray( 1 .. 4 ); for my $method (@List::Objects::WithUtils::Role::Array::Immutable::ImmutableMethods) { eval {; $imm->$method }; ok $@ =~ /implemented/, "$method dies" } eval {; push @$imm, 'bar' }; like $@, qr/read-only/, 'push dies'; eval {; pop @$imm }; like $@, qr/read-only/, 'pop dies'; eval {; unshift @$imm, 0 }; like $@, qr/read-only/, 'unshift dies'; eval {; shift @$imm }; like $@, qr/read-only/, 'shift dies'; eval {; splice @$imm, 0, 1, 10 }; like $@, qr/read-only/, '3-arg splice dies'; eval {; $imm->[10] = 'foo' }; like $@, qr/read-only/, 'attempted extend dies'; eval {; $imm->[0] = 10 }; like $@, qr/read-only/, 'element set dies'; eval {; @$imm = () }; like $@, qr/read-only/, 'array clear dies'; if ($] >= 5.014) { # Breaks on < 5.12, have not investigated yet eval {; $imm->map(sub { $_++ }) }; like $@, qr/read-only/, 'changing vals via topicalizer dies'; } is_deeply [ $imm->all ], [ 1 .. 4 ], 'array ok after exceptions'; # Make sure we didn't recursively break anything: my $with_arr = immarray( array( qw/ a b c / ) ); ok( $with_arr->get(0)->set(0, 'foo'), 'mutable set() inside immutable list ok'); my $with_hash = immarray( hash( foo => 'bar' ) ); ok( $with_hash->get(0)->get('foo') eq 'bar', 'hash in immarray ok' ); ok( $with_hash->get(0)->set(foo => 'baz'), 'hash->set in immarray ok' ); ok( $with_hash->get(0)->get('foo') eq 'baz', 'hash->get in immarray ok' ); { my $warned; local $SIG{__WARN__} = sub { $warned++ }; immarray(3,2,1)->sort(sub { $a <=> $b }); ok !$warned, 'immarray imported $a/$b vars ok'; } done_testing; clear.t100644000764000031 31212701513023 21632 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = [foo => 1, bar => 2]; ok $hr->clear == $hr, 'boxed clear returned self'; ok $hr->is_empty, 'boxed clear ok'; done_testing; pairs_to_objs.pl100644000764000031 27612701513023 22141 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/examplesuse strict; use warnings; use Lowu; use Data::Dumper; use Types::Standard 'Str'; print Dumper [foo => 'bar', baz => 'quux'] ->tuples(2 => Str) ->map(sub { hash(@$_)->inflate }) release-dist-manifest.t100644000764000031 46612701513023 21747 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::DistManifest"; plan skip_all => "Test::DistManifest required for testing the manifest" if $@; manifest_ok(); release-pod-linkcheck.t100644000764000031 77512701513023 21716 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; foreach my $env_skip ( qw( SKIP_POD_LINKCHECK ) ){ plan skip_all => "\$ENV{$env_skip} is set, skipping" if $ENV{$env_skip}; } eval "use Test::Pod::LinkCheck"; if ( $@ ) { plan skip_all => 'Test::Pod::LinkCheck required for testing POD'; } else { Test::Pod::LinkCheck->new->all_pod_ok; } nsect.t100644000764000031 113512701513023 22077 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 10 ]; my $halved = $arr->nsect(2); isa_ok $halved, 'List::Objects::WithUtils::Array', 'boxed nsect returned array obj'; ok $halved->count == 2, 'boxed nsect(2) returned two items'; ok $halved->get(0)->count == $halved->get(1)->count, 'boxed nsect(2) on even set returned even sets'; is_deeply [ $halved->get(0)->all ], [ 1 .. 5 ], 'boxed nsect(2) first set ok' or diag explain $halved; is_deeply [ $halved->get(1)->all ], [ 6 .. 10 ], 'boxed nsect(2) second set ok' or diag explain $halved; done_testing; ssect.t100644000764000031 50512701513023 22064 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 10 ]; my $threeper = $arr->ssect(3); ok $threeper->count == 4, 'boxed ssect(3) returned four items'; my $res = []->ssect(3); ok $res->is_empty, 'boxed ssect on empty array produced empty array' or diag explain $res; done_testing; shift.t100644000764000031 44712701513023 22065 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok !defined []->shift, 'boxed empty array shift ok'; my $arr = [ 1 .. 3 ]; my $shifted = $arr->shift; ok $shifted == 1, 'boxed shift ok'; is_deeply [ $arr->all ], [ 2, 3 ], 'boxed shift removed correct value'; done_testing; visit.t100644000764000031 46512701513023 22106 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [1,2,3]; my $res = []; []->visit(sub { push @$res, $_ }); is_deeply $res, [], 'boxed empty array visit ok'; $arr->visit(sub { push @$res, $_ }); is_deeply $res, [ 1, 2, 3 ], 'boxed visit ok' or diag explain $res; done_testing folds.t100644000764000031 106412701513023 22073 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $sum = sub { $_[0] + $_[1] }; my $arr = [1 .. 3]; cmp_ok $arr->reduce($sum), '==', 6, 'boxed reduce with positional args ok'; cmp_ok [1]->reduce($sum), '==', 1, 'boxed array with one element reduce ok'; ok !defined []->reduce($sum), 'boxed empty array reduce returns undef'; ok !defined []->foldr($sum), 'boxed empty array foldr ok'; cmp_ok [6, 3, 2]->foldl(sub { $a / $b }), '==', 1, 'boxed foldl ok'; cmp_ok [2, 3, 6]->foldr(sub { $b / $a }), '==', 1, 'boxed foldr ok'; done_testing; clear.t100644000764000031 32712701513023 22033 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [1..10]; ok $arr->clear == $arr, 'boxed clear returned original'; ok $arr->is_empty, 'boxed array is_empty after clear'; done_testing; count.t100644000764000031 36612701513023 22100 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = []; ok $arr->count == 0, 'boxed count returned 0 on empty array'; $arr->push( 1, 2, 3); ok $arr->count == 3, 'boxed count returned correct item count'; done_testing; utilsby_no_xs.t100644000764000031 251512701513023 22116 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse strict; use warnings FATAL => 'all'; BEGIN { unless (eval {; require Test::Without::Module; 1 } && !$@) { require Test::More; Test::More::plan(skip_all => 'these tests require Test::Without::Module'); } } use Test::Without::Module 'List::UtilsBy::XS'; use Test::More; use List::Objects::WithUtils; ok !$List::Objects::WithUtils::Role::Array::UsingUtilsByXS, 'List::UtilsBy::XS not loaded'; # sort_by ok array->sort_by(sub { $_->foo })->is_empty, 'empty array sort_by ok'; my $arr = array( +{ id => 'c' }, +{ id => 'a' }, +{ id => 'b' }, ); my $sorted = $arr->sort_by(sub { $_->{id} }); is_deeply [ $sorted->all ], [ +{ id => 'a' }, +{ id => 'b' }, +{ id => 'c' } ], 'sort_by ok'; # nsort_by ok array->nsort_by(sub { $_->foo })->is_empty, 'empty array nsort_by ok'; $arr = array( +{ id => 2 }, +{ id => 1 }, +{ id => 3 }, ); $sorted = $arr->nsort_by(sub { $_->{id} }); is_deeply [ $sorted->all ], [ +{ id => 1 }, +{ id => 2 }, +{ id => 3 } ], 'nsort_by ok'; # uniq_by ok array->uniq_by(sub { $_->foo })->is_empty, 'empty array uniq_by ok'; $arr = array( +{ id => 1 }, +{ id => 2 }, +{ id => 1 }, +{ id => 3 }, +{ id => 3 }, ); my $uniq = $arr->uniq_by(sub { $_->{id} }); is_deeply [ $uniq->all ], [ +{ id => 1 }, +{ id => 2 }, +{ id => 3 }, ], 'uniq_by ok'; done_testing; sliced.t100644000764000031 56412701513023 22020 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{a => 1, b => 2, c => 3, d => 4}; my $slice = $hr->sliced('a', 'c', 'z'); ok $slice->keys->count == 2, 'boxed sliced key count ok'; ok $slice->get('a') == 1, 'sliced get ok'; ok !$slice->exists('z'), 'nonexistant key ignored'; ok !$slice->get('b'), 'unspecified key ignored'; done_testing; kv_map.t100644000764000031 61012701513023 22022 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hs = +{ foo => 1, bar => 2, baz => 3, }; my @res; my $returned = $hs->kv_map( sub { push @res, @_; ($_[0], $_[1] + 1) } ); is_deeply +{ @res }, $hs->unbless, 'boxed kv_map ok'; is_deeply $returned->inflate->unbless, +{ foo => 2, bar => 3, baz => 4 }, 'boxed kv_map retval ok'; done_testing exists.t100644000764000031 32212701513023 22064 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{foo => 1, baz => 2}; ok $hr->exists('foo'), 'boxed exists ok'; ok !$hr->exists('bar'), 'boxed negative exists ok'; done_testing; delete.t100644000764000031 56012701513023 22013 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{foo => 1, baz => 2, bar => 3, quux => 4}; $hr->delete('quux'); ok !$hr->get('quux'), 'boxed delete ok'; my $deleted = $hr->delete('foo', 'baz'); ok $deleted->count == 2, 'deleted 2 elements'; is_deeply +{ $hr->export }, +{ bar => 3 }, 'boxed delete (multi-key) ok'; done_testing; values.t100644000764000031 31112701513023 22042 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{foo => 1, bar => 2, baz => 3}; is_deeply [ $hr->values->sort->all ], [ 1 .. 3 ], 'boxed values ok'; done_testing; failed_require.t100644000764000031 62712701513023 21757 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; no warnings 'once'; require List::Objects::WithUtils; $List::Objects::WithUtils::ImportMap{foo} = 'No::Such::Class'; my $warning; $SIG{__WARN__} = sub { $warning = $_[0] }; eval {; List::Objects::WithUtils->import('foo') }; like $@, qr/Failed to import/, 'bad class failed to import'; like $warning, qr/INC/, 'failed import warned'; done_testing; moo_attributes.pl100644000764000031 166212701513023 22364 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/examplesuse strict; use warnings FATAL => 'all'; # A very simple example of how List::Objects::WithUtils can make for prettier # OO syntax using Moo(se); see List::Objects::Types for more useful bits like # coercions. my $widget_id = 0; { package Widget; use Moo; has id => ( is => 'ro', default => sub { ++$widget_id } ); sub execute { my $self = shift; print "Widget ".$self->id." present!\n" } } { package Machine; use List::Objects::WithUtils; use Types::Standard -types; use Moo; has widgets => ( is => 'ro', # You could skip the Types::Standard import and just use an 'array': default => sub { array_of InstanceOf['Widget'] }, handles => +{ add_widgets => 'push', list_widgets => 'all', each_widget => 'visit', }, ); } my $machine = Machine->new; my @widgets = map {; Widget->new } 1 .. 4; $machine->add_widgets(@widgets); $machine->each_widget(sub { $_->execute }); sliced.t100644000764000031 50512701513023 22206 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 7 ]; my $sliced = $arr->sliced(0, 2); is_deeply [ $sliced->all ], [ 1, 3 ], 'boxed sliced (2 element) ok'; $sliced = $arr->sliced(0, 2, 4); is_deeply [ $sliced->all ], [ 1, 3, 5 ], 'boxed sliced (3 element) ok'; done_testing rotate.t100644000764000031 41312701513023 22237 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [1 .. 4]; my $left = $arr->rotate; is_deeply [ $left->all ], [ 2, 3, 4, 1 ], 'boxed rotate ok'; is_deeply [ $arr->all ], [ 1, 2, 3, 4 ], 'original array intact'; done_testing mapval.t100644000764000031 71612701513023 22227 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 3 ]; my $mapval = $arr->mapval(sub { ++$_ }); is_deeply [ $mapval->all ], [ 2, 3, 4 ], 'boxed mapval ok'; is_deeply [ $arr->all ], [ 1, 2, 3 ], 'original intact'; $mapval = $arr->mapval(sub { $_[0]++ }); is_deeply [ $mapval->all ], [ 2, 3, 4 ], 'boxed mapval on $_[0] ok'; ok []->mapval(sub { 1 })->is_empty, 'boxed empty array mapval ok'; done_testing; exists.t100644000764000031 44612701513023 22266 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [1 .. 3]; ok $arr->exists(0), 'boxed array->exists ok'; ok $arr->exists(1), 'boxed array exists(1) ok'; ok $arr->exists(2), 'boxed array exists(2) ok'; ok !$arr->exists(3), 'boxed !array->exists ok'; done_testing tuples.t100644000764000031 37012701513023 22257 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 7 ]; my $tuples = $arr->tuples(2); is_deeply [ $tuples->all ], [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ], [ 7 ] ], 'boxed tuples ok'; done_testing; bisect.t100644000764000031 110112701513023 22225 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 10 ]; my $pair = $arr->bisect(sub { $_ >= 5 }); isa_ok $pair, 'List::Objects::WithUtils::Array', 'boxed bisect returned array obj'; ok $pair->count == 2, 'boxed bisect() returned two items'; isa_ok $pair->get(0), 'List::Objects::WithUtils::Array'; isa_ok $pair->get(1), 'List::Objects::WithUtils::Array'; is_deeply [ $pair->get(0)->all ], [ 5 .. 10 ]; is_deeply [ $pair->get(1)->all ], [ 1 .. 4 ]; ok []->bisect(sub {})->count == 2, 'boxed bisect on empty array ok'; done_testing; delete.t100644000764000031 53412701513023 22207 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 4 ]; my $deleted = $arr->delete(2); cmp_ok $deleted, '==', 3, 'boxed delete returned correct value'; is_deeply [ $arr->all ], [ 1, 2, 4 ], 'value was deleted'; eval {; []->delete(1) }; ok $@, 'trying to delete nonexistant from boxed array dies'; done_testing; random.t100644000764000031 41612701513023 22224 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok !defined []->random, 'boxed empty array random returned undef'; my $arr = [qw/ foo bar /]; my $random = $arr->random; ok $random eq 'foo' || $random eq 'bar', 'boxed random() ok'; done_testing; insert.t100644000764000031 101312701513023 22262 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = []; my $insert = $arr->insert(0 => 1); ok $insert == $arr, 'boxed insert returned self ok'; is_deeply [ $arr->all ], [ 1 ], 'boxed insert first position on empty list ok'; $arr->insert(4 => 2); is_deeply [ $arr->all ], [ 1, undef, undef, undef, 2 ], 'boxed insert pre-filled nonexistant elems ok'; $arr->insert(3 => 3); is_deeply [ $arr->all ], [ 1, undef, undef, 3, undef, 2 ], 'boxed insert to middle ok'; done_testing; splice.t100644000764000031 101412701513023 22236 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [qw/ a b c d /]; my $spliced = $arr->splice(2); is_deeply [ $arr->all ], [ qw/ a b / ], 'boxed single arg splice modified orig ok'; is_deeply [ $spliced->all ], [ qw/ c d / ], 'boxed single arg splice ok'; $arr = [qw/ a b c d /]; $spliced = $arr->splice(1, 3); is_deeply [ $arr->all ], [ 'a' ], 'boxed 2-arg splice modified orig ok'; is_deeply [ $spliced->all ], [ qw/ b c d / ], 'boxed 2-arg splice ok'; done_testing; subclasses.t100644000764000031 70612701513023 22244 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/03_junctionsuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(1, 2, 3); my $all = $arr->all_items->map(sub { $_[0] }); ok $all->isa('List::Objects::WithUtils::Array::Junction::All'), 'all_items subclass ok'; ok $all > 0, 'all_items ok'; my $any = $arr->any_items; ok $any->isa('List::Objects::WithUtils::Array::Junction::Any'), 'any_items subclass ok'; ok $any > 2, 'any_items ok'; done_testing; kv_grep.t100644000764000031 37712701513023 22214 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hs = +{ foo => 1, bar => 2, baz => 3, }; my $res = $hs->kv_grep(sub { $_[1] > 1 }); is_deeply $res->unbless, +{ bar => 2, baz => 3 }, 'boxed kv_grep ok'; done_testing inflate.t100644000764000031 34612701513023 22175 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $obj = +{foo => 'bar', baz => 'quux'}->inflate; ok $obj->foo eq 'bar', 'boxed inflate ok (1)'; ok $obj->baz eq 'quux', 'boxed inflate ok (2)'; done_testing; defined.t100644000764000031 42312701513023 22145 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{foo => 1, baz => undef}; ok $hr->defined('foo'), 'boxed defined ok'; ok !$hr->defined('baz'), 'boxed negative defined ok'; ok !$hr->defined('bar'), 'boxed nonexistant defined ok'; done_testing; kv_sort.t100644000764000031 40212701513023 22233 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{ map {; $_ => 1 } qw/d b c a/ }; is_deeply [ $hr->kv_sort->all ], [ [ a => 1 ], [ b => 1 ], [ c => 1 ], [ d => 1 ] ], 'boxed kv_sort ok'; done_testing; all_typetinyish.t100644000764000031 104112701513023 22227 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils -all; ok __PACKAGE__->can( 'array' ), 'array ok'; ok __PACKAGE__->can( 'immarray' ), 'immarray ok'; ok __PACKAGE__->can( 'array_of' ), 'array_of ok'; ok __PACKAGE__->can( 'immarray_of' ), 'immarray_of ok'; ok __PACKAGE__->can( 'hash' ), 'hash ok'; ok __PACKAGE__->can( 'immhash' ), 'immhash ok'; ok __PACKAGE__->can( 'hash_of' ), 'hash_of ok'; ok __PACKAGE__->can( 'immhash_of' ), 'immhash_of ok'; cmp_ok []->count, '==', 0, 'autobox ok'; done_testing; cheap_accessors.pl100644000764000031 57312701513023 22431 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/examplesuse strict; use warnings; use 5.10.1; use Lowu; my $result = immarray( +{ name => 'bob', id => '200' }, +{ name => 'joe', id => '400' }, +{ name => 'sam', id => '600' }, +{ name => 'amy', id => '800' }, )->first(sub { $_->{id} > 500 }) or die 'No employees with ID > 500'; my $person = $result->inflate; say "Employee ".ucfirst($person->name)." has ID ".$person->id; uniq_by.t100644000764000031 54512701513023 22415 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_array# (also see utilsby_no_xs.t) use Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ { id => 1 }, { id => 2 }, { id => 1 }, { id => 3 }, { id => 3 }, ]; my $uniq = $arr->uniq_by(sub { $_->{id} }); is_deeply [ $uniq->all ], [ { id => 1 }, { id => 2 }, { id => 3 }, ], 'boxed uniq_by ok'; done_testing; shuffle.t100644000764000031 57312701513023 22404 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [1, 2, 3]; my $shuffled = $arr->shuffle; ok $shuffled->has_any(sub { $_ == 1 }) && $shuffled->has_any(sub { $_ == 2 }) && $shuffled->has_any(sub { $_ == 3 }) && $shuffled->count == 3, 'boxed shuffle ok'; is_deeply [ $arr->all ], [ 1, 2, 3 ], 'original array intact'; done_testing; has_any.t100644000764000031 51312701513023 22364 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = []; ok !$arr->has_any, 'boxed negative bare has_any ok'; $arr->push(qw/ a b c /); ok $arr->has_any, 'boxed bare has_any ok'; ok $arr->has_any(sub { /b/ }), 'boxed has_any ok'; ok !$arr->has_any(sub { /d/ }), 'boxed negative has_any ok'; done_testing; reverse.t100644000764000031 47712701513023 22426 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok []->reverse->is_empty, 'empty array reverse ok'; my $arr = [1, 2, 3]; my $reverse = $arr->reverse; is_deeply [ $reverse->all ], [ 3, 2, 1 ], 'boxed reverse ok'; is_deeply [ $arr->all ], [ 1, 2, 3 ], 'original intact'; done_testing; flatten.t100644000764000031 171512701513023 22424 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; is_deeply [ []->flatten ], [ ], 'boxed empty array flatten with no args ok'; is_deeply [ []->flatten(1) ], [ ], 'boxed empty array flatten-to-depth ok'; my $arr = [ 1, 2, [ 3, 4, [ 5, 6 ], 7 ] ]; is_deeply [ $arr->flatten ], [ $arr->all ], 'boxed flatten with no args same as all() ok'; is_deeply [ $arr->flatten(0) ], [ $arr->all ], 'boxed flatten to depth 0 same as all() ok'; is_deeply [ $arr->flatten(-1) ], [ $arr->all ], 'boxed flatten to negative depth same as all() ok'; is_deeply [ $arr->flatten(1) ], [ 1, 2, 3, 4, [ 5, 6 ], 7 ], 'boxed flatten to depth 1 ok'; is_deeply [ $arr->flatten(2) ], [ 1, 2, 3, 4, 5, 6, 7 ], 'boxed flatten to depth 2 ok'; $arr = [ 1, 2, [ 3, 4, [ 5, 6 ] ], [ 7, 8, [ 9, 10 ] ], ]; is_deeply [ $arr->flatten(1) ], [ 1, 2, 3, 4, [ 5, 6 ], 7, 8, [ 9, 10 ] ], 'boxed flatten complex array ok'; done_testing; sort_by.t100644000764000031 107512701513023 22447 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_array# (also see utilsby_no_xs.t) use Test::More; use strict; use warnings FATAL => 'all'; use Lowu; if ($List::Objects::WithUtils::Role::Array::UsingUtilsByXS) { diag "\nUsing List::UtilsBy::XS\n" } else { diag "\nUsing List::UtilsBy (XS not found)\n" } my $arr = [ +{ id => 'c' }, +{ id => 'a' }, +{ id => 'b' }, ]; my $sorted = $arr->sort_by(sub { $_->{id} }); is_deeply [ $sorted->all ], [ +{ id => 'a' }, +{ id => 'b' }, +{ id => 'c' } ], 'boxed sort_by ok'; ok []->sort_by(sub { $_->foo })->is_empty, 'boxed empty array sort_by ok'; done_testing; unshift.t100644000764000031 47612701513023 22432 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [4]; my $unshifted = $arr->unshift( 1 .. 3 ); ok $unshifted == $arr, 'boxed unshift returned self'; is_deeply [ $arr->all ], [ 1 .. 4 ], 'boxed unshift ok'; ok []->unshift(1)->count == 1, 'unshift to empty array ok'; done_testing; inflate.t100644000764000031 46512701513023 22372 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ foo => 1, bar => 2 ]; my $hash = $arr->inflate; ok $hash->does('List::Objects::WithUtils::Role::Hash'), 'boxed inflate ok'; ok $hash->get('foo') == 1 && $hash->get('bar') == 2, 'boxed inflated hash looks ok'; done_testing; defined.t100644000764000031 30212701513023 22334 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [1, undef, 3]; ok $arr->defined(0), 'boxed defined ok'; ok !$arr->defined(1), 'boxed !defined ok'; done_testing indexes.t100644000764000031 116112701513023 22421 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok ![]->indexes(sub { 1 })->has_any, 'boxed empty indexes ok'; my $arr = [qw/foo bar baz/]; my $idx = $arr->indexes(sub { $_ eq 'bar' }); is_deeply [ $idx->all ], [ 1 ], 'boxed indexes (single) ok'; is_deeply [ $idx->all ], [ $arr->indices(sub { $_ eq 'bar' })->all ], 'boxed indices alias ok'; $arr = [ 1 .. 10 ]; $idx = $arr->indexes(sub { $_ % 2 == 0 }); is_deeply [ $idx->all ], [ 1, 3, 5, 7, 9 ], 'boxed indexes (multiple) ok'; $idx = $arr->indexes; is_deeply [ $idx->all ], [ 0 .. 9 ], 'boxed indexes (no arguments) ok'; done_testing rotator.t100644000764000031 47612701513023 22444 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $empty = []->rotator; ok !defined $empty->(), 'boxed empty rotator returned undef'; my $rotator = [1, 2, 3]->rotator; my @vals = map {; $rotator->() } 1 .. 7; is_deeply [ @vals ], [ 1, 2, 3, 1, 2, 3, 1 ], 'boxed rotator ok'; done_testing rotate_in_place.t100644000764000031 145512701513023 22347 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array(1 .. 4); ok $arr->rotate_in_place == $arr, 'rotate_in_place returned self ok'; is_deeply [ $arr->all ], [ 2, 3, 4, 1 ], 'rotate_in_place default opts ok'; ok $arr->rotate_in_place(right => 1) == $arr, 'rotate_in_place rightwards returned self ok'; is_deeply [ $arr->all ], [ 1, 2, 3, 4 ], 'rotate_in_place rightwards ok'; ok $arr->rotate_in_place(left => 1) == $arr, 'rotate_in_place leftwards returned self ok'; is_deeply [ $arr->all ], [ 2, 3, 4, 1 ], 'rotate_in_place leftwards ok'; ok array->rotate_in_place->is_empty, 'empty array rotate_in_place ok'; eval {; $arr->rotate_in_place(left => 1, right => 1) }; like $@, qr/direction/, 'bad opts die ok'; done_testing; inverted.t100644000764000031 65212701513023 22373 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{ a => 1, b => 1, c => 2, d => 3, }; my $inv = $hr->inverted; ok $inv->keys->count == 3, 'boxed inverted hash has 3 keys' or diag explain $hr; for my $idx (1,2,3) { ok $inv->get($idx)->does('List::Objects::WithUtils::Role::Array'), "key $idx isa array obj"; ok $inv->get($idx)->has_any, "key $idx has elements"; } done_testing get_path.t100644000764000031 62212701513023 22343 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{ scalar => 1, hash => +{ a => 1, b => +{ x => 10 }, }, hashobj => hash( d => [], e => [ 1, { z => 9 }, ], ), }; cmp_ok $hr->get_path('scalar'), '==', 1, 'boxed shallow get_path ok'; cmp_ok $hr->get_path(qw/hash b x/), '==', 10, 'boxed deep get_path ok'; done_testing autobox_subclass.t100644000764000031 113512701513023 22372 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/00_loaduse Test::More; use strict; use warnings FATAL => 'all'; { package My::Array::Obj; use strict; use warnings FATAL => 'all'; use parent 'List::Objects::WithUtils::Array'; sub foo { 1 } } { package My::Hash::Obj; use strict; use warnings FATAL => 'all'; use parent 'List::Objects::WithUtils::Hash'; sub bar { 1 } } { package My::Autoboxen; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils::Autobox HASH => 'My::Hash::Obj', ARRAY => 'My::Array::Obj' ; use Test::More; ok []->foo, 'autoboxed array ok'; ok {}->bar, 'autoboxed hash ok'; } done_testing; Objects000755000764000031 012701513023 20056 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/ListWithUtils.pm100644000764000031 3342612701513023 22540 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objectspackage List::Objects::WithUtils; $List::Objects::WithUtils::VERSION = '2.028003'; use Carp; use strictures 2; our %ImportMap = ( array => 'Array', immarray => 'Array::Immutable', array_of => 'Array::Typed', immarray_of => 'Array::Immutable::Typed', hash => 'Hash', immhash => 'Hash::Immutable', hash_of => 'Hash::Typed', immhash_of => 'Hash::Immutable::Typed', ); our @DefaultImport = keys %ImportMap; sub import { my ($class, @funcs) = @_; my $pkg; if (ref $funcs[0]) { croak 'Expected a list of imports or a HASH but got '.$funcs[0] unless ref $funcs[0] eq 'HASH'; my %opts = %{ $funcs[0] }; @funcs = @{ $opts{import} || [ 'all' ] }; $pkg = $opts{to} || caller; } @funcs = @DefaultImport unless @funcs; my %fmap = map {; lc( substr($_, 0, 1) eq ':' ? substr($_, 1) : $_ ) => 1 } @funcs; if (defined $fmap{all} || defined $fmap{-all}) { @funcs = ( @DefaultImport, 'autobox' ) } elsif (defined $fmap{functions} || defined $fmap{funcs}) { # Legacy import tag, tested but not documented @funcs = @DefaultImport } my @mods; for my $function (@funcs) { if ($function eq 'autobox' || $function eq '-autobox') { require List::Objects::WithUtils::Autobox; List::Objects::WithUtils::Autobox::import($class); next } if (my $thismod = $ImportMap{$function}) { push @mods, 'List::Objects::WithUtils::'.$thismod; next } croak "Unknown import parameter '$function'" } $pkg = caller unless defined $pkg; my @failed; for my $mod (@mods) { my $c = "package $pkg; use $mod; 1;"; local $@; eval $c and not $@ or carp $@ and push @failed, $mod; } if (@failed) { croak 'Failed to import ' . join ', ', @failed } 1 } print <<'_EOB' (CLASS) + (ROLES) -> (SUBCLASS) + (ROLES) List::Objects::WithUtils:: Array (array) + Role::Array + Role::Array::WithJunctions -> Array::Immutable (immarray) + Role::Array::Immutable -> Array::Immutable::Typed (immarray_of) + Role::Array::Immutable + Role::Array::Typed -> Array::Junction (array->{any,all}_items) -> Array::Typed (array_of) + Role::Array::Typed Hash (hash) + Role::Hash -> Hash::Immutable (immhash) + Role::Hash::Immutable -> Hash::Immutable::Typed (immhash_of) + Role::Hash::Immutable + Role::Hash::Typed -> Hash::Typed (hash_of) + Role::Array::Typed Hash::Inflated (hash->inflate) -> Hash::Inflated::RW (hash->inflate(rw => 1)) _EOB unless caller; 1; =pod =for Pod::Coverage import =head1 NAME List::Objects::WithUtils - List objects, kitchen sink included =head1 SYNOPSIS ## A small sample; consult the description, below, for links to ## extended documentation # Import all object constructor functions: # array immarray array_of immarray_of # hash immhash hash_of immhash_of use List::Objects::WithUtils; # Import all of the above plus autoboxing: use List::Objects::WithUtils ':all'; # Same as above, but shorter: use Lowu; # Most methods returning lists return new objects; chaining is easy: array(qw/ aa Ab bb Bc bc /) ->grep(sub { /^b/i }) ->map(sub { uc }) ->uniq ->all; # ( 'BB', 'BC' ) # Useful utilities from other list modules are available: my $want_idx = array( +{ id => '400', user => 'bob' }, +{ id => '600', user => 'suzy' }, +{ id => '700', user => 'fred' }, )->first_index(sub { $_->{id} > 500 }); my $itr = array( 1 .. 7 )->natatime(3); while ( my @nextset = $itr->() ) { ... } my $meshed = array(qw/ a b c d /) ->mesh( array(1 .. 4) ) ->all; # ( 'a', 1, 'b', 2, 'c', 3, 'd', 4 ) my ($evens, $odds) = array( 1 .. 20 ) ->part(sub { $_[0] & 1 }) ->all; my $sorted = array( +{ name => 'bob', acct => 1 }, +{ name => 'fred', acct => 2 }, +{ name => 'suzy', acct => 3 }, )->sort_by(sub { $_->{name} }); # array() objects are mutable: my $mutable = array(qw/ foo bar baz /); $mutable->insert(1, 'quux'); $mutable->delete(2); # ... or use immarray() immutable arrays: my $static = immarray( qw/ foo bar baz / ); $static->set(0, 'quux'); # dies $static->[0] = 'quux'; # dies push @$static, 'quux'; # dies # Construct a hash: my $hash = hash( foo => 'bar', snacks => 'cake' ); # You can set multiple keys in one call: $hash->set( foobar => 'baz', pie => 'cherry' ); # ... which is useful for merging in another (plain) hash: my %foo = ( pie => 'pumpkin', snacks => 'cheese' ); $hash->set( %foo ); # ... or another hash object: my $second = hash( pie => 'key lime' ); $hash->set( $second->export ); # Retrieve one value as a simple scalar: my $snacks = $hash->get('snacks'); # ... or retrieve multiple values as an array-type object: my $vals = $hash->get('foo', 'foobar'); # Take a hash slice of keys, return a new hash object # consisting of the retrieved key/value pairs: my $slice = $hash->sliced('foo', 'pie'); # Arrays inflate to hash objects: my $items = array( qw/ foo bar baz/ )->map(sub { $_ => 1 })->inflate; if ($items->exists('foo')) { # ... } # Hashes inflate to simple objects with accessors: my $obj = $hash->inflate; $snacks = $obj->snacks; # Methods returning multiple values typically return new array-type objects: my @match_keys = $hash->keys->grep(sub { m/foo/ })->all; my @match_vals = $hash->values->grep(sub { m/bar/ })->all; my @sorted_pairs = hash( foo => 2, bar => 3, baz => 1) ->kv ->sort_by(sub { $_->[1] }) ->all; # ( [ baz => 1 ], [ foo => 2 ], [ bar => 3 ] ) # Perl6-inspired Junctions: if ( $hash->keys->any_items == qr/snacks/ ) { # ... hash has key(s) matching /snacks/ ... } if ( $hash->values->all_items > 10 ) { # ... all hash values greater than 10 ... } # Type-checking arrays via Type::Tiny: use Types::Standard -all; my $int_arr = array_of Int() => 1 .. 10; # Type-checking hashes: use Types::Standard -all; my $int_hash = hash_of Int() => (foo => 1, bar => 2); # Native list types can be autoboxed: use List::Objects::WithUtils 'autobox'; my $foo = [ qw/foo baz bar foo quux/ ]->uniq->sort; my $bar = +{ a => 1, b => 2, c => 3 }->values->sort; # Autoboxing is lexically scoped like normal: { no List::Objects::WithUtils::Autobox; [ 1 .. 10 ]->shuffle; # dies } =head1 DESCRIPTION A set of roles and classes defining an object-oriented interface to Perl hashes and arrays with useful utility methods, junctions, type-checking ability, and optional autoboxing. Originally derived from L. =head2 Uses The included objects are useful as-is but are largely intended for use as data container types for attributes. This lends a more natural object-oriented syntax; these are particularly convenient in combination with delegated methods, as in this example: package Some::Thing; use List::Objects::WithUtils; use Moo; has items => ( is => 'ro', builder => sub { array }, handles => +{ add_items => 'push', get_items => 'all', items_where => 'grep', }, ); # ... later ... my $thing = Some::Thing->new; $thing->add_items(@more_items); # Operate on all positive items: for my $item ($thing->items_where(sub { $_ > 0 })->all) { ... } L provides L-based types & coercions matching the list objects provided by this distribution. These integrate nicely with typed or untyped list objects: package Accounts; use List::Objects::Types -types; use Moo 2; has usergroups => ( is => 'ro', # +{ $group => [ [ $usr => $id ], ... ] } # Coerced to objects all the way down: isa => TypedHash[ TypedArray[ArrayObj] ], coerce => 1, builder => sub { +{} }, ); # ... later ... my $users_in_grp = $accts->usergroups ->get($some_group) ->grep(sub { $_[0]->get(0) }); =head2 Objects =head3 Arrays B (L) provides basic mutable ARRAY-type objects. Behavior is defined by L; look there for documentation on available methods. B is imported from L and operates much like an B, except methods that mutate the list are not available; using immutable arrays promotes safer programming patterns. B provides L-compatible type-checking array objects that can coerce and check their values as they are added; see L. B provides immutable type-checking arrays; see L. =head3 Hashes B is the basic mutable HASH-type object imported from L; see L for documentation. B provides immutable (restricted) hashes; see L. B provides L-compatible type-checking hash objects; see L. B provides immutable type-checking hashes; see L. =head2 Importing A bare import list (C) will import all of the object constructor functions described above; they can also be selectively imported, e.g.: use List::Objects::WithUtils 'array_of', 'hash_of'; Importing B lexically enables L, which provides L or L methods for native ARRAY and HASH types. Importing B or B<:all> will import all of the object constructors and additionally turn B on; C is a shortcut for importing B. =head2 Debugging Most methods belonging to these objects are heavily micro-optimized -- at the cost of useful error handling. Since there are few built-in argument checks, a mistake in your code can frequently lead to slightly cryptic errors from the perl side: > my $pos; # whoops, I'm still undefined later: > if ($arr->exists($pos)) { ... } Use of uninitialized value in numeric le (<=) at $useless_lib_lineno ... in which case L is likely to improve your quality of life by providing a real backtrace: $ perl -d:Confess my_app.pl Use of uninitialized value in numeric le (<=) at ... [...]::Array::exists(ARRAY(0x8441068), undef) called at ... =head2 Subclassing The importer for this package is somewhat flexible; a subclass can override import to pass import tags and a target package by feeding this package's C a HASH: # Subclass and import to target packages (see Lowu.pm f.ex): package My::Defaults; use parent 'List::Objects::WithUtils'; sub import { my ($class, @params) = @_; $class->SUPER::import( +{ import => [ 'autobox', 'array', 'hash' ], to => scalar(caller) } ) } Functionality is mostly defined by Roles. For example, it's easy to create your own array class with new methods: package My::Array::Object; use Role::Tiny::With; # Act like List::Objects::WithUtils::Array: with 'List::Objects::WithUtils::Role::Array', 'List::Objects::WithUtils::Role::Array::WithJunctions'; # One way to add your own functional interface: use Exporter 'import'; our @EXPORT = 'my_array'; sub my_array { __PACKAGE__->new(@_) } # ... add/override methods ... ... in which case you may want to also define your own hash subclass that overrides C to produce your preferred arrays: package My::Hash::Object; use Role::Tiny::With; with 'List::Objects::WithUtils::Role::Hash'; use Exporter 'import'; our @EXPORT = 'my_hash'; sub my_hash { __PACKAGE__->new(@_) } sub array_type { 'My::Array::Object' } # ... add/override methods ... =head1 SEE ALSO L for documentation on the basic set of C methods. L for documentation on C junction-returning methods. L for more on C immutable arrays. L for more on C type-checking arrays. L for more on C immutable type-checking arrays. L for documentation regarding C methods. L for more on C immutable hashes. L for more on C type-checking hashes. L for more on C immutable type-checking hashes. L for details on autoboxing. The L module for a convenient importer shortcut. L for relevant L types. L for integration with L class-building sugar. =head1 AUTHOR Jon Portnoy Licensed under the same terms as Perl. The original Array and Hash roles were derived from L by Matthew Phillips (CPAN: MATTP), haarg, and others. Immutable array objects were originally inspired by L by Leon Timmermans (CPAN: LEONT), but now use C. Junctions are adapted from L by Carl Franks (CPAN: CFRANKS) Most of the type-checking code and other useful additions were contributed by Toby Inkster (CPAN: TOBYINK) A significant portion of this code simply wraps other widely-used modules, especially: L L L Inspiration for a few pieces comes from the "classic" (version 0.33) L. =cut nsort_by.t100644000764000031 50612701513023 22603 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_array# (also see utilsby_no_xs.t) use Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ +{ id => 2 }, +{ id => 1 }, +{ id => 3 }, ]; my $sorted = $arr->nsort_by(sub { $_->{id} }); is_deeply [ $sorted->all ], [ +{ id => 1 }, +{ id => 2 }, +{ id => 3 } ], 'boxed nsort_by ok'; done_testing; natatime.t100644000764000031 60312701513023 22544 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 7 ]; my $itr = $arr->natatime(3); is_deeply [ $itr->() ], [1, 2, 3], 'boxed natatime itr() ok'; my $counted; $arr->natatime(3, sub { ++$counted }); is $counted, 3, 'boxed natatime with coderef ok'; $itr = []->natatime(2); ok !defined $itr->(), 'boxed empty array itr returned undef'; done_testing; items_after_incl.t100644000764000031 70412701513023 22502 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 7 ); my $after = $arr->items_after_incl(sub { $_ == 3 }); is_deeply [ $after->all ], [ 3 .. 7 ], 'items_after_incl ok'; ok $arr->items_after_incl(sub { $_ > 10 })->is_empty, 'items_after_incl empty resultset ok'; ok array->items_after_incl(sub { $_ == 1 })->is_empty, 'items_after_incl on empty array ok'; done_testing; maybe_set.t100644000764000031 51412701513023 22520 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hash = +{foo => 1, bar => 2, baz => 3}; ok $hash->maybe_set(foo => 3, bar => 4, quux => 5) == $hash, 'boxed maybe_set returned self ok'; is_deeply +{ $hash->export }, +{ foo => 1, bar => 2, baz => 3, quux => 5 }, 'boxed maybe_set ok'; done_testing items_before_incl.t100644000764000031 55212701513023 22644 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/01_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils 'array'; my $arr = array( 1 .. 7 ); my $before = $arr->items_before_incl(sub { $_ == 4 }); is_deeply [ $before->all ], [ 1 .. 4 ], 'items_before_incl ok'; ok array->items_before_incl(sub { $_ == 1 })->is_empty, 'items_before_incl on empty array ok'; done_testing; array_type.t100644000764000031 25212701513023 22726 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; ok +{}->array_type eq 'List::Objects::WithUtils::Array', 'autoboxed array_type ok'; done_testing; last_where.t100644000764000031 52312701513023 23100 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [qw/ a ba bb c /]; ok $arr->last_where(sub { /^a$/ }) eq 'a', 'boxed last_where ok'; ok !$arr->last_where(sub { /d/ }), 'boxed negative last_where ok'; ok !defined []->last_where(sub { 1 }), 'boxed last_where on empty array returned undef'; done_testing; last_index.t100644000764000031 50312701513023 23073 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [qw/ a ba bb c /]; ok $arr->lastidx(sub { /^b/ }) == 2, 'boxed lastidx ok'; ok $arr->last_index(sub { /d/ }) == -1, 'boxed negative last_index ok'; ok []->last_index(sub { 1 }) == -1, 'boxed last_index on empty array ok'; done_testing; get_or_else.t100644000764000031 131412701513023 23056 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hr = +{a => 1, b => 2, c => 3, d => 4}; ok $hr->get_or_else('b') == 2, 'boxed single-arg get_or_else ok'; ok !$hr->get_or_else('e'), 'boxed single-arg negative get_or_else ok'; cmp_ok $hr->get_or_else(b => 9), '==', 2, 'boxed get_or_else found item ok'; cmp_ok $hr->get_or_else(e => 'foo'), 'eq', 'foo', 'boxed get_or_else defaulted to scalar ok'; my ($invoc, $key); cmp_ok $hr->get_or_else(e => sub { ($invoc, $key) = @_; 'foo' }), 'eq', 'foo', 'boxed get_or_else executed coderef ok'; cmp_ok $invoc, '==', $hr, 'boxed get_or_else coderef invocant ok'; cmp_ok $key, 'eq', 'e', 'boxed get_or_else coderef key ok'; done_testing; delete_when.t100644000764000031 152412701513023 23250 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1, 2, 1, 1, 3, 4, 1 ]; my $deleted = $arr->delete_when(sub { $_ == 1 }); is_deeply [ $deleted->all ], [ (1) x 4 ], 'boxed delete_when returned correct values'; is_deeply [ $arr->all ], [ 2, 3, 4 ], 'boxed delete_when deleted correct values'; $arr->delete_when(sub { $_[0] == 2 }); is_deeply [ $arr->all ], [ 3, 4 ], 'boxed delete_when using @_ ok'; $deleted = $arr->delete_when(sub { $_ == 10 }); is_deeply [ $arr->all ], [ 3, 4 ], 'boxed delete_when deleted nothing ok'; is_deeply [ $deleted->all ], [], 'boxed delete_when deleted nothing ok'; $arr = []; $deleted = $arr->delete_when(sub { $_ == 2 }); ok $deleted->is_empty, 'boxed delete_when on empty list ok'; ok $arr->is_empty, 'boxed delete_when on empty list left list alone'; done_testing; flatten_all.t100644000764000031 67612701513023 23241 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; is_deeply [ []->flatten_all ], [ ], 'boxed empty array flatten_all ok'; my $arr = [ 1, 2, [ 3, 4, [ 5, 6 ], 7 ] ]; is_deeply [ $arr->flatten_all ], [ 1, 2, 3, 4, 5, 6, 7 ], 'boxed flatten_all on refs ok'; $arr = [ 1, 2, array(3, 4, array(5, 6) ), 7 ]; is_deeply [ $arr->flatten_all ], [ 1, 2, 3, 4, 5, 6, 7 ], 'boxed flatten_all on objs ok'; done_testing; items_after.t100644000764000031 62412701513023 23247 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 7 ]; my $after = $arr->items_after(sub { $_ == 3 }); is_deeply [ $after->all ], [ 4 .. 7 ], 'boxed items_after ok'; ok $arr->items_after(sub { $_ > 10 })->is_empty, 'boxed items_after empty resultset ok'; ok []->items_after(sub { $_ == 1 })->is_empty, 'boxed items_after on empty array ok'; done_testing; get_or_else.t100644000764000031 117312701513023 23254 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 3 ]; cmp_ok $arr->get_or_else(0), '==', 1, 'boxed get_or_else existing element ok'; ok !$arr->get_or_else(3), 'boxed get_or_else nonexistant element without default'; cmp_ok $arr->get_or_else(3 => 'foo'), 'eq', 'foo', 'boxed get_or_else defaults to scalar ok'; my ($invoc, $pos); cmp_ok $arr->get_or_else(3 => sub { ($invoc, $pos) = @_; 'foo' }), 'eq', 'foo', 'boxed get_or_else with coderef ok'; cmp_ok $invoc, '==', $arr, 'get_or_else coderef invocant ok'; cmp_ok $pos, '==', 3, 'get_or_else coderef index ok'; done_testing; first_index.t100644000764000031 66112701513023 23264 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [qw/ a ba bb c /]; my $firstidx = $arr->firstidx(sub { /^b/ }); ok $firstidx == 1, 'boxed firstidx ok'; ok $arr->first_index(sub { /^b/ }) == $firstidx, 'boxed first_index alias ok'; ok $arr->first_index(sub { /d/ }) == -1, 'boxed negative first_index ok'; ok []->first_index(sub { 1 }) == -1, 'boxed first_index on empty array ok'; done_testing; first_where.t100644000764000031 44612701513023 23270 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [qw/ a ba bb c /]; my $first = $arr->first_where(sub { /^b/ }); ok $first eq 'ba', 'boxed first_where ok'; ok !defined []->first_where(sub { 1 }), 'boxed first_where on empty array returns undef'; done_testing; intersection.t100644000764000031 103312701513023 23273 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_hashuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $first = +{ map {; $_ => 1 } qw/ a b c d e / }; my $second = hash( map {; $_ => 1 } qw/ c d x y / ); my $third = +{ map {; $_ => 1 } qw/ a b c d e f g / }; my $intersects = $first->intersection($second, $third); ok $intersects->count == 2, 'boxed intersection returned 2 keys' or diag explain $intersects; is_deeply [ $intersects->sort->all ], [ qw/ c d / ], 'boxed intersection intersection looks ok' or diag explain $intersects; done_testing; part_to_hash.t100644000764000031 100112701513023 23426 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $hs = [qw/ann andy bob fred frankie/] ->part_to_hash(sub { ucfirst substr $_, 0, 1 }); isa_ok $hs, 'List::Objects::WithUtils::Hash'; ok $hs->keys->count == 3, 'boxed part_to_hash created 3 keys'; for (qw/A B F/) { isa_ok $hs->get($_), 'List::Objects::WithUtils::Array', "part '$_'"; } is_deeply +{ $hs->export }, +{ A => [qw/ann andy/], B => ['bob'], F => [qw/fred frankie/] }, 'boxed part_to_hash looks ok'; done_testing; intersection.t100644000764000031 71012701513023 23447 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $first = [ qw/ a b c d e / ]; my $second = array( qw/ c d x y / ); my $third = [ qw/ a b c d e f g / ]; my $intersects = $first->intersection($second, $third); ok $intersects->count == 2, '2 items in intersection' or diag explain $intersects; is_deeply [ $intersects->sort->all ], [ qw/ c d / ], 'boxed intersection looks ok' or diag explain $intersects; done_testing items_before.t100644000764000031 70312701513023 23406 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 7 ]; my $before = $arr->items_before(sub { $_ == 4 }); is_deeply [ $before->all ], [ 1 .. 3 ], 'boxed items_before ok'; ok []->items_before(sub { $_ == 4 })->is_empty, 'boxed empty array items_before ok'; $before = [1..3]->items_before(sub { $_ == 1 }); ok $before->is_empty, 'boxed non-matching items_before ok' or diag explain $before; done_testing; 06_immutable_typed000755000764000031 012701513023 20740 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/timmhash_of.t100644000764000031 214512701513023 23401 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/06_immutable_typedBEGIN { unless (eval {; require Types::Standard; 1 } && !$@) { require Test::More; Test::More::plan(skip_all => 'these tests require Types::Standard' ); } } use Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils; use Types::Standard -all; my $immh = immhash_of Int() => ( foo => 1, bar => 2 ); ok $immh->type == Int, 'type ok'; ok $immh->get('foo') == 1 && $immh->get('bar') == 2, 'get ok'; eval {; immhash_of Int() => ( foo => 'baz' ) }; ok $@ =~ /constraint/, 'immhash_of invalid type died'; for my $method (@List::Objects::WithUtils::Role::Hash::Immutable::ImmutableMethods) { local $@; eval {; $immh->$method }; ok $@ =~ /implemented/, "$method dies" } eval {; $immh->{foo} = 3 }; ok $@ =~ /read-only/, 'hash item set dies'; eval {; delete $immh->{foo} }; ok $@ =~ /read-only/, 'hash item delete dies'; eval {; $immh->{quux} = 4 }; ok $@ =~ /read-only/, 'hash item insert dies'; { my $warned; local $SIG{__WARN__} = sub { $warned = shift }; $immh->kv_sort(sub { $a cmp $b }); ok !$warned, 'immhash_of imported $a/$b vars ok'; } done_testing; WithUtils000755000764000031 012701513023 22012 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/ObjectsHash.pm100644000764000031 205212701513023 23372 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtilspackage List::Objects::WithUtils::Hash; $List::Objects::WithUtils::Hash::VERSION = '2.028003'; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, 'List::Objects::WithUtils::Role::Hash' ); use Exporter (); our @EXPORT = 'hash'; sub import { my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub hash { __PACKAGE__->new(@_) } print qq[ die "bad meth"\n die "better call saul"\n] unless caller; 1; =pod =head1 NAME List::Objects::WithUtils::Hash - Hash-type objects WithUtils =head1 SYNOPSIS use List::Objects::WithUtils 'hash'; my $hash = hash( foo => 'bar' ); =head1 DESCRIPTION This class is the basic concrete implementation of L. Methods are documented there. =head2 hash Creates a new hash object. =head1 AUTHOR Jon Portnoy Derived from L by Matt Phillips (CPAN: MATTP) et al Licensed under the same terms as Perl =cut utilsby_no_xs.t100644000764000031 245012701513023 23665 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse strict; use warnings FATAL => 'all'; BEGIN { unless (eval {; require Test::Without::Module; 1 } && !$@) { require Test::More; Test::More::plan(skip_all => 'these tests require Test::Without::Module'); } } use Test::Without::Module 'List::UtilsBy::XS'; use Test::More; use Lowu; ok !$List::Objects::WithUtils::Role::Array::UsingUtilsByXS, 'List::UtilsBy::XS not loaded'; # sort_by ok []->sort_by(sub { $_->foo })->is_empty, 'boxed empty array sort_by ok'; my $arr = [ +{ id => 'c' }, +{ id => 'a' }, +{ id => 'b' }, ]; my $sorted = $arr->sort_by(sub { $_->{id} }); is_deeply [ $sorted->all ], [ +{ id => 'a' }, +{ id => 'b' }, +{ id => 'c' } ], 'sort_by ok'; # nsort_by ok []->nsort_by(sub { $_->foo })->is_empty, 'empty array nsort_by ok'; $arr = [ +{ id => 2 }, +{ id => 1 }, +{ id => 3 }, ]; $sorted = $arr->nsort_by(sub { $_->{id} }); is_deeply [ $sorted->all ], [ +{ id => 1 }, +{ id => 2 }, +{ id => 3 } ], 'nsort_by ok'; # uniq_by ok []->uniq_by(sub { $_->foo })->is_empty, 'empty array uniq_by ok'; $arr = [ +{ id => 1 }, +{ id => 2 }, +{ id => 1 }, +{ id => 3 }, +{ id => 3 }, ]; my $uniq = $arr->uniq_by(sub { $_->{id} }); is_deeply [ $uniq->all ], [ +{ id => 1 }, +{ id => 2 }, +{ id => 3 }, ], 'uniq_by ok'; done_testing; immarray_of.t100644000764000031 251412701513023 23574 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/06_immutable_typedBEGIN { unless (eval {; require Types::Standard; 1 } && !$@) { require Test::More; Test::More::plan(skip_all => 'these tests require Types::Standard' ); } } use Test::More; use strict; use warnings FATAL => 'all'; use List::Objects::WithUtils; use Types::Standard -all; my $immof = immarray_of Int() => 1 .. 5; is_deeply [ $immof->all ], [ 1 .. 5 ], 'immarray_of ok'; ok $immof->type == Int, 'type ok'; eval {; immarray_of Int() => qw/foo 1 2/ }; ok $@ =~ /constraint/, 'immarray_of invalid type died'; for my $method (@List::Objects::WithUtils::Role::Array::Immutable::ImmutableMethods) { local $@; eval {; $immof->$method }; ok $@ =~ /implemented/, "$method dies" } eval {; push @$immof, 6 }; ok $@ =~ /read-only/, 'push dies'; eval {; pop @$immof }; ok $@ =~ /read-only/, 'pop dies'; eval {; unshift @$immof, 0 }; ok $@ =~ /read-only/, 'unshift dies'; eval {; shift @$immof }; ok $@ =~ /read-only/, 'shift dies'; eval {; splice @$immof, 0, 1, 10 }; ok $@ =~ /read-only/, 'splice dies'; eval {; $immof->[10] = 'foo' }; ok $@ =~ /read-only/, 'attempted extend dies'; eval {; $immof->[0] = 10 }; ok $@ =~ /read-only/, 'element set dies'; { my $warned; local $SIG{__WARN__} = sub { $warned++ }; $immof->sort(sub { $a <=> $b }); ok !$warned, 'immarray_of imported $a/$b vars ok'; } done_testing; typed_autovivification.pl100644000764000031 154212701513023 24111 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/examplesuse strict; use warnings; use List::Objects::WithUtils; use List::Objects::Types -types; use Types::Standard -types; # Consider a pattern like MooX::Role::POE::Emitter's registered event/session # map; a given event name has a list of subscribed sessions, and we want # constant-time access/deletion. # A hash of hashes can help: # $registry->{$event}->{$session_id} = 1 # ... but I want some run-time checking to ensure the consistency of my # hash while I'm abusing autovivification: my $registry = hash_of TypedHash[Int]; # 'all' and 'foo' will be coerced to a List::Objects::WithUtils::Hash: $registry->{ all }->{ 1234 } = 1; $registry->{ foo }->{ 1234 } = 1; use Data::Dumper; print Dumper($registry), "\n\n"; # attempting to do something naughty will throw: eval {; $registry->{ bar } = []; }; print "Attempting to add bad element produced:\n $@"; Array.pm100644000764000031 250312701513023 23566 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtilspackage List::Objects::WithUtils::Array; $List::Objects::WithUtils::Array::VERSION = '2.028003'; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, qw/ List::Objects::WithUtils::Role::Array List::Objects::WithUtils::Role::Array::WithJunctions / ); use Exporter (); our @EXPORT = 'array'; sub import { my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub array { __PACKAGE__->new(@_) } 1; =pod =head1 NAME List::Objects::WithUtils::Array - Array-type objects WithUtils =head1 SYNOPSIS use List::Objects::WithUtils 'array'; my $array = array(qw/ a b c /); =head1 DESCRIPTION This class is the basic concrete implementation of L. Methods are documented there. This class also consumes L, which adds the B & B junction-returning methods; see the POD for L and L for details. =head2 array Creates a new array object. =head1 AUTHOR Jon Portnoy Derived from L by Matt Phillips (CPAN: MATTP) et al Licensed under the same terms as Perl =cut rotate_in_place.t100644000764000031 40212701513023 24067 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [1 .. 4]; ok $arr->rotate_in_place == $arr, 'boxed rotate_in_place returned self ok'; is_deeply [ $arr->all ], [ 2, 3, 4, 1 ], 'boxed rotate_in_place ok'; done_testing; blog-post-list-objects.mkdn100644000764000031 1747212701513023 24176 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/examplesTopic: Easy list ops with List-Objects-WithUtils Date: 2013-03-26 Hmm.. I should sort these hash items. Okay, I've got my _sort_ and _map_ ... but I want to sort these objects by `->name` ... oh, right, _List::UtilsBy_! But I want to iterate five of them at a time ... uh, hmm, is natatime in _List::Util_ or _List::MoreUtils_? Ah, screw it: use List::Objects::WithUtils; my $hash = hash(%previous); my $iter = $hash->values ->sort_by(sub { $_->name }) ->natatime(5); while (my @objs = $iter->()) { ... } But now I want to take a slice from this hash and create a new hash ... ah, fook, what was the syntax again? Hum. I could shove the keys I want in `@keys` ... but if any of those keys don't exist in the old hash, I don't want them to be set to `undef` in the new hash, so I need some kind of loop ... Ah, never mind: my $newhash = $hash->sliced(qw/foo bar baz/); There we are! ## A modern approach to list types [List::Objects::WithUtils](http://metacpan.org/release/List-Objects-WithUtils) exists to eliminate that whole train of thought by providing a object-oriented interface to list types (arrays and hashes). Aside from providing native behavior like element manipulation, `sort`, `map`, `grep`, and so forth, you also get the most commonly useful utilities from [List::Util](http://metacpan.org/module/List::Util), [List::MoreUtils](http://metacpan.org/module/List::MoreUtils), [List::UtilsBy](http://metacpan.org/module/List::UtilsBy), and [Syntax::Keyword::Junction](http://metacpan.org/module/Syntax::Keyword::Junction). This post covers the raw basics and the things I use most frequently. See the [List::Objects::WithUtils documentation on metacpan](http://metacpan.org/release/List-Objects-WithUtils) for usage details. #### The basics Getting going is pretty easy; where I might declare an array: my @array = qw/ a b c /; ... or an ARRAY: my $array = [qw/ a b c /]; I can just use `array()`: my $array = array(qw/ a b c /); (Since these are ARRAY-type objects, code that previously treated $array as an ARRAY ref will Just Work so long as it checks 'reftype' where most people might use 'ref' -- porting my old code went pretty smoothly.) Later on, if I need a plain list back out, I can get `all` elements: for my $item ($array->all) { ... } ... or perhaps just find out how many elements the array has: if ( $array->count > 2 ) { ... } I can retrieve a specific index via `get`: my $second = $array->get(1); ... or change it via `set`: $array->set( 1, 'newval' ); The usual array operations work basically as-expected: $array->push('d'); my $last = $array->pop; $array->unshift('z'); my $first = $array->shift; I can `splice` or `delete` items: $array->delete(2); $array->splice( 0, 1 ); ... and transform lists into strings via `join`: my $str = $array->join(''); Working with hashes is much the same; all the expected operations are available. I can create my hash using the expected syntax: my $hash = hash( a => 'foo', b => 'bar', c => 'baz', ); Adding or setting hash elements works essentially as-expected: $hash->set(d => 'pie'); ... but `set` can also take a sequence of pairs, which is great for combining hashes: $hash->set( e => 'cake', f => 'banana', ); # From a plain Perl hash: $hash->set( %old ); # From a hash(): $hash->set( $old->export ); Hash operations like `keys` and `values` return a list, which is of course presented as an array() object. That means it's easy to use chained operations to, say, sort by either key or value: my @bykey = $hash->keys->sort->all; # By value, unique values only. my @byval = $hash->values->uniq->sort->all; Since `sort` takes a sub, I could sort by a hash element, say: my $sorted = array( hash( foo => 1 ), hash( foo => 2 ), hash( foo => 3 ), )->sort(sub { $_[0]->get('foo') cmp $_[1]->get('foo') }); ... but since `sort_by` is available, it would be much cleaner to do: $array->sort_by(sub { $_->get('foo') }); (Note the `$_` -- `sort_by` operates on a topicalizer.) List operations returning new lists makes for pretty chaining: my @all = $array->grep(sub { $_[0] =~ /foo/ }) ->uniq ->sort ->map(sub { uc $_[0] }) ->all; How about a Schwartzian (with a little extra overhead, granted)? my $sorted = array(qw/ abcd ab abc a /) ->map(sub { [ $_[0], length $_[0] ] }) ->sort(sub { $_[0]->[1] <=> $_[1]->[1] }) ->map(sub { $_[0]->[0] }) (This is pointless because we have `sort_by` available (see above), but it's a well-known idiom with which we can demonstrate chaining.) #### Junctions One of the most common things I do with a list is apply `grep` to find stuff -- but sometimes I'm not all that overly interested in _what_ I found, only whether or not it is present. I could, of course, use `grep` and check for found elements: if ( array(1 .. 10)->grep(sub { $_[0] == 4 })->has_any ) { ... } ... or I could turn to `has_any` or `first` for the same purpose, which could be more efficient on account of terminating after the first successful hit: if ( array(1,2,3)->has_any(sub { $_ == 4 }) ) { } if ( array(1,2,3)->first(sub { $_ == 4}) ) { } Still, this is a bit ugly; I just want to know if any items meet a certain criteria, and typing 'sub { ... }' every five minutes gets to be silly. Fortunately, the default `array` class happens to consume [List::Objects::WithUtils::Role::WithJunctions](http://metacpan.org/module/List::Objects::WithUtils::Role::WithJunctions), giving us easy access to [Syntax::Keyword::Junction](http://metacpan.org/module/Syntax::Keyword::Junction) goodness. Calling `any_items` returns the overloaded `any` junction. Our check might look more like: if ( array(1,2,3)->any_items == 4 ) { ... } if ( array('a', 'b', 'c')->any_items eq 'b' ) { ... } You also get `all_items` for free: if ( array(1,2,3)->all_items > 0 ) { ... } #### Slices Traditional slice syntax isn't so bad when using a normal `@array` or `%hash`: my @array = ( 'a' .. 'z' ); my @first = @array[0 .. 5]; my %hash = ( foo => 'bar', baz => 'foo', bar => 'baz' ); # Values for wanted keys: my @foobar = @hash{'foo','bar'}; It starts to get a little more interesting when dealing with references: my @first = @{ $array }[0 .. 5]; my @foobar = @{ $hash }{'foo','bar'} ... and downright obnoxious when I'd like to turn a piece of a hash into a new hash, for example: my %newhash = map {; exists $hash->{$_} ? ( $_ => $hash->{$_} ) : () } 'foo', 'bar'; Instead of all that, I can just use `->sliced`, which works on both `array` and `hash` objects. Now that array example looks more like this: my $array = array( 'a' .. 'z' ); my $slice = $array->sliced( 0 .. 5 ); Unlike `->splice`, `->sliced` leaves the existing array alone and returns a new array-type object containing the values requested. A sliced() hash returns a new hash object: my $newhash = $hash->sliced('foo', 'bar'); When using `->sliced`, keys that don't exist in the old hash won't be created with undefined values in the new hash. In a similar vein, sometimes it's convenient to be able to get all the items before the one matching some condition: my $before = $array->items_before(sub { $_ eq 'd' }); ... or after it: my $after = $array->items_after(sub { $_ eq 't' }); We can make our hash manipulation rather shorter and a bit prettier: my $hash = hash( foo => 'bar', baz => 'foo', bar => 'baz' ); A get() that returns a list of values returns an array object: my @foobar = $hash->get('foo', 'bar')->all; There's plenty more. See the official documentation. Autobox.pm100644000764000031 555712701513023 24145 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtilspackage List::Objects::WithUtils::Autobox; $List::Objects::WithUtils::Autobox::VERSION = '2.028003'; use strictures 2; require Carp; require Module::Runtime; use parent 'autobox'; sub ARRAY_TYPE () { 'List::Objects::WithUtils::Array' } sub HASH_TYPE () { 'List::Objects::WithUtils::Hash' } sub import { my ($class, %params) = @_; # Ability to pass in your own subclasses is tested but undocumented .. # The catch is that the Roles fall back to the standard object classes # if blessed_or_pkg hits on a non-blessed ref (i.e. we're called against # an autoboxed ref). In other words, your autoboxed objects in-scope have # your spiffy new subclass' methods -- but lots of methods checking # blessed_or_pkg() will lose your spiffyness and revert to boring old # standard types. # # I'm sure there's a work-around, but I haven't thought of it, yet . . . %params = map {; lc($_) => $params{$_} } keys %params; $class->SUPER::import( ARRAY => Module::Runtime::use_package_optimistically($params{array} || ARRAY_TYPE), HASH => Module::Runtime::use_package_optimistically($params{hash} || HASH_TYPE) ); } print qq[ b100s: You can skip down to], qq[ http://tools.ietf.org/html/rfc2234#section-4 for the ABNF description of], qq[ ABNF. If you already know ABNF, it should be sufficient to teach it], qq[ to you.\n] unless caller; 1; =pod =for Pod::Coverage import ARRAY_TYPE HASH_TYPE =head1 NAME List::Objects::WithUtils::Autobox - Native data types WithUtils =head1 SYNOPSIS use List::Objects::WithUtils 'autobox'; my @upper = [ qw/foo bar baz/ ]->map(sub { uc })->all; my @sorted_keys = { foo => 'bar', baz => 'quux' }->keys->sort->all; # See List::Objects::WithUtils::Role::Array # and List::Objects::WithUtils::Role::Hash =head1 DESCRIPTION This module is a subclass of L that provides L methods for native ARRAY and HASH types; you can treat native Perl list references as if they were L or L instances. Like L, the effect is lexical in scope and can be disabled: use List::Objects::WithUtils::Autobox; my $foo = [3,2,1]->sort; no List::Objects::WithUtils::Autobox; [3,2,1]->sort; # dies =head2 CAVEATS You can't call B on autoboxed refs (but that would be a silly thing to do anyway -- and if you're really determined, C<< []->copy >> has the same effect). It's worth noting that methods that create new lists will return blessed objects, not native data types. This lets you continue passing result collections around to other pieces of Perl that wouldn't otherwise know how to call the autoboxed methods. (Some methods do return the object they were originally operating on, in which case the original reference is indeed returned, as expected.) =head1 AUTHOR Jon Portnoy =cut items_after_incl.t100644000764000031 66212701513023 24256 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 7 ]; my $after = $arr->items_after_incl(sub { $_ == 3 }); is_deeply [ $after->all ], [ 3 .. 7 ], 'boxed items_after_incl ok'; ok $arr->items_after_incl(sub { $_ > 10 })->is_empty, 'boxed items_after_incl empty resultset ok'; ok []->items_after_incl(sub { $_ == 1 })->is_empty, 'boxed items_after_incl on empty array ok'; done_testing; items_before_incl.t100644000764000031 52212701513023 24412 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/t/09_autobox_arrayuse Test::More; use strict; use warnings FATAL => 'all'; use Lowu; my $arr = [ 1 .. 7 ]; my $before = $arr->items_before_incl(sub { $_ == 4 }); is_deeply [ $before->all ], [ 1 .. 4 ], 'boxed items_before_incl ok'; ok []->items_before_incl(sub { $_ == 1 })->is_empty, 'boxed items_before_incl on empty array ok'; done_testing; Role000755000764000031 012701513023 22713 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtilsHash.pm100644000764000031 3711712701513023 24325 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Rolepackage List::Objects::WithUtils::Role::Hash; $List::Objects::WithUtils::Role::Hash::VERSION = '2.028003'; use strictures 2; use Module::Runtime (); use Scalar::Util (); use List::Util (); =for Pod::Coverage HASH_TYPE blessed_or_pkg =cut sub HASH_TYPE () { 'List::Objects::WithUtils::Hash' } sub blessed_or_pkg { Scalar::Util::blessed($_[0]) ? $_[0] : Module::Runtime::use_module(HASH_TYPE) } use Role::Tiny; sub array_type { 'List::Objects::WithUtils::Array' } sub inflated_type { 'List::Objects::WithUtils::Hash::Inflated' } sub inflated_rw_type { 'List::Objects::WithUtils::Hash::Inflated::RW' } =for Pod::Coverage TO_JSON TO_ZPL damn type =cut sub is_mutable { 1 } sub is_immutable { ! $_[0]->is_mutable } sub type { } our %Required; sub new { my $arraytype = $_[0]->array_type; $Required{$arraytype} = Module::Runtime::require_module($arraytype) unless exists $Required{$arraytype}; bless +{ @_[1 .. $#_] }, Scalar::Util::blessed($_[0]) || $_[0] } sub export { %{ $_[0] } } sub unbless { +{ %{ $_[0] } } } { no warnings 'once'; *TO_JSON = *unbless; *TO_ZPL = *unbless; *damn = *unbless; } sub clear { %{ $_[0] } = (); $_[0] } =for Pod::Coverage untyped =cut sub copy { blessed_or_pkg($_[0])->new(%{ $_[0] }) } { no warnings 'once'; *untyped = *copy; } sub inflate { my ($self, %params) = @_; my $type = $params{rw} ? 'inflated_rw_type' : 'inflated_type'; my $cls = blessed_or_pkg($self); Module::Runtime::require_module( $cls->$type ); $cls->$type->new( %$self ) } sub defined { CORE::defined $_[0]->{ $_[1] } } sub exists { CORE::exists $_[0]->{ $_[1] } } sub is_empty { ! keys %{ $_[0] } } sub get { @_ > 2 ? blessed_or_pkg($_[0])->array_type->new( @{ $_[0] }{ @_[1 .. $#_] } ) : $_[0]->{ $_[1] } } sub get_or_else { exists $_[0]->{ $_[1] } ? $_[0]->{ $_[1] } : (Scalar::Util::reftype $_[2] || '') eq 'CODE' ? $_[2]->(@_[0,1]) : $_[2] } sub get_path { my $ref = $_[0]; for my $part (@_[1 .. $#_]) { $ref = ref $part eq 'ARRAY' ? $ref->[ $part->[0] ] : $ref->{$part}; return undef unless defined $ref; } $ref } =for Pod::Coverage slice =cut { no warnings 'once'; *slice = *sliced; } { local $@; if ($] >= 5.020) { eval q[ sub sliced { blessed_or_pkg($_[0])->new( %{ $_[0] }{ grep {; exists $_[0]->{$_} } @_[1 .. $#_] } ) } ]; } else { eval q[ sub sliced { blessed_or_pkg($_[0])->new( map {; exists $_[0]->{$_} ? ($_ => $_[0]->{$_}) : () } @_[1 .. $#_] ) } ]; } die "installing sub 'sliced' died: $@" if $@; } sub set { my $self = shift; my (@keysidx, @valsidx); $_ % 2 ? push @valsidx, $_ : push @keysidx, $_ for 0 .. $#_; @{$self}{ @_[@keysidx] } = @_[@valsidx]; $self } sub maybe_set { my $self = shift; for (grep {; not $_ % 2 } 0 .. $#_) { $self->{ $_[$_] } = $_[$_ + 1] unless exists $self->{ $_[$_] } } $self } sub delete { blessed_or_pkg($_[0])->array_type->new( CORE::delete @{ $_[0] }{ @_[1 .. $#_] } ) } sub keys { blessed_or_pkg($_[0])->array_type->new( CORE::keys %{ $_[0] } ) } sub values { blessed_or_pkg($_[0])->array_type->new( CORE::values %{ $_[0] } ) } sub intersection { my %seen; my %inner; blessed_or_pkg($_[0])->array_type->new( grep {; not $seen{$_}++ } grep {; ++$inner{$_} > $#_ } map {; CORE::keys %$_ } @_ ) } sub diff { my %seen; my %inner; my @vals = map {; CORE::keys %$_ } @_; $seen{$_}++ for @vals; blessed_or_pkg($_[0])->array_type->new( grep {; $seen{$_} != @_ } grep {; not $inner{$_}++ } @vals ) } sub iter { my @list = %{ $_[0] }; sub { splice @list, 0, 2 } } sub kv { blessed_or_pkg($_[0])->array_type->new( map {; [ $_, $_[0]->{ $_ } ] } CORE::keys %{ $_[0] } ) } sub kv_sort { if (defined $_[1] && (my $cb = $_[1])) { my $pkg = caller; no strict 'refs'; return blessed_or_pkg($_[0])->array_type->new( map {; [ $_, $_[0]->{ $_ } ] } sort {; local (*{"${pkg}::a"}, *{"${pkg}::b"}) = (\$a, \$b); $a->$cb($b) } CORE::keys %{ $_[0] } ) } blessed_or_pkg($_[0])->array_type->new( map {; [ $_, $_[0]->{ $_ } ] } sort( CORE::keys %{ $_[0] } ) ) } sub kv_map { my ($self, $cb) = @_; my $pkg = caller; no strict 'refs'; blessed_or_pkg($self)->array_type->new( List::Util::pairmap {; local (*{"${pkg}::a"}, *{"${pkg}::b"}) = (\$a, \$b); $a->$cb($b) } %$self ) } sub kv_grep { my ($self, $cb) = @_; my $pkg = caller; no strict 'refs'; blessed_or_pkg($self)->new( List::Util::pairgrep {; local (*{"${pkg}::a"}, *{"${pkg}::b"}) = (\$a, \$b); $a->$cb($b) } %$self ) } =for Pod::Coverage invert =cut sub inverted { my ($self) = @_; my $cls = blessed_or_pkg($self); my %new; List::Util::pairmap {; exists $new{$b} ? $new{$b}->push($a) : ( $new{$b} = $cls->array_type->new($a) ) } %$self; $cls->new(%new) } { no warnings 'once'; *invert = *inverted; } sub random_kv { my $key = (CORE::keys %{ $_[0] })[rand CORE::keys %{ $_[0] }]; $key ? [ $key => $_[0]->{$key} ] : undef } sub random_key { (CORE::keys %{ $_[0] })[rand (CORE::keys %{ $_[0] } || return undef)] } sub random_value { [@_ = %{ $_[0] }]->[1|rand @_] } print qq[ huf: I learned that from toyota via agile blahblah,], qq[ it's asking the five "why" questions.\n], qq[ WHY WHY WHY WHY GOD WHY\n] unless caller; 1; =pod =head1 NAME List::Objects::WithUtils::Role::Hash - Hash manipulation methods =head1 SYNOPSIS ## Via List::Objects::WithUtils::Hash -> use List::Objects::WithUtils 'hash'; my $hash = hash(foo => 'bar'); $hash->set( foo => 'baz', pie => 'tasty', ); my @matches = $hash->keys->grep(sub { $_[0] =~ /foo/ })->all; my $pie = $hash->get('pie') if $hash->exists('pie'); for my $pair ( $hash->kv->all ) { my ($key, $val) = @$pair; ... } my $obj = $hash->inflate; my $foo = $obj->foo; ## As a Role -> use Role::Tiny::With; with 'List::Objects::WithUtils::Role::Hash'; =head1 DESCRIPTION A L role defining methods for creating and manipulating HASH-type objects. In addition to the methods documented below, these objects provide a C method exporting a plain HASH-type reference for convenience when feeding L or similar, as well as a C method for compatibility with L. =head2 Basic hash methods =head3 new Constructs a new HASH-type object. =head3 copy Creates a shallow clone of the current object. =head3 defined if ( $hash->defined($key) ) { ... } Returns boolean true if the key has a defined value. =head3 exists if ( $hash->exists($key) ) { ... } Returns boolean true if the key exists. =head3 export my %hash = $hash->export; Returns a raw key => value list. For a plain HASH-type reference, see: L =head3 array_type The class name of array-type objects that will be used to contain the results of methods returning a list. Defaults to L. Subclasses can override C to produce different types of array objects. =head3 inflate my $obj = hash(foo => 'bar', baz => 'quux')->inflate; my $baz = $obj->baz; Inflates the hash-type object into a simple struct-like object with accessor methods matching the keys of the hash. By default, accessors are read-only; specifying C 1> allows setting new values: my $obj = hash(foo => 'bar', baz => 'quux')->inflate(rw => 1); $obj->foo('frobulate'); Returns an L (or L) object. The default objects provide a C method returning a plain hash; this makes it easy to turn inflated objects back into a C for modification: my $first = hash( foo => 'bar', baz => 'quux' )->inflate; my $second = hash( $first->DEFLATE, frobulate => 1 )->inflate; =head3 inflated_type The class that objects are blessed into when calling L. Defaults to L. =head3 inflated_rw_type The class that objects are blessed into when calling L with C 1> specified. Defaults to L, a subclass of L. =head3 is_empty Returns boolean true if the hash has no keys. =head3 is_mutable Returns boolean true if the hash is mutable; immutable subclasses can override to provide a negative value. =head3 is_immutable The opposite of L. =head3 unbless Returns a plain C reference (shallow clone). =head2 Methods that manipulate the hash =head3 clear Clears the current hash entirely. Returns the (same, but now empty) hash object. =head3 delete $hash->delete(@keys); Deletes the given key(s) from the hash. Returns an L object containing the deleted values. =head3 set $hash->set( key1 => $val, key2 => $other, ) Sets keys in the hash. Returns the current hash object. =head3 maybe_set my $hash = hash(foo => 1, bar => 2, baz => 3); $hash->maybe_set(foo => 2, bar => 3, quux => 4); # $hash = +{ foo => 1, bar => 2, baz => 3, quux => 4 } Like L, but only sets values that do not already exist in the hash. Returns the current hash object. =head2 Methods that retrieve items =head3 get my $val = $hash->get($key); my @vals = $hash->get(@keys)->all; Retrieves a key or list of keys from the hash. If taking a slice (multiple keys were specified), values are returned as an L object. (See L if you'd rather generate a new hash.) =head3 get_path my $hash = hash( foo => +{ bar => +{ baz => 'bork' } }, quux => [ +{ weeble => 'snork' } ], ); my $item = $hash->get_path(qw/foo bar baz/); # 'bork' Attempt to retrieve a value from a 'deep' hash (without risking autovivification). If an element of the given path is a (plain) array reference, as in this example: my $item = $hash->get_path('quux', [1], 'weeble'); # "snork" ... then it is taken as the index of an array or array-type object in the path. Returns undef if any of the path elements are nonexistant. An exception is thrown if an invalid access is attempted, such as trying to use a hash-type object as if it were an array. (Available from v2.15.1) =head3 get_or_else # Expect to find an array() obj at $key in $hash, # or create an empty one if $key doesn't exist: my @all = $hash->get_or_else($key => array)->all; # Or pass a coderef # First arg is the object being operated on # Second arg is the requested key my $item = $hash->get_or_else($key => sub { shift->get($defaultkey) }); Retrieves a key from the hash; optionally takes a second argument that is used as a default value if the given key does not exist in the hash. If the second argument is a coderef, it is invoked on the object (with the requested key as an argument) and its return value is taken as the default value. =head3 keys my @keys = $hash->keys->all; Returns the list of keys in the hash as an L object. =head3 values my @vals = $hash->values->all; Returns the list of values in the hash as an L object. =head3 inverted my $hash = hash( a => 1, b => 2, c => 2, d => 3 ); my $newhash = $hash->inverted; # $newhash = +{ # 1 => array('a'), # 2 => array('b', 'c'), # 3 => array('d'), # } Inverts the hash; the values of the original hash become keys in the new object. Their corresponding values are L objects containing the key(s) that mapped to the original value. This is a bit like reversing the hash, but lossless with regards to non-unique values. (Available from v2.14.1) =head3 iter my $iter = $hash->iter; while (my ($key, $val) = $iter->()) { # ... } Returns an iterator that, when called, returns ($key, $value) pairs. When the list is exhausted, an empty list is returned. The iterator operates on a shallow clone of the hash, making it safe to operate on the original hash while using the iterator. (Available from v2.9.1) =head3 kv for my $pair ($hash->kv->all) { my ($key, $val) = @$pair; } Returns an L object containing the key/value pairs in the hash, each of which is a two-element (unblessed) ARRAY. =head3 kv_grep my $positive_vals = $hash->kv_grep(sub { $b > 0 }); Like C, but operates on pairs. See L. Returns a hash-type object consisting of the key/value pairs for which the given block returned true. (Available from v2.21.1) =head3 kv_map # Add 1 to each value, get back an array-type object: my $kvs = hash(a => 2, b => 2, c => 3) ->kv_map(sub { ($a, $b + 1) }); Like C, but operates on pairs. See L. Returns an L object containing the results of the map. (Available from v2.8.1; in versions prior to v2.20.1, C<$_[0]> and C<$_[1]> must be used in place of C<$a> and C<$b>, respectively.) =head3 kv_sort my $kvs = hash(a => 1, b => 2, c => 3)->kv_sort; # $kvs = array( # [ a => 1 ], # [ b => 2 ], # [ c => 3 ] # ) my $reversed = hash(a => 1, b => 2, c => 3) ->kv_sort(sub { $b cmp $a }); # Reverse result as above Like L, but sorted by key. A sort routine can be provided. In versions prior to v2.19.1, C<$_[0]> and C<$_[1]> must be used in place of C<$a> and C<$b>, respectively. =head3 random_kv Returns a random key/value pair from the hash as an C-type reference. Returns undef if the hash is empty. (Available from v2.28.1) =head3 random_key Returns a random key from the hash. Returns undef if the hash is empty. (Available from v2.28.1) =head3 random_value Returns a random value from the hash. Returns undef if the hash is empty. (Available from v2.28.1) =head3 sliced my $newhash = $hash->sliced(@keys); Returns a new hash object built from the specified set of keys and their respective values. If a given key is not found in the hash, it is omitted from the result (this is different than C hash slice syntax, which sets unknown keys to C in the slice). If you only need the values, see L. =head2 Methods that compare hashes =head3 intersection my $first = hash(a => 1, b => 2, c => 3); my $second = hash(b => 2, c => 3, d => 4); my $intersection = $first->intersection($second); my @common = $intersection->sort->all; Returns the list of keys common between all given hash-type objects (including the invocant) as an L object. =head3 diff The opposite of L; returns the list of keys that are not common to all given hash-type objects (including the invocant) as an L object. =head1 NOTES FOR CONSUMERS If creating your own consumer of this role, some extra effort is required to make C<$a> and C<$b> work in sort statements without warnings; an example with a custom exported constructor might look something like: package My::Custom::Hash; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, qw/ List::Objects::WithUtils::Role::Hash My::Custom::Hash::Role / ); use Exporter (); our @EXPORT = 'myhash'; sub import { my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub myhash { __PACKAGE__->new(@_) } =head1 SEE ALSO L L L L L =head1 AUTHOR Jon Portnoy Portions of this code are derived from L by Matthew Phillips (CPAN: MATTP), haarg et al Licensed under the same terms as Perl. =cut Array.pm100644000764000031 10765412701513023 24544 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Rolepackage List::Objects::WithUtils::Role::Array; $List::Objects::WithUtils::Role::Array::VERSION = '2.028003'; use strictures 2; use Carp (); use List::Util (); use Module::Runtime (); use Scalar::Util (); # This (and relevant tests) can disappear if UtilsBy gains XS: our $UsingUtilsByXS = 0; { no warnings 'once'; if (eval {; require List::UtilsBy::XS; 1 } && !$@) { $UsingUtilsByXS = 1; *__sort_by = \&List::UtilsBy::XS::sort_by; *__nsort_by = \&List::UtilsBy::XS::nsort_by; *__uniq_by = \&List::UtilsBy::XS::uniq_by; } else { require List::UtilsBy; *__sort_by = \&List::UtilsBy::sort_by; *__nsort_by = \&List::UtilsBy::nsort_by; *__uniq_by = \&List::UtilsBy::uniq_by; } } =for Pod::Coverage ARRAY_TYPE blessed_or_pkg =begin comment Regarding blessed_or_pkg(): This is some nonsense to support autoboxing; if we aren't blessed, we're autoboxed, in which case we appear to have no choice but to cheap out and return the basic array type. This should only be called to get your hands on ->new(). ->new() methods should be able to operate on a blessed invocant. =end comment =cut sub ARRAY_TYPE () { 'List::Objects::WithUtils::Array' } sub blessed_or_pkg { Scalar::Util::blessed($_[0]) ? $_[0] : Module::Runtime::use_module(ARRAY_TYPE) } sub __flatten_all { # __flatten optimized for max depth: ref $_[0] eq 'ARRAY' || Scalar::Util::blessed($_[0]) # 5.8 doesn't have ->DOES() && $_[0]->can('does') && $_[0]->does('List::Objects::WithUtils::Role::Array') ? map {; __flatten_all($_) } @{ $_[0] } : $_[0] } sub __flatten { my $depth = shift; CORE::map { ref eq 'ARRAY' || Scalar::Util::blessed($_) && $_->can('does') && $_->does('List::Objects::WithUtils::Role::Array') ? $depth > 0 ? __flatten( $depth - 1, @$_ ) : $_ : $_ } @_ } use Role::Tiny; # my position relative to subs matters sub inflated_type { 'List::Objects::WithUtils::Hash' } sub is_mutable { 1 } sub is_immutable { ! $_[0]->is_mutable } sub _try_coerce { # subclass-mungable (keep me under the Role::Tiny import) my (undef, $type, @vals) = @_; Carp::confess "Expected a Type::Tiny type but got $type" unless Scalar::Util::blessed $type; CORE::map {; my $coerced; $type->check($_) ? $_ : $type->assert_valid( $type->has_coercion ? ($coerced = $type->coerce($_)) : $_ ) ? $coerced : Carp::confess "I should be unreachable!" } @vals } =for Pod::Coverage TO_JSON TO_ZPL damn type =cut sub type { # array() has an empty ->type } sub new { bless [ @_[1 .. $#_ ] ], Scalar::Util::blessed($_[0]) || $_[0] } =for Pod::Coverage untyped =cut { no warnings 'once'; *untyped = *copy } sub copy { blessed_or_pkg($_[0])->new(@{ $_[0] }) } sub inflate { my ($self) = @_; my $cls = blessed_or_pkg($self); Module::Runtime::require_module( $cls->inflated_type ); $cls->inflated_type->new(@$self) } { no warnings 'once'; *TO_JSON = *unbless; *TO_ZPL = *unbless; *damn = *unbless; } sub unbless { [ @{ $_[0] } ] } sub validated { my ($self, $type) = @_; # Autoboxed? $self = blessed_or_pkg($self)->new(@$self) unless Scalar::Util::blessed $self; blessed_or_pkg($_[0])->new( CORE::map {; $self->_try_coerce($type, $_) } @$self ) } sub all { @{ $_[0] } } { no warnings 'once'; *export = *all; *elements = *all; } =for Pod::Coverage size =cut sub count { CORE::scalar @{ $_[0] } } { no warnings 'once'; *scalar = *count; *size = *count; } sub end { $#{ $_[0] } } sub is_empty { ! @{ $_[0] } } sub exists { my $r; !!( $_[1] <= $#{ $_[0] } ? $_[1] >= 0 ? 1 : (($r = $_[1] + @{ $_[0] }) <= $#{ $_[0] } && $r >= 0) ? 1 : () : () ) } sub defined { defined $_[0]->[ $_[1] ] } sub get { $_[0]->[ $_[1] ] } sub get_or_else { defined $_[0]->[ $_[1] ] ? $_[0]->[ $_[1] ] : (Scalar::Util::reftype $_[2] || '') eq 'CODE' ? $_[2]->(@_[0,1]) : $_[2] } sub set { $_[0]->[ $_[1] ] = $_[2] ; $_[0] } sub random { $_[0]->[ rand @{ $_[0] } ] } sub kv { my ($self) = @_; blessed_or_pkg($self)->new( map {; [ $_ => $self->[$_] ] } 0 .. $#$self ) } sub head { wantarray ? ( $_[0]->[0], blessed_or_pkg($_[0])->new( @{ $_[0] }[ 1 .. $#{$_[0]} ] ) ) : $_[0]->[0] } sub tail { wantarray ? ( $_[0]->[-1], blessed_or_pkg($_[0])->new( @{ $_[0] }[ 0 .. ($#{$_[0]} - 1) ] ) ) : $_[0]->[-1] } sub pop { CORE::pop @{ $_[0] } } sub push { CORE::push @{ $_[0] }, @_[1 .. $#_]; $_[0] } sub shift { CORE::shift @{ $_[0] } } sub unshift { CORE::unshift @{ $_[0] }, @_[1 .. $#_]; $_[0] } sub clear { @{ $_[0] } = (); $_[0] } sub delete { scalar CORE::splice @{ $_[0] }, $_[1], 1 } sub delete_when { my ($self, $cb) = @_; my @removed; my $i = @$self; while ($i--) { local *_ = \$self->[$i]; CORE::push @removed, CORE::splice @$self, $i, 1 if $cb->($_); } blessed_or_pkg($_[0])->new(@removed) } sub insert { $#{$_[0]} = ($_[1]-1) if $_[1] > $#{$_[0]}; CORE::splice @{ $_[0] }, $_[1], 0, @_[2 .. $#_]; $_[0] } sub intersection { my %seen; blessed_or_pkg($_[0])->new( # Well. Probably not the most efficient approach . . . CORE::grep {; ++$seen{$_} > $#_ } CORE::map {; my %s = (); CORE::grep {; not $s{$_}++ } @$_ } @_ ) } sub diff { my %seen; my @vals = CORE::map {; my %s = (); CORE::grep {; not $s{$_}++ } @$_ } @_; $seen{$_}++ for @vals; my %inner; blessed_or_pkg($_[0])->new( CORE::grep {; $seen{$_} != @_ } CORE::grep {; not $inner{$_}++ } @vals ) } sub join { CORE::join( ( defined $_[1] ? $_[1] : ',' ), @{ $_[0] } ) } sub map { blessed_or_pkg($_[0])->new( CORE::map {; $_[1]->($_) } @{ $_[0] } ) } sub mapval { my ($self, $cb) = @_; my @copy = @$self; blessed_or_pkg($self)->new( CORE::map {; $cb->($_); $_ } @copy ) } sub visit { $_[1]->($_) for @{ $_[0] }; $_[0] } sub grep { blessed_or_pkg($_[0])->new( CORE::grep {; $_[1]->($_) } @{ $_[0] } ) } =for Pod::Coverage indices =cut { no warnings 'once'; *indices = *indexes; } sub indexes { $_[1] ? blessed_or_pkg($_[0])->new( grep {; local *_ = \$_[0]->[$_]; $_[1]->() } 0 .. $#{ $_[0] } ) : blessed_or_pkg($_[0])->new( 0 .. $#{ $_[0] } ) } sub sort { if (defined $_[1] && (my $cb = $_[1])) { my $pkg = caller; no strict 'refs'; return blessed_or_pkg($_[0])->new( CORE::sort {; local (*{"${pkg}::a"}, *{"${pkg}::b"}) = (\$a, \$b); $a->$cb($b) } @{ $_[0] } ) } blessed_or_pkg($_[0])->new( CORE::sort @{ $_[0] } ) } sub reverse { blessed_or_pkg($_[0])->new( CORE::reverse @{ $_[0] } ) } =for Pod::Coverage slice =cut { no warnings 'once'; *slice = *sliced } sub sliced { my @safe = @{ $_[0] }; blessed_or_pkg($_[0])->new( @safe[ @_[1 .. $#_] ] ) } sub splice { blessed_or_pkg($_[0])->new( @_ == 2 ? CORE::splice( @{ $_[0] }, $_[1] ) : CORE::splice( @{ $_[0] }, $_[1], $_[2], @_[3 .. $#_] ) ) } sub has_any { defined $_[1] ? !! &List::Util::any( $_[1], @{ $_[0] } ) : !! @{ $_[0] } } =for Pod::Coverage first =cut { no warnings 'once'; *first = *first_where } sub first_where { &List::Util::first( $_[1], @{ $_[0] } ) } sub last_where { my ($self, $cb) = @_; my $i = @$self; while ($i--) { local *_ = \$self->[$i]; my $ret = $cb->(); $self->[$i] = $_; return $_ if $ret; } undef } { no warnings 'once'; *first_index = *firstidx; *last_index = *lastidx; } sub firstidx { my ($self, $cb) = @_; for my $i (0 .. $#$self) { local *_ = \$self->[$i]; return $i if $cb->(); } -1 } sub lastidx { my ($self, $cb) = @_; for my $i (CORE::reverse 0 .. $#$self) { local *_ = \$self->[$i]; return $i if $cb->(); } -1 } { no warnings 'once'; *zip = *mesh; } sub mesh { my $max_idx = -1; for (@_) { $max_idx = $#$_ if $max_idx < $#$_ } blessed_or_pkg($_[0])->new( CORE::map {; my $idx = $_; map {; $_->[$idx] } @_ } 0 .. $max_idx ) } sub natatime { my @list = @{ $_[0] }; my $count = $_[1]; my $itr = sub { CORE::splice @list, 0, $count }; if (defined $_[2]) { while (my @nxt = $itr->()) { $_[2]->(@nxt) } return } $itr } sub rotator { my @list = @{ $_[0] }; my $pos = 0; sub { my $val = $list[$pos++]; $pos = 0 if $pos == @list; $val } } sub part { my ($self, $code) = @_; my @parts; CORE::push @{ $parts[ $code->($_) ] }, $_ for @$self; my $cls = blessed_or_pkg($self); $cls->new( map {; $cls->new(defined $_ ? @$_ : () ) } @parts ) } sub part_to_hash { my ($self, $code) = @_; my %parts; CORE::push @{ $parts{ $code->($_) } }, $_ for @$self; my $cls = blessed_or_pkg($self); Module::Runtime::require_module( $cls->inflated_type ); @parts{keys %parts} = map {; $cls->new(@$_) } values %parts; $cls->inflated_type->new(%parts) } sub bisect { my ($self, $code) = @_; my @parts = ( [], [] ); CORE::push @{ $parts[ $code->($_) ? 0 : 1 ] }, $_ for @$self; my $cls = blessed_or_pkg($self); $cls->new( map {; $cls->new(@$_) } @parts ) } sub nsect { my ($self, $sections) = @_; my $total = scalar @$self; my @parts; my $x = 0; $sections = $total if (defined $sections ? $sections : 0) > $total; if ($sections && $total) { CORE::push @{ $parts[ int($x++ * $sections / $total) ] }, $_ for @$self; } my $cls = blessed_or_pkg($self); $cls->new( map {; $cls->new(@$_) } @parts ) } sub ssect { my ($self, $per) = @_; my @parts; my $x = 0; if ($per) { CORE::push @{ $parts[ int($x++ / $per) ] }, $_ for @$self; } my $cls = blessed_or_pkg($self); $cls->new( map {; $cls->new(@$_) } @parts ) } sub tuples { my ($self, $size, $type, $bless) = @_; $size = 2 unless defined $size; Carp::confess "Expected a positive integer size but got $size" if $size < 1; # Autoboxed? Need to be blessed if we're to _try_coerce: my $cls = blessed_or_pkg($self); $self = $cls->new(@$self) if defined $type and not Scalar::Util::blessed $self; my $itr = do { my @copy = @$self; sub { CORE::splice @copy, 0, $size } }; my @res; while (my @nxt = $itr->()) { @nxt = CORE::map {; $self->_try_coerce($type, $_) } @nxt if defined $type; CORE::push @res, $bless ? $cls->new(@nxt) : [ @nxt ]; } $cls->new(@res) } =for Pod::Coverage fold_left foldl fold_right =cut { no warnings 'once'; *foldl = *reduce; *fold_left = *reduce; } sub reduce { my $pkg = caller; no strict 'refs'; my $cb = $_[1]; List::Util::reduce { local (*{"${pkg}::a"}, *{"${pkg}::b"}) = (\$a, \$b); $a->$cb($b) } @{ $_[0] } } { no warnings 'once'; *fold_right = *foldr; } sub foldr { my $pkg = caller; no strict 'refs'; my $cb = $_[1]; List::Util::reduce { local (*{"${pkg}::a"}, *{"${pkg}::b"}) = (\$b, \$a); $a->$cb($b) } CORE::reverse @{ $_[0] } } sub rotate { my ($self, %params) = @_; $params{left} && $params{right} ? Carp::confess "Cannot rotate in both directions!" : $params{right} ? blessed_or_pkg($self)->new( @$self ? ($self->[-1], @{ $self }[0 .. ($#$self - 1)]) : () ) : blessed_or_pkg($self)->new( @$self ? (@{ $self }[1 .. $#$self], $self->[0]) : () ) } sub rotate_in_place { $_[0] = Scalar::Util::blessed $_[0] ? $_[0]->rotate(@_[1 .. $#_]) : rotate(@_) } sub items_after { my ($started, $lag); blessed_or_pkg($_[0])->new( CORE::grep $started ||= do { my $x = $lag; $lag = $_[1]->(); $x }, @{ $_[0] } ) } sub items_after_incl { my $started; blessed_or_pkg($_[0])->new( CORE::grep $started ||= $_[1]->(), @{ $_[0] } ) } sub items_before { my $more = 1; blessed_or_pkg($_[0])->new( CORE::grep $more &&= !$_[1]->(), @{ $_[0] } ) } sub items_before_incl { my $more = 1; my $lag = 1; blessed_or_pkg($_[0])->new( CORE::grep $more &&= do { my $x = $lag; $lag = !$_[1]->(); $x }, @{ $_[0] } ) } sub pick { return $_[0]->shuffle if $_[1] >= @{ $_[0] }; my %idx; $idx{ int rand @{ $_[0] } } = 1 until keys %idx == $_[1]; blessed_or_pkg($_[0])->new( @{ $_[0] }[keys %idx] ) } sub roll { blessed_or_pkg($_[0])->new( @{ $_[0] }[ map {; int rand @{ $_[0] } } 0 .. (defined $_[1] ? $_[1] : @{ $_[0] }) - 1 ] ) } sub shuffle { blessed_or_pkg($_[0])->new( List::Util::shuffle( @{ $_[0] } ) ) } =for Pod::Coverage squish =cut { no warnings 'once'; *squish = *squished; } sub squished { # @last is a single-item array to make tracking undefs saner -> my (@last, @res); ITEM: for (@{ $_[0] }) { if (!@last) { # No items seen yet. $last[0] = $_; CORE::push @res, $_; next ITEM } elsif (!defined $_) { # Possibly two undefs in a row: next ITEM if not defined $last[0]; # .. or not: $last[0] = $_; CORE::push @res, $_; next ITEM } elsif (!defined $last[0]) { # Previous was an undef (but this isn't) $last[0] = $_; CORE::push @res, $_; next ITEM } next ITEM if $_ eq $last[0]; $last[0] = $_; CORE::push @res, $_; } blessed_or_pkg($_[0])->new(@res) } sub uniq { my %s; blessed_or_pkg($_[0])->new( CORE::grep {; not $s{$_}++ } @{ $_[0] } ) } sub repeated { my %s; blessed_or_pkg($_[0])->new( CORE::grep {; $s{$_}++ == 1 } @{ $_[0] } ) } sub sort_by { blessed_or_pkg($_[0])->new( __sort_by( $_[1], @{ $_[0] } ) ) } sub nsort_by { blessed_or_pkg($_[0])->new( __nsort_by( $_[1], @{ $_[0] } ) ) } sub uniq_by { blessed_or_pkg($_[0])->new( __uniq_by( $_[1], @{ $_[0] } ) ) } sub flatten_all { CORE::map {; __flatten_all($_) } @{ $_[0] } } sub flatten { __flatten( ( defined $_[1] ? $_[1] : 0 ), @{ $_[0] } ) } print qq[ My sleeping pattern is cryptographically secure.\n] unless caller; 1; =pod =head1 NAME List::Objects::WithUtils::Role::Array - Array manipulation methods =head1 SYNOPSIS ## Via List::Objects::WithUtils::Array -> use List::Objects::WithUtils 'array'; my $array = array(qw/ a b c /); $array->push(qw/ d e f /); my @upper = $array->map(sub { uc })->all; if ( $array->has_any(sub { $_ eq 'a' }) ) { ... } my $sum = array(1 .. 10)->reduce(sub { $a + $b }); # See below for full list of methods ## As a Role -> use Role::Tiny::With; with 'List::Objects::WithUtils::Role::Array'; =head1 DESCRIPTION A L role defining methods for creating and manipulating ARRAY-type objects. L consumes this role (along with L) to provide B object methods. In addition to the methods documented below, these objects provide a C method exporting a plain ARRAY-type reference for convenience when feeding L or similar, as well as a C method for compatibility with L. =head2 Basic array methods =head3 new Constructs a new ARRAY-type object. =head3 copy Returns a shallow clone of the current object. =head3 count Returns the number of elements in the array. =head3 defined Returns true if the element at the specified position is defined. (Available from v2.13.1) =head3 end Returns the last index of the array (or -1 if the array is empty). =head3 exists Returns true if the specified index exists in the array. Negative indices work as you might expect: my $arr = array(1, 2, 3); $arr->set(-2 => 'foo') if $arr->exists(-2); # [ 1, 'foo', 3 ] (Available from v2.13.1) =head3 is_empty Returns boolean true if the array is empty. =head3 is_mutable Returns boolean true if the hash is mutable; immutable subclasses can override to provide a negative value. =head3 is_immutable The opposite of L. (Subclasses do not need to override so long as L returns a correct value.) =head3 inflate my $hash = $array->inflate; # Same as: # my $hash = hash( $array->all ) Inflates an array-type object to a hash-type object. Returns an object of type L; by default this is a L. Throws an exception if the array contains an odd number of elements. =head3 inflated_type The class name that objects are blessed into when calling L; subclasses can override to provide their own hash-type objects. Defaults to L. A consumer returning an C that is not a hash-type object will result in undefined behavior. =head3 scalar See L. =head3 unbless Returns a plain C reference (shallow clone). =head2 Methods that manipulate the list =head3 clear Delete all elements from the array. Returns the newly-emptied array object. =head3 delete Splices a given index out of the array. Returns the removed value. =head3 delete_when $array->delete_when( sub { $_ eq 'foo' } ); Splices all items out of the array for which the given subroutine evaluates to true. Returns a new array object containing the deleted values (possibly none). =head3 insert $array->insert( $position, $value ); $array->insert( $position, @values ); Inserts values at a given position, moving the rest of the array rightwards. The array will be "backfilled" (with undefs) if $position is past the end of the array. Returns the array object. (Available from v2.12.1) =head3 pop Pops the last element off the array and returns it. =head3 push Pushes elements to the end of the array. Returns the array object. =head3 rotate_in_place array(1 .. 3)->rotate_in_place; # 2, 3, 1 array(1 .. 3)->rotate_in_place(right => 1); # 3, 1, 2 Rotates the array in-place. A direction can be given. Also see L, L. =head3 set $array->set( $index, $value ); Takes an array element and a new value to set. Returns the array object. =head3 shift Shifts the first element off the beginning of the array and returns it. =head3 unshift Adds elements to the beginning of the array. Returns the array object. =head3 splice # 1- or 2-arg splice (remove elements): my $spliced = $array->splice(0, 2) # 3-arg splice (replace): $array->splice(0, 1, 'abc'); Performs a C on the current list and returns a new array object consisting of the items returned from the splice. The existing array is modified in-place. =head3 validated use Types::Standard -all; my $valid = array(qw/foo bar baz/)->validated(Str); Accepts a L type, against which each element of the current array will be checked before being added to a new array. Returns the new array. If the element fails the type check but can be coerced, the coerced value will be added to the new array. Dies with a stack trace if the value fails type checks and can't be coerced. (You probably want an B object from L instead.) See: L, L =head2 Methods that retrieve items =head3 all Returns all elements in the array as a plain list. =head3 bisect my ($true, $false) = array( 1 .. 10 ) ->bisect(sub { $_ >= 5 }) ->all; my @bigger = $true->all; # ( 5 .. 10 ) my @smaller = $false->all; # ( 1 .. 4 ) Like L, but creates an array-type object containing two partitions; the first contains all items for which the subroutine evaluates to true, the second contains items for which the subroutine evaluates to false. =head3 nsect my ($first, $second) = array( 1 .. 10 )->nsect(2)->all; # array( 1 .. 5 ), array( 6 .. 10 ) Like L and L, but takes an (integer) number of sets to create. If there are no items in the list (or no sections are requested), an empty array-type object is returned. If the list divides unevenly, the first set will be the largest. Inspired by L. (Available from v2.11.1) =head3 ssect my ($first, $second) = array( 1 .. 10 )->ssect(5)->all; # array( 1 .. 5 ), array( 6 .. 10 ); Like L and L, but takes an (integer) target number of items per set. If the list divides unevenly, the last set will be smaller than the specified target. Inspired by L. (Available from v2.11.1) =head3 elements Same as L; included for consistency with similar array-type object classes. =head3 export Same as L; included for consistency with hash-type objects. =head3 flatten Flatten array objects to plain lists, possibly recursively. C without arguments is the same as L: my @flat = array( 1, 2, [ 3, 4 ] )->flatten; # @flat = ( 1, 2, [ 3, 4 ] ); If a depth is specified, sub-arrays are recursively flattened until the specified depth is reached: my @flat = array( 1, 2, [ 3, 4 ] )->flatten(1); # @flat = ( 1, 2, 3, 4 ); my @flat = array( 1, 2, [ 3, 4, [ 5, 6 ] ] )->flatten(1); # @flat = ( 1, 2, 3, 4, [ 5, 6 ] ); This works with both ARRAY-type references and array objects: my @flat = array( 1, 2, [ 3, 4, array( 5, 6 ) ] )->flatten(2); # @flat = ( 1, 2, 3, 4, 5, 6 ); (Specifically, consumers of this role and plain ARRAYs are flattened; other ARRAY-type objects are left alone.) See L for flattening to an unlimited depth. =head3 flatten_all Returns a plain list consisting of all sub-arrays recursively flattened. Also see L. =head3 get Returns the array element corresponding to a specified index. =head3 get_or_else # Expect to find an object at $pos in $array, # or return an empty one if $pos is undef: my @keys = $array->get_or_else($pos => hash)->keys->all; # Or pass a coderef that provides a default return value; # First arg is the object being operated on: my $item_or_first = $array->get_or_else($pos => sub { shift->get(0) }); # Second arg is the requested index: my $item = $array->get_or_else(3 => sub { my (undef, $pos) = @_; my $created = make_value_for( $pos ); $array->set($pos => $created); $created }); Returns the element corresponding to a specified index; optionally takes a second argument that is used as a default return value if the given index is undef (the array remains unmodified). If the second argument is a coderef, it is invoked on the object (with the requested index as an argument) and its return value is taken as the default. =head3 head my ($first, $rest) = $array->head; In list context, returns the first element of the list, and a new array-type object containing the remaining list. The original object's list is untouched. In scalar context, returns just the first element of the array: my $first = $array->head; =head3 tail Similar to L, but returns either the last element and a new array-type object containing the remaining list (in list context), or just the last element of the list (in scalar context). =head3 join my $str = $array->join(' '); Joins the array's elements and returns the joined string. Defaults to ',' if no delimiter is specified. =head3 kv Returns an array-type object containing index/value pairs as (unblessed) ARRAYs; this is much like L, except the array index is the "key." =head3 zip =head3 mesh my $meshed = array(qw/ a b c /)->mesh( array( 1 .. 3 ) ); $meshed->all; # 'a', 1, 'b', 2, 'c', 3 Takes array references or objects and returns a new array object consisting of one element from each array, in turn, until all arrays have been traversed fully. You can mix and match references and objects freely: my $meshed = array(qw/ a b c /)->mesh( array( 1 .. 3 ), [ qw/ foo bar baz / ], ); (C is an alias for C.) =head3 part my $parts = array( 1 .. 8 )->part(sub { $i++ % 2 }); # Returns array objects: $parts->get(0)->all; # 1, 3, 5, 7 $parts->get(1)->all; # 2, 4, 6, 8 Takes a subroutine that indicates into which partition each value should be placed. Returns an array-type object containing partitions represented as array-type objects, as seen above. Skipped partitions are empty array objects: my $parts = array(qw/ foo bar /)->part(sub { 1 }); $parts->get(0)->is_empty; # true $parts->get(1)->is_empty; # false The subroutine is passed the value we are operating on, or you can use the topicalizer C<$_>: array(qw/foo bar baz 1 2 3/) ->part(sub { m/^[0-9]+$/ ? 0 : 1 }) ->get(1) ->all; # 'foo', 'bar', 'baz' =head3 part_to_hash my $people = array(qw/ann andy bob fred frankie/); my $parts = $people->part_to_hash(sub { ucfirst substr $_, 0, 1 }); $parts->get('A')->all; # 'ann', 'andy' Like L, but partitions values into a hash-type object using the result of the given subroutine as the hash key; the values are array-type objects. The returned object is of type L; by default this is a L. (Available from v2.23.1) =head3 pick my $picked = array('a' .. 'f')->pick(3); Returns a new array object containing the specified number of elements chosen randomly and without repetition. If the given number is equal to or greater than the number of elements in the list, C will return a shuffled list (same as calling L). (Available from v2.26.1) =head3 random Returns a random element from the array. =head3 reverse Returns a new array object consisting of the reversed list of elements. =head3 roll Much like L, but repeated entries in the resultant list are allowed, and the number of entries to return may be larger than the size of the array. If the number of elements to return is not specified, the size of the original array is used. (Available from v2.26.1) =head3 rotate my $leftwards = $array->rotate; my $rightwards = $array->rotate(right => 1); Returns a new array object containing the rotated list. Also see L, L. =head3 shuffle my $shuffled = $array->shuffle; Returns a new array object containing the shuffled list. =head3 sliced my $slice = $array->sliced(1, 3, 5); Returns a new array object consisting of the elements retrived from the specified indexes. =head3 tuples my $tuples = array(1 .. 7)->tuples(2); # Returns: # array( # [ 1, 2 ], # [ 3, 4 ], # [ 5, 6 ], # [ 7 ], # ) Returns a new array object consisting of tuples (unblessed ARRAY references) of the specified size (defaults to 2). C accepts L types as an optional second parameter; if specified, items in tuples are checked against the type and a coercion is attempted (if available for the given type) if the initial type-check fails: use Types::Standard -all; my $tuples = array(1 .. 7)->tuples(2 => Int); A stack-trace is thrown if a value in a tuple cannot be made to validate. As of v2.24.1, it's possible to make the returned tuples blessed array-type objects (of the type of the original class) by passing a boolean true third parameter: # bless()'d tuples, no type validation or coercion: my $tuples = array(1 .. 7)->tuples(2, undef, 'bless'); See: L, L =head2 Methods that find items =head3 grep my $matched = $array->grep(sub { /foo/ }); Returns a new array object consisting of the list of elements for which the given subroutine evaluates to true. C<$_[0]> is the element being operated on; you can also use the topicalizer C<$_>. =head3 indexes my $matched = $array->indexes(sub { /foo/ }); If passed a reference to a subroutine, C behaves like L, but returns a new array object consisting of the list of array indexes for which the given subroutine evaluates to true. If no subroutine is provided, returns a new array object consisting of the full list of indexes (like C on an array in perl-5.12+). This feature was added in C. =head3 first_where my $arr = array( qw/ ab bc bd de / ); my $first = $arr->first_where(sub { /^b/ }); ## 'bc' Returns the first element of the list for which the given sub evaluates to true. C<$_> is set to each element, in turn, until a match is found (or we run out of possibles). =head3 first_index Like L, but return the index of the first successful match. Returns -1 if no match is found. =head3 firstidx An alias for L. =head3 last_where Like L, but returns the B successful match. =head3 last_index Like L, but returns the index of the B successful match. =head3 lastidx An alias for L. =head3 has_any if ( $array->has_any(sub { $_ eq 'foo' }) ) { ... } If passed no arguments, returns boolean true if the array has any elements. If passed a sub, returns boolean true if the sub is true for any element of the array. C<$_> is set to the element being operated upon. =head3 intersection my $first = array(qw/ a b c /); my $second = array(qw/ b c d /); my $intersection = $first->intersection($second); Returns a new array object containing the list of values common between all given array-type objects (including the invocant). The new array object is not sorted in any predictable order. (It may be worth noting that an intermediate hash is used; objects that stringify to the same value will be taken to be the same.) =head3 diff my $first = array(qw/ a b c d /); my $second = array(qw/ b c x /); my @diff = $first->diff($second)->sort->all; # (a, d, x) The opposite of L; returns a new array object containing the list of values that are not common between all given array-type objects (including the invocant). The same constraints as L apply. =head3 items_after my $after = array( 1 .. 10 )->items_after(sub { $_ == 5 }); ## $after contains [ 6, 7, 8, 9, 10 ] Returns a new array object consisting of the elements of the original list that occur after the first position for which the given sub evaluates to true. =head3 items_after_incl Like L, but include the item that evaluated to true. =head3 items_before The opposite of L. =head3 items_before_incl The opposite of L. =head2 Methods that iterate the list =head3 map my $lowercased = $array->map(sub { lc }); # Same as: my $lowercased = $array->map(sub { lc $_[0] }); Evaluates a given subroutine for each element of the array, and returns a new array object. C<$_[0]> is the element being operated on; you can also use the topicalizer C<$_>. Also see L. =head3 mapval my $orig = array(1, 2, 3); my $incr = $orig->mapval(sub { ++$_ }); $incr->all; # (2, 3, 4) $orig->all; # Still untouched An alternative to L. C<$_> is a copy, rather than an alias to the current element, and the result is retrieved from the altered C<$_> rather than the return value of the block. This feature is borrowed from L by Lukas Mai (CPAN: MAUKE). =head3 natatime my $iter = array( 1 .. 7 )->natatime(3); $iter->(); ## ( 1, 2, 3 ) $iter->(); ## ( 4, 5, 6 ) $iter->(); ## ( 7 ) array( 1 .. 7 )->natatime(3, sub { my @vals = @_; ... }); Returns an iterator that, when called, produces a list containing the next 'n' items. If given a coderef as a second argument, it will be called against each bundled group. =head3 rotator my $rot = array(qw/cat sheep mouse/); $rot->(); ## 'cat' $rot->(); ## 'sheep' $rot->(); ## 'mouse' $rot->(); ## 'cat' Returns an iterator that, when called, produces the next element in the array; when there are no elements left, the iterator returns to the start of the array. See also L, L. (Available from v2.7.1) =head3 reduce my $sum = array(1,2,3)->reduce(sub { $a + $b }); Reduces the array by calling the given subroutine for each element of the list. C<$a> is the accumulated value; C<$b> is the current element. See L. Prior to C, C<$_[0]> and C<$_[1]> must be used in place of C<$a> and C<$b>, respectively. Using positional arguments may make for cleaner syntax in some cases: my $divide = sub { my ($acc, $next) = @_; $acc / $next }; my $q = $array->reduce($divide); An empty list reduces to C. This is a "left fold" -- B is an alias for L (as of v2.17.1). See also: L =head3 foldr my $result = array(2,3,6)->foldr(sub { $_[1] / $_[0] }); # 1 Reduces the array by calling the given subroutine for each element of the list starting at the end (the opposite of L). Unlike L (foldl), the first argument passed to the subroutine is the current element; the second argument is the accumulated value. An empty list reduces to C. (Available from v2.17.1) =head3 visit $arr->visit(sub { warn "array contains: $_" }); Executes the given subroutine against each element sequentially; in practice this is much like L, except the return value is thrown away. Returns the original array object. (Available from v2.7.1) =head2 Methods that sort the list =head3 sort my $sorted = $array->sort(sub { $a cmp $b }); Returns a new array object consisting of the list sorted by the given subroutine. Prior to version 2.18.1, positional arguments (C<$_[0]> and C<$_[1]>) must be used in place of C<$a> and C<$b>, respectively. =head3 sort_by my $array = array( { id => 'a' }, { id => 'c' }, { id => 'b' }, ); my $sorted = $array->sort_by(sub { $_->{id} }); Returns a new array object consisting of the list of elements sorted via a stringy comparison using the given sub. See L. Uses L if available. =head3 nsort_by Like L, but using numerical comparison. =head3 repeated my $repeats = $array->repeated; The opposite of L; returns a new array object containing only repeated elements. (The same constraints apply with regards to stringification; see L) (Available from v2.26.1) =head3 squished my $squished = array(qw/a a b a b b/)->squished; # $squished = array( 'a', 'b', 'a', 'b' ); Similar to L, but only consecutively repeated values are removed from the returned (new) array object. The same constraints as L apply with regards to stringification, but multiple Cs in a row will also be squished. (Available from v2.27.1) =head3 uniq my $unique = $array->uniq; Returns a new array object containing only unique elements from the original array. (It may be worth noting that this takes place via an intermediate hash; objects that stringify to the same value are not unique, even if they are different objects. L plus L may help you there.) =head3 uniq_by my $array = array( { id => 'a' }, { id => 'a' }, { id => 'b' }, ); my $unique = $array->uniq_by(sub { $_->{id} }); Returns a new array object consisting of the list of elements for which the given sub returns unique values. Uses L if available; falls back to L if not. =head1 NOTES FOR CONSUMERS If creating your own consumer of this role, some extra effort is required to make C<$a> and C<$b> work in sort statements without warnings; an example with a custom exported constructor (and junction support) might look something like: package My::Custom::Array; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, qw/ List::Objects::WithUtils::Role::Array List::Objects::WithUtils::Role::Array::WithJunctions My::Custom::Array::Role / ); use Exporter (); our @EXPORT = 'myarray'; sub import { # touch $a/$b in caller to avoid 'used only once' warnings: my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub myarray { __PACKAGE__->new(@_) } =head1 SEE ALSO L L L L L L L L =head1 AUTHOR Jon Portnoy Portions of this code were contributed by Toby Inkster (CPAN: TOBYINK). Portions of this code are derived from L by Matthew Phillips (MATTP), Graham Knop (HAARG) et al. Portions of this code are inspired by L-0.33 by Adam Kennedy (ADAMK), Tassilo von Parseval, and Aaron Crane. L was inspired by Yanick Champoux in L Licensed under the same terms as Perl. =cut Hash000755000764000031 012701513023 22675 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtilsTyped.pm100644000764000031 301712701513023 24461 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Hashpackage List::Objects::WithUtils::Hash::Typed; $List::Objects::WithUtils::Hash::Typed::VERSION = '2.028003'; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, qw/ List::Objects::WithUtils::Role::Hash List::Objects::WithUtils::Role::Hash::Typed / ); use Exporter (); our @EXPORT = 'hash_of'; sub import { my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub hash_of { __PACKAGE__->new(@_) } 1; =pod =head1 NAME List::Objects::WithUtils::Hash::Typed - Type-checking hash objects =head1 SYNOPSIS use List::Objects::WithUtils 'hash_of'; use Types::Standard -all; my $arr = hash_of Int() => ( foo => 1, bar => 2 ); =head1 DESCRIPTION These are type-checking hash objects; values are checked against the specified type when the object is constructed or new elements are added. The first argument passed to the constructor should be a L type: use Types::Standard -all; my $hash = hash_of Int() => ( foo => 1 ); If the initial type-check fails, a coercion is attempted. This class consumes the following roles, which contain most of the relevant documentation: L L Also see L, L =head2 hash_of Creates a new typed hash object. =head1 AUTHOR Jon Portnoy with significant contributions from Toby Inkster (CPAN: TOBYINK) =cut Array000755000764000031 012701513023 23070 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtilsTyped.pm100644000764000031 351112701513023 24653 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Arraypackage List::Objects::WithUtils::Array::Typed; $List::Objects::WithUtils::Array::Typed::VERSION = '2.028003'; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, qw/ List::Objects::WithUtils::Role::Array List::Objects::WithUtils::Role::Array::WithJunctions List::Objects::WithUtils::Role::Array::Typed /, ); use Exporter (); our @EXPORT = 'array_of'; sub import { my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub array_of { __PACKAGE__->new(@_) } 1; =pod =for Pod::Coverage array_of =head1 NAME List::Objects::WithUtils::Array::Typed - Type-checking array objects =head1 SYNOPSIS use List::Objects::WithUtils 'array_of'; use Types::Standard -all; use List::Objects::Types -all; my $arr = array_of( Int() => 1 .. 10 ); $arr->push('foo'); # dies, failed type check $arr->push(11 .. 15); # ok my $arr_of_arrs = array_of( ArrayObj ); $arr_of_arrs->push([], []); # ok, coerces to ArrayObj =head1 DESCRIPTION These are type-checking array objects; elements are checked against the specified type when the object is constructed or new elements are added. The first argument passed to the constructor should be a L type: use Types::Standard -all; my $arr = array_of Str() => qw/foo bar baz/; If the initial type-check fails, a coercion is attempted. This class consumes the following roles, which contain most of the relevant documentation: L L L Also see L, L =head1 AUTHOR Jon Portnoy with significant contributions from Toby Inkster (CPAN: TOBYINK) =cut Inflated.pm100644000764000031 171412701513023 25124 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Hashpackage List::Objects::WithUtils::Hash::Inflated; $List::Objects::WithUtils::Hash::Inflated::VERSION = '2.028003'; use strictures 2; use Carp (); use Scalar::Util (); sub new { bless +{ @_[1 .. $#_] }, $_[0] } sub DEFLATE { %{ $_[0] } } our $AUTOLOAD; sub can { my ($self, $method) = @_; if (my $sub = $self->SUPER::can($method)) { return $sub } return unless exists $self->{$method}; sub { my ($self) = @_; if (my $sub = $self->SUPER::can($method)) { goto $sub } $AUTOLOAD = $method; goto &AUTOLOAD } } sub AUTOLOAD { my $self = shift; ( my $method = $AUTOLOAD ) =~ s/.*:://; Scalar::Util::blessed($self) or Carp::confess "Not a class method: '$method'"; Carp::confess "Can't locate object method '$method'" unless exists $self->{$method}; Carp::confess "Accessor '$method' is read-only" if @_; $self->{$method} } sub DESTROY {} 1; =pod =for Pod::Coverage new can AUTOLOAD DEFLATE =cut Immutable.pm100644000764000031 236612701513023 25321 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Hashpackage List::Objects::WithUtils::Hash::Immutable; $List::Objects::WithUtils::Hash::Immutable::VERSION = '2.028003'; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, qw/ List::Objects::WithUtils::Role::Hash List::Objects::WithUtils::Role::Hash::Immutable /, ); use Exporter (); our @EXPORT = 'immhash'; sub import { my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub immhash { __PACKAGE__->new(@_) } 1; =pod =head1 NAME List::Objects::WithUtils::Hash::Immutable - Immutable hash objects =head1 SYNOPSIS use List::Objects::WithUtils 'immhash'; my $hash = immhash( foo => 1, bar => 2 ); =head1 DESCRIPTION These are immutable hash objects; attempting to call list-mutating methods (or modify the backing hash directly) will throw an exception. This class consumes the following roles, which contain most of the relevant documentation: L L (See L for a mutable implementation.) =head2 immhash Creates a new immutable hash object. =head1 AUTHOR Jon Portnoy =cut Junction.pm100644000764000031 1323612701513023 25404 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Arraypackage List::Objects::WithUtils::Array::Junction; $List::Objects::WithUtils::Array::Junction::VERSION = '2.028003'; ## no critic { package List::Objects::WithUtils::Array::Junction::Base; use strictures 2; use parent 'List::Objects::WithUtils::Array'; use overload '==' => 'num_eq', '!=' => 'num_ne', '>=' => 'num_ge', '>' => 'num_gt', '<=' => 'num_le', '<' => 'num_lt', 'eq' => 'str_eq', 'ne' => 'str_ne', 'ge' => 'str_ge', 'gt' => 'str_gt', 'le' => 'str_le', 'lt' => 'str_lt', 'bool' => 'bool', '""' => sub { shift }, ; } { package List::Objects::WithUtils::Array::Junction::All; use strict; use warnings; our @ISA = 'List::Objects::WithUtils::Array::Junction::Base'; sub num_eq { return regex_eq(@_) if ref $_[1] eq 'Regexp'; for (@{ $_[0] }) { return unless $_ == $_[1] } 1 } sub num_ne { return regex_ne(@_) if ref $_[1] eq 'Regexp'; for (@{ $_[0] }) { return unless $_ != $_[1] } 1 } sub num_ge { return num_le( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return unless $_ >= $_[1] } 1 } sub num_gt { return num_lt( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return unless $_ > $_[1] } 1 } sub num_le { return num_ge( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return unless $_ <= $_[1] } 1 } sub num_lt { return num_gt( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return unless $_ < $_[1] } 1 } sub str_eq { for (@{ $_[0] }) { return unless $_ eq $_[1] } 1 } sub str_ne { for (@{ $_[0] }) { return unless $_ ne $_[1] } 1 } sub str_ge { return str_le( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return unless $_ ge $_[1] } 1 } sub str_gt { return str_lt( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return unless $_ gt $_[1] } 1 } sub str_le { return str_ge( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return unless $_ le $_[1] } 1 } sub str_lt { return str_gt( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return unless $_ lt $_[1] } 1 } sub regex_eq { for (@{ $_[0] }) { return unless $_ =~ $_[1] } 1 } sub regex_ne { for (@{ $_[0] }) { return unless $_ !~ $_[1] } 1 } sub bool { for (@{ $_[0] }) { return unless $_ } 1 } } { package List::Objects::WithUtils::Array::Junction::Any; use strict; use warnings; our @ISA = 'List::Objects::WithUtils::Array::Junction::Base'; sub num_eq { return regex_eq(@_) if ref $_[1] eq 'Regexp'; for (@{ $_[0] }) { return 1 if $_ == $_[1] } () } sub num_ne { return regex_eq(@_) if ref $_[1] eq 'Regexp'; for (@{ $_[0] }) { return 1 if $_ != $_[1] } () } sub num_ge { return num_le( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return 1 if $_ >= $_[1] } () } sub num_gt { return num_lt( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return 1 if $_ > $_[1] } () } sub num_le { return num_ge( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return 1 if $_ <= $_[1] } () } sub num_lt { return num_gt( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return 1 if $_ < $_[1] } () } sub str_eq { for (@{ $_[0] }) { return 1 if $_ eq $_[1] } () } sub str_ne { for (@{ $_[0] }) { return 1 if $_ ne $_[1] } () } sub str_ge { return str_le( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return 1 if $_ ge $_[1] } () } sub str_gt { return str_lt( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return 1 if $_ gt $_[1] } () } sub str_le { return str_ge( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return 1 if $_ le $_[1] } () } sub str_lt { return str_gt( @_[0, 1] ) if $_[2]; for (@{ $_[0] }) { return 1 if $_ lt $_[1] } () } sub regex_eq { for (@{ $_[0] }) { return 1 if $_ =~ $_[1] } () } sub regex_ne { for (@{ $_[0] }) { return 1 if $_ !~ $_[1] } () } sub bool { for (@{ $_[0] }) { return 1 if $_ } () } } 1; =pod =for Pod::Coverage new =head1 NAME List::Objects::WithUtils::Array::Junction - Lightweight junction classes =head1 SYNOPSIS # See List::Objects::WithUtils::Role::Array::WithJunctions =head1 DESCRIPTION These are light-weight junction objects covering most of the functionality provided by L. They provide the objects created by the C and C methods defined by L. Only the junction types used by L ('any' and 'all') are implemented; nothing is exported. The C<~~> smart-match operator is not supported. See L if you were looking for a stand-alone implementation with more features. The junction objects produced are subclasses of L. See L for usage details. =head2 Motivation My original goal was to get L out of the L dependency tree; that one came along with L. L would have done that for me. Unfortunately, that comes with some unresolved RT bugs right now that are reasonably annoying (especially warnings under perl-5.18.x). =head1 AUTHOR This code is originally derived from L by way of L; the original author is Carl Franks, based on the Perl6 design documentation. Adapted to L by Jon Portnoy =cut Hash000755000764000031 012701513023 23576 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/RoleTyped.pm100644000764000031 376012701513023 25367 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Role/Hashpackage List::Objects::WithUtils::Role::Hash::Typed; $List::Objects::WithUtils::Role::Hash::Typed::VERSION = '2.028003'; use strictures 2; use Carp (); use Scalar::Util (); use Type::Tie (); use Role::Tiny; requires 'type', 'untyped', 'new'; around type => sub { tied(%{$_[1]})->type }; around untyped => sub { my (undef, $self) = @_; require List::Objects::WithUtils::Hash; List::Objects::WithUtils::Hash->new(%$self) }; around new => sub { my (undef, $class, $type) = splice @_, 0, 2; if (my $blessed = Scalar::Util::blessed $class) { $type = $class->type; $class = $blessed; } else { $type = shift; } my $self = +{}; tie %$self, 'Type::Tie::HASH', $type; %$self = @_; bless $self, $class; }; 1; =pod =for Pod::Coverage new hash_of =head1 NAME List::Objects::WithUtils::Role::Hash::Typed - Type-checking hash behavior =head1 SYNOPSIS # Via List::Objects::WithUtils::Hash::Typed -> use List::Objects::WithUtils 'hash_of'; use Types::Standard -all; my $arr = hash_of(Int, foo => 1, bar => 2); $arr->set(baz => 3.14159); # dies, failed type check =head1 DESCRIPTION This role makes use of L to add type-checking behavior to L consumers. The first argument passed to the constructor should be a L type (or other object conforming to L, as of C): use Types::Standard -all; my $arr = hash_of ArrayRef() => (foo => [], bar => []); Values are checked against the specified type when the object is constructed or new elements are added. If the initial type-check fails, a coercion is attempted. Values that cannot be coerced will throw an exception. Also see L, L =head2 type Returns the L type the object was created with. =head2 untyped Returns a (shallow) clone that is a plain L. =head1 AUTHOR Jon Portnoy ; typed hashes implemented by Toby Inkster (CPAN: TOBYINK) =cut Immutable.pm100644000764000031 270312701513023 25507 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Arraypackage List::Objects::WithUtils::Array::Immutable; $List::Objects::WithUtils::Array::Immutable::VERSION = '2.028003'; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, qw/ List::Objects::WithUtils::Role::Array List::Objects::WithUtils::Role::Array::WithJunctions List::Objects::WithUtils::Role::Array::Immutable /, ); use Exporter (); our @EXPORT = 'immarray'; sub import { my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub immarray { __PACKAGE__->new(@_) } 1; =pod =head1 NAME List::Objects::WithUtils::Array::Immutable - Immutable array objects =head1 SYNOPSIS use List::Objects::WithUtils 'immarray'; my $array = immarray(qw/ a b c /); my ($head, $rest) = $array->head; =head1 DESCRIPTION These are immutable array objects; attempting to call list-mutating methods (or modify the backing array directly) will throw an exception. This class consumes the following roles, which contain most of the relevant documentation: L L L (See L for a mutable implementation.) =head2 immarray Creates a new immutable array object. =head1 AUTHOR Jon Portnoy Licensed under the same terms as Perl. =cut TiedRO.pm100644000764000031 50612701513023 25403 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Role/Hashpackage List::Objects::WithUtils::Role::Hash::TiedRO; $List::Objects::WithUtils::Role::Hash::TiedRO::VERSION = '2.028003'; =for Pod::Coverage *EVERYTHING* =cut use strictures 2; use Carp (); use Role::Tiny; around $_ => sub { Carp::croak "Attempted to modify a read-only value" } for qw/ STORE DELETE CLEAR /; 1; Array000755000764000031 012701513023 23771 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/RoleTyped.pm100644000764000031 510112701513023 25551 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Role/Arraypackage List::Objects::WithUtils::Role::Array::Typed; $List::Objects::WithUtils::Role::Array::Typed::VERSION = '2.028003'; use strictures 2; use Carp (); use Scalar::Util (); use Type::Tie (); use Role::Tiny; requires 'type', 'untyped', 'new'; around type => sub { tied(@{$_[1]})->type }; around untyped => sub { my (undef, $self) = @_; require List::Objects::WithUtils::Array; List::Objects::WithUtils::Array->new(@$self) }; around new => sub { # yes, this splice is correct: my (undef, $class, $type) = splice @_, 0, 2; if (my $blessed = Scalar::Util::blessed $class) { $type = $class->type; $class = $blessed; } else { $type = shift; } my $self = []; tie @$self, 'Type::Tie::ARRAY', $type; push @$self, @_; bless $self, $class; }; print qq[ you seem to be ignoring mst\n], qq[ would you like to talk to me instead?\n], qq[ mauke++ # talking paperclip\n], qq[ I can't help you but I'm in a pretty good mood\n] unless caller; 1; =pod =for Pod::Coverage new array_of =head1 NAME List::Objects::WithUtils::Role::Array::Typed - Type-checking array behavior =head1 SYNOPSIS # Via List::Objects::WithUtils::Array::Typed -> use List::Objects::WithUtils 'array_of'; use Types::Standard -all; use List::Objects::Types -all; # Array of Ints: my $arr = array_of Int() => (1,2,3); # Array of array objects of Ints (coerced from ARRAYs): my $arr = array_of TypedArray[Int] => [1,2,3], [4,5,6]; =head1 DESCRIPTION This role makes use of L to add type-checking behavior to L consumers. The first argument passed to the constructor should be a L type (or other object conforming to L, as of C): use Types::Standard -all; my $arr = array_of Str() => qw/foo bar baz/; Elements are checked against the specified type when the object is constructed or new elements are added. If the initial type-check fails, a coercion is attempted. Values that cannot be coerced will throw an exception. Also see L, L =head2 type Returns the L type the object was created with. =head2 untyped Returns a (shallow) clone that is a plain L. Since most methods that return a new list will (attempt to) return a list object of the same type as their parent, this can be useful to avoid type check failures in a method chain that creates intermediate lists. =head1 AUTHOR Jon Portnoy with significant contributions from Toby Inkster (CPAN: TOBYINK) =cut Inflated000755000764000031 012701513023 24423 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/HashRW.pm100644000764000031 126312701513023 25453 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Hash/Inflatedpackage List::Objects::WithUtils::Hash::Inflated::RW; $List::Objects::WithUtils::Hash::Inflated::RW::VERSION = '2.028003'; use strictures 2; use Carp (); use Scalar::Util (); use parent 'List::Objects::WithUtils::Hash::Inflated'; our $AUTOLOAD; sub AUTOLOAD { my $self = shift; ( my $method = $AUTOLOAD ) =~ s/.*:://; Scalar::Util::blessed($self) or Carp::confess "Not a class method: '$method'"; Carp::confess "Can't locate object method '$method'" unless exists $self->{$method}; return $self->{$method} unless @_; Carp::confess "Multiple arguments passed to setter '$method'" if @_ > 1; $self->{$method} = $_[0] } 1; =pod =for Pod::Coverage AUTOLOAD =cut TiedRO.pm100644000764000031 124412701513023 25616 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Role/Arraypackage List::Objects::WithUtils::Role::Array::TiedRO; $List::Objects::WithUtils::Role::Array::TiedRO::VERSION = '2.028003'; =for Pod::Coverage *EVERYTHING* =cut use strictures 2; use Carp (); # This role can be applied to the objects backing tied arrays # after construction time in order to swap a mutable tied array # for an immutable implementation; # Array::Immutable::Typed::immarray_of does this in order to retain # normal tied type array behavior until construction is complete. use Role::Tiny; around $_ => sub { Carp::croak "Attempted to modify a read-only value" } for qw/ STORE STORESIZE CLEAR PUSH POP SHIFT SPLICE UNSHIFT EXTEND /; 1; Immutable.pm100644000764000031 331012701513023 26210 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Role/Hashpackage List::Objects::WithUtils::Role::Hash::Immutable; $List::Objects::WithUtils::Role::Hash::Immutable::VERSION = '2.028003'; use strictures 2; use Carp (); use Tie::Hash (); sub _make_unimp { my ($method) = @_; sub { local $Carp::CarpLevel = 1; Carp::croak "Method '$method' not implemented on immutable hashes" } } our @ImmutableMethods = qw/ clear set maybe_set delete /; use Role::Tiny; requires 'new', @ImmutableMethods; around is_mutable => sub { () }; around new => sub { my ($orig, $class) = splice @_, 0, 2; my $self = $class->$orig(@_); # This behavior changed in c. 45f59a73 -- # we can revert back if Hash::Util gains the flexibility discussed on p5p # (lock_keys without an exception on unknown key retrieval) # For now, take the tie performance hit :( tie %$self, 'Tie::StdHash' and %$self = @_ unless tied %$self; Role::Tiny->apply_roles_to_object( tied(%$self), 'List::Objects::WithUtils::Role::Hash::TiedRO' ); $self }; around $_ => _make_unimp($_) for @ImmutableMethods; 1; =pod =head1 NAME List::Objects::WithUtils::Role::Hash::Immutable - Immutable hash behavior =head1 SYNOPSIS # Via List::Objects::WithUtils::Hash::Immutable -> use List::Objects::WithUtils 'immhash'; my $hash = immhash( foo => 1, bar => 2 ); $hash->set(foo => 3); # dies =head1 DESCRIPTION This role adds immutable behavior to L consumers. The following methods are not available and will throw an exception: clear set maybe_set delete (The backing hash is also marked read-only.) See L for a consumer implementation. =head1 AUTHOR Jon Portnoy =cut Immutable.pm100644000764000031 432212701513023 26407 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Role/Arraypackage List::Objects::WithUtils::Role::Array::Immutable; $List::Objects::WithUtils::Role::Array::Immutable::VERSION = '2.028003'; use strictures 2; use Carp (); use Tie::Array (); sub _make_unimp { my ($method) = @_; sub { local $Carp::CarpLevel = 1; Carp::croak "Method '$method' not implemented on immutable arrays" } } our @ImmutableMethods = qw/ clear delete delete_when insert pop push rotate_in_place set shift unshift splice /; use Role::Tiny; requires 'new', @ImmutableMethods; around is_mutable => sub { () }; around new => sub { my ($orig, $class) = splice @_, 0, 2; my $self = $class->$orig(@_); # SvREADONLY behavior is not very reliable. # Remove mutable behavior from our backing tied array instead: # If we're already tied, something else is going on, # like we're a typed array. # Otherwise, tie a StdArray & push items. tie @$self, 'Tie::StdArray' and push @$self, @_ unless tied @$self; Role::Tiny->apply_roles_to_object( tied(@$self), 'List::Objects::WithUtils::Role::Array::TiedRO' ); $self }; around $_ => _make_unimp($_) for @ImmutableMethods; print qq[ Coroutines are not magic pixiedust\n], qq[ LeoNerd: Any sufficiently advanced technology.\n], qq[ DrForr: ... probably corrupts the C stack during XS calls? ;)\n], unless caller; 1; =pod =head1 NAME List::Objects::WithUtils::Role::Array::Immutable - Immutable array behavior =head1 SYNOPSIS # Via List::Objects::WithUtils::Array::Immutable -> use List::Objects::WithUtils 'immarray'; my $array = immarray(qw/ a b c /); $array->push('d'); # dies =head1 DESCRIPTION This role adds immutable behavior to L consumers. The following methods are not available and will throw an exception: clear set pop push shift unshift delete delete_when insert rotate_in_place splice (The backing array is also marked read-only.) See L for a consumer implementation that also pulls in L & L. =head1 AUTHOR Jon Portnoy Licensed under the same terms as Perl. =cut Immutable000755000764000031 012701513023 24614 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/HashTyped.pm100644000764000031 275512701513023 26410 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Hash/Immutablepackage List::Objects::WithUtils::Hash::Immutable::Typed; $List::Objects::WithUtils::Hash::Immutable::Typed::VERSION = '2.028003'; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, qw/ List::Objects::WithUtils::Role::Hash List::Objects::WithUtils::Role::Hash::Typed List::Objects::WithUtils::Role::Hash::Immutable / ); use Exporter (); our @EXPORT = 'immhash_of'; sub import { my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub immhash_of { __PACKAGE__->new(@_) } 1; =pod =head1 NAME List::Objects::WithUtils::Hash::Immutable::Typed - Immutable typed hashes =head1 SYNOPSIS use List::Objects::WithUtils 'immhash_of'; use Types::Standard -types; my $hash = immhash_of Int() => ( foo => 1, bar => 2 ); =head1 DESCRIPTION These are immutable type-checking hash objects, essentially a combination of L and L. Type-checking is performed when the object is created; attempts to modify the object will throw an exception. This class consumes the following roles, which contain most of the relevant documentation: L L L =head2 immhash_of Creates a new immutable typed hash object. =head1 AUTHOR Jon Portnoy =cut Immutable000755000764000031 012701513023 25007 5ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/ArrayTyped.pm100644000764000031 311212701513023 26567 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Array/Immutablepackage List::Objects::WithUtils::Array::Immutable::Typed; $List::Objects::WithUtils::Array::Immutable::Typed::VERSION = '2.028003'; use strictures 2; require Role::Tiny; Role::Tiny->apply_roles_to_package( __PACKAGE__, qw/ List::Objects::WithUtils::Role::Array List::Objects::WithUtils::Role::Array::WithJunctions List::Objects::WithUtils::Role::Array::Typed List::Objects::WithUtils::Role::Array::Immutable /, ); use Exporter (); our @EXPORT = 'immarray_of'; sub import { my $pkg = caller; { no strict 'refs'; ${"${pkg}::a"} = ${"${pkg}::a"}; ${"${pkg}::b"} = ${"${pkg}::b"}; } goto &Exporter::import } sub immarray_of { __PACKAGE__->new(@_) } 1; =pod =for Pod::Coverage immarray_of =head1 NAME List::Objects::WithUtils::Array::Immutable::Typed - Immutable typed arrays =head1 SYNOPSIS use List::Objects::WithUtils 'immarray_of'; use Types::Standard -types; my $array = immarray_of( Int() => 1, 2, 3 ); =head1 DESCRIPTION These are immutable type-checking array objects, essentially a combination of L and L. Type-checking is performed when the object is created; attempts to modify the object will throw an exception. This class consumes the following roles, which contain most of the relevant documentation: L L L L =head1 AUTHOR Jon Portnoy =cut WithJunctions.pm100644000764000031 412712701513023 27303 0ustar00avenjat000000000000List-Objects-WithUtils-2.028003/lib/List/Objects/WithUtils/Role/Arraypackage List::Objects::WithUtils::Role::Array::WithJunctions; $List::Objects::WithUtils::Role::Array::WithJunctions::VERSION = '2.028003'; use strictures 2; use List::Objects::WithUtils::Array::Junction (); use Role::Tiny; sub any_items { List::Objects::WithUtils::Array::Junction::Any->new( @{ $_[0] } ) } sub all_items { List::Objects::WithUtils::Array::Junction::All->new( @{ $_[0] } ) } 1; =pod =head1 NAME List::Objects::WithUtils::Role::Array::WithJunctions - Add junctions =head1 SYNOPSIS ## Via List::Objects::WithUtils::Array -> use List::Objects::WithUtils 'array'; my $array = array(qw/ a b c /); if ( $array->any_items eq 'b' ) { ... } if ( $array->all_items eq 'a' ) { ... } if ( $array->any_items == qr/^b/ ) { ... } ## As a Role -> use Role::Tiny::With; with 'List::Objects::WithUtils::Role::Array', 'List::Objects::WithUtils::Role::Array::WithJunctions'; =head1 DESCRIPTION These methods supply overloaded L objects that can be compared with values using normal Perl comparison operators. Regular expressions can be matched by providing a C regular expression object to the C<==> or C operators. There is no support for the C<~~> experimental smart-match operator. The junction objects returned are subclasses of L, allowing manipulation of junctions (of varying degrees of sanity) -- a simple case might be generating a new junction out of an old junction: my $list = array(3, 4, 5); if ( (my $anyof = $list->any_items) > 2 ) { my $incr = $anyof->map(sub { $_[0] + 1 })->all_items; if ( $incr > 6 ) { # ... } # Drop junction magic again: my $plain = array( $incr->all ); } =head2 any_items Returns the overloaded B object for the current array; a comparison is true if any items in the array satisfy the condition. =head2 all_items Returns the overloaded B object for the current array; a comparison is true only if all items in the array satisfy the condition. =head1 AUTHOR Jon Portnoy =cut