Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
Most of the code is borrowed from the PDKcompile script by the fabulous Jenda, I just tweaked it to make it work with PAR...
So what does it do? It allows you to create an INI-like POD section inside your script that contains all parameters to create a (freestanding) executable with PAR's pp tool. Such an INI section looks like this:
=begin PARcompile [main] name=MyScript [options] exe=$name.$ver.exe icon=myicon.ico [info] CompanyName=MyCompany FileDescription=PARcompile - PAR compiler frontend ProductName=$name $ver LegalCopyright=Copyright (c) 2004 Jouke Visser. LegalTrademarks=n.a. Comments=<<*END* PARcompile, the PAR Compiler Frontend, is a wrapper application for the pp tool, shipped with Autrijus Tang's PAR. It is based upon Jenda Krynicky's PDKcompile tool. This program is free software; you can redistribute it and/or modify i +t under the same terms as Perl itself. *END* =cut
So here's the code!
#!/usr/bin/perl # This is the PDKCompile script from Jenda Krynicky < +>, # 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 " $VERSION by Jouke Visser <jouke\> (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] or PARcompile --template The 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/". ; ; 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 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 ; ; 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 ; 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" or "-l ; /usr/local/lib/" 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 <> *END* [do_before] run= [do_after] run= =cut

Jouke Visser, Perl 'Adept'
Using Perl to help the disabled: pVoice and pStory

In reply to PARcompile by Jouke

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others meditating upon the Monastery: (8)
    As of 2021-04-21 15:13 GMT
    Find Nodes?
      Voting Booth?

      No recent polls found