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;