diff options
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Tie/RefHash.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/tlperl/lib/Tie/RefHash.pm | 312 |
1 files changed, 204 insertions, 108 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Tie/RefHash.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Tie/RefHash.pm index ed72abc90e..896680f99f 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Tie/RefHash.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Tie/RefHash.pm @@ -1,102 +1,80 @@ -package Tie::RefHash; - -use vars qw/$VERSION/; - -$VERSION = "1.39"; - -use 5.005; - -=head1 NAME - -Tie::RefHash - use references as hash keys - -=head1 SYNOPSIS - - require 5.004; - use Tie::RefHash; - tie HASHVARIABLE, 'Tie::RefHash', LIST; - tie HASHVARIABLE, 'Tie::RefHash::Nestable', LIST; - - untie HASHVARIABLE; - -=head1 DESCRIPTION - -This module provides the ability to use references as hash keys if you -first C<tie> the hash variable to this module. Normally, only the -keys of the tied hash itself are preserved as references; to use -references as keys in hashes-of-hashes, use Tie::RefHash::Nestable, -included as part of Tie::RefHash. - -It is implemented using the standard perl TIEHASH interface. Please -see the C<tie> entry in perlfunc(1) and perltie(1) for more information. - -The Nestable version works by looking for hash references being stored -and converting them to tied hashes so that they too can have -references as keys. This will happen without warning whenever you -store a reference to one of your own hashes in the tied hash. - -=head1 EXAMPLE - - use Tie::RefHash; - tie %h, 'Tie::RefHash'; - $a = []; - $b = {}; - $c = \*main; - $d = \"gunk"; - $e = sub { 'foo' }; - %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5); - $a->[0] = 'foo'; - $b->{foo} = 'bar'; - for (keys %h) { - print ref($_), "\n"; - } - - tie %h, 'Tie::RefHash::Nestable'; - $h{$a}->{$b} = 1; - for (keys %h, keys %{$h{$a}}) { - print ref($_), "\n"; - } - -=head1 THREAD SUPPORT - -L<Tie::RefHash> fully supports threading using the C<CLONE> method. - -=head1 STORABLE SUPPORT - -L<Storable> hooks are provided for semantically correct serialization and -cloning of tied refhashes. - -=head1 RELIC SUPPORT - -This version of Tie::RefHash seems to no longer work with 5.004. This has not -been throughly investigated. Patches welcome ;-) - -=head1 LICENSE - -This program is free software; you can redistribute it and/or modify it under -the same terms as Perl itself - -=head1 MAINTAINER - -Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt> - -=head1 AUTHOR - -Gurusamy Sarathy gsar@activestate.com - -'Nestable' by Ed Avis ed@membled.com - -=head1 SEE ALSO - -perl(1), perlfunc(1), perltie(1) - -=cut +package Tie::RefHash; # git description: Tie-RefHash-1.39-10-g2cfa4bd +# ABSTRACT: Use references as hash keys + +our $VERSION = '1.40'; + +#pod =head1 SYNOPSIS +#pod +#pod require 5.004; +#pod use Tie::RefHash; +#pod tie HASHVARIABLE, 'Tie::RefHash', LIST; +#pod tie HASHVARIABLE, 'Tie::RefHash::Nestable', LIST; +#pod +#pod untie HASHVARIABLE; +#pod +#pod =head1 DESCRIPTION +#pod +#pod This module provides the ability to use references as hash keys if you +#pod first C<tie> the hash variable to this module. Normally, only the +#pod keys of the tied hash itself are preserved as references; to use +#pod references as keys in hashes-of-hashes, use Tie::RefHash::Nestable, +#pod included as part of Tie::RefHash. +#pod +#pod It is implemented using the standard perl TIEHASH interface. Please +#pod see the C<tie> entry in perlfunc(1) and perltie(1) for more information. +#pod +#pod The Nestable version works by looking for hash references being stored +#pod and converting them to tied hashes so that they too can have +#pod references as keys. This will happen without warning whenever you +#pod store a reference to one of your own hashes in the tied hash. +#pod +#pod =head1 EXAMPLE +#pod +#pod use Tie::RefHash; +#pod tie %h, 'Tie::RefHash'; +#pod $a = []; +#pod $b = {}; +#pod $c = \*main; +#pod $d = \"gunk"; +#pod $e = sub { 'foo' }; +#pod %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5); +#pod $a->[0] = 'foo'; +#pod $b->{foo} = 'bar'; +#pod for (keys %h) { +#pod print ref($_), "\n"; +#pod } +#pod +#pod tie %h, 'Tie::RefHash::Nestable'; +#pod $h{$a}->{$b} = 1; +#pod for (keys %h, keys %{$h{$a}}) { +#pod print ref($_), "\n"; +#pod } +#pod +#pod =head1 THREAD SUPPORT +#pod +#pod L<Tie::RefHash> fully supports threading using the C<CLONE> method. +#pod +#pod =head1 STORABLE SUPPORT +#pod +#pod L<Storable> hooks are provided for semantically correct serialization and +#pod cloning of tied refhashes. +#pod +#pod =head1 AUTHORS +#pod +#pod Gurusamy Sarathy <gsar@activestate.com> +#pod +#pod Tie::RefHash::Nestable by Ed Avis <ed@membled.com> +#pod +#pod =head1 SEE ALSO +#pod +#pod perl(1), perlfunc(1), perltie(1) +#pod +#pod =cut use Tie::Hash; -use vars '@ISA'; -@ISA = qw(Tie::Hash); +our @ISA = qw(Tie::Hash); use strict; -use Carp qw/croak/; +use Carp (); BEGIN { local $@; @@ -114,7 +92,7 @@ BEGIN { local $@; if ( _HAS_SCALAR_UTIL ) { - Scalar::Util->import("refaddr"); + *refaddr = sub { goto \&Scalar::Util::refaddr } } else { require overload; @@ -148,7 +126,7 @@ sub TIEHASH { if ( ++$count > 1000 ) { # this ensures we don't fill up with a huge array dead weakrefs - @thread_object_registry = grep { defined } @thread_object_registry; + @thread_object_registry = grep defined, @thread_object_registry; $count = 0; } } else { @@ -169,7 +147,7 @@ sub STORABLE_freeze { sub STORABLE_thaw { my ( $self, $is_cloning, $version, $refs, $reg ) = @_; - croak "incompatible versions of Tie::RefHash between freeze and thaw" + Carp::croak "incompatible versions of Tie::RefHash between freeze and thaw" unless $version eq $storable_format_version; @$self = ( {}, $reg ); @@ -185,20 +163,20 @@ sub CLONE { # when the thread has been cloned all the objects need to be updated. # dead weakrefs are undefined, so we filter them out - @thread_object_registry = grep { defined && do { $_->_reindex_keys; 1 } } @thread_object_registry; + @thread_object_registry = grep defined && do { $_->_reindex_keys; 1 }, @thread_object_registry; $count = 0; # we just cleaned up } sub _reindex_keys { my ( $self, $extra_keys ) = @_; # rehash all the ref keys based on their new StrVal - %{ $self->[0] } = map { refaddr($_->[0]) => $_ } (values(%{ $self->[0] }), @{ $extra_keys || [] }); + %{ $self->[0] } = map +(Scalar::Util::refaddr($_->[0]) => $_), (values(%{ $self->[0] }), @{ $extra_keys || [] }); } sub FETCH { my($s, $k) = @_; if (ref $k) { - my $kstr = refaddr($k); + my $kstr = Scalar::Util::refaddr($k); if (defined $s->[0]{$kstr}) { $s->[0]{$kstr}[1]; } @@ -214,7 +192,7 @@ sub FETCH { sub STORE { my($s, $k, $v) = @_; if (ref $k) { - $s->[0]{refaddr($k)} = [$k, $v]; + $s->[0]{Scalar::Util::refaddr($k)} = [$k, $v]; } else { $s->[1]{$k} = $v; @@ -225,13 +203,13 @@ sub STORE { sub DELETE { my($s, $k) = @_; (ref $k) - ? (delete($s->[0]{refaddr($k)}) || [])->[1] + ? (delete($s->[0]{Scalar::Util::refaddr($k)}) || [])->[1] : delete($s->[1]{$k}); } sub EXISTS { my($s, $k) = @_; - (ref $k) ? exists($s->[0]{refaddr($k)}) : exists($s->[1]{$k}); + (ref $k) ? exists($s->[0]{Scalar::Util::refaddr($k)}) : exists($s->[1]{$k}); } sub FIRSTKEY { @@ -263,9 +241,9 @@ sub CLEAR { %{$s->[1]} = (); } -package Tie::RefHash::Nestable; -use vars '@ISA'; -@ISA = 'Tie::RefHash'; +package # hide from PAUSE + Tie::RefHash::Nestable; +our @ISA = 'Tie::RefHash'; sub STORE { my($s, $k, $v) = @_; @@ -277,3 +255,121 @@ sub STORE { } 1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Tie::RefHash - Use references as hash keys + +=head1 VERSION + +version 1.40 + +=head1 SYNOPSIS + + require 5.004; + use Tie::RefHash; + tie HASHVARIABLE, 'Tie::RefHash', LIST; + tie HASHVARIABLE, 'Tie::RefHash::Nestable', LIST; + + untie HASHVARIABLE; + +=head1 DESCRIPTION + +This module provides the ability to use references as hash keys if you +first C<tie> the hash variable to this module. Normally, only the +keys of the tied hash itself are preserved as references; to use +references as keys in hashes-of-hashes, use Tie::RefHash::Nestable, +included as part of Tie::RefHash. + +It is implemented using the standard perl TIEHASH interface. Please +see the C<tie> entry in perlfunc(1) and perltie(1) for more information. + +The Nestable version works by looking for hash references being stored +and converting them to tied hashes so that they too can have +references as keys. This will happen without warning whenever you +store a reference to one of your own hashes in the tied hash. + +=head1 EXAMPLE + + use Tie::RefHash; + tie %h, 'Tie::RefHash'; + $a = []; + $b = {}; + $c = \*main; + $d = \"gunk"; + $e = sub { 'foo' }; + %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5); + $a->[0] = 'foo'; + $b->{foo} = 'bar'; + for (keys %h) { + print ref($_), "\n"; + } + + tie %h, 'Tie::RefHash::Nestable'; + $h{$a}->{$b} = 1; + for (keys %h, keys %{$h{$a}}) { + print ref($_), "\n"; + } + +=head1 THREAD SUPPORT + +L<Tie::RefHash> fully supports threading using the C<CLONE> method. + +=head1 STORABLE SUPPORT + +L<Storable> hooks are provided for semantically correct serialization and +cloning of tied refhashes. + +=head1 SEE ALSO + +perl(1), perlfunc(1), perltie(1) + +=head1 SUPPORT + +Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Tie-RefHash> +(or L<bug-Tie-RefHash@rt.cpan.org|mailto:bug-Tie-RefHash@rt.cpan.org>). + +=head1 AUTHORS + +Gurusamy Sarathy <gsar@activestate.com> + +Tie::RefHash::Nestable by Ed Avis <ed@membled.com> + +=head1 CONTRIBUTORS + +=for stopwords Yuval Kogman Karen Etheridge Florian Ragwitz Jerry D. Hedden + +=over 4 + +=item * + +Yuval Kogman <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Jerry D. Hedden <jdhedden@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENCE + +This software is copyright (c) 2006 by יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut |