| Subject: | No support for overloaded objects |
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 |
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';