Skip Menu |
 

This queue is for tickets about the Devel-Cycle CPAN distribution.

Report information
The Basics
Id: 72911
Status: new
Priority: 0/
Queue: Devel-Cycle

People
Owner: Nobody in particular
Requestors: 'spro^^*%*^6ut# [...] &$%*c
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: No support for overloaded objects
Download (untitled) / with headers
text/plain 245b
Devel::Cycle doesn’t know not to ues %{}, etc., directly on objects with overloading. Attached is an incomplete patch to fix this. I’m afraid I don’t have much of an incentive to finish this, as it already does what I needed it to do.
Subject: open_ktyMfiJo.txt
Download open_ktyMfiJo.txt
text/plain 2.6k
Only in Devel-Cycle-1.10-overload/lib: .DS_Store diff -rup Devel-Cycle-1.10/lib/Devel/Cycle.pm Devel-Cycle-1.10-overload/lib/Devel/Cycle.pm --- Devel-Cycle-1.10/lib/Devel/Cycle.pm 2008-07-08 18:27:08.000000000 -0700 +++ Devel-Cycle-1.10-overload/lib/Devel/Cycle.pm 2011-12-02 14:41:47.000000000 -0800 @@ -13,6 +13,7 @@ my %SHORT_NAMES; require Exporter; +require overload; our @ISA = qw(Exporter); our @EXPORT = qw(find_cycle find_weakened_cycle); @@ -148,10 +149,19 @@ sub _find_cycle_HASH { my $complain = shift; my @report = @_; - for my $key (sort keys %$current) { - next if !$inc_weak_refs && isweak($current->{$key}); - _find_cycle($current->{$key},{%$seenit},$callback,$inc_weak_refs,$complain, - (@report,['HASH',$key,$current => $current->{$key},$inc_weak_refs?isweak($current->{$key}):()])); + my $overloaded = defined overload::Method($current, '%{}'); + my $class; + if($overloaded) { + $class = ref $current; + bless $current; + } + my %hash = map +($_ => \$current->{$_}), keys %$current; + $overloaded and bless $current, $class; + + for my $key (sort keys %hash) { + next if !$inc_weak_refs && isweak(${ $hash{$key} }); + _find_cycle(${ $hash{$key} },{%$seenit},$callback,$inc_weak_refs,$complain, + (@report,['HASH',$key,$current => ${ $hash{$key} },$inc_weak_refs?isweak(${ $hash{$key} }):()])); } } @@ -173,9 +183,13 @@ sub _find_cycle_CODE { my $closed_vars = PadWalker::closed_over( $current ); foreach my $varname ( sort keys %$closed_vars ) { + my $is_weak = reftype($closed_vars->{$varname}) eq 'REF' + && isweak(${ $closed_vars->{$varname} }); + next if !$inc_weak_refs && $is_weak; my $value = $closed_vars->{$varname}; _find_cycle_dispatch($value,{%$seenit},$callback,$inc_weak_refs,$complain, - (@report,['CODE',$varname,$current => $value])); + (@report,['CODE',$varname,$current => $value, + $inc_weak_refs ? $is_weak : ()])); } } @@ -203,7 +217,7 @@ sub _format_reference { my $package = blessed($ref); my $prefix = $package ? ($FORMATTING eq 'roasted' ? "${package}::" : "${package}=" ) : ''; my $sygil = $deref ? '\\' : ''; - my $shortname = ($SHORT_NAMES{$ref} ||= $SHORT_NAME++); + my $shortname = ($SHORT_NAMES{refaddr $ref} ||= $SHORT_NAME++); return $sygil . ($sygil ? '$' : '$$'). $prefix . $shortname . $suffix if $type eq 'SCALAR'; return $sygil . ($sygil ? '@' : '$') . $prefix . $shortname . $suffix if $type eq 'ARRAY'; return $sygil . ($sygil ? '%' : '$') . $prefix . $shortname . $suffix if $type eq 'HASH';


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.