view release on metacpan or  search on metacpan

lib/Padre/Plugin/Perl6/StdColorizerTask.pm  view on Meta::CPAN

	# associate a task with a certain buffer
	eval {
		$doc->check_syntax_in_background( force => 1 );
		$doc->get_outline( force => 1 );
	};
	if ($@) {

		#print "$doc\n";
	}

	# finished here
	$thread_running = 0;

	return 1;
}

# Task thread subroutine
sub run {
	my $self = shift;

	# temporary file for the process STDIN
	require File::Temp;
	my $tmp_in = File::Temp->new( SUFFIX => '_p6_in.txt' );
	binmode $tmp_in, ':utf8';
	print $tmp_in $self->{text};
	delete $self->{text};
	close $tmp_in or warn "cannot close $tmp_in\n";

	# temporary file for the process STDOUT
	my $tmp_out = File::Temp->new( SUFFIX => '_p6_out.txt' );
	close $tmp_out or warn "cannot close $tmp_out\n";

	# temporary file for the process STDERR
	my $tmp_err = File::Temp->new( SUFFIX => '_p6_err.txt' );
	close $tmp_err or warn "cannot close $tmp_out\n";

	my $tmp_dir = File::Spec->catfile( Padre::Constant::PLUGIN_DIR,
		'Padre-Plugin-Perl6'
	);
	if ( not -e $tmp_dir ) {
		require File::Path;
		File::Path::mkpath($tmp_dir);
	}
	$tmp_dir .= '/';

	# construct the command
	require Cwd;
	require File::Basename;
	require File::Spec;
	my $cmd =
		  Padre::Perl->perl . " "
		. File::Spec->catfile( Padre::Util::share('Perl6'), 'p6tokens.p5' )
		. qq( "$tmp_in" "$tmp_out" "$tmp_err" "$tmp_dir");

	# all this is needed to prevent win32 platforms from:
	# 1. popping out a command line on each run...
	# 2. STD.pm uses Storable
	# 3. Padre TaskManager does not like tasks that do Storable operations...
	if (Padre::Constant::WIN32) {

		# on win32 platforms, we need to use this to prevent command line popups when using wperl.exe
		require Win32;
		require Win32::Process;

		sub print_error {
			print Win32::FormatMessage( Win32::GetLastError() );
		}

		my $p_obj;
		Win32::Process::Create( $p_obj, Padre::Perl->perl, $cmd, 0, Win32::Process::DETACHED_PROCESS(), '.' )
			or warn &print_error;
		$p_obj->Wait( Win32::Process::INFINITE() );
	} else {

		# On other platforms, we will simply use the perl way of calling a command
		`$cmd`;
	}

	my ( $out, $err );
	{
		local $/ = undef; #enable localized slurp mode

		# slurp the process output...
		open my $CHLD_OUT, '<', $tmp_out or warn "Could not open $tmp_out";
		binmode $CHLD_OUT;
		$out = <$CHLD_OUT>;
		close $CHLD_OUT or warn "Could not close $tmp_out\n";

		open my $CHLD_ERR, '<', $tmp_err or warn "Cannot open $tmp_err\n";
		binmode $CHLD_ERR, ':utf8';
		$err = <$CHLD_ERR>;
		close $CHLD_ERR or warn "Could not close $tmp_err\n";
	}

	if ($err) {

		# remove ANSI color escape sequences...
		$err =~ s/\033\[\d+(?:;\d+(?:;\d+)?)?m//g;
		TRACE(qq{STD.pm warning/error:\n$err\n}) if DEBUG;
		my @messages = split /\n/, $err;
		my ( $lineno, $type );
		my $issues = [];
		my $prefix = '';
		for my $msg (@messages) {
			if ( $msg =~ /^===SORRY!===/i ) {

				# the following lines are errors until we see the warnings section
				$type = 'F';
			} elsif ( $msg =~ /^Potential difficulties/i ) {

				# all rest are warnings...
				$type   = 'W';
				$lineno = undef;
			} elsif ( $msg =~ /^Undeclared routine/i ) {

				# all rest are warnings...
				$prefix = 'Undeclared routine: ';
				$lineno = undef;
				$type   = 'W';
			} elsif ( $msg =~ /^\s+(.+?)\s+used at (\d+)/i ) {