#!/usr/bin/perl
# This is the PDKCompile script from Jenda Krynicky <Jenda@Krynicky.cz>,
# tweaked to make it work with the pp tool that is shipped with PAR.
#
# I left as much code the same as it was, just made some adjustments...
#
# Jouke Visser, April 2004
use strict;
use warnings;
use Getopt::Long;
use Hash::Case::Preserve;
our $VERSION = '0.1';
print "PARcompile.pl $VERSION by Jouke Visser <jouke\@pvoice.org> (c) 2004\nBased upon PDKCompile 0.8.3 by Jenda Krynicky\n\n";

use FileHandle;
use Config::IniHash qw(ReadINI);

use Win32::Service qw(StopService StartService);

my ($help, $template, $print, %options);
GetOptions(
	'help'        => \$help, 
	'h'           => \$help, 
	'template'    => \$template,
	't' 	      => \$template,
	'print'       => \$print, 
	'p'           => \$print,
	'verbose!'    => \$options{'verbose'},
	'add=s'       => \$options{'add'},
	'bundle!'     => \$options{'bundle'},
	'clean!'      => \$options{'clean'},
	'dependent!'  => \$options{'dependent'},
	'compile!'    => \$options{'compile'},
	'execute!'    => \$options{'execute'},
	'exclude=s'   => \$options{'exclude'},
	'filter=s'    => \$options{'filter'},
	'gui!'        => \$options{'gui'},
	'icon=s'      => \$options{'icon'},
	'lib=s'       => \$options{'lib'},
	'link=s'      => \$options{'link'},
	'log=s'       => \$options{'log'},
	'modfilter=s' => \$options{'modfilter'},
	'multiarch!'  => \$options{'multiarch'},
	'noscan!'     => \$options{'noscan'},
	'output=s'    => \$options{'output'},
	'par!'        => \$options{'par'},
	'perlscript!' => \$options{'perlscript'},
	'run!'        => \$options{'run'},
	'save!'       => \$options{'save'},
	'sign!'       => \$options{'sign'}
);

our ($scriptfile, $config);

$scriptfile = shift();
if ($template) {
	PrintTemplate();
	exit;
} elsif ($help) {
	PrintHelp();
	exit;
} elsif (not defined $scriptfile) {
	print STDERR "No scriptfile specified...exiting\n\n";
	PrintHelp();
	exit;
} elsif (! -e $scriptfile) {
	print STDERR "Cannot find script file $scriptfile!\n\n";
	PrintHelp();
	exit;
}

my $INI = SnipINISection($scriptfile);
if (! $INI) {
	print STDERR "Cannot find\n\t=begin PARcompile\nin script $scriptfile\n\n";
	PrintHelp();
	exit;
}

my ($ver, $filever) = findVersion($scriptfile);
$config = prepareConfig( $scriptfile, $ver, $filever);

if (! ($config = ReadINI(\$INI, 
                         heredoc      => 1, 
                         withdefaults => 0, 
                         systemvars   => 1,
		         forValue     => \&insertVars, 
		         hash         => $config)
	)) {
	$INI =~ s/^/\t/m;
	print STDERR "Invalid data in PARcompile section:\n$INI\n\nGood data look like this:\n";
	PrintTemplate();
	exit;
}
clearVars();
MergeOptions($config, \%options);

my $info = FillInInfo($config->{info});
delete $ENV{Perl5opt};

print "\tcompiling $config->{main}->{name} $ver\n";


my @command = (
	'pp', 
	OptS('add'),
	OptB('bundle'),
	OptB('clean'),
	OptB('dependent'),
	OptB('compile'),
	OptB('execute'),
	OptS('exclude'),
	OptS('filter'),
	OptB('gui'),
	OptS('icon'),
	OptS('lib'),
	OptS('link'),
	OptS('log'),
	OptS('modfilter'),
	OptB('multiarch'),
	OptB('noscan'),
	OptS('output'),
	OptB('par'),
	OptB('perlscript'),
	OptB('run'),
	OptB('save'),
	OptB('sign'),
	OptS('bind'),
	OptS('blib'),
	OptB('clean'),
	OptS('debug'),
	OptB('dependent'),
	OptS('exe'),
	OptB('force'),
	OptB('gui'),
	OptS('icon'),
	OptS('lib'),
	OptB('nocompress'),
	OptS('tmpdir'),
	OptS('trim'),
	OptB('verbose'),
	OptB('xclude'),
	"--info=$info",
	$scriptfile
);

if ($print) {
	print join ("\n\t", @command), "\n";

} else {

	Run($config->{'do_before'});

	print "\n";
	print join (" ", @command), "\n" if $options{'verbose'};
	print "\n";
	if (system(join(' ',@command)) > 0) {
		exit;
	}

	if ($config->{main}->{destination}) {
		my $source = $config->{options}->{exe};
		my $dest = (-d $config->{main}->{destination})
			? $config->{main}->{destination}.'/'.$source
			: $config->{main}->{destination};
		print "\nMoving $source to $dest\n";
		(!-e $dest or unlink $dest)
		and rename $source, $dest
		or print STDERR "Cannot move the created $source to $config->{main}->{destination}\n";
	}

	MakeHTML($config) if $config->{main}->{html};
	Run($config->{'do_after'});

}

exit();

#==========================================================
# functions

sub OptB {
	my $name = shift;
	return ($options{$name} ? "--$name" : ());
}

sub OptS {
	my $name = shift;
	return ($options{$name} ? "--$name=$options{$name}" : '');
}

sub prepareConfig {
	my ($scriptfile, $ver, $filever) = @_;
	my ($volume, $scriptdir);
	($volume, $scriptdir, $scriptfile) = File::Spec->splitpath(File::Spec->rel2abs($scriptfile));
	$scriptdir = $volume.$scriptdir;

	my $config = {};
	tie %$config, 'Hash::Case::Preserve';
	$config->{main} = {};
	tie %{$config->{main}}, 'Hash::Case::Preserve';
	$config->{options} = {};
	tie %{$config->{options}}, 'Hash::Case::Preserve';
	$config->{info} = {};
	tie %{$config->{info}}, 'Hash::Case::Preserve';

	my ($main, $options, $info) = ( $config->{main}, $config->{options}, $config->{info});

	$main->{script}    = $main->{scriptfile}  = $scriptfile;
	$main->{scriptdir} = $scriptdir;
	$main->{ver}       = $main->{version}     = $ver;
	$main->{filever}   = $main->{fileversion} = $filever;

	{
		my $name = $scriptfile;
		$name =~ s/\.([^.]+)$//; # strip extension
		my $ext = $1;
		$name = ucfirst($name);
		$main->{name} = $name;
		$config->{options}->{exe_def} = 1;
		$config->{options}->{exe} = "$name.exe";
	}

	$main->{pod} = $scriptfile;
	$options->{force} = 1;

	return $config;
}

sub findVersion {
	my $scriptfile = shift;
	my ($FILE,$ver);
	open $FILE, '< ' .  $scriptfile or die "Cannot open script file $scriptfile : $!\n";
	while (<$FILE>) {
		if (/^\s*(?:our|my)?\s*\$(?:\w+::)*VERSION\s*=\s*['"]?([0-9.]+)/i
		or /^\s*\*(?:\w+::)*VERSION\s*=\s*\\['"]?([0-9.]+)/i
		or /^\s*VERSION\s*=>\s*['"]?([0-9.]+)/i) {
			$ver = $1;
			last;
		}
	}
	close $FILE;
	die "Cannot find \$VERSION=... in the script file $scriptfile!\n"
		unless defined $ver;

	my $filever = $ver;
	$filever =~ tr/0-9.//cd; # strip anything except numbers and dots

	$filever =~ s/^\./0./;
	$filever =~ s/\.$//;
	$filever =~ s/\.\./.0./;

	if ($filever !~ s/^(\d+\.\d+\.\d+\.\d+)/$1/) {
		$filever .= '.0.0.0';
		$filever =~ s/^(\d+\.\d+\.\d+).*/$1/;
		$filever .= '.' . BuildNumber($scriptfile, $ver);
	}

	return ($ver, $filever);
}

sub SnipINISection {
	my $scriptfile = shift;
	my ( $FILE, $INI);
	open $FILE, '< ' .  $scriptfile or die "Cannot open script file $scriptfile : $!\n";
	while (<$FILE>) {
		if (/^=(?:begin|for)\s+PARcompile\s*$/i) {
			while (<$FILE>) {
				last if /^=(?:end|cut)\s*$/;
				$INI .= $_;
			}
			last;
		}
	}
	close $FILE;
	return $INI;
}

sub BuildNumber {
	my ($script, $ver) = @_;
	my ($line, $VER, $build);
	if (open $VER, "< $script.ver") {
		$line = <$VER>;
		close $VER;
		if ($line =~ /^\Q$ver\E : (\d+)$/) {
			$build = $1 + 1;
		} else {
			$build = 0;
		}
	} else {
		$build = 0;
	}
	if (! $print) {
		open $VER, "> $script.ver";
		print $VER "$ver : $build\n";
		close $VER;
	}

	return $build;
}

sub FillInInfo {
	our $info = shift();

	$info->{ProductName} = "$config->{main}->{name} $ver" unless $info->{ProductName};
	if (!$info->{LegalCopyright}) {
		if ($info->{CompanyName}) {
			$info->{LegalCopyright} = "$info->{CompanyName} © ".((localtime())[5] + 1900);
		}
	} else {
		$info->{LegalCopyright} =~ s/\(c\)/©/g;
	}
	$info->{OriginalFilename} = $options{exe} unless $info->{OriginalFilename};
	$info->{InternalName} = "$config->{main}->{name} $ver" unless $info->{InternalName};
	$info->{comments}=~s/\n//g;
	qq{CompanyName="$info->{CompanyName}";FileDescription="$info->{FileDescription}";FileVersion="$filever";ProductName="$info->{ProductName}";ProductVersion="$filever";LegalCopyright="$info->{LegalCopyright}";LegalTrademarks="$info->{LegalTrademarks}";OriginalFilename="$info->{OriginalFilename}";InternalName="$info->{InternalName}";Comments="$info->{comments}"};
}

sub MergeOptions {
	my ($config, $cmdline_options) = @_;

	# merge the options specified in the POD section with the ones from the command line
	foreach my $option (keys %$cmdline_options) {
		if (defined $cmdline_options->{$option}) {
			$config->{options}->{$option} = $cmdline_options->{$option};
		} else {
			$cmdline_options->{$option} = $config->{options}->{$option};
		}
	}
}

sub PrintHelp {
	print <<'*END*';
Ussage: PARcompile [options] script.pl
    or  PARcompile --template

The script.pl MUST contain a POD section
    =for PARcompile
or
    =begin PARcompile
The section contains data about the executable
to be created in INI file like format.
Run
    PARcompile -t
to get an empty template.

The only options processed by PARcompile itself are
    --help  : print this information
    --print : do not execute pp, just print the command
    --template : print a template of the POD section
all others are passed to pp.
*END*
}

sub PrintTemplate {
	print '=begin PARcompile', <<'*END*';


;	You may use $variables in the values.
;	Predefined variables:
;		scriptfile = name of the file we compile (just the filename!)
;		scriptdir = full path to the directory where is the compiled script stored
;		name = the name part of the $scriptfile
;	All values specified in ANY section may be used in later values.
;	The variable names are case insensitive, as are all options, variable names
;	may contain only word characters =~ /^\$\w+$/.
;	You only get the default values if you do NOT specify the option at all!

[main]
;name=
;	Name of the project
;	By default the name of the script without extension
;pod=
;	What file to process with pod2html
;	By default the script
html=
;	Where to write the the HTML docs.
;	If this option is empty, no docs are created.
polishhtml=0
;	Moves the index below the name and version. Removes the link to index from AUTHOR and DISCLAIMER.
destination=
;	Where to move the created file to.

[options]
add=
;	*MODULE*|*FILE*
;        Add the specified module into the package, along with its
;        dependencies. Also accepts filenames relative to the @INC path; i.e.
;        "-M Module::ScanDeps" means the same thing as "-M
;        Module/ScanDeps.pm".
;
;        If *FILE* does not have a ".pm"/".ix"/".al" extension, it will not
;        be scanned for dependencies, and will be placed under "/" instead of
;        "/lib/" inside the PAR file.
;
;        You may specify "-M" multiple times.
;
bundle=
;	0 or 1
;      Bundle core modules in the resulting package. This option is enabled
;      by default, except when "-p" or "-P" is specified.
;
clean=
;	0 or 1
;        Clean up temporary files extracted from the application at runtime.
;        By default, these files are cached in the temporary directory; this
;        allows the program to start up faster next time.
;
dependent=
;	0 or 1
;        Reduce the executable size by not including a copy of perl
;        interpreter. Executables built this way will need a separate
;        perl5x.dll or libperl.so to function correctly. This option is only
;        available if perl is built as a shared library.
;
compile=
;	0 or 1
;        Run "perl -c inputfile" to determine additonal run-time
;        dependencies.
;
execute=
;	0 or 1
;        Run "perl inputfile" to determine additonal run-time dependencies.
;
exclude=
;	*MODULE*
;        Exclude the given module from the dependency search patch and from
;        the package.
;
filter=
;	 Can be either 'Bleach' or 'Bytecode';
;        Filter source script(s) with a PAR::Filter subclass. You may specify
;        multiple such filters.
;
;        If you wish to hide the source code from casual prying, this will
;        do:
;
;            % pp -f Bleach source.pl
;
;        Users with Perl 5.8.1 and above may also try out the experimental
;        byte-compiling filter, which will strip away all comments and
;        indents:
;
;            % pp -f Bytecode source.pl
;
gui
;	0 or 1
;        Build an executable that does not have a console window. This option
;        is ignored on non-MSWin32 platforms or when "par" is specified.
;
icon=
;	*FILE*
;        Specify an icon file (in .ico, .exe or .dll format) for the
;        executable. This option is ignored on non-MSWin32 platforms or when
;        "par" is specified.
;
lib=
;	*DIR*
;        Add the given directory to the perl library file search path. May be
;        specified multiple times.
;
link=
;	*FILE*|*LIBRARY*
;        Add the given shared library (a.k.a. shared object or DLL) into the
;        packed file. Also accepts names under library paths; i.e. "-l
;        ncurses" means the same thing as "-l libncurses.so" or "-l
;        /usr/local/lib/libncurses.so" in most Unixes. May be specified
;        multiple times.
;
log=
;	*FILE*
;        Log the output of packaging to a file rather than to stdout.
;
modfilter=
;	*FILTER*
;        Filter included perl module(s) with a PAR::Filter subclass. You may
;        specify multiple such filters.
;
multiarch=
;	0 or 1
;        Build a multi-architecture PAR file. Implies "par".
;
noscan=
;	0 or 1
;        Skip the default static scanning altogether, using run-time
;        dependencies from "compile" or "execute" exclusively.
;
output=
;	*FILE*
;        File name for the final packaged executable.
;
par=
;	0 or 1
;        Create PAR archives only; do not package to a standalone binary.
;
perlscript=
;	0 or 1
;        Create stand-alone perl script; do not package to a standalone
;        binary.
;
run=
;	0 or 1
;        Run the resulting packaged script after packaging it.
;
save=
;	0 or 1
;        Do not delete generated PAR file after packaging.
;
sign=
;	0 or 1
;        Cryptographically sign the generated PAR or binary file using
;        Module::Signature.
;

[info]
CompanyName=
FileDescription=
ProductName=$name $ver
LegalCopyright=$CompanyName (c) 2004
;	in LegalCopyright option (c) is converted to the copyright sign
LegalTrademarks=
OriginalFilename=$exe
InternalName=$name $ver
Comments=

[do_before]
start_services=
;	Comma separated list of service names
stop_services=
run=
;	Newline separated list of commands to run. Use the HEREDOC syntax.
;	If you do not want to wait for the program to finish use this:
;		start Notepad.exe $script

[do_after]
start_services=
stop_services=
run=

=cut
*END*
}

sub Run {
	my $tasks = shift() or return;
	for ($tasks->{'stop_services'}, $tasks->{'start_services'}, $tasks->{'run'}) {
		s/^\s+//;
		s/\s+$//;
	}
	if ($tasks->{'stop_services'}) {
		print "\nStopping services:\n";
		my @services = split /\s*[;,]\s*/, $tasks->{'stop_services'};
		foreach (@services) {
			next if $_ eq '';
			print "\t$_\n";
			StopService(undef, $_);
		}
		sleep(1);
		foreach (@services) {
			next if $_ eq '';
			my %status;
			Win32::Service::GetStatus(undef, $_, \%status);
			if (! %status) {
				print "\t\tTHE SERVICE DOESN'T EXIST!\n";
				next;
			};
			while ($status{CurrentState} != 1) {
				sleep(1);
				print '.';
				Win32::Service::GetStatus(undef, $_, \%status);
			}
		}
		print " done.\n";
	}
	if ($tasks->{'start_services'}) {
		print "\nStarting services:\n";
		my @services = split /\s*[;,]\s*/, $tasks->{'start_services'};
		foreach (@services) {
			next if $_ eq '';
			print "\t$_\n";
			StartService(undef, $_);
		}
		sleep(1);
		foreach (@services) {
			next if $_ eq '';
			my %status;
			Win32::Service::GetStatus(undef, $_, \%status);
			if (! %status) {
				print "\t\tTHE SERVICE DOESN'T EXIST!\n";
				next;
			};
			while ($status{CurrentState} != 4) {
				sleep(1);
				print '.';
				Win32::Service::GetStatus(undef, $_, \%status);
			}
		}
		print " done.\n";
	}
	if ($tasks->{'run'}) {
		chomp $tasks->{'run'};
		print "\nRunning commands:\n";
		foreach (split /\n/, $tasks->{'run'}) {
			next if $_ eq '';
			print "\t$_\n";
			system($_);
		}
		print " done.\n";
	}

}

sub MakeHTML {
	my $config = shift();
	my ($name, $ver, $source, $htmlfile) = map {$config->{main}->{$_}} qw(name ver pod html);
	my $desc = $config->{info}->{FileDescription};

	print "\nCreating HTML documentation: $source => $htmlfile\n";
	system qq{pod2html --title "$name $ver : $desc" --backlink "_index_" $source > $htmlfile};

	if ($config->{main}->{polishhtml}) {
		open IN, "<$htmlfile" or die "$!\n";
		open OUT, ">$htmlfile.tmp" or die "$!\n";

		while (<IN>) {
			last if /^\Q<!-- INDEX BEGIN -->\E$/;
			print OUT $_;
		}

		my $index = $_;
		while (<IN>) {
			next if /^\t\Q<LI><A HREF="#$name">\E/i;
			$index .= $_;
			last if /^\Q<HR>\E$/;
		}

		while (<IN>) {
			last if /^\Q<A HREF="#__index__">\E/;
			print OUT $_;
		}

		<IN>;

		print OUT $index;

		while (<IN>) {
			print OUT $_;
			last if m{^\Q<H1><A NAME="author">AUTHOR</A></H1>\E$};
		}

		while (<IN>) {
			next if m{\Q<A HREF="#__index__">\E};
			print OUT $_;
		}

		close IN;
		close OUT;

		unlink $htmlfile;
		rename $htmlfile.'.tmp', $htmlfile;
	}
}

my %data;
sub insertVars {
	my ($name, $value, $section, $hash) = @_;
	$name = lc $name;
	$section = lc $section;

	$value =~ s/(?:\x0D\x0A?|\x0A)/\x0D\x0A/sg; #convert end of lines to CRLF
	$value =~ s/\$(\w+)/$data{lc $1} || $config->{main}->{$1} || $config->{options}->{$1} || $config->{info}->{$1} || '$'.$1/ge; # interpolate variables

	if ($section eq 'main' and $name eq 'exe') {
		$config->{options}->{exe_def} = 0;

	} elsif ($section eq 'main' and $name eq 'type') {
		$value = uc($value) || 'EXE';
		die "The [main]type may only be set to EXE!\n"
			if $value !~ /^(?:EXE)$/;

		if ($config->{options}->{exe_def}) {
			$config->{options}->{exe} = "$config->{main}->{name}.exe";
		}

	} elsif ($section eq 'main' and $name eq 'name') {
		if ($config->{options}->{exe_def}) {
			$config->{options}->{exe} = "$value.exe";
		}

	} elsif ($section eq 'main' and $name eq 'html' and $value eq '1') {
		$value = "$config->{main}->{name}.html";
	} elsif ($section eq 'options' and $name eq 'output' and not $value) {
		$value =  $config->{options}->{exe};
	}

	$data{$name} = $value;
	return $value;
}

sub clearVars {undef %data}

1;

=begin PARcompile

[main]
;pod=
html=
polishhtml=0
destination=

[options]
add=Getopt::Long
bundle=
clean=
dependent=
compile=
execute=
exclude=
filter=
gui
icon=
lib=
link=
log=
modfilter=
multiarch=
noscan=
output=
par=
perlscript=
run=
save=
sign=

[info]
CompanyName=Jouke Visser
FileDescription=PARcompile - an easy way to compile perlscripts with PAR
ProductName=$name $ver
LegalCopyright=$CompanyName (c) 2004
;	in LegalCopyright option (c) is converted to the copyright sign
LegalTrademarks=
OriginalFilename=$exe
InternalName=$name $ver
Comments= <<*END*
This is PARcompile, based upon Jenda Krynicky's PDKcompile.
It was created by Jouke Visser <jouke@pvoice.org>
*END*

[do_before]
start_services=
stop_services=
run=

[do_after]
start_services=
stop_services=
run=

=cut