view release on metacpan or  search on metacpan

lib/Log/Shiras/Unhide.pm  view on Meta::CPAN

		^Tie|				^Text|				^Time.Local|		^Try|
		^Type|				^unicore|			^UNIVERSAL|			^utf8|
		^Variable|			^Win32|				^XML|				
		^YAML				
	)/x;
my	$run_once_hash;
our	$strip_match;
my	$temp_dir;


#########1 import   2#########3#########4#########5#########6#########7#########8#########9

sub import {
    my( $class, @args ) = @_;
	# Handle re-call
	if( $strip_match ){
		warn "------------>Trying to reload Unhide with string: $strip_match !!!!!!!!!\n" if IMPORT_DEBUG;
		_resurrector_init();
		return 1;
	}

	warn "Received args:" . join( '~|~', @args ) if @args and IMPORT_DEBUG;

	# Build a temporary directory
	$temp_dir = File::Temp->newdir( CLEANUP => 1 );

	# Handle versions
	if( $args[0] and $args[0] =~ /^v?\d+\.?\d*/ ){# Version check since import highjacks the built in
		warn "Running version check on version: $args[0]" if IMPORT_DEBUG;
		my $result = $VERSION <=> version->parse( $args[0]);
		warn "Tested against version -$VERSION- gives result: $result" if IMPORT_DEBUG;
		if( $result < 0 ){
			die "Version -$args[0]- requested for Log::Shiras::Switchboard " .
					"- the installed version is: $VERSION";
		}
		shift @args;
	}

	# Build/Load the string strippers
	my @strip_list;
	for my $flag ( @args ){
		warn "Arrived at import with flag: $flag" if IMPORT_DEBUG;
		if( $flag =~ /^:([A-Za-z]+)$/ ){# Handle text based flags
			my $strip = $1;
			push @strip_list, $strip eq 'debug' ? 'LogSD' : $strip;
		}else{
			die "Flag -$flag- passed to import Log::Shiras::Switchboard did not pass the format test.";
		}
	}

	# Implement string stripping
	if( @strip_list ){
		$strip_match = '(' . join( '|', @strip_list	) . ')';
		warn "Using Log::Shiras::Unhide-$VERSION strip_match string: $strip_match" if !$ENV{hide_warn};
		_resurrector_init();
		$ENV{loaded_filter_util_call} = 1;
		# Check for Filter::Util::Call availability
		warn "Attempting to strip leading qr/###$Log::Shiras::Unhide::strip_match/" if IMPORT_DEBUG;
		my $FILTER_MODULE = "Filter::Util::Call";
		my $require_result;
		eval{ $require_result = require_module( 'Filter::Util::Call' ) };# require_module( $FILTER_MODULE ) };#
		if( $require_result and ($require_result == 1  or $require_result eq $FILTER_MODULE) ) {
			$ENV{loaded_filter_util_call} = 1;
			# Strip the top level script
			Filter::Util::Call::filter_add(
				sub {
					my $status;
					if($status = Filter::Util::Call::filter_read() > 0 ){
						s/^(\s*)###$Log::Shiras::Unhide::strip_match\s/$1/mg;
					}
					warn "----->script scrubbed line  : $_" if VIEW_TRANSFORM;
					$status;
				}
			);
		}else{
			warn "$FILTER_MODULE required to strip the script.  The flags |" . join( ' ', @args ) .
				"| will only be implemented for 'use'd modules - ('cpan Filter::Util::Call' to install)";
		}
	}
}

#########1 Functional Startup Private Methods     5#########6#########7#########8#########9

sub _resurrector_init {
    unshift @INC, \&_resurrector_loader;
}

sub _resurrector_loader {

    my ($code, $module) = @_;

    warn "$module sent to source filter scrub\n" if INTERNAL_DEBUG;

	# Skip Stuff that isn't likely to have source filter flags
    if($module =~ $my_unhide_skip_check) {
		warn "Don't scrub |$module| (it's on the skip list) return undef" if INTERNAL_DEBUG;
        return undef;
    }else{
		warn "Scrubbing Module: $module\n" if INTERNAL_DEBUG;;
	}

    my $path = $module;
	warn "Finding the location of module: $module" if INTERNAL_DEBUG;

	# Skip unknown files
    if(!-f $module) {
          # We might have a 'use lib' statement that modified the
          # INC path, search again.
        $path = _pm_search($module);
        if(! defined $path) {
            warn "File $module not found" if INTERNAL_DEBUG;
            return undef;
        }
        warn "File $module found in $path" if INTERNAL_DEBUG;
    }

    warn "Unhiding debug in module $path" if INTERNAL_DEBUG;
	my	$fh;
	if( exists $run_once_hash->{$path} ){
		warn "No action since this is already done" if INTERNAL_DEBUG;
	}else{