PAR-Packer

 view release on metacpan or  search on metacpan

contrib/gui_pp/gpp_readme.txt  view on Meta::CPAN

Gpp provides (yet another) gui frontend to the PAR compiler - pp. The help
display is taken from the pod in pp (or pp.bat on win32) at runtime, and
options to pp are "use"ed from Packer.pm, so new options in later PAR versions
should appear automatically in gpp. Gpp looks for pp (or pp.bat) first in the
current directory, then in the environment variable PATH.

Options are displayed in a scrolling window, with a checkbox next to each to
enable it. Options that take an integer value have an up/down counter next to
them. Options that take a string or non-integer number have an entrybox with a
pulldown history window. Each option checkbox has a popup hint with the pp
short description.

Only the following options are expected to be supported by pp and are treated
specially by gpp:
        -h
The "Help" button displays the pp pod and -h doesn't appear in the list.
        -o <output file>
The output file has an entry box of it's own and -o doesn't appear in the list,
        -L <logfile>
The "View Log" button displays the contents of the file shown next to "L" in

script/tkpp  view on Meta::CPAN

	-label   => '~Tkpp documentation',
	-command => [ \&open_pod_documentation, $main, 'tkpp' ],
);
my $pp_pod_menu = $help_menu->command(
	-label   => '~pp documentation',
	-command => [ \&open_pod_documentation, $main, 'pp' ],
);
$help_menu->separator;
$help_menu->command(
	-label   => 'About Tkpp',
	-command => sub { popup_information( $main, $general_configuration{tk}{about_message} ); },
);

$help_menu->command(
	-label   => 'About pp',
	-command => sub { popup_information( $main, $general_configuration{pp_version} ); },
);

#=======
# Header Frame
#=======
my $header_frame = $main->Frame( -background => 'white' );
$header_frame->Label(
	-text       => $general_configuration{tk}{name_application} . ' (v' . $VERSION . ')',
	-background => 'white',
	-font       => '{Arial} 10 {bold}',

script/tkpp  view on Meta::CPAN

sub build_pp {
	my ( $widget, $ref_options, $display_commandline ) = @_;

	clean_report();
	$command = $EMPTY;

	# perl.exe not found
	if ( !-e $ref_options->{'--perlfile'}{-value} ) {
		my $error = 'The path to ' . basename($EXECUTABLE_NAME) . ' has not been set or invalid.';
		popup_information_warning( $widget, $error );
		$options_pp{'--perlfile'}{-widget}->focus;
		$notebook->raise('General');
		print_error($error);
		return;
	}

	# pp not found
	if ( !-e $ref_options->{'--ppfile'}{-value} ) {
		my $error = 'The path to ' . basename( $general_configuration{pp_path} ) . ' has not been set or invalid.';
		popup_information_warning( $widget, $error );
		$options_pp{'--ppfile'}{-widget}->focus;
		$notebook->raise('General');
		print_error($error);
		return;
	}
	$command .= ' "' . $ref_options->{'--ppfile'}{-value} . $DOUBLE_QUOTE;

	# output not found
	my $output = $ref_options->{'--output'}{-value};
	if ( $output eq $EMPTY ) {
		my $error = 'You must specify an output file to write.';
		popup_information_warning( $widget, $error );
		$options_pp{'--output'}{-widget}->focus;
		$notebook->raise('General');
		print_error($error);
		return;
	}

	# Overwrite output or not
	if ( -e $output ) {
		my $warning = 'The output ' . basename($output) . ' already exists.' . "\n" . 'Do you want overwrite it ?';
		if ( !popup_confirmation( $widget, $warning ) ) {
			$options_pp{'--output'}{-widget}->focus;
			$notebook->raise('General');
			return;
		}

		unlink $output or print_ok("Unable to delete $output"), return;
		print_ok("$output deleted");
	}
	$command .= ' --output="' . $ref_options->{'--output'}{-value} . $DOUBLE_QUOTE;
	print_ok( 'Start building ' . basename($output) );

script/tkpp  view on Meta::CPAN

	# PAR, perlscript check extension
	if ( $ref_options->{'--output'}{-value} =~ m{\.par$}msxi ) {
		$command .= ' --par';
	}
	elsif ( $ref_options->{'--output'}{-value} =~ m{\.pl$}msxi ) {
		$command .= ' --perlscript';
	}
	elsif ( $ref_options->{'--output'}{-value} !~ m{\Q$Config{_exe}\E$}msxi ) {
		my $error = 'You are trying to write your output file as an invalid file format.'
		  . "It must be either a $Config{_exe} or .par file.";
		popup_information_warning( $widget, $error );
		$options_pp{'--output'}{-widget}->focus;
		$notebook->raise('General');
		print_error($error);
		return;
	}

	# Check iconfile
	# if ( my $icon = $ref_options->{'--icon'}{-value} ) {
	#   my $error
	#     = ( !-e $ref_options->{'--icon'}{-value} ) ? 'You have to set an existing icon file'
	#     : ( $icon !~ m{\.(?:dll|ico|exe)$}msxi ) ? 'You are trying to use an icon with bad extension ('
	#     . basename($icon) . ').'
	#     . "\nExtension must be .dll, .exe or .ico."
	#     : undef;
	#
	#   if ( defined $error ) {
	#     popup_information_warning( $widget, $error );
	#     $options_pp{'--icon'}{-widget}->focus;
	#     $notebook->raise('General');
	#     print_error($error);
	#     return;
	#   }
	#   else {
	#     $command .= ' --icon="' . $ref_options->{'--icon'}{-value} . $DOUBLE_QUOTE;
	#   }
	# }

script/tkpp  view on Meta::CPAN

		$command .= " --log=\"$logfile\"";
		if ( -e $logfile ) { unlink $logfile or die "Unable to delete $logfile\n"; }
	}

	# verbose
	if ( $ref_options->{'--verbose'}{-value} ne 'none' ) {

		# Need to select logfile
		unless ( my $logfile = $ref_options->{'--log'}{-value} ) {
			my $error = 'You have to select a log file if you want to see verbose message.';
			popup_information_warning( $widget, $error );
			$options_pp{'--log'}{-widget}->focus;
			$notebook->raise('General');
			print_error($error);
			return;
		}

		$command .= ' --verbose=' . $ref_options->{'--verbose'}{-value};
	}

	# scandependencies

script/tkpp  view on Meta::CPAN

	if ( $options_pp{'--podstrip'}{-value} == 1 ) {
		$ENV{PAR_VERBATIM} = 1;
	}

	# --filter
	if ( my $filter = $options_pp{'--filter'}{-value} and $options_pp{'--filter'}{-value} ne 'None' ) {
		if ( exists $FILTERS_MODULES{$filter} ) {
			eval "use $FILTERS_MODULES{$filter}";
			if ( $EVAL_ERROR !~ /^\s*$/msx ) {
				my $error = "You have to install $FILTERS_MODULES{$filter} to use '$filter' filter";
				popup_information_warning( $widget, $error );
				$options_pp{'--filter'}{-widget}->focus;
				$notebook->raise('Option');
				print_error($error);
				return;
			}
		}
		$command .= ' --filter="' . $filter . $DOUBLE_QUOTE;
	}

	# --modfilter

script/tkpp  view on Meta::CPAN

	}
	elsif ( -e $options_pp{'--sourcefile'}{-value} ) {

		# add source file in command
		$command .= ' "' . $ref_options->{'--sourcefile'}{-value} . $DOUBLE_QUOTE;
	}

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

script/tkpp  view on Meta::CPAN

		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 {
	my ( $widget, $message ) = @_;
	$widget->bell;
	$widget->messageBox(
		-icon    => 'warning',
		-title   => 'Warning',
		-type    => 'OK',
		-message => $message,
	);

	return;
}

#================================================
# popup_information($widget, $message);
#================================================
sub popup_information {
	my ( $widget, $message ) = @_;

	$widget->bell;
	$widget->messageBox(
		-icon    => 'info',
		-title   => 'Information',
		-type    => 'OK',
		-message => $message,
	);

	return;
}

#================================================
# popup_confirmation($widget, $message);
#================================================
sub popup_confirmation {
	my ( $widget, $message ) = @_;

	$widget->bell;
	my $response = $widget->messageBox(
		-icon    => 'info',
		-title   => 'Information',
		-type    => 'OKCANCEL',
		-message => $message,
	);