Hash-MoreUtils-0.06/000755 000765 000024 00000000000 13306502651 014206 5ustar00snostaff000000 000000 Hash-MoreUtils-0.06/Changes000644 000765 000024 00000002646 13306501125 015504 0ustar00snostaff000000 000000 Revision history for Hash-MoreUtils 0.06 2018-06-08 - update toolchain for modern perl environments including * automated regression test * test coverage analyzation * pod coverage - introducing common code style - introduce a bunch of missing functions: * slice_without (Thanks to Theo van Hoesel ) * slice_missing / slice_missing_map (Thanks to Christoph Zimmermann ) * slice_notdef / slice_notdef_map (Thanks to Christoph Zimmermann ) * slice_true / slice_true_map * slice_false / slice_false_map 0.05 2013-12-09 - Fix hashsort with sort block (Koichi Nakashima - http://nksm.name) 0.04 2013-10-04 - add slice_map family - Changes reformatted as per CPAN::Changes::Spec 0.03 2013-09-07 - Add documentation about intended behaviour of slice* when no list given (fixing RT#77429 and RT#57095), thanks to Titi Ala'ilima and Bernhard Graf - Changes reformatted as per CPAN::Changes::Spec - Move to GitHub.com 0.02 2010-04-28 - Taking maintainership (Jens Rehsack) - Implement optimized versions for slice, slice_exists and slice_def - Add test for each function to work proper with default keys - Add safe_reverse as wished in RT#48403 (Ed Davis) - Add test for hashsort 0.01 2005-11-05 - First version, released on an unsuspecting world. Hash-MoreUtils-0.06/MANIFEST000644 000765 000024 00000000440 13306502651 015335 0ustar00snostaff000000 000000 Changes lib/Hash/MoreUtils.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README.md t/00-load.t t/01-hash.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Hash-MoreUtils-0.06/t/000755 000765 000024 00000000000 13306502650 014450 5ustar00snostaff000000 000000 Hash-MoreUtils-0.06/README.md000644 000765 000024 00000017023 13306501140 015460 0ustar00snostaff000000 000000 # NAME Hash::MoreUtils - Provide the stuff missing in Hash::Util # SYNOPSIS use Hash::MoreUtils qw(:all); my %h = (foo => "bar", FOO => "BAR", true => 1, false => 0); my %s = slice \%h, qw(true false); # (true => 1, false => 0) my %f = slice_false \%h; # (false => 0) my %u = slice_grep { $_ =~ m/^[A-Z]/ }, \%h; # (FOO => "BAR") my %r = safe_reverse \%h; # (bar => "foo", BAR => "FOO", 0 => "false", 1 => "true") # DESCRIPTION Similar to [List::MoreUtils](https://metacpan.org/pod/List::MoreUtils), `Hash::MoreUtils` contains trivial but commonly-used functionality for hashes. The primary focus for the moment is providing a common API - speeding up by XS is far away at the moment. # FUNCTIONS ## `slice` HASHREF\[, LIST\] Returns a hash containing the (key, value) pair for every key in LIST. If no `LIST` is given, all keys are assumed as `LIST`. ## `slice_def` HASHREF\[, LIST\] As `slice`, but only includes keys whose values are defined. If no `LIST` is given, all keys are assumed as `LIST`. ## `slice_exists` HASHREF\[, LIST\] As `slice` but only includes keys which exist in the hashref. If no `LIST` is given, all keys are assumed as `LIST`. ## `slice_without` HASHREF\[, LIST \] As `slice` but without any (key/value) pair whose key is in LIST. If no `LIST` is given, in opposite to slice an empty list is assumed, thus nothing will be deleted. ## `slice_missing` HASHREF\[, LIST\] Returns a HASH containing the (key => undef) pair for every `LIST` element (as key) that does not exist hashref. If no `LIST` is given there are obviously no non-existent keys in `HASHREF` so the returned HASH is empty. ## `slice_notdef` HASHREF\[, LIST\] Searches for undefined slices with the given `LIST` elements as keys in the given `HASHREF`. Returns a `HASHREF` containing the slices (key -> undef) for every undefined item. To search for undefined slices `slice_notdef` needs a `LIST` with items to search for (as keys). If no `LIST` is given it returns an empty `HASHREF` even when the given `HASHREF` contains undefined slices. ## `slice_true` HASHREF\[, LIST\] A special `slice_grep` which returns only those elements of the hash which's values evaluates to `TRUE`. If no `LIST` is given, all keys are assumed as `LIST`. ## `slice_false` HASHREF\[, LIST\] A special `slice_grep` which returns only those elements of the hash which's values evaluates to `FALSE`. If no `LIST` is given, all keys are assumed as `LIST`. ## `slice_grep` BLOCK, HASHREF\[, LIST\] As `slice`, with an arbitrary condition. If no `LIST` is given, all keys are assumed as `LIST`. Unlike `grep`, the condition is not given aliases to elements of anything. Instead, `%_` is set to the contents of the hashref, to avoid accidentally auto-vivifying when checking keys or values. Also, 'uninitialized' warnings are turned off in the enclosing scope. ## `slice_map` HASHREF\[, MAP\] Returns a hash containing the (key, value) pair for every key in `MAP`. If no `MAP` is given, all keys of `HASHREF` are assumed mapped to themselves. ## `slice_def_map` HASHREF\[, MAP\] As `slice_map`, but only includes keys whose values are defined. If no `MAP` is given, all keys of `HASHREF` are assumed mapped to themselves. ## `slice_exists_map` HASHREF\[, MAP\] As `slice_map` but only includes keys which exist in the hashref. If no `MAP` is given, all keys of `HASHREF` are assumed mapped to themselves. ## `slice_missing_map` HASHREF\[, MAP\] As `slice_missing` but checks for missing keys (of `MAP`) and map to the value (of `MAP`) as key in the returned HASH. The slices of the returned `HASHREF` are always undefined. If no `MAP` is given, `slice_missing` will be used on `HASHREF` which will return an empty HASH. ## `slice_notdef_map` HASHREF\[, MAP\] As `slice_notdef` but checks for undefined keys (of `MAP`) and map to the value (of `MAP`) as key in the returned HASH. If no `MAP` is given, `slice_notdef` will be used on `HASHREF` which will return an empty HASH. ## `slice_true_map` HASHREF\[, MAP\] As `slice_map`, but only includes pairs whose values are `TRUE`. If no `MAP` is given, all keys of `HASHREF` are assumed mapped to themselves. ## `slice_false_map` HASHREF\[, MAP\] As `slice_map`, but only includes pairs whose values are `FALSE`. If no `MAP` is given, all keys of `HASHREF` are assumed mapped to themselves. ## `slice_grep_map` BLOCK, HASHREF\[, MAP\] As `slice_map`, with an arbitrary condition. If no `MAP` is given, all keys of `HASHREF` are assumed mapped to themselves. Unlike `grep`, the condition is not given aliases to elements of anything. Instead, `%_` is set to the contents of the hashref, to avoid accidentally auto-vivifying when checking keys or values. Also, 'uninitialized' warnings are turned off in the enclosing scope. ## `hashsort` \[BLOCK,\] HASHREF my @array_of_pairs = hashsort \%hash; my @pairs_by_length = hashsort sub { length($a) <=> length($b) }, \%hash; Returns the (key, value) pairs of the hash, sorted by some property of the keys. By default (if no sort block given), sorts the keys with `cmp`. I'm not convinced this is useful yet. If you can think of some way it could be more so, please let me know. ## `safe_reverse` \[BLOCK,\] HASHREF my %dup_rev = safe_reverse \%hash sub croak_dup { my ($k, $v, $r) = @_; exists( $r->{$v} ) and croak "Cannot safe reverse: $v would be mapped to both $k and $r->{$v}"; $v; }; my %easy_rev = safe_reverse \&croak_dup, \%hash Returns safely reversed hash (value, key pairs of original hash). If no `BLOCK` is given, following routine will be used: sub merge_dup { my ($k, $v, $r) = @_; return exists( $r->{$v} ) ? ( ref($r->{$v}) ? [ @{$r->{$v}}, $k ] : [ $r->{$v}, $k ] ) : $k; }; The `BLOCK` will be called with 3 arguments: - `key` The key from the `( key, value )` pair in the original hash - `value` The value from the `( key, value )` pair in the original hash - `ref-hash` Reference to the reversed hash (read-only) The `BLOCK` is expected to return the value which will used for the resulting hash. # AUTHOR Hans Dieter Pearcey, ``, Jens Rehsack, `` # BUGS Please report any bugs or feature requests to `bug-hash-moreutils@rt.cpan.org`, or through the web interface at [http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Hash-MoreUtils](http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Hash-MoreUtils). I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. # SUPPORT You can find documentation for this module with the perldoc command. perldoc Hash::MoreUtils You can also look for information at: - RT: CPAN's request tracker [http://rt.cpan.org/NoAuth/Bugs.html?Dist=Hash-MoreUtils](http://rt.cpan.org/NoAuth/Bugs.html?Dist=Hash-MoreUtils) - AnnoCPAN: Annotated CPAN documentation [http://annocpan.org/dist/Hash-MoreUtils](http://annocpan.org/dist/Hash-MoreUtils) - CPAN Ratings [http://cpanratings.perl.org/d/Hash-MoreUtils](http://cpanratings.perl.org/d/Hash-MoreUtils) - Search CPAN [http://search.cpan.org/dist/Hash-MoreUtils/](http://search.cpan.org/dist/Hash-MoreUtils/) # ACKNOWLEDGEMENTS # COPYRIGHT & LICENSE Copyright 2005 Hans Dieter Pearcey, all rights reserved. Copyright 2010-2018 Jens Rehsack This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. Hash-MoreUtils-0.06/MANIFEST.SKIP000644 000765 000024 00000000515 13267356547 016126 0ustar00snostaff000000 000000 \B\.svn\b \B\.git\b \.gitignore$ .travis.yml \.[Bb][Aa][Kk]$ \.orig$ \.old$ \.tdy$ \.tmp$ \..*swp ^Makefile$ ^Build$ ^Build\.bat$ \.Inline/.* _Inline/.* \.bak$ \.tar$ \.tgz$ \.tar\.gz$ ^mess/ ^tmp/ ^testdata/ ^blib/ ^sandbox/ ^pm_to_blib$ ^cover_db/ ^_build/.* ~$ .*\.planner ^\..* Hash-MoreUtils-.* \bxt ^MYMETA\.json$ ^MYMETA\..*$ Hash-MoreUtils-0.06/META.yml000644 000765 000024 00000001521 13306502650 015455 0ustar00snostaff000000 000000 --- abstract: 'Provide the stuff missing in Hash::Util' author: - 'Hans Dieter Pearcey ' - 'Jens Rehsack ' build_requires: Test::More: '0.9' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Hash-MoreUtils no_index: directory: - t - inc requires: perl: v5.8.1 resources: bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Hash-MoreUtils homepage: https://metacpan.org/release/Hash-MoreUtils license: http://dev.perl.org/licenses/ repository: https://github.com/perl5-utils/Hash-MoreUtils.git version: '0.06' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Hash-MoreUtils-0.06/lib/000755 000765 000024 00000000000 13306502650 014753 5ustar00snostaff000000 000000 Hash-MoreUtils-0.06/Makefile.PL000644 000765 000024 00000010725 13267373135 016176 0ustar00snostaff000000 000000 use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker; my %RUN_DEPS = (); my %CONFIGURE_DEPS = ( 'ExtUtils::MakeMaker' => 0, ); my %BUILD_DEPS = (); my %TEST_DEPS = ( 'Test::More' => 0.90, ); WriteMakefile1( MIN_PERL_VERSION => '5.008001', META_ADD => { 'meta-spec' => {version => 2}, resources => { homepage => 'https://metacpan.org/release/Hash-MoreUtils', repository => { url => 'https://github.com/perl5-utils/Hash-MoreUtils.git', web => 'https://github.com/perl5-utils/Hash-MoreUtils', type => 'git', }, bugtracker => { web => 'http://rt.cpan.org/Public/Dist/Display.html?Name=Hash-MoreUtils', mailto => 'bug-Hash-MoreUtils@rt.cpan.org', }, license => 'http://dev.perl.org/licenses/', }, prereqs => { develop => { requires => { 'Test::CPAN::Changes' => 0, 'Test::CheckManifest' => 0, 'Module::CPANTS::Analyse' => '0.96', 'Test::Kwalitee' => 0, 'Test::Pod' => 0, 'Test::Pod::Coverage' => 0, 'Test::Pod::Spelling::CommonMistakes' => 0, 'Test::Spelling' => 0, 'Test::Perl::Critic' => 0, 'Test::PerlTidy' => 0, }, }, configure => { requires => {%CONFIGURE_DEPS}, }, build => {requires => {%BUILD_DEPS}}, test => {requires => {%TEST_DEPS}}, runtime => { requires => { %RUN_DEPS, perl => '5.8.1', }, }, }, }, NAME => 'Hash::MoreUtils', VERSION_FROM => 'lib/Hash/MoreUtils.pm', ABSTRACT_FROM => 'lib/Hash/MoreUtils.pm', LICENSE => 'perl', AUTHOR => ['Hans Dieter Pearcey ', 'Jens Rehsack '], CONFIGURE_REQUIRES => \%CONFIGURE_DEPS, PREREQ_PM => \%RUN_DEPS, BUILD_REQUIRES => \%BUILD_DEPS, TEST_REQUIRES => \%TEST_DEPS, test => {TESTS => 't/*.t xt/*.t'}, ); sub WriteMakefile1 { # originally written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params = @_; my $eumm_version = $ExtUtils::MakeMaker::VERSION; $eumm_version = eval $eumm_version; die "EXTRA_META is deprecated" if (exists($params{EXTRA_META})); die "License not specified" if (!exists($params{LICENSE})); $params{TEST_REQUIRES} and $eumm_version < 6.6303 and $params{BUILD_REQUIRES} = {%{$params{BUILD_REQUIRES} || {}}, %{delete $params{TEST_REQUIRES}}}; #EUMM 6.5502 has problems with BUILD_REQUIRES $params{BUILD_REQUIRES} and $eumm_version < 6.5503 and $params{PREREQ_PM} = {%{$params{PREREQ_PM} || {}}, %{delete $params{BUILD_REQUIRES}}}; ref $params{AUTHOR} and "ARRAY" eq ref $params{AUTHOR} and $eumm_version < 6.5702 and $params{AUTHOR} = join(", ", @{$params{AUTHOR}}); delete $params{CONFIGURE_REQUIRES} if ($eumm_version < 6.52); delete $params{MIN_PERL_VERSION} if ($eumm_version < 6.48); delete $params{META_MERGE} if ($eumm_version < 6.46); delete $params{META_ADD}{prereqs} if ($eumm_version < 6.58); delete $params{META_ADD}{'meta-spec'} if ($eumm_version < 6.58); delete $params{META_ADD} if ($eumm_version < 6.46); delete $params{LICENSE} if ($eumm_version < 6.31); delete $params{AUTHOR} if ($] < 5.005); delete $params{ABSTRACT_FROM} if ($] < 5.005); delete $params{BINARY_LOCATION} if ($] < 5.005); # more or less taken from Moose' Makefile.PL if ($params{CONFLICTS}) { my $ok = CheckConflicts(%params); exit(0) if ($params{PREREQ_FATAL} and not $ok); my $cpan_smoker = grep { $_ =~ m/(?:CR_SMOKER|CPAN_REPORTER|AUTOMATED_TESTING)/ } keys %ENV; unless ($cpan_smoker || $ENV{PERL_MM_USE_DEFAULT}) { sleep 4 unless ($ok); } delete $params{CONFLICTS}; } WriteMakefile(%params); } Hash-MoreUtils-0.06/META.json000644 000765 000024 00000003754 13306502651 015640 0ustar00snostaff000000 000000 { "abstract" : "Provide the stuff missing in Hash::Util", "author" : [ "Hans Dieter Pearcey ", "Jens Rehsack " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Hash-MoreUtils", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Module::CPANTS::Analyse" : "0.96", "Test::CPAN::Changes" : "0", "Test::CheckManifest" : "0", "Test::Kwalitee" : "0", "Test::Perl::Critic" : "0", "Test::PerlTidy" : "0", "Test::Pod" : "0", "Test::Pod::Coverage" : "0", "Test::Pod::Spelling::CommonMistakes" : "0", "Test::Spelling" : "0" } }, "runtime" : { "requires" : { "perl" : "v5.8.1" } }, "test" : { "requires" : { "Test::More" : "0.9" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Hash-MoreUtils@rt.cpan.org", "web" : "http://rt.cpan.org/Public/Dist/Display.html?Name=Hash-MoreUtils" }, "homepage" : "https://metacpan.org/release/Hash-MoreUtils", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://github.com/perl5-utils/Hash-MoreUtils.git", "web" : "https://github.com/perl5-utils/Hash-MoreUtils" } }, "version" : "0.06", "x_serialization_backend" : "JSON::PP version 2.27400_02" } Hash-MoreUtils-0.06/lib/Hash/000755 000765 000024 00000000000 13306502650 015636 5ustar00snostaff000000 000000 Hash-MoreUtils-0.06/lib/Hash/MoreUtils.pm000644 000765 000024 00000030047 13306500101 020110 0ustar00snostaff000000 000000 package Hash::MoreUtils; use strict; use warnings; use vars qw(@EXPORT_OK %EXPORT_TAGS $VERSION); use base 'Exporter'; %EXPORT_TAGS = ( all => [ qw(slice slice_def slice_exists slice_without slice_missing), qw(slice_notdef slice_true slice_false slice_grep), qw(slice_map slice_def_map slice_exists_map slice_missing_map), qw(slice_notdef_map slice_true_map slice_false_map slice_grep_map), qw(hashsort safe_reverse) ], ); @EXPORT_OK = (@{$EXPORT_TAGS{all}}); $VERSION = '0.06'; =head1 NAME Hash::MoreUtils - Provide the stuff missing in Hash::Util =head1 SYNOPSIS use Hash::MoreUtils qw(:all); my %h = (foo => "bar", FOO => "BAR", true => 1, false => 0); my %s = slice \%h, qw(true false); # (true => 1, false => 0) my %f = slice_false \%h; # (false => 0) my %u = slice_grep { $_ =~ m/^[A-Z]/ }, \%h; # (FOO => "BAR") my %r = safe_reverse \%h; # (bar => "foo", BAR => "FOO", 0 => "false", 1 => "true") =head1 DESCRIPTION Similar to L, C contains trivial but commonly-used functionality for hashes. The primary focus for the moment is providing a common API - speeding up by XS is far away at the moment. =head1 FUNCTIONS =head2 C HASHREF[, LIST] Returns a hash containing the (key, value) pair for every key in LIST. If no C is given, all keys are assumed as C. =head2 C HASHREF[, LIST] As C, but only includes keys whose values are defined. If no C is given, all keys are assumed as C. =head2 C HASHREF[, LIST] As C but only includes keys which exist in the hashref. If no C is given, all keys are assumed as C. =head2 C HASHREF[, LIST ] As C but without any (key/value) pair whose key is in LIST. If no C is given, in opposite to slice an empty list is assumed, thus nothing will be deleted. =head2 C HASHREF[, LIST] Returns a HASH containing the (key => undef) pair for every C element (as key) that does not exist hashref. If no C is given there are obviously no non-existent keys in C so the returned HASH is empty. =head2 C HASHREF[, LIST] Searches for undefined slices with the given C elements as keys in the given C. Returns a C containing the slices (key -> undef) for every undefined item. To search for undefined slices C needs a C with items to search for (as keys). If no C is given it returns an empty C even when the given C contains undefined slices. =head2 C HASHREF[, LIST] A special C which returns only those elements of the hash which's values evaluates to C. If no C is given, all keys are assumed as C. =head2 C HASHREF[, LIST] A special C which returns only those elements of the hash which's values evaluates to C. If no C is given, all keys are assumed as C. =head2 C BLOCK, HASHREF[, LIST] As C, with an arbitrary condition. If no C is given, all keys are assumed as C. Unlike C, the condition is not given aliases to elements of anything. Instead, C<< %_ >> is set to the contents of the hashref, to avoid accidentally auto-vivifying when checking keys or values. Also, 'uninitialized' warnings are turned off in the enclosing scope. =cut sub slice { my ($href, @list) = @_; @list and return map { $_ => $href->{$_} } @list; return %{$href}; } sub slice_exists { my ($href, @list) = @_; @list or @list = keys %{$href}; return map { $_ => $href->{$_} } grep { exists($href->{$_}) } @list; } sub slice_without { my ($href, @list) = @_; @list or return %{$href}; local %_ = %{$href}; delete $_{$_} for @list; return %_; } sub slice_def { my ($href, @list) = @_; @list or @list = keys %{$href}; return map { $_ => $href->{$_} } grep { defined($href->{$_}) } @list; } sub slice_missing { my ($href, @list) = @_; @list or return (); return map { $_ => undef } grep { !exists($href->{$_}) } @list; } sub slice_notdef { my ($href, @list) = @_; @list or return (); return map { $_ => undef } grep { !defined($href->{$_}) } @list; } sub slice_true { my ($href, @list) = @_; @list or @list = keys %{$href}; return map { $_ => $href->{$_} } grep { defined $href->{$_} and $href->{$_} } @list; } sub slice_false { my ($href, @list) = @_; @list or @list = keys %{$href}; return map { $_ => $href->{$_} } grep { not $href->{$_} } @list; } ## no critic (Subroutines::ProhibitSubroutinePrototypes) sub slice_grep (&@) { my ($code, $href, @list) = @_; local %_ = %{$href}; @list or @list = keys %{$href}; no warnings 'uninitialized'; ## no critic (TestingAndDebugging::ProhibitNoWarnings) return map { ($_ => $_{$_}) } grep { $code->($_) } @list; } use warnings; =head2 C HASHREF[, MAP] Returns a hash containing the (key, value) pair for every key in C. If no C is given, all keys of C are assumed mapped to themselves. =head2 C HASHREF[, MAP] As C, but only includes keys whose values are defined. If no C is given, all keys of C are assumed mapped to themselves. =head2 C HASHREF[, MAP] As C but only includes keys which exist in the hashref. If no C is given, all keys of C are assumed mapped to themselves. =head2 C HASHREF[, MAP] As C but checks for missing keys (of C) and map to the value (of C) as key in the returned HASH. The slices of the returned C are always undefined. If no C is given, C will be used on C which will return an empty HASH. =head2 C HASHREF[, MAP] As C but checks for undefined keys (of C) and map to the value (of C) as key in the returned HASH. If no C is given, C will be used on C which will return an empty HASH. =head2 C HASHREF[, MAP] As C, but only includes pairs whose values are C. If no C is given, all keys of C are assumed mapped to themselves. =head2 C HASHREF[, MAP] As C, but only includes pairs whose values are C. If no C is given, all keys of C are assumed mapped to themselves. =head2 C BLOCK, HASHREF[, MAP] As C, with an arbitrary condition. If no C is given, all keys of C are assumed mapped to themselves. Unlike C, the condition is not given aliases to elements of anything. Instead, C<< %_ >> is set to the contents of the hashref, to avoid accidentally auto-vivifying when checking keys or values. Also, 'uninitialized' warnings are turned off in the enclosing scope. =cut sub slice_map { my ($href, %map) = @_; %map and return map { $map{$_} => $href->{$_} } keys %map; return %{$href}; } sub slice_exists_map { my ($href, %map) = @_; %map or return slice_exists($href); return map { $map{$_} => $href->{$_} } grep { exists($href->{$_}) } keys %map; } sub slice_missing_map { my ($href, %map) = @_; %map or return slice_missing($href); return map { $map{$_} => undef } grep { !exists($href->{$_}) } keys %map; } sub slice_notdef_map { my ($href, %map) = @_; %map or return slice_notdef($href); return map { $map{$_} => $href->{$_} } grep { !defined($href->{$_}) } keys %map; } sub slice_def_map { my ($href, %map) = @_; %map or return slice_def($href); return map { $map{$_} => $href->{$_} } grep { defined($href->{$_}) } keys %map; } sub slice_true_map { my ($href, %map) = @_; %map or return slice_true($href); return map { $map{$_} => $href->{$_} } grep { defined $href->{$_} and $href->{$_} } keys %map; } sub slice_false_map { my ($href, %map) = @_; %map or return slice_false($href); return map { $map{$_} => $href->{$_} } grep { not $href->{$_} } keys %map; } sub slice_grep_map (&@) { my ($code, $href, %map) = @_; %map or return goto &slice_grep; local %_ = %{$href}; no warnings 'uninitialized'; ## no critic (TestingAndDebugging::ProhibitNoWarnings) return map { ($map{$_} => $_{$_}) } grep { $code->($_) } keys %map; } use warnings; =head2 C [BLOCK,] HASHREF my @array_of_pairs = hashsort \%hash; my @pairs_by_length = hashsort sub { length($a) <=> length($b) }, \%hash; Returns the (key, value) pairs of the hash, sorted by some property of the keys. By default (if no sort block given), sorts the keys with C. I'm not convinced this is useful yet. If you can think of some way it could be more so, please let me know. =cut sub hashsort { my ($code, $hash) = @_; $hash or return map { ($_ => $hash->{$_}) } sort { $a cmp $b } keys %{$hash = $code}; # Localise $a, $b my ($caller_a, $caller_b) = do { my $pkg = caller(); ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; (\*{$pkg . '::a'}, \*{$pkg . '::b'}); }; ## no critic (Variables::RequireInitializationForLocalVars) local (*$caller_a, *$caller_b); ## no critic (BuiltinFunctions::RequireSimpleSortBlock) return map { ($_ => $hash->{$_}) } sort { (*$caller_a, *$caller_b) = (\$a, \$b); $code->(); } keys %$hash; } =head2 C [BLOCK,] HASHREF my %dup_rev = safe_reverse \%hash sub croak_dup { my ($k, $v, $r) = @_; exists( $r->{$v} ) and croak "Cannot safe reverse: $v would be mapped to both $k and $r->{$v}"; $v; }; my %easy_rev = safe_reverse \&croak_dup, \%hash Returns safely reversed hash (value, key pairs of original hash). If no C<< BLOCK >> is given, following routine will be used: sub merge_dup { my ($k, $v, $r) = @_; return exists( $r->{$v} ) ? ( ref($r->{$v}) ? [ @{$r->{$v}}, $k ] : [ $r->{$v}, $k ] ) : $k; }; The C will be called with 3 arguments: =over 8 =item C The key from the C<< ( key, value ) >> pair in the original hash =item C The value from the C<< ( key, value ) >> pair in the original hash =item C Reference to the reversed hash (read-only) =back The C is expected to return the value which will used for the resulting hash. =cut sub safe_reverse { my ($code, $hash) = @_; unless ($hash) { $hash = $code; $code = sub { my ($k, $v, $r) = @_; return exists($r->{$v}) ? (ref($r->{$v}) ? [@{$r->{$v}}, $k] : [$r->{$v}, $k]) : $k; }; } my %reverse; while (my ($key, $val) = each %{$hash}) { $reverse{$val} = &{$code}($key, $val, \%reverse); } return %reverse; } 1; =head1 AUTHOR Hans Dieter Pearcey, C<< >>, Jens Rehsack, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Hash::MoreUtils You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2005 Hans Dieter Pearcey, all rights reserved. Copyright 2010-2018 Jens Rehsack This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut 1; # End of Hash::MoreUtils Hash-MoreUtils-0.06/t/00-load.t000644 000765 000024 00000000232 13267357767 016015 0ustar00snostaff000000 000000 #!perl -T use Test::More tests => 1; BEGIN { use_ok('Hash::MoreUtils'); } diag("Testing Hash::MoreUtils $Hash::MoreUtils::VERSION, Perl $], $^X"); Hash-MoreUtils-0.06/t/01-hash.t000644 000765 000024 00000022425 13306443670 016011 0ustar00snostaff000000 000000 #!perl use strict; use warnings; use Test::More; use Hash::MoreUtils qw(:all); my %e; my %h = ( a => 1, b => 2, c => undef ); my %H = ( a => 1, b => 2, c => undef, d => 0, D => "0E0", C => !!$h{c}, ); is_deeply({slice(\%h, qw(a))}, {a => 1}, "simple slice",); is_deeply( {slice(\%h, qw(a d))}, { a => 1, d => undef }, "slice to nonexistent", ); is_deeply( {slice(\%h)}, { a => 1, b => 2, c => undef }, "slice with default keys", ); is_deeply({slice_def(\%h, qw(a c d))}, {a => 1}, "slice_def undef + nonexistent",); ok(!exists $h{d}, "slice_def didn't autovivify d"); is_deeply( {slice_exists(\%h, qw(a c d))}, { a => 1, c => undef }, "slice_exists nonexistent", ); ok(!exists $h{d}, "slice_exists didn't autovivify d"); is_deeply( {slice_exists(\%h)}, { a => 1, b => 2, c => undef }, "slice_exists with default keys", ); is_deeply( {slice_without(\%h, qw(a d))}, { b => 2, c => undef }, "slice_without did withold the right keys", ); is_deeply( {slice_without(\%h)}, { a => 1, b => 2, c => undef }, "slice_without did not withold anything with default keys", ); my %r = slice_without(\%h, qw(b d)); my %d = slice_without(\%h, keys %r); is_deeply({%d}, {b => 2}, "slice_without only witheld the (key/value) pairs from list"); is_deeply({slice_missing(\%h, qw(a b f))}, {f => undef}, "slice_missing with given list",); is_deeply({slice_missing(\%h)}, {}, "slice_missing without list",); is_deeply({slice_missing(\%h, ())}, {}, "slice_missing with empty list",); is_deeply({slice_missing(\%e)}, {}, "slice_missing on empty hash",); is_deeply({slice_missing(\%e, qw(a))}, {a => undef}, "slice_missing on empty hash with given list",); is_deeply( {slice_notdef(\%h, qw(a b c d))}, { c => undef, d => undef }, "slice_notdef on undefined", ); is_deeply({slice_notdef(\%h)}, {}, "slice_notdef with default list",); is_deeply( {slice_def \%h}, { a => 1, b => 2 }, "slice_def with default keys", ); is_deeply( {slice_true \%H}, { a => 1, b => 2, D => "0E0" }, "slice_true on all keys" ); is_deeply( {slice_true \%H, keys %h}, { a => 1, b => 2, }, "slice_true on given keys" ); is_deeply( {slice_true \%H, qw(a b c A B C)}, { a => 1, b => 2, }, "slice_true on given mixed existing and not existing keys" ); is_deeply( {slice_false \%H}, { c => undef, d => 0, C => !!$h{c} }, "slice_false on all keys" ); is_deeply( {slice_false \%H, keys %h}, { c => undef, }, "slice_false on given keys" ); is_deeply( {slice_false \%H, qw(a b c d A B C D)}, { c => undef, d => 0, A => undef, B => undef, C => !!$h{c} }, "slice_false on given mixed existing and not existing keys" ); is_deeply( {slice_grep { $_ gt 'a' } \%h}, { b => 2, c => undef }, "slice_grep on keys", ); my %sgtest = ( a => undef, b => 0, c => 5 ); my @sgtest = keys %sgtest; is_deeply({slice_grep { $_ eq 'b' } \%sgtest, @sgtest}, {b => 0}, "slice_grep over given array",); is_deeply({slice_grep { $_{$_} && $_{$_} > 1 } \%h}, {b => 2}, "slice_grep on values",); # slice_map and friends is_deeply({slice_map(\%h, (a => "A"))}, {A => 1}, "simple_map slice",); is_deeply( { slice_map( \%h, ( a => "A", d => "D" ) ) }, { A => 1, D => undef }, "slice_map to nonexistent", ); is_deeply( {slice_map(\%h)}, { a => 1, b => 2, c => undef }, "slice_map with default keys", ); is_deeply( { slice_def_map( \%h, ( a => "A", c => "C", d => "D" ) ) }, {A => 1}, "slice_def_map undef + nonexistent", ); ok(!exists $h{d}, "slice_def_map didn't autovivify d"); ok(!exists $h{D}, "slice_def_map didn't autovivify D"); is_deeply( { slice_exists_map( \%h, ( a => "A", c => "C", d => "D" ) ) }, { A => 1, C => undef }, "slice_exists_map nonexistent", ); ok(!exists $h{d}, "slice_exists_map didn't autovivify d"); ok(!exists $h{D}, "slice_exists_map didn't autovivify D"); is_deeply( {slice_exists_map(\%h)}, { a => 1, b => 2, c => undef }, "slice_exists_map with default keys", ); is_deeply( { slice_missing_map( \%h, ( a => "A", b => "B", f => "F" ) ) }, {F => undef}, "slice_missing_map with given map", ); is_deeply({slice_missing_map(\%h)}, {}, "slice_missing_map using slice_missing",); is_deeply({slice_missing_map(\%h, ())}, {}, "slice_missing_map with empty map",); is_deeply({slice_missing_map(\%e)}, {}, "slice_missing_map one empty hash",); is_deeply({slice_missing_map(\%e, (a => 'b'))}, {b => undef}, "slice_missing_map on empty hash with map",); is_deeply( { slice_notdef_map( \%h, ( a => "A", b => "B", c => "C" ) ) }, {C => undef}, "slice_notdef_map with given map", ); is_deeply({slice_notdef_map(\%h)}, {}, "slice_notdef_map using slice_notdef",); is_deeply({slice_notdef_map(\%h, ())}, {}, "slice_notdef_map with empty map",); is_deeply({slice_notdef_map(\%e)}, {}, "slice_notdef_map on empty hash",); is_deeply({slice_notdef_map(\%e, (a => 'b'))}, {b => undef}, "slice_notdef_map on empty hash with map",); is_deeply( {slice_def_map \%h}, { a => 1, b => 2 }, "slice_def_map with default keys", ); is_deeply( {slice_true_map \%H}, { a => 1, b => 2, D => "0E0" }, "slice_true_map on implicit keys" ); is_deeply( { slice_true_map \%H, ( a => "A", b => "B", d => "D" ) }, { A => 1, B => 2, }, "slice_true_map on given map" ); is_deeply( { slice_true_map \%H, ( a => "A", b => "B", D => "d", e => "E", E => "e" ) }, { A => 1, B => 2, d => "0E0" }, "slice_true_map on given map with mixed existing and not existing" ); is_deeply( {slice_false_map \%H}, { c => undef, d => 0, C => !!$h{c} }, "slice_false_map on implicit keys" ); is_deeply( { slice_false_map \%H, ( d => "D", D => "d", C => "c" ) }, { c => !!$h{c}, D => 0, }, "slice_false_map on given map" ); is_deeply( { slice_false_map \%H, ( a => "A", b => "B", c => "C", d => "D", e => "E", A => "a", B => "b", D => "d", C => "c", ) }, { C => undef, D => 0, E => undef, a => undef, b => undef, c => !!$h{c}, }, "slice_false_map on given map with mixed existing and not existing" ); is_deeply( { slice_grep_map { $_ gt 'a' } \%h, ( a => "A", b => "B", c => "C" ) }, { B => 2, C => undef }, "slice_grep_map on keys", ); is_deeply( { slice_grep_map { $_{$_} && $_{$_} > 1 } \%h, ( a => "A", b => "B", c => "C" ), }, {B => 2}, "slice_grep_map on values", ); is_deeply({slice_grep_map { $_{$_} && $_{$_} > 1 } \%h}, {b => 2}, "slice_grep_map use slice_grep",); # hashsort and safe_reverse is_deeply([hashsort \%h], ['a', 1, 'b', 2, 'c', undef], "hashsort with default function",); is_deeply([hashsort sub { $a cmp $b }, \%h], ['a', 1, 'b', 2, 'c', undef], "hashsort with sort block",); is_deeply([hashsort sub { $b cmp $a }, \%h], ['c', undef, 'b', 2, 'a', 1], "hashsort with sort block (reverse)",); my %he = slice_def(\%h); is_deeply( {safe_reverse(\%he),}, { 2 => 'b', 1 => 'a' }, "safe revert with unique values and default function", ); %he = ( a => 1, b => 1 ); my %hec = safe_reverse(\%he); is_deeply([keys %hec, sort @{$hec{1}}], [1, qw(a b)], "safe revert with duplicate values and default function",); %he = ( a => 1, b => 1, c => 1 ); %hec = safe_reverse(\%he); is_deeply([keys %hec, sort @{$hec{1}}], [1, qw(a b c)], "safe revert with all keys have the same value and default function"); %he = slice_def(\%h); %hec = safe_reverse( sub { my ($k, $v, $r) = @_; exists $r->{$v} ? $r->{$v} : $k; }, \%he ); is_deeply( \%hec, { 2 => 'b', 1 => 'a' }, "safe revert with unique values and LEFT_PRECEDENCE behavior emulating function" ); done_testing;