Hash-Ordered-0.014/000755 000765 000024 00000000000 13510640204 014210 5ustar00davidstaff000000 000000 Hash-Ordered-0.014/devel/000755 000765 000024 00000000000 13510640204 015307 5ustar00davidstaff000000 000000 Hash-Ordered-0.014/LICENSE000644 000765 000024 00000026354 13510640204 015227 0ustar00davidstaff000000 000000 This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. Hash-Ordered-0.014/cpanfile000644 000765 000024 00000002715 13510640204 015721 0ustar00davidstaff000000 000000 requires "Carp" => "0"; requires "constant" => "0"; requires "overload" => "0"; requires "perl" => "5.008"; requires "strict" => "0"; requires "warnings" => "0"; on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "List::Util" => "0"; requires "Test::Deep" => "0"; requires "Test::FailWarnings" => "0"; requires "Test::Fatal" => "0"; requires "Test::More" => "0.96"; requires "perl" => "5.008"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "6.17"; requires "perl" => "5.008"; }; on 'develop' => sub { requires "Dist::Zilla" => "5"; requires "Dist::Zilla::Plugin::Meta::Contributors" => "0"; requires "Dist::Zilla::Plugin::ReleaseStatus::FromVersion" => "0"; requires "Dist::Zilla::PluginBundle::DAGOLDEN" => "0.072"; requires "File::Spec" => "0"; requires "File::Temp" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Pod::Coverage::TrustPod" => "0"; requires "Pod::Wordlist" => "0"; requires "Software::License::Apache_2_0" => "0"; requires "Test::CPAN::Meta" => "0"; requires "Test::MinimumVersion" => "0"; requires "Test::More" => "0"; requires "Test::Perl::Critic" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Pod::Coverage" => "1.08"; requires "Test::Portability::Files" => "0"; requires "Test::Spelling" => "0.12"; requires "Test::Version" => "1"; }; Hash-Ordered-0.014/Changes000644 000765 000024 00000006537 13510640204 015516 0ustar00davidstaff000000 000000 Revision history for Hash-Ordered 0.014 2019-07-08 09:09:15-04:00 America/New_York - No changes from 0.013-TRIAL. 0.013 2019-07-03 11:37:59-04:00 America/New_York (TRIAL RELEASE) [Fixed] - Fixed bugs in or_equals and dor_equals. (GH #8) 0.012 2017-03-09 11:35:00-05:00 America/New_York - No changes from 0.011-TRIAL. 0.011 2017-03-03 22:35:34-05:00 America/New_York (TRIAL RELEASE) [Fixed] - Fixed bug iterating a tied hash and clearing the underlying hash of data. - Fixed bug in merge() where order of new pairs was reversed. 0.010 2016-02-01 19:02:50-05:00 America/New_York [Fixed] - pop() and shift() now return empty list when hash is empty instead of warning and returning undef values. - push() and unshift() of existing keys would cause corruption in certain cases involving optimized deletion of the existing key. This has been fixed. [Documented] - Noted that pop() and shift() return just the value in scalar context and undef key/value if the ordered hash is empty. 0.009 2015-05-05 12:14:04-04:00 America/New_York [Fixed] - Fixed bug in new() that mishandled duplicate keys 0.008 2015-05-05 06:26:42-04:00 America/New_York [Optimized] - Methods which take lists of keys or key/value pairs no longer makes a temporary copy, which speeds them up substantially for large lists 0.007 2015-05-04 10:57:31-04:00 America/New_York [Optimized] - The 'as_list' method no longer makes a temporary copy of keys to list 0.006 2015-05-03 20:48:41-04:00 America/New_York [Changed] - The 'values' method in scalar context now returns an optimized count of elements. [Documentation] - Amended various parts of the documentation. - Fixed formatting of benchmark results and a SEE ALSO list. 0.005 2015-05-01 04:59:00-04:00 America/New_York (TRIAL RELEASE) [Added] - Added 'preinc', 'postinc', 'predec', 'postdec', 'add', 'subtract', 'concat', 'or_equals' and 'dor_equals' functions for efficient in-place modification of hash elements. [Changed] - The 'keys' method in scalar context now returns an optimized count of keys. [Fixed] - Keys in the internal ordered list of keys are now stringified so they are in exactly the same form as they would be in a Perl hash. This slows construction slightly, but is necessary for correctness. - Added explicit stringification and numification overloads to mimic an unoverloaded object rather than falling back on the result of boolification. [Optimized] - Added indexed tombstone deletion for hashes over 25 elements; this makes deletion faster than all other pure-Perl ordered hash implementations that I benchmarked. - Numerous functions micro-optimized, including get and set. 0.004 2015-04-24 11:45:23-04:00 America/New_York - No changes from 0.003-TRIAL 0.003 2015-04-20 01:29:48+02:00 Europe/Berlin (TRIAL RELEASE) [Added] - Added 'clear' method for efficient clearing. [Optimized] - Replaced use of List::Util::first to speed up element removal. 0.002 2014-07-05 14:00:24-04:00 America/New_York [Documented] - Added Hash::Ordered::Benchmarks 0.001 2014-07-02 18:37:27-04:00 America/New_York - First release Hash-Ordered-0.014/MANIFEST000644 000765 000024 00000001066 13510640204 015344 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. CONTRIBUTING.mkdn Changes LICENSE MANIFEST META.json META.yml Makefile.PL README cpanfile devel/bench-all.pl dist.ini lib/Hash/Ordered.pm lib/Hash/Ordered/Benchmarks.pod perlcritic.rc t/00-report-prereqs.dd t/00-report-prereqs.t t/basic.t t/invariants.t t/tie.t tidyall.ini xt/author/00-compile.t xt/author/critic.t xt/author/minimum-version.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/portability.t xt/author/test-version.t xt/release/distmeta.t Hash-Ordered-0.014/perlcritic.rc000644 000765 000024 00000001166 13510640204 016702 0ustar00davidstaff000000 000000 severity = 5 verbose = 8 [Variables::ProhibitPunctuationVars] allow = $@ $! [TestingAndDebugging::ProhibitNoStrict] allow = refs [Variables::ProhibitEvilVariables] variables = $DB::single # Turn these off [-BuiltinFunctions::ProhibitStringyEval] [-ControlStructures::ProhibitPostfixControls] [-ControlStructures::ProhibitUnlessBlocks] [-Documentation::RequirePodSections] [-InputOutput::ProhibitInteractiveTest] [-References::ProhibitDoubleSigils] [-RegularExpressions::RequireExtendedFormatting] [-InputOutput::ProhibitTwoArgOpen] [-Modules::ProhibitEvilModules] # Turn this on [Lax::ProhibitStringyEval::ExceptForRequire] Hash-Ordered-0.014/CONTRIBUTING.mkdn000644 000765 000024 00000006604 13510640204 017000 0ustar00davidstaff000000 000000 ## HOW TO CONTRIBUTE Thank you for considering contributing to this distribution. This file contains instructions that will help you work with the source code. The distribution is managed with Dist::Zilla. This means that many of the usual files you might expect are not in the repository, but are generated at release time, as is much of the documentation. Some generated files are kept in the repository as a convenience (e.g. Makefile.PL or cpanfile). Generally, **you do not need Dist::Zilla to contribute patches**. You do need Dist::Zilla to create a tarball. See below for guidance. ### Getting dependencies If you have App::cpanminus 1.6 or later installed, you can use `cpanm` to satisfy dependencies like this: $ cpanm --installdeps . Otherwise, look for either a `Makefile.PL` or `cpanfile` file for a list of dependencies to satisfy. ### Running tests You can run tests directly using the `prove` tool: $ prove -l $ prove -lv t/some_test_file.t For most of my distributions, `prove` is entirely sufficient for you to test any patches you have. I use `prove` for 99% of my testing during development. ### Code style and tidying Please try to match any existing coding style. If there is a `.perltidyrc` file, please install Perl::Tidy and use perltidy before submitting patches. If there is a `tidyall.ini` file, you can also install Code::TidyAll and run `tidyall` on a file or `tidyall -a` to tidy all files. ### Patching documentation Much of the documentation Pod is generated at release time. Some is generated boilerplate; other documentation is built from pseudo-POD directives in the source like C<=method> or C<=func>. If you would like to submit a documentation edit, please limit yourself to the documentation you see. If you see typos or documentation issues in the generated docs, please email or open a bug ticket instead of patching. ### Where to send patches and pull requests If you found this distribution on Github, sending a pull-request is the best way to contribute. If a pull-request isn't possible, a bug ticket with a patch file is the next best option. As a last resort, an email to the author(s) is acceptable. ## Installing and using Dist::Zilla Dist::Zilla is not required for contributing, but if you'd like to learn more, this section will get you up to speed. Dist::Zilla is a very powerful authoring tool, optimized for maintaining a large number of distributions with a high degree of automation, but it has a large dependency chain, a bit of a learning curve and requires a number of author-specific plugins. To install it from CPAN, I recommend one of the following approaches for the quickest installation: # using CPAN.pm, but bypassing non-functional pod tests $ cpan TAP::Harness::Restricted $ PERL_MM_USE_DEFAULT=1 HARNESS_CLASS=TAP::Harness::Restricted cpan Dist::Zilla # using cpanm, bypassing *all* tests $ cpanm -n Dist::Zilla In either case, it's probably going to take about 10 minutes. Go for a walk, go get a cup of your favorite beverage, take a bathroom break, or whatever. When you get back, Dist::Zilla should be ready for you. Then you need to install any plugins specific to this distribution: $ cpan `dzil authordeps` $ dzil authordeps | cpanm Once installed, here are some dzil commands you might try: $ dzil build $ dzil test $ dzil xtest You can learn more about Dist::Zilla at http://dzil.org/ Hash-Ordered-0.014/t/000755 000765 000024 00000000000 13510640204 014453 5ustar00davidstaff000000 000000 Hash-Ordered-0.014/xt/000755 000765 000024 00000000000 13510640204 014643 5ustar00davidstaff000000 000000 Hash-Ordered-0.014/README000644 000765 000024 00000036630 13510640204 015100 0ustar00davidstaff000000 000000 NAME Hash::Ordered - A fast, pure-Perl ordered hash class VERSION version 0.014 SYNOPSIS use Hash::Ordered; my $oh = Hash::Ordered->new( a => 1 ); $oh->get( 'a' ); $oh->set( 'a' => 2 ); $oh->exists( 'a' ); $val = $oh->delete( 'a' ); @keys = $oh->keys; @vals = $oh->values; @pairs = $oh->as_list $oh->push( c => 3, d => 4 ); $oh->unshift( e => 5, f => 6 ); ( $k, $v ) = $oh->pop; ( $k, $v ) = $oh->shift; $iter = $oh->iterator; while( ( $k, $v ) = $iter->() ) { ... } $copy = $oh->clone; $subset = $oh->clone( qw/c d/ ); $reversed = $oh->clone( reverse $oh->keys ); @value_slice = $oh->values( qw/c f/ ); # qw/3 6/ @pairs_slice = $oh->as_list( qw/f e/ ); # qw/f 6 e 5/ $oh->postinc( 'a' ); # like $oh{a}++ $oh->add( 'a', 5 ); # like $oh{a} += 5 $oh->concat( 'a', 'hello' ); # like $oh{a} .= 'hello' $oh->or_equals( 'g', '23' ); # like $oh{g} ||= 23 $oh->dor_equals( 'g', '23' ); # like $oh{g} //= 23 DESCRIPTION This module implements an ordered hash, meaning that it associates keys with values like a Perl hash, but keeps the keys in a consistent order. Because it is implemented as an object and manipulated with method calls, it is much slower than a Perl hash. This is the cost of keeping order. However, compared to other ordered hash implementations, Hash::Ordered is optimized for getting and setting individual elements and is generally faster at most other tasks as well. For specific details, see Hash::Ordered::Benchmarks. METHODS new $oh = Hash::Ordered->new; $oh = Hash::Ordered->new( @pairs ); Constructs an object, with an optional list of key-value pairs. The position of a key corresponds to the first occurrence in the list, but the value will be updated if the key is seen more than once. Current API available since 0.009. clone $oh2 = $oh->clone; $oh2 = $oh->clone( @keys ); Creates a shallow copy of an ordered hash object. If no arguments are given, it produces an exact copy. If a list of keys is given, the new object includes only those keys in the given order. Keys that aren't in the original will have the value "undef". keys @keys = $oh->keys; $size = $oh->keys; In list context, returns the ordered list of keys. In scalar context, returns the number of elements. Current API available since 0.005. values @values = $oh->values; @values = $oh->values( @keys ); Returns an ordered list of values. If no arguments are given, returns the ordered values of the entire hash. If a list of keys is given, returns values in order corresponding to those keys. If a key does not exist, "undef" will be returned for that value. In scalar context, returns the number of elements. Current API available since 0.006. get $value = $oh->get("some key"); Returns the value associated with the key, or "undef" if it does not exist in the hash. set $oh->set("some key" => "some value"); Associates a value with a key and returns the value. If the key does not already exist in the hash, it will be added at the end. exists if ( $oh->exists("some key") ) { ... } Test if some key exists in the hash (without creating it). delete $value = $oh->delete("some key"); Removes a key-value pair from the hash and returns the value. clear $oh->clear; Removes all key-value pairs from the hash. Returns undef in scalar context or an empty list in list context. Current API available since 0.003. push $oh->push( one => 1, two => 2); Add a list of key-value pairs to the end of the ordered hash. If a key already exists in the hash, it will be deleted and re-inserted at the end with the new value. Returns the number of keys after the push is complete. pop ($key, $value) = $oh->pop; $value = $oh->pop; Removes and returns the last key-value pair in the ordered hash. In scalar context, only the value is returned. If the hash is empty, the returned key and value will be "undef". unshift $oh->unshift( one => 1, two => 2 ); Adds a list of key-value pairs to the beginning of the ordered hash. If a key already exists, it will be deleted and re-inserted at the beginning with the new value. Returns the number of keys after the unshift is complete. shift ($key, $value) = $oh->shift; $value = $oh->shift; Removes and returns the first key-value pair in the ordered hash. In scalar context, only the value is returned. If the hash is empty, the returned key and value will be "undef". merge $oh->merge( one => 1, two => 2 ); Merges a list of key-value pairs into the ordered hash. If a key already exists, its value is replaced. Otherwise, the key-value pair is added at the end of the hash. as_list @pairs = $oh->as_list; @pairs = $oh->as_list( @keys ); Returns an ordered list of key-value pairs. If no arguments are given, all pairs in the hash are returned. If a list of keys is given, the returned list includes only those key-value pairs in the given order. Keys that aren't in the original will have the value "undef". iterator $iter = $oh->iterator; $iter = $oh->iterator( reverse $oh->keys ); # reverse while ( my ($key,$value) = $iter->() ) { ... } Returns a code reference that returns a single key-value pair (in order) on each invocation, or the empty list if all keys are visited. If no arguments are given, the iterator walks the entire hash in order. If a list of keys is provided, the iterator walks the hash in that order. Unknown keys will return "undef". The list of keys to return is set when the iterator is generator. Keys added later will not be returned. Subsequently deleted keys will return "undef" for the value. preinc $oh->preinc($key); # like ++$hash{$key} This method is sugar for incrementing a key without having to call "set" and "get" explicitly. It returns the new value. Current API available since 0.005. postinc $oh->postinc($key); # like $hash{$key}++ This method is sugar for incrementing a key without having to call "set" and "get" explicitly. It returns the old value. Current API available since 0.005. predec $oh->predec($key); # like --$hash{$key} This method is sugar for decrementing a key without having to call "set" and "get" explicitly. It returns the new value. Current API available since 0.005. postdec $oh->postdec($key); # like $hash{$key}-- This method is sugar for decrementing a key without having to call "set" and "get" explicitly. It returns the old value. Current API available since 0.005. add $oh->add($key, $n); # like $hash{$key} += $n This method is sugar for adding a value to a key without having to call "set" and "get" explicitly. With no value to add, it is treated as "0". It returns the new value. Current API available since 0.005. subtract $oh->subtract($key, $n); # like $hash{$key} -= $n This method is sugar for subtracting a value from a key without having to call "set" and "get" explicitly. With no value to subtract, it is treated as "0". It returns the new value. Current API available since 0.005. concat $oh->concat($key, $str); # like $hash{$key} .= $str This method is sugar for concatenating a string onto the value of a key without having to call "set" and "get" explicitly. It returns the new value. If the value to append is not defined, no concatenation is done and no warning is given. Current API available since 0.005. or_equals $oh->or_equals($key, $str); # like $hash{$key} ||= $str This method is sugar for assigning to a key if the existing value is false without having to call "set" and "get" explicitly. It returns the new value. Current API available since 0.005. dor_equals $oh->dor_equals($key, $str); # like $hash{$key} //= $str This method is sugar for assigning to a key if the existing value is not defined without having to call "set" and "get" explicitly. It returns the new value. Current API available since 0.005. OVERLOADING Boolean if ( $oh ) { ... } When used in boolean context, a Hash::Ordered object is true if it has any entries and false otherwise. String say "$oh"; When used in string context, a Hash::Ordered object stringifies like typical Perl objects. E.g. "Hash::Ordered=ARRAY(0x7f815302cac0)" Current API available since 0.005. Numeric $count = 0 + $oh; When used in numeric context, a Hash::Ordered object numifies as the decimal representation of its memory address, just like typical Perl objects. E.g. 140268162536552 For the number of keys, call the "keys" method in scalar context. Current API available since 0.005. Fallback Other overload methods are derived from these three, if possible. TIED INTERFACE Using "tie" is slower than using method calls directly. But for compatibility with libraries that can only take hashes, it's available if you really need it: tie my %hash, "Hash::Ordered", @pairs; If you want to access the underlying object for method calls, use "tied": tied( %hash )->unshift( @data ); Tied hash API available since 0.005. CAVEATS Deletion and order modification with push, pop, etc. This can be expensive, as the ordered list of keys has to be updated. For small hashes with no more than 25 keys, keys are found and spliced out with linear search. As an optimization for larger hashes, the first change to the ordered list of keys will construct an index to the list of keys. Thereafter, removed keys will be marked with a "tombstone" record. Tombstones will be garbage collected whenever the number of tombstones exceeds the number of valid keys. These internal implementation details largely shouldn't concern you. The important things to note are: * The costs of efficient deletion are deferred until you need it * Deleting lots of keys will temporarily appear to leak memory until garbage collection occurs MOTIVATION For a long time, I used Tie::IxHash for ordered hashes, but I grew frustrated with things it lacked, like a cheap way to copy an IxHash object or a convenient iterator when not using the tied interface. As I looked at its implementation, it seemed more complex than I though it needed, with an extra level of indirection that slows data access. Given that frustration, I started experimenting with the simplest thing I thought could work for an ordered hash: a hash of key-value pairs and an array with key order. As I worked on this, I also started searching for other modules doing similar things. What I found fell broadly into two camps: modules based on tie (even if they offered an OO interface), and pure OO modules. They all either lacked features I deemed necessary or else seemed overly-complex in either implementation or API. Hash::Ordered attempts to find the sweet spot with simple implementation, reasonably good efficiency for most common operations, and a rich, intuitive API. After discussions with Mario Roy about the potential use of Hash::Ordered with MCE, I optimized deletion of larger hashes and provided a tied interface for compatibility. Mario's suggestions and feedback about optimization were quite valuable. Thank you, Mario! SEE ALSO This section describes other ordered-hash modules I found on CPAN. For benchmarking results, see Hash::Ordered::Benchmarks. Tie modules The following modules offer some sort of tie interface. I don't like ties, in general, because of the extra indirection involved over a direct method call. Still, you can make any tied interface into a faster OO one with "tied": tied( %tied_hash )->FETCH($key); Tie::Hash::Indexed is implemented in XS and thus seems promising if pure-Perl isn't a criterion; it generally fails tests on Perl 5.18 and above due to the hash randomization change. Despite being XS, it is slower than Hash::Ordered at everything exception creation and deletion. Tie::IxHash is probably the most well known and includes an OO API. Given the performance problems it has, "well known" is the only real reason to use it. These other modules below have very specific designs/limitations and I didn't find any of them suitable for general purpose use: * Tie::Array::AsHash — array elements split with separator; tie API only * Tie::Hash::Array — ordered alphabetically; tie API only * Tie::InsertOrderHash — ordered by insertion; tie API only * Tie::LLHash — linked-list implementation; quite slow * Tie::StoredOrderHash — ordered by last update; tie API only Other ordered hash modules Other modules stick with an object-oriented API, with a wide variety of implementation approaches. Array::AsHash is essentially an inverse implementation from Hash::Ordered. It keeps pairs in an array and uses a hash to index into the array. This indirection would already make hash-like operations slower, but the specific implementation makes it even worse, with abstractions and function calls that make getting or setting individual items up to 10x slower than Hash::Ordered. However, "Array::AsHash" takes an arrayref to initialize, which is very fast and can return the list of pairs faster, too. If you mostly create and list out very large ordered hashes and very rarely touch individual entries, I think this could be something to very cautiously consider. These other modules below have restrictions or particularly complicated implementations (often relying on "tie") and thus I didn't think any of them really suitable for use: * Array::Assign — arrays with named access; restricted keys * Array::OrdHash — overloads array/hash deref and uses internal tied data * Data::Pairs — array of key-value hashrefs; allows duplicate keys * Data::OMap — array of key-value hashrefs; no duplicate keys * Data::XHash — blessed, tied hashref with doubly-linked-list SUPPORT Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at . You will be notified automatically of any progress on your issue. Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. git clone https://github.com/dagolden/Hash-Ordered.git AUTHOR David Golden CONTRIBUTORS * Andy Lester * Benct Philip Jonsson * Mario Roy COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Hash-Ordered-0.014/META.yml000644 000765 000024 00000002407 13510640204 015464 0ustar00davidstaff000000 000000 --- abstract: 'A fast, pure-Perl ordered hash class' author: - 'David Golden ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' List::Util: '0' Test::Deep: '0' Test::FailWarnings: '0' Test::Fatal: '0' Test::More: '0.96' perl: '5.008' configure_requires: ExtUtils::MakeMaker: '6.17' perl: '5.008' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: apache meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Hash-Ordered no_index: directory: - corpus - examples - t - xt package: - DB provides: Hash::Ordered: file: lib/Hash/Ordered.pm version: '0.014' requires: Carp: '0' constant: '0' overload: '0' perl: '5.008' strict: '0' warnings: '0' resources: bugtracker: https://github.com/dagolden/Hash-Ordered/issues homepage: https://github.com/dagolden/Hash-Ordered repository: https://github.com/dagolden/Hash-Ordered.git version: '0.014' x_authority: cpan:DAGOLDEN x_contributors: - 'Andy Lester ' - 'Benct Philip Jonsson ' - 'Mario Roy ' x_generated_by_perl: v5.28.1 x_serialization_backend: 'YAML::Tiny version 1.73' Hash-Ordered-0.014/tidyall.ini000644 000765 000024 00000000240 13510640204 016347 0ustar00davidstaff000000 000000 ; Install Code::TidyAll ; run "tidyall -a" to tidy all files ; run "tidyall -g" to tidy only files modified from git [PerlTidy] select = {lib,t}/**/*.{pl,pm,t} Hash-Ordered-0.014/lib/000755 000765 000024 00000000000 13510640204 014756 5ustar00davidstaff000000 000000 Hash-Ordered-0.014/Makefile.PL000644 000765 000024 00000002740 13510640204 016165 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use 5.008; use ExtUtils::MakeMaker 6.17; my %WriteMakefileArgs = ( "ABSTRACT" => "A fast, pure-Perl ordered hash class", "AUTHOR" => "David Golden ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.17" }, "DISTNAME" => "Hash-Ordered", "LICENSE" => "apache", "MIN_PERL_VERSION" => "5.008", "NAME" => "Hash::Ordered", "PREREQ_PM" => { "Carp" => 0, "constant" => 0, "overload" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "List::Util" => 0, "Test::Deep" => 0, "Test::FailWarnings" => 0, "Test::Fatal" => 0, "Test::More" => "0.96" }, "VERSION" => "0.014", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "List::Util" => 0, "Test::Deep" => 0, "Test::FailWarnings" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "constant" => 0, "overload" => 0, "strict" => 0, "warnings" => 0 ); 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); Hash-Ordered-0.014/META.json000644 000765 000024 00000006104 13510640204 015632 0ustar00davidstaff000000 000000 { "abstract" : "A fast, pure-Perl ordered hash class", "author" : [ "David Golden " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "apache_2_0" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Hash-Ordered", "no_index" : { "directory" : [ "corpus", "examples", "t", "xt" ], "package" : [ "DB" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.17", "perl" : "5.008" } }, "develop" : { "requires" : { "Dist::Zilla" : "5", "Dist::Zilla::Plugin::Meta::Contributors" : "0", "Dist::Zilla::Plugin::ReleaseStatus::FromVersion" : "0", "Dist::Zilla::PluginBundle::DAGOLDEN" : "0.072", "File::Spec" : "0", "File::Temp" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Pod::Coverage::TrustPod" : "0", "Pod::Wordlist" : "0", "Software::License::Apache_2_0" : "0", "Test::CPAN::Meta" : "0", "Test::MinimumVersion" : "0", "Test::More" : "0", "Test::Perl::Critic" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Portability::Files" : "0", "Test::Spelling" : "0.12", "Test::Version" : "1" } }, "runtime" : { "requires" : { "Carp" : "0", "constant" : "0", "overload" : "0", "perl" : "5.008", "strict" : "0", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "List::Util" : "0", "Test::Deep" : "0", "Test::FailWarnings" : "0", "Test::Fatal" : "0", "Test::More" : "0.96", "perl" : "5.008" } } }, "provides" : { "Hash::Ordered" : { "file" : "lib/Hash/Ordered.pm", "version" : "0.014" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/dagolden/Hash-Ordered/issues" }, "homepage" : "https://github.com/dagolden/Hash-Ordered", "repository" : { "type" : "git", "url" : "https://github.com/dagolden/Hash-Ordered.git", "web" : "https://github.com/dagolden/Hash-Ordered" } }, "version" : "0.014", "x_authority" : "cpan:DAGOLDEN", "x_contributors" : [ "Andy Lester ", "Benct Philip Jonsson ", "Mario Roy " ], "x_generated_by_perl" : "v5.28.1", "x_serialization_backend" : "Cpanel::JSON::XS version 4.09" } Hash-Ordered-0.014/dist.ini000644 000765 000024 00000001061 13510640204 015652 0ustar00davidstaff000000 000000 name = Hash-Ordered author = David Golden license = Apache_2_0 copyright_holder = David Golden copyright_year = 2014 [@DAGOLDEN] :version = 0.072 stopwords = IxHash stopwords = JIT stopwords = concat stopwords = darwin stopwords = dec stopwords = decrement stopwords = decrementing stopwords = incrementing stopwords = postdec stopwords = predec stopwords = postinc stopwords = preinc stopwords = tombstoned [ReleaseStatus::FromVersion] testing = third_decimal_odd [Meta::Contributors] contributor = Mario Roy Hash-Ordered-0.014/lib/Hash/000755 000765 000024 00000000000 13510640204 015641 5ustar00davidstaff000000 000000 Hash-Ordered-0.014/lib/Hash/Ordered.pm000644 000765 000024 00000077314 13510640204 017577 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; package Hash::Ordered; # ABSTRACT: A fast, pure-Perl ordered hash class our $VERSION = '0.014'; use Carp (); use constant { _DATA => 0, # unordered data _KEYS => 1, # ordered keys _INDX => 2, # index into _KEYS (on demand) _OFFS => 3, # index offset for optimized shift/unshift _GCNT => 4, # garbage count _ITER => 5, # for tied hash support }; use constant { _INDEX_THRESHOLD => 25, # max size before indexing/tombstone deletion _TOMBSTONE => \1, # ref to arbitrary scalar }; # 'overloading.pm' not available until 5.10.1 so emulate with Scalar::Util BEGIN { if ( $] gt '5.010000' ) { ## no critic eval q{ sub _stringify { no overloading; "$_[0]" } sub _numify { no overloading; 0+$_[0] } }; die $@ if $@; # uncoverable branch true } else { ## no critic eval q{ require Scalar::Util; sub _stringify { sprintf("%s=ARRAY(0x%x)",ref($_[0]),Scalar::Util::refaddr($_[0])) } sub _numify { Scalar::Util::refaddr($_[0]) } }; die $@ if $@; # uncoverable branch true } } use overload q{""} => \&_stringify, q{0+} => \&_numify, q{bool} => sub { !!scalar %{ $_[0]->[_DATA] } }, fallback => 1; #pod =method new #pod #pod $oh = Hash::Ordered->new; #pod $oh = Hash::Ordered->new( @pairs ); #pod #pod Constructs an object, with an optional list of key-value pairs. #pod #pod The position of a key corresponds to the first occurrence in the list, but #pod the value will be updated if the key is seen more than once. #pod #pod Current API available since 0.009. #pod #pod =cut sub new { my $class = shift; Carp::croak("new() requires key-value pairs") unless @_ % 2 == 0; my ( %data, @keys, $k ); while (@_) { # must stringify keys for _KEYS array $k = shift; push @keys, "$k" unless exists $data{$k}; $data{$k} = shift; } return bless [ \%data, \@keys, undef, 0, 0 ], $class; } #pod =method clone #pod #pod $oh2 = $oh->clone; #pod $oh2 = $oh->clone( @keys ); #pod #pod Creates a shallow copy of an ordered hash object. If no arguments are #pod given, it produces an exact copy. If a list of keys is given, the new #pod object includes only those keys in the given order. Keys that aren't #pod in the original will have the value C. #pod #pod =cut sub clone { my $self = CORE::shift; my $clone; if (@_) { my %subhash; @subhash{@_} = @{ $self->[_DATA] }{@_}; $clone = [ \%subhash, [ map "$_", @_ ], undef, 0, 0 ]; } elsif ( $self->[_INDX] ) { $clone = [ { %{ $self->[_DATA] } }, [ grep !ref($_), @{ $self->[_KEYS] } ], undef, 0, 0 ]; } else { $clone = [ { %{ $self->[_DATA] } }, [ @{ $self->[_KEYS] } ], undef, 0, 0 ]; } return bless $clone, ref $self; } #pod =method keys #pod #pod @keys = $oh->keys; #pod $size = $oh->keys; #pod #pod In list context, returns the ordered list of keys. In scalar context, returns #pod the number of elements. #pod #pod Current API available since 0.005. #pod #pod =cut sub keys { my ($self) = @_; return wantarray ? ( grep !ref($_), @{ $self->[_KEYS] } ) : @{ $self->[_KEYS] } - $self->[_GCNT]; } #pod =method values #pod #pod @values = $oh->values; #pod @values = $oh->values( @keys ); #pod #pod Returns an ordered list of values. If no arguments are given, returns #pod the ordered values of the entire hash. If a list of keys is given, returns #pod values in order corresponding to those keys. If a key does not exist, C #pod will be returned for that value. #pod #pod In scalar context, returns the number of elements. #pod #pod Current API available since 0.006. #pod #pod =cut sub values { my $self = CORE::shift; return wantarray ? ( map { $self->[_DATA]{$_} } ( @_ ? @_ : grep !ref($_), @{ $self->[_KEYS] } ) ) : @{ $self->[_KEYS] } - $self->[_GCNT]; } #pod =method get #pod #pod $value = $oh->get("some key"); #pod #pod Returns the value associated with the key, or C if it does not exist in #pod the hash. #pod #pod =cut sub get { return $_[0]->[_DATA]{ $_[1] }; } #pod =method set #pod #pod $oh->set("some key" => "some value"); #pod #pod Associates a value with a key and returns the value. If the key does not #pod already exist in the hash, it will be added at the end. #pod #pod =cut sub set { my ( $self, $key ) = @_; # don't copy $_[2] in case it's large if ( !exists $self->[_DATA]{$key} ) { my $keys = $self->[_KEYS]; if ( my $indx = $self->[_INDX] ) { $indx->{$key} = @$keys ? $indx->{ $keys->[-1] } + 1 : 0; } CORE::push @{ $self->[_KEYS] }, "$key"; # stringify key } return $self->[_DATA]{$key} = $_[2]; } #pod =method exists #pod #pod if ( $oh->exists("some key") ) { ... } #pod #pod Test if some key exists in the hash (without creating it). #pod #pod =cut sub exists { return exists $_[0]->[_DATA]{ $_[1] }; } #pod =method delete #pod #pod $value = $oh->delete("some key"); #pod #pod Removes a key-value pair from the hash and returns the value. #pod #pod =cut sub delete { my ( $self, $key ) = @_; if ( exists $self->[_DATA]{$key} ) { my $keys = $self->[_KEYS]; # JIT an index if hash is "large" if ( !$self->[_INDX] && @$keys > _INDEX_THRESHOLD ) { my %indx; $indx{ $keys->[$_] } = $_ for 0 .. $#{$keys}; $self->[_INDX] = \%indx; } if ( $self->[_INDX] ) { # tombstone $keys->[ delete( $self->[_INDX]{$key} ) + $self->[_OFFS] ] = _TOMBSTONE; # GC keys and remove index if more than half keys are tombstone. # Index will be recreated if needed on next delete if ( ++$self->[_GCNT] > @$keys / 2 ) { @{ $self->[_KEYS] } = grep !ref($_), @{ $self->[_KEYS] }; $self->[_INDX] = undef; $self->[_OFFS] = 0; $self->[_GCNT] = 0; } # or maybe garbage collect start of list elsif ( ref( $keys->[0] ) ) { my $i = 0; $i++ while ref( $keys->[$i] ); splice @$keys, 0, $i; $self->[_GCNT] -= $i; $self->[_OFFS] -= $i; } # or maybe garbage collect end of list elsif ( ref( $keys->[-1] ) ) { my $i = $#{$keys}; $i-- while ref( $keys->[$i] ); $self->[_GCNT] -= $#{$keys} - $i; splice @$keys, $i + 1; } } else { my $i; for ( 0 .. $#{$keys} ) { if ( $keys->[$_] eq $key ) { $i = $_; last; } } splice @$keys, $i, 1; } return delete $self->[_DATA]{$key}; } return undef; ## no critic } #pod =method clear #pod #pod $oh->clear; #pod #pod Removes all key-value pairs from the hash. Returns undef in scalar context #pod or an empty list in list context. #pod #pod Current API available since 0.003. #pod #pod =cut sub clear { my ($self) = @_; @$self = ( {}, [], undef, 0, 0 ); return; } #pod =method push #pod #pod $oh->push( one => 1, two => 2); #pod #pod Add a list of key-value pairs to the end of the ordered hash. If a key already #pod exists in the hash, it will be deleted and re-inserted at the end with the new #pod value. #pod #pod Returns the number of keys after the push is complete. #pod #pod =cut sub push { my $self = CORE::shift; my ( $data, $keys ) = @$self; while (@_) { my ( $k, $v ) = splice( @_, 0, 2 ); $self->delete($k) if exists $data->{$k}; $data->{$k} = $v; if ( my $indx = $self->[_INDX] ) { $indx->{$k} = @$keys ? $indx->{ $keys->[-1] } + 1 : 0; } CORE::push @$keys, "$k"; # stringify keys } return @$keys - $self->[_GCNT]; } #pod =method pop #pod #pod ($key, $value) = $oh->pop; #pod $value = $oh->pop; #pod #pod Removes and returns the last key-value pair in the ordered hash. #pod In scalar context, only the value is returned. If the hash is empty, #pod the returned key and value will be C. #pod #pod =cut sub pop { my ($self) = @_; if ( $self->[_INDX] ) { my $key = $self->[_KEYS][-1]; return $key, $self->delete($key); } else { my $key = CORE::pop @{ $self->[_KEYS] }; return defined($key) ? ( $key, delete $self->[_DATA]{$key} ) : (); } } #pod =method unshift #pod #pod $oh->unshift( one => 1, two => 2 ); #pod #pod Adds a list of key-value pairs to the beginning of the ordered hash. If a key #pod already exists, it will be deleted and re-inserted at the beginning with the #pod new value. #pod #pod Returns the number of keys after the unshift is complete. #pod #pod =cut sub unshift { my $self = CORE::shift; my ( $data, $keys ) = @$self; while (@_) { my ( $k, $v ) = splice( @_, -2, 2 ); $self->delete($k) if exists $data->{$k}; $data->{$k} = $v; CORE::unshift @$keys, "$k"; # stringify keys $self->[_INDX]{$k} = -( ++$self->[_OFFS] ) if $self->[_INDX]; } return @$keys - $self->[_GCNT]; } #pod =method shift #pod #pod ($key, $value) = $oh->shift; #pod $value = $oh->shift; #pod #pod Removes and returns the first key-value pair in the ordered hash. #pod In scalar context, only the value is returned. If the hash is empty, #pod the returned key and value will be C. #pod #pod =cut sub shift { my ($self) = @_; if ( $self->[_INDX] ) { my $key = $self->[_KEYS][0]; return $key, $self->delete($key); } else { my $key = CORE::shift @{ $self->[_KEYS] }; return defined($key) ? ( $key, delete $self->[_DATA]{$key} ) : (); } } #pod =method merge #pod #pod $oh->merge( one => 1, two => 2 ); #pod #pod Merges a list of key-value pairs into the ordered hash. If a key already #pod exists, its value is replaced. Otherwise, the key-value pair is added at #pod the end of the hash. #pod #pod =cut sub merge { my $self = CORE::shift; while (@_) { my ( $k, $v ) = splice( @_, 0, 2 ); if ( !exists $self->[_DATA]{$k} ) { my $size = CORE::push @{ $self->[_KEYS] }, "$k"; # stringify key $self->[_INDX]{$k} = $size - 1 if $self->[_INDX]; } $self->[_DATA]{$k} = $v; } return @{ $self->[_KEYS] } - $self->[_GCNT]; } #pod =method as_list #pod #pod @pairs = $oh->as_list; #pod @pairs = $oh->as_list( @keys ); #pod #pod Returns an ordered list of key-value pairs. If no arguments are given, all #pod pairs in the hash are returned. If a list of keys is given, the returned list #pod includes only those key-value pairs in the given order. Keys that aren't in #pod the original will have the value C. #pod #pod =cut sub as_list { my $self = CORE::shift; return map { ; $_ => $self->[_DATA]{$_} } ( @_ ? @_ : grep !ref($_), @{ $self->[_KEYS] } ); } #pod =method iterator #pod #pod $iter = $oh->iterator; #pod $iter = $oh->iterator( reverse $oh->keys ); # reverse #pod #pod while ( my ($key,$value) = $iter->() ) { ... } #pod #pod Returns a code reference that returns a single key-value pair (in order) on #pod each invocation, or the empty list if all keys are visited. #pod #pod If no arguments are given, the iterator walks the entire hash in order. If a #pod list of keys is provided, the iterator walks the hash in that order. Unknown #pod keys will return C. #pod #pod The list of keys to return is set when the iterator is generator. Keys added #pod later will not be returned. Subsequently deleted keys will return C #pod for the value. #pod #pod =cut # usually we avoid copying keys in @_; here we must for the closure sub iterator { my ( $self, @keys ) = @_; @keys = grep !ref($_), @{ $self->[_KEYS] } unless @keys; my $data = $self->[_DATA]; return sub { return unless @keys; my $key = CORE::shift(@keys); return ( $key => $data->{$key} ); }; } #pod =method preinc #pod #pod $oh->preinc($key); # like ++$hash{$key} #pod #pod This method is sugar for incrementing a key without having to call C and #pod C explicitly. It returns the new value. #pod #pod Current API available since 0.005. #pod #pod =cut sub preinc { return ++$_[0]->[_DATA]{ $_[1] }; } #pod =method postinc #pod #pod $oh->postinc($key); # like $hash{$key}++ #pod #pod This method is sugar for incrementing a key without having to call C and #pod C explicitly. It returns the old value. #pod #pod Current API available since 0.005. #pod #pod =cut sub postinc { return $_[0]->[_DATA]{ $_[1] }++; } #pod =method predec #pod #pod $oh->predec($key); # like --$hash{$key} #pod #pod This method is sugar for decrementing a key without having to call C and #pod C explicitly. It returns the new value. #pod #pod Current API available since 0.005. #pod #pod =cut sub predec { return --$_[0]->[_DATA]{ $_[1] }; } #pod =method postdec #pod #pod $oh->postdec($key); # like $hash{$key}-- #pod #pod This method is sugar for decrementing a key without having to call C and #pod C explicitly. It returns the old value. #pod #pod Current API available since 0.005. #pod #pod =cut sub postdec { return $_[0]->[_DATA]{ $_[1] }--; } #pod =method add #pod #pod $oh->add($key, $n); # like $hash{$key} += $n #pod #pod This method is sugar for adding a value to a key without having to call #pod C and C explicitly. With no value to add, it is treated as "0". #pod It returns the new value. #pod #pod Current API available since 0.005. #pod #pod =cut sub add { return $_[0]->[_DATA]{ $_[1] } += $_[2] || 0; } #pod =method subtract #pod #pod $oh->subtract($key, $n); # like $hash{$key} -= $n #pod #pod This method is sugar for subtracting a value from a key without having to call #pod C and C explicitly. With no value to subtract, it is treated as "0". #pod It returns the new value. #pod #pod Current API available since 0.005. #pod #pod =cut sub subtract { return $_[0]->[_DATA]{ $_[1] } -= $_[2] || 0; } #pod =method concat #pod #pod $oh->concat($key, $str); # like $hash{$key} .= $str #pod #pod This method is sugar for concatenating a string onto the value of a key without #pod having to call C and C explicitly. It returns the new value. If the #pod value to append is not defined, no concatenation is done and no warning is #pod given. #pod #pod Current API available since 0.005. #pod #pod =cut sub concat { if ( defined $_[2] ) { return $_[0]->[_DATA]{ $_[1] } .= $_[2]; } else { return $_[0]->[_DATA]{ $_[1] }; } } #pod =method or_equals #pod #pod $oh->or_equals($key, $str); # like $hash{$key} ||= $str #pod #pod This method is sugar for assigning to a key if the existing value is false #pod without having to call C and C explicitly. It returns the new value. #pod #pod Current API available since 0.005. #pod #pod =cut sub or_equals { my ($self,$key) = @_; if ( my $val = $self->get($key) ) { return $val; } return $self->set($key,$_[2]); } #pod =method dor_equals #pod #pod $oh->dor_equals($key, $str); # like $hash{$key} //= $str #pod #pod This method is sugar for assigning to a key if the existing value is not #pod defined without having to call C and C explicitly. It returns the new #pod value. #pod #pod Current API available since 0.005. #pod #pod =cut sub dor_equals { my ($self,$key) = @_; if ( defined( my $val = $self->get($key) ) ) { return $val; } return $self->set($key,$_[2]); } #--------------------------------------------------------------------------# # tied hash support -- slower, but I maybe some thing are more succinct #--------------------------------------------------------------------------# { no strict 'refs'; *{ __PACKAGE__ . '::TIEHASH' } = \&new; *{ __PACKAGE__ . '::STORE' } = \&set; *{ __PACKAGE__ . '::FETCH' } = \&get; *{ __PACKAGE__ . '::EXISTS' } = \&exists; *{ __PACKAGE__ . '::DELETE' } = \&delete; *{ __PACKAGE__ . '::CLEAR' } = \&clear; } sub FIRSTKEY { my ($self) = @_; my @keys = grep !ref($_), @{ $self->[_KEYS] }; $self->[_ITER] = sub { return unless @keys; return CORE::shift(@keys); }; return $self->[_ITER]->(); } sub NEXTKEY { return defined( $_[0]->[_ITER] ) ? $_[0]->[_ITER]->() : undef; } sub SCALAR { return scalar %{ $_[0]->[_DATA] }; } 1; # vim: ts=4 sts=4 sw=4 et: __END__ =pod =encoding UTF-8 =head1 NAME Hash::Ordered - A fast, pure-Perl ordered hash class =head1 VERSION version 0.014 =head1 SYNOPSIS use Hash::Ordered; my $oh = Hash::Ordered->new( a => 1 ); $oh->get( 'a' ); $oh->set( 'a' => 2 ); $oh->exists( 'a' ); $val = $oh->delete( 'a' ); @keys = $oh->keys; @vals = $oh->values; @pairs = $oh->as_list $oh->push( c => 3, d => 4 ); $oh->unshift( e => 5, f => 6 ); ( $k, $v ) = $oh->pop; ( $k, $v ) = $oh->shift; $iter = $oh->iterator; while( ( $k, $v ) = $iter->() ) { ... } $copy = $oh->clone; $subset = $oh->clone( qw/c d/ ); $reversed = $oh->clone( reverse $oh->keys ); @value_slice = $oh->values( qw/c f/ ); # qw/3 6/ @pairs_slice = $oh->as_list( qw/f e/ ); # qw/f 6 e 5/ $oh->postinc( 'a' ); # like $oh{a}++ $oh->add( 'a', 5 ); # like $oh{a} += 5 $oh->concat( 'a', 'hello' ); # like $oh{a} .= 'hello' $oh->or_equals( 'g', '23' ); # like $oh{g} ||= 23 $oh->dor_equals( 'g', '23' ); # like $oh{g} //= 23 =head1 DESCRIPTION This module implements an ordered hash, meaning that it associates keys with values like a Perl hash, but keeps the keys in a consistent order. Because it is implemented as an object and manipulated with method calls, it is much slower than a Perl hash. This is the cost of keeping order. However, compared to other B hash implementations, Hash::Ordered is optimized for getting and setting individual elements and is generally faster at most other tasks as well. For specific details, see L. =head1 METHODS =head2 new $oh = Hash::Ordered->new; $oh = Hash::Ordered->new( @pairs ); Constructs an object, with an optional list of key-value pairs. The position of a key corresponds to the first occurrence in the list, but the value will be updated if the key is seen more than once. Current API available since 0.009. =head2 clone $oh2 = $oh->clone; $oh2 = $oh->clone( @keys ); Creates a shallow copy of an ordered hash object. If no arguments are given, it produces an exact copy. If a list of keys is given, the new object includes only those keys in the given order. Keys that aren't in the original will have the value C. =head2 keys @keys = $oh->keys; $size = $oh->keys; In list context, returns the ordered list of keys. In scalar context, returns the number of elements. Current API available since 0.005. =head2 values @values = $oh->values; @values = $oh->values( @keys ); Returns an ordered list of values. If no arguments are given, returns the ordered values of the entire hash. If a list of keys is given, returns values in order corresponding to those keys. If a key does not exist, C will be returned for that value. In scalar context, returns the number of elements. Current API available since 0.006. =head2 get $value = $oh->get("some key"); Returns the value associated with the key, or C if it does not exist in the hash. =head2 set $oh->set("some key" => "some value"); Associates a value with a key and returns the value. If the key does not already exist in the hash, it will be added at the end. =head2 exists if ( $oh->exists("some key") ) { ... } Test if some key exists in the hash (without creating it). =head2 delete $value = $oh->delete("some key"); Removes a key-value pair from the hash and returns the value. =head2 clear $oh->clear; Removes all key-value pairs from the hash. Returns undef in scalar context or an empty list in list context. Current API available since 0.003. =head2 push $oh->push( one => 1, two => 2); Add a list of key-value pairs to the end of the ordered hash. If a key already exists in the hash, it will be deleted and re-inserted at the end with the new value. Returns the number of keys after the push is complete. =head2 pop ($key, $value) = $oh->pop; $value = $oh->pop; Removes and returns the last key-value pair in the ordered hash. In scalar context, only the value is returned. If the hash is empty, the returned key and value will be C. =head2 unshift $oh->unshift( one => 1, two => 2 ); Adds a list of key-value pairs to the beginning of the ordered hash. If a key already exists, it will be deleted and re-inserted at the beginning with the new value. Returns the number of keys after the unshift is complete. =head2 shift ($key, $value) = $oh->shift; $value = $oh->shift; Removes and returns the first key-value pair in the ordered hash. In scalar context, only the value is returned. If the hash is empty, the returned key and value will be C. =head2 merge $oh->merge( one => 1, two => 2 ); Merges a list of key-value pairs into the ordered hash. If a key already exists, its value is replaced. Otherwise, the key-value pair is added at the end of the hash. =head2 as_list @pairs = $oh->as_list; @pairs = $oh->as_list( @keys ); Returns an ordered list of key-value pairs. If no arguments are given, all pairs in the hash are returned. If a list of keys is given, the returned list includes only those key-value pairs in the given order. Keys that aren't in the original will have the value C. =head2 iterator $iter = $oh->iterator; $iter = $oh->iterator( reverse $oh->keys ); # reverse while ( my ($key,$value) = $iter->() ) { ... } Returns a code reference that returns a single key-value pair (in order) on each invocation, or the empty list if all keys are visited. If no arguments are given, the iterator walks the entire hash in order. If a list of keys is provided, the iterator walks the hash in that order. Unknown keys will return C. The list of keys to return is set when the iterator is generator. Keys added later will not be returned. Subsequently deleted keys will return C for the value. =head2 preinc $oh->preinc($key); # like ++$hash{$key} This method is sugar for incrementing a key without having to call C and C explicitly. It returns the new value. Current API available since 0.005. =head2 postinc $oh->postinc($key); # like $hash{$key}++ This method is sugar for incrementing a key without having to call C and C explicitly. It returns the old value. Current API available since 0.005. =head2 predec $oh->predec($key); # like --$hash{$key} This method is sugar for decrementing a key without having to call C and C explicitly. It returns the new value. Current API available since 0.005. =head2 postdec $oh->postdec($key); # like $hash{$key}-- This method is sugar for decrementing a key without having to call C and C explicitly. It returns the old value. Current API available since 0.005. =head2 add $oh->add($key, $n); # like $hash{$key} += $n This method is sugar for adding a value to a key without having to call C and C explicitly. With no value to add, it is treated as "0". It returns the new value. Current API available since 0.005. =head2 subtract $oh->subtract($key, $n); # like $hash{$key} -= $n This method is sugar for subtracting a value from a key without having to call C and C explicitly. With no value to subtract, it is treated as "0". It returns the new value. Current API available since 0.005. =head2 concat $oh->concat($key, $str); # like $hash{$key} .= $str This method is sugar for concatenating a string onto the value of a key without having to call C and C explicitly. It returns the new value. If the value to append is not defined, no concatenation is done and no warning is given. Current API available since 0.005. =head2 or_equals $oh->or_equals($key, $str); # like $hash{$key} ||= $str This method is sugar for assigning to a key if the existing value is false without having to call C and C explicitly. It returns the new value. Current API available since 0.005. =head2 dor_equals $oh->dor_equals($key, $str); # like $hash{$key} //= $str This method is sugar for assigning to a key if the existing value is not defined without having to call C and C explicitly. It returns the new value. Current API available since 0.005. =head1 OVERLOADING =head2 Boolean if ( $oh ) { ... } When used in boolean context, a Hash::Ordered object is true if it has any entries and false otherwise. =head2 String say "$oh"; When used in string context, a Hash::Ordered object stringifies like typical Perl objects. E.g. C Current API available since 0.005. =head2 Numeric $count = 0 + $oh; When used in numeric context, a Hash::Ordered object numifies as the decimal representation of its memory address, just like typical Perl objects. E.g. C<140268162536552> For the number of keys, call the L method in scalar context. Current API available since 0.005. =head2 Fallback Other L methods are derived from these three, if possible. =head1 TIED INTERFACE Using C is slower than using method calls directly. But for compatibility with libraries that can only take hashes, it's available if you really need it: tie my %hash, "Hash::Ordered", @pairs; If you want to access the underlying object for method calls, use C: tied( %hash )->unshift( @data ); Tied hash API available since 0.005. =head1 CAVEATS =head2 Deletion and order modification with push, pop, etc. This can be expensive, as the ordered list of keys has to be updated. For small hashes with no more than 25 keys, keys are found and spliced out with linear search. As an optimization for larger hashes, the first change to the ordered list of keys will construct an index to the list of keys. Thereafter, removed keys will be marked with a "tombstone" record. Tombstones will be garbage collected whenever the number of tombstones exceeds the number of valid keys. These internal implementation details largely shouldn't concern you. The important things to note are: =over 4 =item * The costs of efficient deletion are deferred until you need it =item * Deleting lots of keys will temporarily appear to leak memory until garbage collection occurs =back =head1 MOTIVATION For a long time, I used L for ordered hashes, but I grew frustrated with things it lacked, like a cheap way to copy an IxHash object or a convenient iterator when not using the tied interface. As I looked at its implementation, it seemed more complex than I though it needed, with an extra level of indirection that slows data access. Given that frustration, I started experimenting with the simplest thing I thought could work for an ordered hash: a hash of key-value pairs and an array with key order. As I worked on this, I also started searching for other modules doing similar things. What I found fell broadly into two camps: modules based on tie (even if they offered an OO interface), and pure OO modules. They all either lacked features I deemed necessary or else seemed overly-complex in either implementation or API. Hash::Ordered attempts to find the sweet spot with simple implementation, reasonably good efficiency for most common operations, and a rich, intuitive API. After discussions with Mario Roy about the potential use of Hash::Ordered with L, I optimized deletion of larger hashes and provided a tied interface for compatibility. Mario's suggestions and feedback about optimization were quite valuable. Thank you, Mario! =head1 SEE ALSO This section describes other ordered-hash modules I found on CPAN. For benchmarking results, see L. =head2 Tie modules The following modules offer some sort of tie interface. I don't like ties, in general, because of the extra indirection involved over a direct method call. Still, you can make any tied interface into a faster OO one with C: tied( %tied_hash )->FETCH($key); L is implemented in XS and thus seems promising if pure-Perl isn't a criterion; it generally fails tests on Perl 5.18 and above due to the hash randomization change. Despite being XS, it is slower than Hash::Ordered at everything exception creation and deletion. L is probably the most well known and includes an OO API. Given the performance problems it has, "well known" is the only real reason to use it. These other modules below have very specific designs/limitations and I didn't find any of them suitable for general purpose use: =over 4 =item * L — array elements split with separator; tie API only =item * L — ordered alphabetically; tie API only =item * L — ordered by insertion; tie API only =item * L — linked-list implementation; quite slow =item * L — ordered by last update; tie API only =back =head2 Other ordered hash modules Other modules stick with an object-oriented API, with a wide variety of implementation approaches. L is essentially an inverse implementation from Hash::Ordered. It keeps pairs in an array and uses a hash to index into the array. This indirection would already make hash-like operations slower, but the specific implementation makes it even worse, with abstractions and function calls that make getting or setting individual items up to 10x slower than Hash::Ordered. However, C takes an arrayref to initialize, which is very fast and can return the list of pairs faster, too. If you mostly create and list out very large ordered hashes and very rarely touch individual entries, I think this could be something to very cautiously consider. These other modules below have restrictions or particularly complicated implementations (often relying on C) and thus I didn't think any of them really suitable for use: =over 4 =item * L — arrays with named access; restricted keys =item * L — overloads array/hash deref and uses internal tied data =item * L — array of key-value hashrefs; allows duplicate keys =item * L — array of key-value hashrefs; no duplicate keys =item * L — blessed, tied hashref with doubly-linked-list =back =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. L git clone https://github.com/dagolden/Hash-Ordered.git =head1 AUTHOR David Golden =head1 CONTRIBUTORS =for stopwords Andy Lester Benct Philip Jonsson Mario Roy =over 4 =item * Andy Lester =item * Benct Philip Jonsson =item * Mario Roy =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Hash-Ordered-0.014/lib/Hash/Ordered/000755 000765 000024 00000000000 13510640204 017225 5ustar00davidstaff000000 000000 Hash-Ordered-0.014/lib/Hash/Ordered/Benchmarks.pod000644 000765 000024 00000035752 13510640204 022022 0ustar00davidstaff000000 000000 # PODNAME: Hash::Ordered::Benchmarks # ABSTRACT: Ordered hash benchmarking __END__ =pod =encoding UTF-8 =head1 NAME Hash::Ordered::Benchmarks - Ordered hash benchmarking =head1 VERSION version 0.014 =head1 INTRODUCTION The L internals are simple: a hash of data and an array of ordered keys. I thought this would perform well for common tasks and likely outperform more complicated ordered hash implementations, so I decided to do some benchmarking to test it. B: since the initial benchmarking, C gained just-in-time indexing of the keys array to support faster tombstone deletion, which adds some conditional data structures to the internals. It also now supports C. The revised benchmarks include the C mode for comparison with other tied hash implementations. =head1 MODULES TESTED In my review of alternatives to C, six seemed sufficiently general-purpose to be worth benchmarking. The modules tested are listed in the benchmark output in shorthand: =over 4 =item * L — denoted C =item * L — denoted C =item * L — denoted C =item * L — denoted C and marked with "*" =item * L — denoted C =item * L — denoted C =item * L — denoted C =back Note that L is written in XS and also may require forced installation as its tests often fail for Perl 5.18+ due to the hash randomization change. If there are different methods of doing something with a module, the variations are described in each section below. =head1 BENCHMARKS I conducted benchmarking with the L module. The test script is in the C directory of the distribution. Tests were run on Perl 5.20.2 on a Mac Book Pro (darwin-thread-multi-2level). Each benchmark ran for 5 CPU seconds. Benchmarks were run at several different scales to reveal differences in efficiency as hash size grows. The details are described in each section below. A seed list of keys and values was generated from random integers using L. The same seed list was used for all benchmarks unless otherwise noted. I did not test advanced features of these modules, as apples-to-apples comparison is difficult. Still, the performance on common, simple measures could suggest how features that combine these operations might perform. =head2 Ordered hash creation I tested hash creation for 10, 100 and 1000 elements. For some modules there were different options for creating a hash: =over 4 =item * C takes an array-reference with an option to use it directly or to clone it. In one case I provided the seed list array reference with the clone option to true ("a:ah_cp"). In another case I created a new array reference from the seed list and provided it directly ("a:ah_rf"). =item * C can be initialized either with C ("h:o_oo") or via C ("h:o_th"). =item * C can be initialized either with C ("t:ix_oo") or via C ("t:ix_th"). =item * C can be created with a list ("t:xh_ls") or an array reference ("t:xh_rf"). =back As expected, when C gets an array reference, it's very fast. C does well here, also. Of the non-XS, more hash-like choices, C does well. Results for ordered hash creation for 10 elements t:h:i 136030/s a:ah_rf 111411/s h:o_oo 101293/s * h:o_th 98646/s * t:ix_oo 61853/s t:ix_th 61715/s a:ah_cp 56375/s a:oh 54337/s t:llh 33553/s d:xh_ls 14068/s d:xh_rf 13926/s Results for ordered hash creation for 100 elements t:h:i 16503/s a:ah_rf 15398/s h:o_oo 11226/s * h:o_th 10793/s * a:oh 7783/s t:ix_th 7570/s t:ix_oo 7405/s a:ah_cp 7035/s t:llh 3533/s d:xh_ls 1561/s d:xh_rf 1550/s Results for ordered hash creation for 1000 elements t:h:i 1552/s a:ah_rf 1509/s h:o_oo 1160/s * h:o_th 1158/s * a:oh 815/s t:ix_th 772/s t:ix_oo 757/s a:ah_cp 684/s t:llh 340/s d:xh_ls 154/s d:xh_rf 152/s =head2 Getting hash elements I tested retrieving values for 10% of the keys, randomly selected, from hashes of 10, 100 and 1000 elements. The hash was created beforehand so the benchmarks reflect only element access. Some modules had choices for how to retrieve an value, usually between a method (denoted with "_oo"), tied hash access ("_th") or with a dereference ("_rf"). Generally, method calls turned out faster than other approaches for a given module, demonstrating the inefficiency of tied objects. Results for fetching ~10% of 10 elements h:o_oo 1844781/s * d:xh_oo 1292883/s t:ix_oo 1187104/s t:h:i 932793/s h:o_th 817346/s * d:xh_rf 703441/s t:ix_th 649291/s a:oh 560060/s t:llh 514911/s a:ah 260639/s Results for fetching ~10% of 100 elements h:o_oo 285983/s * d:xh_oo 183292/s t:ix_oo 165100/s t:h:i 128713/s h:o_th 107213/s * d:xh_rf 87049/s t:ix_th 79642/s a:oh 66109/s t:llh 58741/s a:ah 27533/s Results for fetching ~10% of 1000 elements h:o_oo 30342/s * d:xh_oo 19004/s t:ix_oo 17132/s t:h:i 13269/s h:o_th 11100/s * d:xh_rf 8919/s t:ix_th 7844/s a:oh 6763/s t:llh 5666/s a:ah 2772/s =head2 Setting hash elements I tested changing values for 10% of the keys, randomly selected, from hashes of 10, 100 and 1000 elements. The hash was created beforehand so the benchmarks reflect only element mutation. No new keys were added. Some modules had choices for how to modify a value, usually between a method (denoted with "_oo"), tied hash access ("_th") or with a dereference ("_rf"). Again, methods outperformed. Results for replacing ~10% of 10 elements h:o_oo 1378880/s * t:h:i 945403/s d:xh_oo 941643/s t:ix_oo 887283/s h:o_th 652269/s * t:llh 590160/s d:xh_rf 537694/s a:oh 530787/s t:ix_th 508001/s a:ah 159258/s Results for replacing ~10% of 100 elements h:o_oo 192769/s * t:h:i 126284/s d:xh_oo 119845/s t:ix_oo 113992/s h:o_th 81159/s * t:llh 72403/s d:xh_rf 64791/s a:oh 62666/s t:ix_th 59809/s a:ah 16405/s Results for replacing ~10% of 1000 elements h:o_oo 19909/s * t:h:i 13445/s d:xh_oo 12487/s t:ix_oo 11601/s h:o_th 8357/s * t:llh 7503/s d:xh_rf 6599/s a:oh 6410/s t:ix_th 6118/s a:ah 1651/s =head2 Adding hash elements I tested adding 10, 100 and 1000 elements to an empty hash. Some modules had choices for how to append a value, usually between a method (denoted with "_oo"), tied hash access ("_th") or with a dereference ("_rf"). For C, I did not use the "lazy" option, but did the equivalent using C and a method call: tied(%tllh)->last( irand(), 42 ) for 1 .. $n; Generally, it seemed like the differences were smaller than for other benchmarks. Methods still outperformed. Results for adding 10 elements to empty hash h:o_oo 341022/s * t:h:i 295079/s t:ix_oo 258981/s h:o_th 245996/s * t:ix_th 211341/s t:llh 191298/s a:oh 137447/s a:ah 112651/s d:xh_oo 87215/s d:xh_rf 80379/s Results for adding 100 elements to empty hash h:o_oo 58519/s * t:h:i 55166/s t:ix_oo 48658/s h:o_th 42066/s * t:ix_th 38632/s a:oh 34842/s t:llh 28384/s d:xh_oo 24841/s d:xh_rf 21517/s a:ah 13726/s Results for adding 1000 elements to empty hash h:o_oo 6497/s * t:h:i 6108/s t:ix_oo 5528/s h:o_th 4650/s * t:ix_th 4329/s a:oh 4233/s d:xh_oo 3121/s t:llh 3011/s d:xh_rf 2696/s a:ah 1423/s =head2 Deleting hash elements I tested creating hashes of 10, 100 and 1000 elements and then deleting 10% of the keys, chosen randomly. I would have liked to have isolated creation from deletion, but I couldn't figure out a way to do that given how C runs the same tests over and over. Some modules had choices for how to delete a value, usually between a method (denoted with "_oo"), tied hash access ("_th") or with a dereference ("_rf"). The performance changes (or lack thereof) at the three different sizes reveals implementation differences. (Though recall that some of this is the creation performance difference as well as deletion difference.) For example, C XS does very well, which could be its good creation performance, but could also be good deletion. C does linear search deleting a key for the 10 element hash, but automatically switches to indexed, tombstone deletion for the larger hashes. When deleting only 10% of keys, garbage collection of tombstoned keys never occurs, so that amortized cost is not included. C improves at larger sizes as deleting from a linked list is faster than splicing out an element of an array. Conversely, C just gets worse. Results for creating 10 element hash then deleting ~10% t:h:i 131578/s h:o_oo 94598/s * h:o_th 84018/s * a:ah 67109/s t:ix_oo 55477/s t:ix_th 52792/s a:oh 46938/s t:llh 30399/s d:xh_oo 13756/s d:xh_rf 13499/s Results for creating 100 element hash then deleting ~10% t:h:i 17420/s h:o_oo 9242/s * h:o_th 8438/s * a:oh 5738/s t:ix_oo 3922/s t:ix_th 3862/s a:ah 3286/s t:llh 3250/s d:xh_oo 1508/s d:xh_rf 1499/s Results for creating 1000 element hash then deleting ~10% t:h:i 1635/s h:o_oo 934/s * h:o_th 799/s * t:llh 319/s a:oh 204/s d:xh_oo 152/s d:xh_rf 151/s t:ix_oo 78/s t:ix_th 78/s a:ah 40/s =head2 Extracting the hash as a list I tested getting an ordered list of pairs from hashes of 10, 100 and 1000 elements. The hash was created beforehand so the benchmarks reflect only conversion to a list. Oddly, modules that usually have more than one way to do things don't for this. Even C doesn't really have an OO way to do it, so I did it longhand: @list = map { $_ => $tix_oo->FETCH($_) } $tix_oo->Keys; Because C keeps its internal representation as an ordered list of pairs, it outperforms the rest handily as it merely needs to dereference that data structure. Results for listing pairs of 10 element hash a:ah 321044/s h:o_oo 178288/s * t:ix_oo 89263/s t:h:i 79184/s h:o_th 56112/s * t:ix_th 48009/s a:oh 47433/s t:llh 37996/s d:xh 37439/s Results for listing pairs of 100 element hash a:ah 36399/s h:o_oo 19537/s * t:ix_oo 9049/s t:h:i 7768/s h:o_th 6254/s * a:oh 5060/s t:ix_th 4907/s d:xh 4122/s t:llh 3813/s Results for listing pairs of 1000 element hash a:ah 3784/s h:o_oo 1959/s * t:ix_oo 905/s t:h:i 773/s h:o_th 625/s * a:oh 523/s t:ix_th 492/s d:xh 427/s t:llh 377/s =head1 CONCLUSION With the exception of hash creation and element deletion, C generally outperformed the other ordered hash implementations. Even for creation, it was the fastest of the pure-Perl, hash-based implementations, often by a large margin. In the original release of C, deletion got worse as the hash size grew. The new JIT indexing with tombstones now makes deletion far faster than any pure-Perl implementation. C, with the opposite internal implementation compared to C, performs best at creation and listing pairs, but is dead last at element access and modification. I believe the poor performance is mostly due to extra indirection (e.g. an extra function call) and logic in the element access methods. For uses that don't require much element access and have lots of creation/serialization, it could still be a useful choice. Generally, every module that depends on C for some portion of its implementation pays a substantial performance penalty. Comparing C benchmarks with and without C for individual element operations shows how severe this penalty can be. C — likely because of its XS implementation — performs decently, but not well enough in my opinion to justify its use. As the author of C, I'm clearly biased, but I think these benchmarks make a very good case for it being the "go to" module for pure-Perl, general-purpose ordered hashes. =head1 AUTHOR David Golden =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Hash-Ordered-0.014/xt/author/000755 000765 000024 00000000000 13510640204 016145 5ustar00davidstaff000000 000000 Hash-Ordered-0.014/xt/release/000755 000765 000024 00000000000 13510640204 016263 5ustar00davidstaff000000 000000 Hash-Ordered-0.014/xt/release/distmeta.t000644 000765 000024 00000000172 13510640204 020262 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::MetaTests. use Test::CPAN::Meta; meta_yaml_ok(); Hash-Ordered-0.014/xt/author/critic.t000644 000765 000024 00000000201 13510640204 017600 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; use Test::Perl::Critic (-profile => "perlcritic.rc") x!! -e "perlcritic.rc"; all_critic_ok(); Hash-Ordered-0.014/xt/author/minimum-version.t000644 000765 000024 00000000152 13510640204 021466 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; use Test::MinimumVersion; all_minimum_version_ok( qq{5.010} ); Hash-Ordered-0.014/xt/author/test-version.t000644 000765 000024 00000000637 13510640204 021002 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.09 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 0, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; Hash-Ordered-0.014/xt/author/00-compile.t000644 000765 000024 00000002661 13510640204 020204 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More; plan tests => 2; my @module_files = ( 'Hash/Ordered.pm' ); # fake home for cpan-testers use File::Temp; local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 ); my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ); Hash-Ordered-0.014/xt/author/pod-syntax.t000644 000765 000024 00000000252 13510640204 020437 0ustar00davidstaff000000 000000 #!perl # 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(); Hash-Ordered-0.014/xt/author/portability.t000644 000765 000024 00000000322 13510640204 020671 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; eval 'use Test::Portability::Files'; plan skip_all => 'Test::Portability::Files required for testing portability' if $@; options(test_one_dot => 0); run_tests(); Hash-Ordered-0.014/xt/author/pod-spell.t000644 000765 000024 00000000704 13510640204 020232 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007005 use Test::Spelling 0.12; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ Andy Benchmarks Benct David Golden Hash IxHash JIT Jonsson Lester Mario Ordered Philip Roy andy bpjonsson concat dagolden darwin dec decrement decrementing incrementing lib marioeroy postdec postinc predec preinc tombstoned Hash-Ordered-0.014/xt/author/pod-coverage.t000644 000765 000024 00000000334 13510640204 020705 0ustar00davidstaff000000 000000 #!perl # 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' }); Hash-Ordered-0.014/t/tie.t000644 000765 000024 00000002065 13510640204 015424 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; use Test::More 0.96; use Test::FailWarnings; use Test::Deep '!blessed'; use Test::Fatal; binmode( Test::More->builder->$_, ":utf8" ) for qw/output failure_output todo_output/; use Hash::Ordered; use constant HO => "Hash::Ordered"; my %hash; tie %hash, HO; isa_ok( tied(%hash), HO, "tied hash" ); ok( !scalar %hash, "scalar \%hash is false when empty" ); tie %hash, "Hash::Ordered", 'a' .. 'z'; isa_ok( tied(%hash), HO, "tied hash" ); ok( scalar %hash, "scalar \%hash is true when populated" ); cmp_deeply( [%hash], [ 'a' .. 'z' ], 'tied hash is order-preserving' ); $hash{'zz'} = 42; cmp_deeply( [%hash], [ 'a' .. 'z', zz => 42 ], 'new keys append' ); is( $hash{'y'} = 23, 23, "setting returns value" ); cmp_deeply( [%hash], [ 'a' .. 'x', y => 23, zz => 42 ], 'setting replaces original value' ); ok( exists $hash{y}, "exists finds existing key" ); is( delete $hash{y}, 23, "deleting returns last value" ); ok( !exists $hash{y}, "exists doesn't find deleted key" ); done_testing; # vim: ts=4 sts=4 sw=4 et tw=75: Hash-Ordered-0.014/t/invariants.t000644 000765 000024 00000013432 13510640204 017021 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; use Test::More 0.96; ##use Test::FailWarnings; use Test::Deep '!blessed'; use Test::Fatal; binmode( Test::More->builder->$_, ":utf8" ) for qw/output failure_output todo_output/; use Hash::Ordered; use List::Util qw/max min shuffle/; use constant HO => "Hash::Ordered"; my $thresh = Hash::Ordered::_INDEX_THRESHOLD(); sub _invar { my ( $hash, $label ) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $label => sub { my $err = 0; my ( $data, $keys, $indx, $offs, $gcnt ) = @$hash; cmp_deeply( [ sort grep !ref($_), @$keys ], [ sort keys %$data ], "all keys in _DATA are in _KEYS" ) or $err++; my $tomb_cnt = scalar( grep ref($_), @$keys ); my $non_tomb_cnt = @$keys - $tomb_cnt; is( @$keys - $gcnt, $non_tomb_cnt, "_KEYS length minus _GCNT equals number of non-tombstone keys in _KEYS" ) or $err++; if (%$data) { ok( !ref( $keys->[0] ), "first element of _KEYS is not tombstone" ) or $err++; ok( !ref( $keys->[-1] ), "last element of _KEYS is not tombstone" ) or $err++; } # if indexing has kicked in, invariants change if ($indx) { pass("has _INDX"); # find unindexed on right my $on_right = 0; for my $i ( reverse 0 .. $#{$keys} ) { last if !ref( $keys->[$i] ); $on_right++; } ok( $gcnt <= @$keys / 2, "no more than half keys elements are tombstones" ) or $err++; is( max( values %$indx ) + $offs + $on_right, $#{$keys}, "max index value plus offset plus right-side-unindexed" ) or $err++; cmp_deeply( [ sort grep !ref($_), @$keys ], [ sort keys %$indx ], "all keys in _INDX are in _KEYS" ) or $err++; cmp_deeply( [ sort keys %$data ], [ sort keys %$indx ], "all keys in _DATA are in _INDX" ) or $err++; my $mis_indexed = grep { ref($_) } map { $keys->[ $_ + $offs ] } values %$indx; is( $mis_indexed, 0, "_INDX elements are all valid" ) or $err++; } else { pass("does not have _INDX"); is( $offs, 0, "_OFFS is zero without _INDX set" ) or $err++; is( $gcnt, 0, "_GCNT is zero without _INDX set" ) or $err++; } diag explain $hash if $err; }; } sub _new { my $size = shift; return $size ? HO->new( map { ( $_ => $_ ) } 0 .. $size - 1 ) : HO->new; } for my $size ( 0, int( $thresh / 3 ), $thresh + 1, 3 * $thresh ) { my ( $k, $v, @pairs ); my $l = "size $size"; # construct new hash, my $h = _new($size); _invar( $h, "$l: after creation" ); # delete some keys my @keys = shuffle $h->keys; my @sorted = sort { $a <=> $b } @keys; for ( 1 .. 3 ) { last unless @keys; $h->delete( shift(@keys) ); _invar( $h, "$l: deleted a key" ); } # clear and recreate $h->clear; _invar( $h, "$l: after clear" ); $h = _new($size); _invar( $h, "$l: after creation" ); next unless $size; # pop and push ( $k, $v ) = $h->pop; _invar( $h, "$l: after pop" ); $h->push( $k, $v ); _invar( $h, "$l: after push" ); # shift and unshift ( $k, $v ) = $h->shift; _invar( $h, "$l: after shift" ); $h->unshift( $k, $v ); _invar( $h, "$l: after unshift" ); # create tombstones at front $h->delete(1); $h->delete(2); _invar( $h, "$l: tombstones at key positions 1 & 2" ); $h->delete(0); _invar( $h, "$l: tombstones at key positions 0" ); $h->unshift( map { $_ => $_ } 0 .. 3 ); _invar( $h, "$l: keys 1, 2, 3 unshifted" ); # create tombstones at back $h->delete( $size - 3 ); $h->delete( $size - 2 ); _invar( $h, "$l: tombstones at key positions -3 & -2" ); $h->delete( $size - 1 ); _invar( $h, "$l: tombstones at key positions -1" ); $h->push( map { $_ => $_ } $size - 3 .. $size - 1 ); _invar( $h, "$l: keys from -3, -2, and -1 pushed back " ); # unshift and delete $h->unshift( "a", "b" ); _invar( $h, "$l: unshift value" ); $h->delete("a"); _invar( $h, "$l: delete unshifted value" ); # push and delete $h->push( "a", "b" ); _invar( $h, "$l: push value" ); $h->delete("a"); _invar( $h, "$l: delete pushed value" ); # set a reference $h->push( $h, 42 ); _invar( $h, "$l: pushed a reference" ); $h->delete($h); _invar( $h, "$l: deleted a reference" ); # delete remaining keys randomly $h->delete($_) for @keys; _invar( $h, "$l: remaining keys deleted" ); # set/delete all keys $h->clear; $h->set( $_ => -$_ ) for @keys; _invar( $h, "$l: set all keys" ); $h->delete($_) for @keys; _invar( $h, "$l: delete all keys" ); # double set $h->clear; $h->set( $_ => $_ ) for @sorted; $h->set( $_ => $_ ) for @sorted; _invar( $h, "$l: double set" ); # double merge $h->clear; $h->set( $_ => $_ ) for @keys; $h->set( $_ => $_ ) for @keys; _invar( $h, "$l: double merge" ); # double push $h->clear; $h->push( $_ => $_ ) for @sorted; $h->push( $_ => $_ ) for @sorted; _invar( $h, "$l: double push" ); # double unshift $h->clear; $h->unshift( $_ => $_ ) for @keys; $h->unshift( $_ => $_ ) for @keys; _invar( $h, "$l: double unshift" ); } { # construct hash with a reference my $ref = []; my $h = HO->new( $ref, 42 ); _invar( $h, "construct hash with reference as key" ); my $j = $h->clone($ref); _invar( $j, "clone hash with reference as key" ); } done_testing; Hash-Ordered-0.014/t/basic.t000644 000765 000024 00000027667 13510640204 015743 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; use Test::More 0.96; use Test::FailWarnings; use Test::Deep '!blessed'; use Test::Fatal; binmode( Test::More->builder->$_, ":utf8" ) for qw/output failure_output todo_output/; use Hash::Ordered; use constant HO => "Hash::Ordered"; subtest "constructors" => sub { my $hash; $hash = new_ok( HO, [], "new()" ); cmp_deeply( [ $hash->keys ], [], "empty keys" ); cmp_deeply( [ $hash->values ], [], "empty values" ); $hash = new_ok( HO, [ a => 1, b => 2 ], "new( \@pairs )" ); cmp_deeply( [ $hash->keys ], [qw/a b/], "keys ordered as expected" ); cmp_deeply( [ $hash->values ], [qw/1 2/], "values ordered as expected" ); like( exception { HO->new("a") }, qr/requires key-value pairs/, "unbalanced args throws exception" ); for my $size ( 10, 1000 ) { $hash = new_ok( HO, [ 1 .. $size * 2 ] ); $hash->delete(3); # trigger tombstone on large hash my $clone = $hash->clone; cmp_deeply( [ $clone->as_list ], [ $hash->as_list ], "clone() returns copy" ); my $same = $hash->clone( $hash->keys ); cmp_deeply( [ $same->as_list ], [ $hash->as_list ], "clone( keys )" ); my $rev = $hash->clone( reverse $hash->keys ); my $expected = [ map { $_ => $hash->get($_) } reverse $hash->keys ]; cmp_deeply( [ $rev->as_list ], $expected, "clone( reverse keys )" ); my $filter = $hash->clone('5'); cmp_deeply( [ $filter->as_list ], [ 5 => 6 ], "clone( '5' )" ); my $extra = $hash->clone( 'c', '1' ); cmp_deeply( [ $extra->as_list ], [ c => undef, 1 => 2 ], "clone( 'c', '1' )" ); } $hash = new_ok( HO, [ a => 1, b => 2, a => 2 ] ); cmp_deeply( [ $hash->keys ], [qw/a b/], "keys ordered as expected" ); cmp_deeply( [ $hash->values ], [qw/2 2/], "values ordered as expected" ); }; subtest "overloading" => sub { my $hash = new_ok( HO, [], "new()" ); ok( !$hash, "empty hash is boolean false" ); $hash->set( a => 1 ); ok( !!$hash, "non-empty hash is boolean true" ); $hash = new_ok( HO, [], "new()" ); like( "$hash", qr/\AHash::Ordered=ARRAY\(0x[0-9a-f]+\)\z/, "stringified gives typical Perl object string form" ); like( 0+ $hash, qr/\A\d+\z/, "numified gives typical Perl object decimal address" ); }; subtest "element methods" => sub { for my $size ( 10, 1000 ) { my $hash = new_ok( HO, [ 1 .. $size * 2 ] ); $hash->delete(3); # trigger tombstone on large hash my @keys = $hash->keys; my @values = $hash->values; ok( !$hash->exists("a"), "exists is false for non-existing element" ); is( $hash->get("a"), undef, "get on non-existing element returns undef" ); is( $hash->set( "a", 1 ), 1, "set on non-existing element returns new value" ); is( $hash->get("a"), 1, "get on existing element returns value" ); ok( $hash->exists("a"), "exists is true for existing element" ); is( $hash->set( "b", 2 ), 2, "set another key" ); cmp_deeply( [ $hash->keys ], [ @keys, qw/a b/ ], "keys ordered as expected" ); cmp_deeply( [ $hash->values ], [ @values, qw/1 2/ ], "values ordered as expected" ); is( $hash->delete("a"), 1, "delete existing key returns old value" ); is( $hash->delete("z"), undef, "delete non-existing key returns undef" ); is( $hash->set( "b", 9 ), 9, "set existing key" ); is( $hash->set( "c", 3 ), 3, "set another non-existent key" ); cmp_deeply( [ $hash->keys ], [ @keys, qw/b c/ ], "keys ordered as expected" ); cmp_deeply( [ $hash->values ], [ @values, qw/9 3/ ], "values ordered as expected" ); { my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_; return }; $hash->set( undef, 42 ); is( $hash->get(undef), 42, "undef is an acceptable key" ); for (@warnings) { like( $_, qr/uninitialized value/, "undef warning" ); } } } }; subtest "output and iteration" => sub { my $hash = new_ok( HO, [ 'a' .. 'z' ], "new('a'..'z')" ); cmp_deeply( [ $hash->as_list ], [ 'a' .. 'z' ], "as_list" ); cmp_deeply( [ $hash->as_list(qw/a c g zz/) ], [ a => 'b', c => 'd', g => 'h', zz => undef ], "as_list( keys )" ); my @slice = $hash->values(qw/a c zz g/); cmp_deeply( \@slice, [ 'b', 'd', undef, 'h' ], "values( keys )" ); my $iter = $hash->iterator; my @saw; while ( my ( $k, $v ) = $iter->() ) { push @saw, $k, $v; } cmp_deeply( [@saw], [ $hash->as_list ], "iterator walked hash in order" ) or diag explain \@saw; $iter = $hash->iterator( reverse $hash->keys ); @saw = (); while ( my ( $k, $v ) = $iter->() ) { unshift @saw, $k, $v; } cmp_deeply( [@saw], [ $hash->as_list ], "iterator( reverse keys ) walked hash in expected order" ) or diag explain \@saw; }; subtest "clear" => sub { my $hash = new_ok( HO, [ 'a' .. 'f' ], "new('a'..'f')" ); cmp_deeply( [ $hash->as_list ], [ 'a' .. 'f' ], "as_list returns non-empty list" ); is( $hash->clear, undef, "clearing hash returns undef" ); cmp_deeply( [ $hash->as_list ], [], "as_list returns empty list" ); cmp_deeply( $hash, HO->new, "cleared hash and new empty hash are equal" ); }; subtest "list methods" => sub { for my $size ( 10, 1000 ) { my @pairs = ( 1 .. $size * 2 ); my $hash = new_ok( HO, \@pairs ); $hash->delete(3); # trigger tombstone on large hash splice @pairs, 2, 2; # delete '3' and '4' my $hsize = $hash->keys; my $vsize = $hash->values; my $actual_size =()= keys %{ $hash->[0] }; is( $hsize, $actual_size, "keys gives size in scalar context" ); is( $vsize, $actual_size, "values gives size in scalar context" ); is( $hash->push( b => 2, c => 3 ), $hsize + 2, "pushing 2 new pairs" ); cmp_deeply( [ $hash->as_list ], [ @pairs, b => 2, c => 3 ], "hash keys/values correct after pushing new pairs" ); cmp_deeply( [ $hash->pop ], [ c => 3 ], "pop returns last pair" ); cmp_deeply( [ $hash->as_list ], [ @pairs, b => 2 ], "hash keys/values correct after pop" ); is( $hash->unshift( y => 25, z => 26 ), $hsize + 3, "unshifting 2 pairs" ); cmp_deeply( [ $hash->as_list ], [ y => 25, z => 26, @pairs, b => 2 ], "hash keys/values correct after unshifting new pairs" ); cmp_deeply( [ $hash->shift ], [ y => 25 ], "shift returns first pair" ); cmp_deeply( [ $hash->as_list ], [ z => 26, @pairs, b => 2 ], "hash keys/values correct after shifting" ); ok( $hash->push( z => 42 ), "pushing existing key with new value" ); cmp_deeply( [ $hash->as_list ], [ @pairs, b => 2, z => 42 ], "hash keys/values correct after pushing existing key" ); ok( $hash->unshift( z => 26 ), "unshifting existing key with new value" ); cmp_deeply( [ $hash->as_list ], [ z => 26, @pairs, b => 2 ], "hash keys/values correct after unshifting existing key" ); ok( $hash->merge( z => 2, c => 3, d => 4 ), "merging key-value pairs" ); cmp_deeply( [ $hash->as_list ], [ z => 2, @pairs, b => 2, c => 3, d => 4 ], "hash keys/values correct after merging pairs" ); # scalar context pop/shift { $hash->push( zz => 'aa' ); my $v = $hash->pop; is( $v, 'aa', "scalar pop returns value" ); $hash->unshift( yy => 'bb' ); $v = $hash->shift; is( $v, 'bb', "scalar shift returns value" ); } # termination checks { my $clone = $hash->clone; 1 while my ( $k, $v ) = $clone->pop; pass("pop terminates"); } { my $clone = $hash->clone; 1 while my ( $k, $v ) = $clone->shift; pass("shift terminates"); } } # empty hash tests { my $hash = new_ok(HO); my ( $k, $v ); ( $k, $v ) = $hash->pop; cmp_deeply( [ $k, $v ], [ undef, undef ], "pop empty in list context" ); ( $k, $v ) = $hash->shift; cmp_deeply( [ $k, $v ], [ undef, undef ], "shift empty in list context" ); $v = $hash->pop; is( $v, undef, "pop empty in scalar context" ); $v = $hash->shift; is( $v, undef, "shift empty in scalar context" ); } }; subtest "modifiers" => sub { my $hash = new_ok( HO, [ 'a' => 0 ] ); # preinc is( $hash->preinc('a'), 1, "preinc return" ); # add is( $hash->add( 'a', 2 ), 3, "add +2 return" ); is( $hash->add( 'a', -1 ), 2, "add -1 return" ); # postinc is( $hash->postinc('a'), '2', "postinc return" ); is( $hash->get('a'), 3, "value was incremented" ); # predec is( $hash->predec('a'), '2', "predec return" ); # postdec is( $hash->postdec('a'), '2', "postdec return" ); is( $hash->get('a'), 1, "value was decremented" ); # concat is( $hash->concat('a'), '1', "concat undef return" ); is( $hash->concat( 'a', 'a' ), '1a', "concat 'a' return" ); # or_equals is( $hash->or_equals( 'a', 42 ), '1a', "or_equals on existing key" ); is( $hash->or_equals( 'b', 0 ), '0', "or_equals on new key" ); is( $hash->or_equals( 'b', 42 ), '42', "or_equals on existing, false key" ); # dor_equals is( $hash->dor_equals( 'a', 23 ), '1a', "dor_equals on existing key" ); is( $hash->dor_equals( 'c', 0 ), '0', "dor_equals on new key" ); is( $hash->dor_equals( 'c', 42 ), '0', "dor_equals on existing, false key" ); }; subtest 'key ordering' => sub { my $hash = new_ok( HO, [] ); cmp_deeply( [ $hash->keys ], [], 'New hash has no keys' ); my $rc = $hash->set( 'Rogers' => 'Captain America' ); is( $rc, 'Captain America', 'Proper return value' ); cmp_deeply( [ $hash->keys ], [ 'Rogers' ], 'Added Rogers' ); cmp_deeply( [ $hash->values ], [ 'Captain America' ], 'Added Rogers' ); # Try to replace an existing entry with or_equals. $rc = $hash->or_equals( 'Rogers' => 'Human Torch' ); is( $rc, 'Captain America', 'Rogers is still Captain America' ); # Try to replace an existing entry with dor_equals. $rc = $hash->dor_equals( 'Rogers' => 'The Impossible Man' ); is( $rc, 'Captain America', 'Rogers is *still* Captain America' ); $rc = $hash->or_equals( 'Banner' => 'Hulk' ); is( $rc, 'Hulk', 'Proper return value' ); cmp_deeply( [ $hash->keys ], [ 'Rogers', 'Banner' ], 'Added Banner through or_equals' ); cmp_deeply( [ $hash->values ], [ 'Captain America', 'Hulk' ], 'Added Banner through or_equals' ); $rc = $hash->dor_equals( 'Romanoff' => 'Black Widow' ); is( $rc, 'Black Widow', 'Proper return value' ); cmp_deeply( [ $hash->keys ], [ 'Rogers', 'Banner', 'Romanoff' ], 'Added Romanoff through or_equals' ); cmp_deeply( [ $hash->values ], [ 'Captain America', 'Hulk', 'Black Widow' ], 'Added Romanoff through or_equals' ); # In Captain America #180, Rogers becomes Nomad. # Replace him with a call to push(). $rc = $hash->push( 'Rogers' => 'Nomad' ); is( $rc, 3, 'There are still three keys' ); cmp_deeply( [ $hash->keys ], [ 'Banner', 'Romanoff', 'Rogers' ], 'Changing Rogers puts him at the end of the list' ); cmp_deeply( [ $hash->values ], [ 'Hulk', 'Black Widow', 'Nomad' ], 'Changing Rogers puts him at the end of the list' ); }; done_testing; exit 0; Hash-Ordered-0.014/t/00-report-prereqs.t000644 000765 000024 00000013426 13510640204 020055 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.027 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'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $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 ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass; # vim: ts=4 sts=4 sw=4 et: Hash-Ordered-0.014/t/00-report-prereqs.dd000644 000765 000024 00000005611 13510640204 020176 0ustar00davidstaff000000 000000 do { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '6.17', 'perl' => '5.008' } }, 'develop' => { 'requires' => { 'Dist::Zilla' => '5', 'Dist::Zilla::Plugin::Meta::Contributors' => '0', 'Dist::Zilla::Plugin::ReleaseStatus::FromVersion' => '0', 'Dist::Zilla::PluginBundle::DAGOLDEN' => '0.072', 'File::Spec' => '0', 'File::Temp' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Pod::Coverage::TrustPod' => '0', 'Pod::Wordlist' => '0', 'Software::License::Apache_2_0' => '0', 'Test::CPAN::Meta' => '0', 'Test::MinimumVersion' => '0', 'Test::More' => '0', 'Test::Perl::Critic' => '0', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Portability::Files' => '0', 'Test::Spelling' => '0.12', 'Test::Version' => '1' } }, 'runtime' => { 'requires' => { 'Carp' => '0', 'constant' => '0', 'overload' => '0', 'perl' => '5.008', 'strict' => '0', 'warnings' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'List::Util' => '0', 'Test::Deep' => '0', 'Test::FailWarnings' => '0', 'Test::Fatal' => '0', 'Test::More' => '0.96', 'perl' => '5.008' } } }; $x; }Hash-Ordered-0.014/devel/bench-all.pl000644 000765 000024 00000027713 13510640204 017503 0ustar00davidstaff000000 000000 #!/usr/bin/env perl use v5.10; use strict; use warnings; use lib 'lib'; use List::Util qw/shuffle/; use Math::Random::MT::Auto qw/irand/; use Benchmark qw( countit ); use Hash::Ordered; use Tie::IxHash; use Tie::LLHash; use Tie::Hash::Indexed; use Array::AsHash; use Array::OrdHash; use Data::XHash; use constant COUNT => $ENV{COUNT} // 5; use constant NUMS => [ 10, 100, 1000 ]; STDOUT->autoflush(1); my %FILTER = $ENV{FILTER} ? ( map { $_ => 1 } split /,/, $ENV{FILTER} ) : (); my %PAIRS = ( map { $_ => [ map { irand() => irand() } 1 .. $_ ] } @{ NUMS() } ); sub time_them { my (%mark) = @_; my %results; my @mods = grep { %FILTER ? $FILTER{$_} : 1 } sort keys %mark; for my $k (@mods) { ## warn "Timing $k...\n"; my $res = countit( COUNT, $mark{$k} ); my $iter_s = $res->iters / ( $res->cpu_a + 1e-9 ); $results{$k} = $iter_s; } printf( "%20s %10s%s\n", $_, int( $results{$_} ) . "/s", $_ =~ /^h:o/ ? " *" : "" ) for sort { $results{$b} <=> $results{$a} } keys %results; say ""; } my %TESTS; #--------------------------------------------------------------------------# # Create with keys #--------------------------------------------------------------------------# $TESTS{create} = sub { for my $size ( @{ NUMS() } ) { say my $title = " Results for ordered hash creation for $size elements"; my %mark; $mark{"h:o_oo"} = sub { my $h = Hash::Ordered->new( @{ $PAIRS{$size} } ); }; $mark{"h:o_th"} = sub { tie my %h, 'Hash::Ordered', @{ $PAIRS{$size} }; }; $mark{"t:ix_oo"} = sub { my $h = Tie::IxHash->new( @{ $PAIRS{$size} } ); }; $mark{"t:ix_th"} = sub { tie my %h, 'Tie::IxHash', @{ $PAIRS{$size} }; }; $mark{"t:llh"} = sub { tie my %h, 'Tie::LLHash', @{ $PAIRS{$size} }; }; $mark{"t:h:i"} = sub { tie my %h, 'Tie::Hash::Indexed', @{ $PAIRS{$size} }; }; $mark{"a:ah_rf"} = sub { my $h = Array::AsHash->new( { array => [ @{ $PAIRS{$size} } ] } ); }; $mark{"a:ah_cp"} = sub { my $h = Array::AsHash->new( { array => $PAIRS{$size}, clone => 1 } ); }; $mark{"d:xh_ls"} = sub { my $h = Data::XHash::xh( @{ $PAIRS{$size} } ); }; $mark{"d:xh_rf"} = sub { my $h = Data::XHash::xhr( [ @{ $PAIRS{$size} } ] ); }; $mark{"a:oh"} = sub { my $h = Array::OrdHash->new( @{ $PAIRS{$size} } ); }; time_them(%mark); } }; #--------------------------------------------------------------------------# # Get values #--------------------------------------------------------------------------# $TESTS{get} = sub { for my $size ( @{ NUMS() } ) { say my $title = " Results for fetching ~10% of $size elements"; my $oh = Hash::Ordered->new( @{ $PAIRS{$size} } ); my $tix_oo = Tie::IxHash->new( @{ $PAIRS{$size} } ); my $aah = Array::AsHash->new( { array => [ @{ $PAIRS{$size} } ] } ); my $dxh = Data::XHash::xh( @{ $PAIRS{$size} } ); my $aoh = Array::OrdHash->new( @{ $PAIRS{$size} } ); tie my %ho_th, 'Hash::Ordered', @{ $PAIRS{$size} }; tie my %tix_th, 'Tie::IxHash', @{ $PAIRS{$size} }; tie my %tllh, 'Tie::LLHash', @{ $PAIRS{$size} }; tie my %thi, 'Tie::Hash::Indexed', @{ $PAIRS{$size} }; my ( %mark, $v ); my @keys = keys %{ { @{ $PAIRS{$size} } } }; my $n = int( .1 * scalar @keys ) || 1; my @lookup = map { $keys[ int( rand( scalar @keys ) ) ] } 1 .. $n; $mark{"h:o_oo"} = sub { $v = $oh->get($_) for @lookup }; $mark{"h:o_th"} = sub { $v = $ho_th{$_} for @lookup }; $mark{"t:ix_oo"} = sub { $v = $tix_oo->FETCH($_) for @lookup }; $mark{"t:ix_th"} = sub { $v = $tix_th{$_} for @lookup }; $mark{"t:llh"} = sub { $v = $tllh{$_} for @lookup }; $mark{"t:h:i"} = sub { $v = $thi{$_} for @lookup }; $mark{"a:ah"} = sub { $v = $aah->get($_) for @lookup }; $mark{"d:xh_oo"} = sub { $v = $dxh->fetch($_) for @lookup }; $mark{"d:xh_rf"} = sub { $v = $dxh->{$_} for @lookup }; $mark{"a:oh"} = sub { $v = $aoh->{$_} for @lookup }; time_them(%mark); } }; #--------------------------------------------------------------------------# # replace values #--------------------------------------------------------------------------# $TESTS{replace} = sub { for my $size ( @{ NUMS() } ) { say my $title = " Results for replacing ~10% of $size elements"; my $oh = Hash::Ordered->new( @{ $PAIRS{$size} } ); my $tix_oo = Tie::IxHash->new( @{ $PAIRS{$size} } ); my $aah = Array::AsHash->new( { array => [ @{ $PAIRS{$size} } ] } ); my $dxh = Data::XHash::xh( @{ $PAIRS{$size} } ); my $aoh = Array::OrdHash->new( @{ $PAIRS{$size} } ); tie my %ho_th, 'Hash::Ordered', @{ $PAIRS{$size} }; tie my %tix_th, 'Tie::IxHash', @{ $PAIRS{$size} }; tie my %tllh, 'Tie::LLHash', @{ $PAIRS{$size} }; tie my %thi, 'Tie::Hash::Indexed', @{ $PAIRS{$size} }; my ( %mark, $v ); my @keys = keys %{ { @{ $PAIRS{$size} } } }; my $n = int( .1 * scalar @keys ) || 1; my @lookup = map { $keys[ int( rand( scalar @keys ) ) ] } 1 .. $n; my $new_value = irand(); $mark{"h:o_oo"} = sub { $oh->set( $_, $new_value ) for @lookup }; $mark{"h:o_th"} = sub { $ho_th{$_} = $new_value for @lookup }; $mark{"t:ix_oo"} = sub { $tix_oo->STORE( $_, $new_value ) for @lookup }; $mark{"t:ix_th"} = sub { $tix_th{$_} = $new_value for @lookup }; $mark{"t:llh"} = sub { $tllh{$_} = $new_value for @lookup }; $mark{"t:h:i"} = sub { $thi{$_} = $new_value for @lookup }; $mark{"a:ah"} = sub { $aah->put( $_, $new_value ) for @lookup }; $mark{"d:xh_oo"} = sub { $dxh->store( $_, $new_value ) for @lookup }; $mark{"d:xh_rf"} = sub { $dxh->{$_} = $new_value for @lookup }; $mark{"a:oh"} = sub { $aoh->{$_} = $new_value for @lookup }; time_them(%mark); } }; #--------------------------------------------------------------------------# # adding values #--------------------------------------------------------------------------# $TESTS{add} = sub { for my $size ( @{ NUMS() } ) { say my $title = " Results for adding $size elements to empty hash"; my ( %mark, $v ); my @keys = keys %{ { @{ $PAIRS{$size} } } }; my $n = int( .1 * scalar @keys ) || 1; $mark{"h:o_oo"} = sub { my $oh = Hash::Ordered->new; $oh->set( irand(), 42 ) for 1 .. $n; }; $mark{"h:o_th"} = sub { tie my %ho_th, 'Hash::Ordered'; $ho_th{ irand() } = 42 for 1 .. $n }; $mark{"t:ix_oo"} = sub { my $tix_oo = Tie::IxHash->new(); $tix_oo->STORE( irand(), 42 ) for 1 .. $n; }; $mark{"t:ix_th"} = sub { tie my %tix_th, 'Tie::IxHash'; $tix_th{ irand() } = 42 for 1 .. $n }; $mark{"t:llh"} = sub { tie my %tllh, 'Tie::LLHash'; tied(%tllh)->last( irand(), 42 ) for 1 .. $n; }; $mark{"t:h:i"} = sub { tie my %thi, 'Tie::Hash::Indexed'; $thi{ irand() } = 42 for 1 .. $n; }; $mark{"a:ah"} = sub { my $aah = Array::AsHash->new(); $aah->put( irand(), 42 ) for 1 .. $n }; $mark{"d:xh_oo"} = sub { my $dxh = Data::XHash::xh(); $dxh->store( irand(), 42 ) for 1 .. $n }; $mark{"d:xh_rf"} = sub { my $dxh = Data::XHash::xh(); $dxh->{ irand() } = 42 for 1 .. $n }; $mark{"a:oh"} = sub { my $aoh = Array::OrdHash->new(); push @$aoh, irand(), 42 for 1 .. $n }; time_them(%mark); } }; #--------------------------------------------------------------------------# # delete values #--------------------------------------------------------------------------# $TESTS{delete} = sub { for my $size ( @{ NUMS() } ) { say my $title = " Results for creating $size element hash then deleting ~10%"; my ( %mark, $v ); my @keys = keys %{ { @{ $PAIRS{$size} } } }; my $n = int( .1 * scalar @keys ) || 1; my @lookup = map { $keys[ int( rand( scalar @keys ) ) ] } 1 .. $n; $mark{"h:o_oo"} = sub { my $oh = Hash::Ordered->new( @{ $PAIRS{$size} } ); $oh->delete($_) for @lookup; }; $mark{"h:o_th"} = sub { tie my %ho_th, 'Hash::Ordered', @{ $PAIRS{$size} }; delete $ho_th{$_} for @lookup; }; $mark{"t:ix_oo"} = sub { my $tix_oo = Tie::IxHash->new( @{ $PAIRS{$size} } ); $tix_oo->DELETE($_) for @lookup; }; $mark{"t:ix_th"} = sub { tie my %tix_th, 'Tie::IxHash', @{ $PAIRS{$size} }; delete $tix_th{$_} for @lookup; }; $mark{"t:llh"} = sub { tie my %tllh, 'Tie::LLHash', @{ $PAIRS{$size} }; delete $tllh{$_} for @lookup; }; $mark{"t:h:i"} = sub { tie my %thi, 'Tie::Hash::Indexed', @{ $PAIRS{$size} }; delete $thi{$_} for @lookup; }; $mark{"a:ah"} = sub { my $aah = Array::AsHash->new( { array => [ @{ $PAIRS{$size} } ] } ); $aah->delete($_) for @lookup; }; $mark{"d:xh_oo"} = sub { my $dxh = Data::XHash::xh( @{ $PAIRS{$size} } ); $dxh->delete($_) for @lookup; }; $mark{"d:xh_rf"} = sub { my $dxh = Data::XHash::xh( @{ $PAIRS{$size} } ); delete $dxh->{$_} for @lookup; }; $mark{"a:oh"} = sub { my $aoh = Array::OrdHash->new( @{ $PAIRS{$size} } ); delete $aoh->{$_} for @lookup; }; time_them(%mark); } }; #--------------------------------------------------------------------------# # list values #--------------------------------------------------------------------------# $TESTS{list} = sub { for my $size ( @{ NUMS() } ) { say my $title = " Results for listing pairs of $size element hash"; my $oh = Hash::Ordered->new( @{ $PAIRS{$size} } ); my $tix_oo = Tie::IxHash->new( @{ $PAIRS{$size} } ); my $aah = Array::AsHash->new( { array => [ @{ $PAIRS{$size} } ] } ); my $dxh = Data::XHash::xh( @{ $PAIRS{$size} } ); my $aoh = Array::OrdHash->new( @{ $PAIRS{$size} } ); tie my %ho_th, 'Hash::Ordered', @{ $PAIRS{$size} }; tie my %tix_th, 'Tie::IxHash', @{ $PAIRS{$size} }; tie my %tllh, 'Tie::LLHash', @{ $PAIRS{$size} }; tie my %thi, 'Tie::Hash::Indexed', @{ $PAIRS{$size} }; my ( %mark, @list ); $mark{"h:o_oo"} = sub { @list = $oh->as_list }; $mark{"h:o_th"} = sub { @list = %ho_th }; $mark{"t:ix_oo"} = sub { @list = map { $_ => $tix_oo->FETCH($_) } $tix_oo->Keys; }; $mark{"t:ix_th"} = sub { @list = %tix_th }; $mark{"t:llh"} = sub { @list = %tllh }; $mark{"t:h:i"} = sub { @list = %thi }; $mark{"a:ah"} = sub { @list = $aah->get_array }; $mark{"d:xh"} = sub { @list = $dxh->as_array }; $mark{"a:oh"} = sub { @list = %$aoh }; time_them(%mark); } }; #--------------------------------------------------------------------------# # main program #--------------------------------------------------------------------------# my @order = qw/create get replace add delete list/; for my $run ( @ARGV ? @ARGV : @order ) { if ( my $sub = $TESTS{$run} ) { $sub->(); } else { say "Unknown benchmark: $run"; } }