#!/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.2';
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);

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 $scriptf
+ile\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 da
+ta 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', 
    OptM('add'),
    OptB('bundle'),
    OptB('clean'),
    OptB('dependent'),
    OptB('compile'),
    OptB('execute'),
    OptS('exclude'),
    OptM('filter'),
    OptB('gui'),
    OptS('icon'),
    OptM('lib'),
    OptM('link'),
    OptS('log'),
    OptM('modfilter'),
    OptB('multiarch'),
    OptB('noscan'),
    OptS('output'),
    OptB('par'),
    OptB('perlscript'),
    OptB('run'),
    OptB('save'),
    OptB('sign'),
    OptB('verbose'),
    "--info=$info",
    $scriptfile
);

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

} else {

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

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

    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 {
# generate options without parameters
    my $name = shift;
    return ($options{$name} ? "--$name" : '');
}

sub OptS {
# generate options that can exist only once and have parameters
    my $name = shift;
    return ($options{$name} ? "--$name=$options{$name}" : '');
}

sub OptM {
# generate options that can exist multiple times and have parameters
    my $name = shift;
    my @distinct;
    if ($options{$name})
    {
        @distinct = split(/;/,$options{$name});
        return map {"--$name=$_"} @distinct;
    }
    return '';
}

sub prepareConfig {
    my ($scriptfile, $ver, $filever) = @_;
    my ($volume, $scriptdir);
    ($volume, $scriptdir, $scriptfile) = File::Spec->splitpath(File::S
+pec->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 $s
+criptfile : $!\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 $s
+criptfile : $!\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} © ".((loca
+ltime())[5] + 1900);
        }
    } else {
        $info->{LegalCopyright} =~ s/\(c\)/©/g;
    }
    $info->{OriginalFilename} = $options{exe} unless $info->{OriginalF
+ilename};
    $info->{InternalName} = "$config->{main}->{name} $ver" unless $inf
+o->{InternalName};
    $info->{comments}=~s/\n//g;
    qq{CompanyName="$info->{CompanyName}";FileDescription="$info->{Fil
+eDescription}";FileVersion="$filever";ProductName="$info->{ProductNam
+e}";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 fro
+m 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, vari
+able 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 i
+ndex from AUTHOR and DISCLAIMER.
destination=
;    Where to move the created file to.

[options]
;
;    Some options that pp recognizes can be specified more than once o
+n the 
;    commandline. for those options you can specify them as a semicolo
+n-seperated list, for example:
;add=GetOpt::Long;Locale::Maketext::Lexicon;Wx
add=
;    *MODULE*|*FILE*
;        Add the specified module into the package, along with its
;        dependencies. Also accepts filenames relative to the @INC pat
+h; 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 wil
+l not
;        be scanned for dependencies, and will be placed under "/" ins
+tead 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 en
+abled
;      by default, except when "-p" or "-P" is specified.
;
clean=
;    0 or 1
;        Clean up temporary files extracted from the application at ru
+ntime.
;        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 i
+s 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 dependen
+cies.
;
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 experime
+ntal
;        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 specifie
+d.
;
icon=
;    *FILE*
;        Specify an icon file (in .ico, .exe or .dll format) for the
;        executable. This option is ignored on non-MSWin32 platforms o
+r 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) in
+to 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 specifie
+d
;        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. Y
+ou 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 bina
+ry.
;
perlscript=
;    0 or 1
;        Create stand-alone perl script; do not package to a standalon
+e
;        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]
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]
run=

=cut
*END*
}

sub Run {
    my $tasks = shift() or return;
    for ($tasks->{'run'}) {
        s/^\s+//;
        s/\s+$//;
    }
    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} || $conf
+ig->{options}->{$1} || $config->{info}->{$1} || '$'.$1/ge; # interpol
+ate 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 $valu
+e) {
        $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;Wx;FileHandle
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 P
+AR
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]
run=

[do_after]
run=

=cut
[download]