RSS Git Download  Clone
Raw Blame History
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;