Tie-RefHash-Weak-0.09/0000755000076500007650000000000011076261353016034 5ustar nothingmuchnothingmuchTie-RefHash-Weak-0.09/Changes0000644000076500007650000000143011076261336017326 0ustar nothingmuchnothingmuch0.09 - Filter dead refs from the magic data storage to avoid uninitialized warnings. 0.08 - Add fieldhash compatibility API (by Father Chrysostomos) - Fix overloading edge cases (Father Chrysostomos) - Fix REF type references (really scalars) (Father Chrysostomos) 0.07 - Warn when trying to store keys that are shared subrefs (they never get garbage collected) 0.06 - Fix a silly typo 0.05 - Weaken the entries in the magic array of $selfs 0.04 - Variable::Magic doesn't do more than one instance of a given magic per SV, so the data is now an array of objects 0.03 - Use Variable::Magic to kill stale keys immediately, preventing value leaks 0.02 - Fix overload::StrVal behavior (broken by Tie::RefHash change), thanks to Hans Dieter Pearcey 0.01 - Initial release Tie-RefHash-Weak-0.09/lib/0000755000076500007650000000000011076261347016605 5ustar nothingmuchnothingmuchTie-RefHash-Weak-0.09/lib/Tie/0000755000076500007650000000000011076261347017326 5ustar nothingmuchnothingmuchTie-RefHash-Weak-0.09/lib/Tie/RefHash/0000755000076500007650000000000011076261347020646 5ustar nothingmuchnothingmuchTie-RefHash-Weak-0.09/lib/Tie/RefHash/Weak.pm0000644000076500000000000001131511076261207020626 0ustar nothingmuchwheel#!/usr/bin/perl package Tie::RefHash::Weak; use base qw/Tie::RefHash Exporter/; use strict; use warnings; use warnings::register; use overload (); use B qw/svref_2object CVf_CLONED/; our $VERSION = 0.09; our @EXPORT_OK = qw 'fieldhash fieldhashes'; our %EXPORT_TAGS = ( all => \@EXPORT_OK ); use Scalar::Util qw/weaken reftype/; use Variable::Magic qw/wizard cast getdata/; my $wiz = wizard free => \&_clear_weakened_sub, data => \&_add_magic_data; sub _clear_weakened_sub { my ( $key, $objs ) = @_; local $@; foreach my $self ( grep { defined } @{ $objs || [] } ) { eval { $self->_clear_weakened($key) }; # support subclassing } } sub _add_magic_data { my ( $key, $objects ) = @_; $objects; } sub _clear_weakened { my ( $self, $key ) = @_; $self->DELETE( $key ); } sub STORE { my($s, $k, $v) = @_; if (ref $k) { # make sure we use the same function that RefHash is using for ref keys my $kstr = Tie::RefHash::refaddr($k); my $entry = [$k, $v]; weaken( $entry->[0] ); my $objects; if ( reftype $k eq 'CODE' ) { unless ( svref_2object($k)->CvFLAGS & CVf_CLONED ) { warnings::warnif("Non closure code references never get garbage collected: $k"); } else { $objects = &getdata ( $k, $wiz ) or &cast( $k, $wiz, ( $objects = [] ) ); } } else { $objects = &getdata( $k, $wiz ) or &cast( $k, $wiz, ( $objects = [] ) ); } @$objects = grep { defined } @$objects; unless ( grep { $_ == $s } @$objects ) { push @$objects, $s; weaken($objects->[-1]); } $s->[0]{$kstr} = $entry; } else { $s->[1]{$k} = $v; } $v; } sub fieldhash(\%) { tie %{$_[0]}, __PACKAGE__; return $_[0]; } sub fieldhashes { tie %{$_}, __PACKAGE__ for @_; return @_; } __PACKAGE__ __END__ =pod =head1 NAME Tie::RefHash::Weak - A Tie::RefHash subclass with weakened references in the keys. =head1 SYNOPSIS use Tie::RefHash::Weak; tie my %h, 'Tie::RefHash::Weak'; # OR: use Tie::RefHash::Weak 'fieldhash'; fieldhash my %h; { # new scope my $val = "foo"; $h{\$val} = "bar"; # key is weak ref print join(", ", keys %h); # contains \$val, returns regular reference } # $val goes out of scope, refcount goes to zero # weak references to \$val are now undefined keys %h; # no longer contains \$val # see also Tie::RefHash =head1 DESCRIPTION The L module can be used to access hashes by reference. This is useful when you index by object, for example. The problem with L, and cross indexing, is that sometimes the index should not contain strong references to the objecs. L's internal structures contain strong references to the key, and provide no convenient means to make those references weak. This subclass of L has weak keys, instead of strong ones. The values are left unaltered, and you'll have to make sure there are no strong references there yourself. =head1 FUNCTIONS For compatibility with L, this module will, upon request, export the following two functions. You may also write C. =over 4 =item fieldhash %hash This ties the hash and returns a reference to it. =item fieldhashes \%hash1, \%hash2 ... This ties each hash that is passed to it as a reference. It returns the list of references in list context, or the number of hashes in scalar context. =back =head1 THREAD SAFETY L version 1.32 and above have correct handling of threads (with respect to changing reference addresses). If your module requires Tie::RefHash::Weak to be thread aware you need to depend on both L and L version 1.32 (or later). Version 0.02 and later of Tie::RefHash::Weak depend on a thread-safe version of Tie::RefHash anyway, so if you are using the latest version this should already be taken care of for you. =head1 5.10.0 COMPATIBILITY Due to a minor change in Perl 5.10.0 a bug in the handling of magic freeing was uncovered causing segmentation faults. This has been patched but not released yet, as of 0.08. =head1 CAVEAT You can use an LVALUE reference (such as C<\substr ...>) as a hash key, but due to a bug in perl (see L) it might not be possible to weaken a reference to it, in which case the hash element will never be deleted automatically. =head1 AUTHORS Yuval Kogman some maintenance by Hans Dieter Pearcey =head1 COPYRIGHT & LICENSE Copyright (c) 2004 Yuval Kogman. All rights reserved This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L (the live object cache), L =cut Tie-RefHash-Weak-0.09/Makefile.PL0000644000076500007650000000064410665742017020016 0ustar nothingmuchnothingmuch#!/usr/bin/perl -w use strict; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Tie::RefHash::Weak', VERSION_FROM => 'lib/Tie/RefHash/Weak.pm', INSTALLDIRS => 'site', SIGN => 1, PL_FILES => { }, PREREQ_PM => { 'Task::Weaken' => 0, # no weak refs before this 'Scalar::Util' => 0, 'Tie::RefHash' => '1.34', # use refaddr instead of overload::StrVal 'Variable::Magic' => 0, }, ); Tie-RefHash-Weak-0.09/MANIFEST0000644000076500007650000000037211076261350017164 0ustar nothingmuchnothingmuchChanges lib/Tie/RefHash/Weak.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml t/01basic.t t/02gc.t t/fieldhash.t t/overload.t t/thread_clone.t TODO SIGNATURE Public-key signature (added by MakeMaker) Tie-RefHash-Weak-0.09/MANIFEST.SKIP0000644000076500007650000000103410616456126017733 0ustar nothingmuchnothingmuch# Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \b_darcs\b # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ # Avoid Devel::Cover files. \bcover_db\b ### DEFAULT MANIFEST.SKIP ENDS HERE #### \.DS_Store$ \.sw.$ \.tar\.gz$ ^(\w+-)*(\w+)-\d\.\d+$ Tie-RefHash-Weak-0.09/META.yml0000644000076500007650000000075411076261347017316 0ustar nothingmuchnothingmuch--- #YAML:1.0 name: Tie-RefHash-Weak version: 0.09 abstract: ~ license: ~ author: ~ generated_by: ExtUtils::MakeMaker version 6.44 distribution_type: module requires: Scalar::Util: 0 Task::Weaken: 0 Tie::RefHash: 1.34 Variable::Magic: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 Tie-RefHash-Weak-0.09/SIGNATURE0000644000076500007650000000261211076261353017321 0ustar nothingmuchnothingmuchThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 cca661de3f7fb9b941393af161431adbff5034d4 Changes SHA1 08bb8f7c311a8361b0d1defe78b146f4e78bb3df MANIFEST SHA1 ddb918d4e02cc06f4b9fe77adeca65403f8fdd56 MANIFEST.SKIP SHA1 126321f7e957f409ff08ee7c3d9c61ebe7542fff META.yml SHA1 671cb0205c15d3d680eb7bdc577731c886080282 Makefile.PL SHA1 e5e7fbf8ee6bd82b6a57f51901c9e836d40bfcd8 TODO SHA1 bdc9edd09d0426c0af2abfecb75eca1b8bde211a lib/Tie/RefHash/Weak.pm SHA1 264cbe5dd6df60229b9da06a7d389deb2876d417 t/01basic.t SHA1 58b89b0f01b67805ee99d923008b618a8b6ce4a3 t/02gc.t SHA1 e26274f99f7fca5a1ae27e76944c37fc3d58bca5 t/fieldhash.t SHA1 be0dab62022a0174c9ac4a6e2b467fbf211ee64a t/overload.t SHA1 e291095ccf408d33daa7fb7c94aaf3b7fd2fec65 t/thread_clone.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.7 (Darwin) iD8DBQFI+WLoVCwRwOvSdBgRAsqiAKC90eoP4heA5rITQ8LWKVgNY7r+mQCfWqOY D2jSXv+uf4s7Y40hhVea6u8= =3bZi -----END PGP SIGNATURE----- Tie-RefHash-Weak-0.09/t/0000755000076500007650000000000011076261347016302 5ustar nothingmuchnothingmuchTie-RefHash-Weak-0.09/t/01basic.t0000644000076500007650000000463210674433141017712 0ustar nothingmuchnothingmuch#!/usr/bin/perl use strict; use warnings; use Test::More tests => 26; use Scalar::Util qw/weaken/; BEGIN { use_ok("Tie::RefHash::Weak") }; tie my %hash, "Tie::RefHash::Weak"; isa_ok(tied %hash, "Tie::RefHash::Weak", 'tied(%hash)'); my $val = "foo"; $hash{blah} = $val; is_deeply([ keys %hash ], [ "blah" ], "keys returns 'blah'"); is($hash{blah}, $val, "normal string as key"); my $delete_is_borked; SKIP: { my $deleted = delete($hash{blah}); use Tie::RefHash; tie my %refhash, 'Tie::RefHash'; $refhash{foo} = 1; my $r = []; $refhash{$r} = 2; unless (delete($refhash{foo}) == 1 and delete($refhash{$r}) == 2) { $delete_is_borked=1; skip "Tie::RefHash::delete is broken", 1; } is($deleted, $val, "delete returns value"); } ok(!exists($hash{blah}), "deleted value no longer exists()"); my $ref = \$val; $hash{$ref} = $val; is($hash{$ref}, $val, "ref as key"); is_deeply([ keys %hash ], [ $ref ], "keys returns ref"); ok(exists($hash{$ref}), "existing value exists()"); SKIP: { my $deleted = delete($hash{$ref}); skip "Tie::RefHash::delete is broken", 1 if $delete_is_borked; is($deleted, $val, "delete returns value"); } ok(!exists($hash{$ref}), "deleted value no longer exists()"); is_deeply([ keys %hash ], [ ], "no keys in hash"); { my $goner = "blech"; $ref = \$goner; weaken($ref); $hash{$ref} = "foo"; is($hash{$ref}, "foo", "ref as key"); is_deeply([ keys %hash ], [ $ref ], "keys returns ref"); ok(exists($hash{$ref}), "existing value exists()"); } # $goner has droppped out of scope is($ref, undef, "reference was undefined"); is_deeply([ values %hash ], [], "no values in hash"); is(scalar keys %hash, 0, "scalar keys returns 0"); is_deeply([ keys %hash ], [] , "keys returns emtpy list"); { my $bar = 1; my $closure = sub { fail("should never execute"); $bar }; $hash{$closure} = "blah"; is( $hash{$closure}, "blah", "code ref key" ); } is_deeply([ keys %hash ], [], "no more keys" ); %hash = (); my @w; $SIG{__WARN__} = sub { push @w, "@_" }; { no warnings 'Tie::RefHash::Weak'; my $sub = sub { fail("should never execute") }; $hash{$sub} = "boo"; is( $hash{$sub}, "boo", "code ref key" ); } is( scalar(@w), 0, "no warnings (disabled"); { local $TODO = "perl doesn't GC non closures"; is_deeply([ keys %hash ], [], "no more keys" ); } @w = (); %hash = (); $hash{sub { }} = 1; is( scalar(@w), 1, "got a warning" ); like( $w[0], qr/never get garbage collected/i, "right warning" ); Tie-RefHash-Weak-0.09/t/02gc.t0000644000076500000000000000315110734046402015752 0ustar nothingmuchwheel#!/usr/bin/perl use strict; use warnings; use Test::More tests => 10; use Symbol qw 'gensym geniosym'; BEGIN { use_ok("Tie::RefHash::Weak") } sub Tie::RefHash::Weak::cnt { my $s = shift; scalar keys %{ $s->[0] } } my @types = ( sub { my $v = shift; \$v }, # SCALAR sub { my $v = shift; \\$v }, # REF sub { my $v = shift; \substr $v, 0 }, # LVALUE sub { [ $_[0] ] }, # ARRAY sub { { value => $_[0] } }, # HASH sub { gensym }, # GLOB sub { geniosym }, # IO sub { my $v = shift; sub { $v } }, # CODE ); my $secret_vault = $types[2]->(''); # workaround for a perl bug my $n = 10; # create a large hunk of tie my %hash, 'Tie::RefHash::Weak'; tie my %hash_2, 'Tie::RefHash::Weak'; my @copies = map {bless new_ref($_), "Some::Class"} 1 .. 1 << $n; @hash{@copies} = (1) x @copies; @hash_2{@copies} = (1) x @copies; sub new_ref { my $v = shift; push @types, my $h = shift @types; $h->( $v ); } is(scalar keys %hash_2, 1 << $n, "scalar keys"); is(scalar keys %hash, 1 << $n, "scalar keys"); is((tied %hash)->cnt, 1 << $n, "cnt"); splice(@copies, 0, 1 << ($n-1)); # throw some away is((tied %hash)->cnt, 1 << ($n-1), "cnt"); is((tied %hash_2)->cnt, 1 << ($n-1), "cnt"); is(scalar keys %hash, 1 << ($n-1), "scalar keys"); is(scalar keys %hash_2, 1 << ($n-1), "scalar keys"); splice(@copies, 0, 1 << ($n-2)); # throw some away for (my $i = 0; $i <= 1 << $n; $i++){ exists $hash{$copies[-$i] || 'foo'}; $hash{$copies[-$i] || 'foo'}++; } is((tied %hash)->cnt, 1 << ($n-2), "cnt"); @copies = (); is((tied %hash)->cnt, 0, "cnt" ); Tie-RefHash-Weak-0.09/t/fieldhash.t0000644000076500000000000000124410734046624017155 0ustar nothingmuchwheel#!/usr/bin/perl use strict; use warnings; use Test::More tests => 7; BEGIN { use_ok("Tie::RefHash::Weak", ':all') }; my $thing = fieldhash my %fieldmouse; isa_ok(tied %fieldmouse, "Tie::RefHash::Weak", 'tied(%hash)'); is $thing, \%fieldmouse, 'return val of fieldhash'; $thing = fieldhashes \my %hash1, \my %hash2; isa_ok(tied %hash1, "Tie::RefHash::Weak", '%hash1 tied by fieldhashes()'); isa_ok(tied %hash2, "Tie::RefHash::Weak", '%hash2 tied by fieldhashes()'); is $thing, 2, 'return val of fieldhashes (scalar)'; my(%foo, %bar); is_deeply [map "$_", fieldhashes\(%foo, %bar)], [map "$_", \(%foo, %bar)], 'return val of fieldhashes (list)'; Tie-RefHash-Weak-0.09/t/overload.t0000644000076500000000000000264710734046402017043 0ustar nothingmuchwheel#!/usr/bin/perl use strict; use warnings; use Test::More tests => 6; use Scalar::Util 'weaken'; use Symbol qw 'gensym geniosym'; BEGIN { use_ok("Tie::RefHash::Weak") }; tie my %hash, "Tie::RefHash::Weak"; { package overloaded; use overload fallback => 1, '${}' => sub { \my $v }, '@{}' => sub { [] }, '%{}' => sub { +{} }, '&{}' => sub { my $v; sub { $v } }, '*{}' => sub { Symbol::gensym }, } my @types = ( sub { \my $v }, # SCALAR sub { \\my $v }, # REF sub { \substr my $v = '', 0 }, # LVALUE sub { [] }, # ARRAY sub { +{} }, # HASH sub { gensym }, # GLOB sub { geniosym }, # IO sub { my $v; sub { $v } }, # CODE ); my @refs = map { &$_, bless &$_, "overloaded"} @types; @hash{@refs} = (1) x @refs; is_deeply [sort(map Tie::RefHash::refaddr($_), keys %hash)], [sort(map Tie::RefHash::refaddr($_), @refs )], 'elements with overloaded keys can be created'; @refs = map { &$_, bless &$_, "overloaded"} @types; # we'll make sure these are freed: weaken $_ for my @copies = @refs; my $value = []; %hash = (); # start from scratch @hash{@refs} = ($value) x @refs; weaken $value; is scalar keys %hash, @refs, 'number of keys to begin with'; @refs = (); is grep(defined, @copies), 0, 'the keys were freed'; is $value, undef, 'the value was freed'; is scalar keys %hash, 0, 'elements with overloaded keys are freed'; Tie-RefHash-Weak-0.09/t/thread_clone.t0000644000076500007650000000255210411763137021116 0ustar nothingmuchnothingmuch#!/usr/bin/perl use strict; use warnings; BEGIN { # this is sucky because threads.pm has to be loaded before Test::Builder use Config; if ( $Config{usethreads} ) { require threads; threads->import; require Test::More; Test::More->import( tests => 14 ); } else { require Test::More; Test::More->import( skip_all => "threads aren't enabled in your perl" ) } } use Tie::RefHash; tie my %hash, "Tie::RefHash"; my $r1 = {}; my $r2 = []; my $v1 = "foo"; $hash{$r1} = "hash"; $hash{$r2} = "array"; $hash{$v1} = "string"; is( $hash{$v1}, "string", "fetch by string before clone ($v1)" ); is( $hash{$r1}, "hash", "fetch by ref before clone ($r1)" ); is( $hash{$r2}, "array", "fetch by ref before clone ($r2)" ); my $th = threads->create(sub { is( scalar keys %hash, 3, "key count is OK" ); ok( exists $hash{$v1}, "string key exists ($v1)" ); is( $hash{$v1}, "string", "fetch by string" ); ok( exists $hash{$r1}, "ref key exists ($r1)" ); is( $hash{$r1}, "hash", "fetch by ref" ); ok( exists $hash{$r2}, "ref key exists ($r2)" ); is( $hash{$r2}, "array", "fetch by ref" ); is_deeply( [ sort keys %hash ], [ sort $r1, $r2, $v1 ], "keys are ok" ); }); $th->join; is( $hash{$v1}, "string", "fetch by string after clone, orig thread ($v1)" ); is( $hash{$r1}, "hash", "fetch by ref after clone ($r1)" ); is( $hash{$r2}, "array", "fetch by ref after clone ($r2)" ); Tie-RefHash-Weak-0.09/TODO0000644000076500007650000000010310671104015016505 0ustar nothingmuchnothingmuch- stop leaking magic - should $self be weakened in the magic data?