package LIMS::Local::DevelCycle; use strict; use warnings; use Devel::Cycle; # use Carp::Always; use FindBin qw($Bin); # warn $Bin; my $out = ''; { # patched _get_type sub to prevent "Unhandled type: REGEXP" warning: # https://rt.cpan.org/Public/Bug/Display.html?id=56681 no warnings 'redefine'; sub Devel::Cycle::_get_type { my $thingy = shift; return unless ref $thingy; # return 'SCALAR' if UNIVERSAL::isa($thingy,'SCALAR') || UNIVERSAL::isa($thingy,'REF'); return 'SCALAR' if UNIVERSAL::isa($thingy,'SCALAR') || UNIVERSAL::isa($thingy,'REF') || UNIVERSAL::isa($thingy,'Regexp'); return 'ARRAY' if UNIVERSAL::isa($thingy,'ARRAY'); return 'HASH' if UNIVERSAL::isa($thingy,'HASH'); return 'CODE' if UNIVERSAL::isa($thingy,'CODE'); undef; } } sub find { my $thing = shift; # return 0 if $ENV{HARNESS_ACTIVE}; find_cycle($thing); =begin # error if run under fastcgi: warn '-------------------------------------------------------'; open my $oldout, '>&', STDOUT or die "Can't dup STDOUT: $!"; close STDOUT; warn '-------------------------------------------------------'; open STDOUT, '>', \$out or die "Can't redirect STDOUT: $!"; warn '-------------------------------------------------------'; find_cycle($thing); warn '-------------------------------------------------------'; open STDOUT, '>&', $oldout or die "Can't dup \$oldout: $!"; return $out ? "got this: [$out]\n" : 0; =cut } # exit 0; 1;