Hash-MoreUtils-0.05000755000765000024 012251300224 13314 5ustar00snostaff000000000000Hash-MoreUtils-0.05/Build.PL000444000765000024 140412251300224 14744 0ustar00snostaff000000000000use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Hash::MoreUtils', license => 'perl', dist_version_from => 'lib/Hash/MoreUtils.pm', build_requires => { 'Test::More' => '0.90', }, dist_author => [ 'Hans Dieter Pearcey ', 'Jens Rehsack ' ], meta_merge => { resources => { repository => "https://github.com/perl5-utils/Hash-MoreUtils", }, }, add_to_cleanup => ['Hash-MoreUtils-*'], test_files => [ "t/*.t", "xt/*.t" ], ); $builder->create_build_script(); Hash-MoreUtils-0.05/Changes000444000765000024 151512251300224 14746 0ustar00snostaff000000000000Revision history for Hash-MoreUtils 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.05/MANIFEST000444000765000024 14212251300224 14557 0ustar00snostaff000000000000Build.PL Changes lib/Hash/MoreUtils.pm MANIFEST META.json META.yml README t/00-load.t t/01-hash.t Hash-MoreUtils-0.05/META.json000444000765000024 177712251300224 15106 0ustar00snostaff000000000000{ "abstract" : "Provide the stuff missing in Hash::Util", "author" : [ "Hans Dieter Pearcey ", "Jens Rehsack " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4203", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Hash-MoreUtils", "prereqs" : { "build" : { "requires" : { "Test::More" : "0.90" } }, "configure" : { "requires" : { "Module::Build" : "0.42" } } }, "provides" : { "Hash::MoreUtils" : { "file" : "lib/Hash/MoreUtils.pm", "version" : "0.05" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/perl5-utils/Hash-MoreUtils" } }, "version" : "0.05" } Hash-MoreUtils-0.05/META.yml000444000765000024 121412251300224 14720 0ustar00snostaff000000000000--- abstract: 'Provide the stuff missing in Hash::Util' author: - 'Hans Dieter Pearcey ' - 'Jens Rehsack ' build_requires: Test::More: 0.90 configure_requires: Module::Build: 0.42 dynamic_config: 1 generated_by: 'Module::Build version 0.4203, CPAN::Meta::Converter version 2.132830' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Hash-MoreUtils provides: Hash::MoreUtils: file: lib/Hash/MoreUtils.pm version: 0.05 resources: license: http://dev.perl.org/licenses/ repository: https://github.com/perl5-utils/Hash-MoreUtils version: 0.05 Hash-MoreUtils-0.05/README000444000765000024 162112251300224 14331 0ustar00snostaff000000000000Hash-MoreUtils The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE Copyright (C) 2005 Hans Dieter Pearcey This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Hash-MoreUtils-0.05/lib000755000765000024 012251300224 14062 5ustar00snostaff000000000000Hash-MoreUtils-0.05/lib/Hash000755000765000024 012251300224 14745 5ustar00snostaff000000000000Hash-MoreUtils-0.05/lib/Hash/MoreUtils.pm000444000765000024 1704212251300224 17407 0ustar00snostaff000000000000package Hash::MoreUtils; use strict; use warnings; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); use Scalar::Util qw(blessed); require Exporter; @ISA = qw(Exporter); %EXPORT_TAGS = ( all => [ qw(slice slice_def slice_exists slice_grep), qw(slice_map slice_def_map slice_exists_map slice_grep_map), qw(hashsort safe_reverse) ], ); @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } ); $VERSION = '0.05'; =head1 NAME Hash::MoreUtils - Provide the stuff missing in Hash::Util =head1 SYNOPSIS use Hash::MoreUtils qw(slice slice_def slice_exists slice_grep hashsort ); =head1 DESCRIPTION Similar to C<< List::MoreUtils >>, C<< Hash::MoreUtils >> contains trivial but commonly-used functionality for hashes. =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 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; %{$href}; } sub slice_exists { my ( $href, @list ) = @_; @list or @list = keys %{$href}; return map { $_ => $href->{$_} } grep {exists( $href->{$_} ) } @list; } sub slice_def { my ( $href, @list ) = @_; @list or @list = keys %{$href}; return map { $_ => $href->{$_} } grep { defined( $href->{$_} ) } @list; } sub slice_grep (&@) { my ( $code, $href, @list ) = @_; local %_ = %{$href}; @list or @list = keys %{$href}; no warnings 'uninitialized'; return map { ( $_ => $_{$_} ) } grep { $code->($_) } @list; } =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 theirself. =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 theirself. =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 theirself. =head2 C BLOCK, HASHREF[, MAP] As C, with an arbitrary condition. If no C is given, all keys of C are assumed mapped to theirself. 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; %{$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_def_map { my ( $href, %map ) = @_; %map or return slice_def($href); return map { $map{$_} => $href->{$_} } grep { defined( $href->{$_} ) } keys %map; } sub slice_grep_map (&@) { my ( $code, $href, %map ) = @_; %map or return goto &slice_grep; local %_ = %{$href}; no warnings 'uninitialized'; return map { ( $map{$_} => $_{$_} ) } grep { $code->($_) } keys %map; } =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 ) = @_; my $cmp; if ( $hash ) { my $package = caller; $cmp = sub { no strict 'refs'; local ${$package.'::a'} = $a; local ${$package.'::b'} = $b; $code->(); }; } else { $hash = $code; $cmp = sub { $a cmp $b }; } return map { ( $_ => $hash->{$_} ) } sort { $cmp->() } 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 = save_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-2013 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.05/t000755000765000024 012251300224 13557 5ustar00snostaff000000000000Hash-MoreUtils-0.05/t/00-load.t000444000765000024 23312251300224 15213 0ustar00snostaff000000000000#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Hash::MoreUtils' ); } diag( "Testing Hash::MoreUtils $Hash::MoreUtils::VERSION, Perl $], $^X" ); Hash-MoreUtils-0.05/t/01-hash.t000444000765000024 613612251300224 15250 0ustar00snostaff000000000000#!perl use strict; use warnings; use Test::More; use Hash::MoreUtils qw(:all); my %h = (a => 1, b => 2, c => undef); 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_def \%h }, { a => 1, b => 2 }, "slice_def with default keys", ); is_deeply( { slice_grep { $_ gt 'a' } \%h }, { b => 2, c => undef }, "slice_grep on keys", ); 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_def_map \%h }, { a => 1, b => 2 }, "slice_def_map with default keys", ); 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", ); # 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", ); done_testing;