view release on metacpan or  search on metacpan

script/tkpp  view on Meta::CPAN

	# sourcefile not found
	elsif ( !-e $ref_options->{'--sourcefile'}{-value} ) {
		my $error = 'You must specify a source file to build.';
		popup_information_warning( $widget, $error );
		$options_pp{'--sourcefile'}{-widget}->focus;
		$notebook->raise('General');
		print_error($error);
		return;
	}

	# tkpp is execute in temp directory (read/write). if -M is used, tkpp have to check the module
	# in current source file directory. We will add it in the @INC
	# Perl will execute with -I option to change @INC
	$command = ' -I ' . dirname( $ref_options->{'--sourcefile'}{-value} ) . $command;

	# Display and execute command
	display_command("$EXECUTABLE_NAME $command");

	# Dispay output notebook
	$notebook->raise('Output');

	# Just display command line
	if ( defined $display_commandline ) {
		return;
	}
	execute_command( $EXECUTABLE_NAME, $command, $ref_options->{'--output'}{-value} );

	return;
}

sub execute_command {
	my ( $executable, $arguments, $outputfile_exe ) = @_;

	# Now, we can complet the command line
	$status = $ALL_STATUS{building};

	# Use Win32 Process
	if ( $OSNAME eq 'MSWin32' ) {
		require Win32::Process;
		require Win32;
		import Win32::Process qw(CREATE_NO_WINDOW STILL_ACTIVE );

		my $logfile         = $options_pp{'--log'}{-value};
		my $octet_size_read = 0;
		my $flags           = CREATE_NO_WINDOW();

		Win32::Process::Create( $win32_process_buiding, $executable, $arguments, 0, $flags, '.' )
		  or print_error( 'Erreur [' . Win32::GetLastError() . '] : ' . Win32::FormatMessage( Win32::GetLastError() ) );

		$build_button->configure( -state => 'disabled' );
		$build_button->redraw_button;

		# Check process id running and enabled Build button
		$main->after( $REPEAT_FILE_TIME, [ \&check_process_id, $logfile, \$octet_size_read, $outputfile_exe ] );

	}
	else {
		$main->Busy( -recurse => 1 );
		system( $executable, $arguments ) == 0 or print_error("Command line failed : $?");
		$main->Unbusy();
		$status = $ALL_STATUS{finished};
	}

	return;
}

#================================================
# check process working
#================================================
sub check_process_id {
	my ( $logfile, $ref_octet_size_read, $outputfile_exe ) = @_;
	my $pid = $win32_process_buiding->GetProcessID();
	my $exitcode;
	my $still_active = $win32_process_buiding->GetExitCode($exitcode);

	# Read file
	if ( defined $logfile and -e $logfile ) {
		my ( $buffer, $buffer_size ) = ( undef, 1000 );
		open my $fh, '<', $logfile or die "Unable to read $logfile";
		seek $fh, ${$ref_octet_size_read}, 0;

		while ( read( $fh, $buffer, $buffer_size ) != 0 ) {
			print_ok( $buffer, 1 );
			${$ref_octet_size_read} += $buffer_size;
		}
		close $fh or die "Unable to close $logfile\n";

		#${$ref_octet_size_read} = ( stat($log_file) )[7];
	}

	# Check if process is active
	if ( $exitcode == STILL_ACTIVE() ) {
		$main->after( $REPEAT_FILE_TIME, [ \&check_process_id, $logfile, $ref_octet_size_read, $outputfile_exe ] );
		return;
	}

	$build_button->configure( -state => 'normal' );
	$build_button->redraw_button;
	$win32_process_buiding = undef;

	if ( -e $outputfile_exe ) {
		$status = $ALL_STATUS{finished};
		print_ok("\n ==> $status");
	}
	else {
		$status = $ALL_STATUS{error};
		my $error = Win32::GetLastError();
		print_error("Building $outputfile_exe failed :");
		print_error( Win32::FormatMessage($error) );
		print_error("Active verbose to see more details (General Options)");
		print_ok("\n ==> $status");
	}

	return;
}

#================================================
# popup_information_warning($widget, $message);
#================================================
sub popup_information_warning {