RSS Git Download  Clone
Raw Blame History
package LIMS::Local::DevelCycle;

use strict;
use warnings;

use Devel::Cycle;
use Data::Printer alias => 'p';
# use Carp::Always;

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; # p $thingy; # very large output!!
        return unless ref $thingy;
#       return 'SCALAR' if UNIVERSAL::isa($thingy,'SCALAR') || UNIVERSAL::isa($thingy,'REF');
        # https://rt.cpan.org/Public/Bug/Display.html?id=56681 (also added GLOB):
        return 'SCALAR' if grep UNIVERSAL::isa($thingy, $_),
            qw(SCALAR REF REGEXP GLOB);
        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};

#=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;