Hi Alan,
Thanks for the reply.
> >.... I'll apologise up front if this idea has been discussed before.
>
> This is new :)
That's always nice!
> You may have done this, but how about =item / =back bracketing for other
> options like
> "-l" that can occur multiple times? One =item bracket could generate multiple
> "-l".
It's an idea, certainly. I don't currently do this, mainly because
it's was easier to code for the --option=value or -O value general
cases. The whole thing only took an evenings tinkering.
> On the other hand, why not process the "=item PAR --addlist" into multiple
> "--addfile"
> options and avoid the extra file? It's equivalent.
This is a nice idea. I'll look at doing just that. The --addlist
option is the only argument specialisation at the moment anyway.
> At the very least, show it to us, and I'll add it to the contrib/ directory !
The code is below. There are naturally lots of places it could be
improved, and it's currently hardwired to use a windows directory
separator when locating pp. Watch this space, I guess, for v0.2 ;-)
Cheers,
Robin
#!/usr/bin/perl -w
####################################################################
# File: pppp.pl
# Description: Preprocess a Perl file for packaging by the PAR pp
# tool.
#
# (c) Robin Macharg, 2005
#
# You are free to distribute this code under the same terms as Perl.
#
# Discussion
#
# The Perl ARchiver (PAR) provides a mechanism by which Perl files
# can be packaged as self-contained executables, using a utility
# called 'pp'. This script allows a user to encode configuration
# information for pp/PAR within the pod documentation. This is
# done with a series of "=head2 PAR ..." pod clauses. Additional
# information is contained within the pod section following the
# "=head2" clause, e.g.
#
# =head2 PAR -A addfile.txt
#
# C:\temp\addfile1.txt;/path/to/adfiles/addfile1.txt
# C:\temp\addfile2.txt;/path/to/adfiles/addfile2.txt
# C:\temp\addfile3.txt;/path/to/adfiles/addfile3.txt
#
# =head2 PAR -c
#
# The name pppp was suggested by Doug Smith.
#
# Revision History
#
# Date Author Comment
# ------------------------------------------------------------------
# 10/03/2005 - RMM - RMM = Robin Macharg
# Created.
####################################################################
# Pragmata
use strict;
use warnings;
use Config;
# Global variables
my $options = "";
my $pp = $Config{'scriptdir'} . '\pp.bat'; # pp command
my $input_file = $ARGV[0];
####################################################################
##
## Main code
##
####################################################################
# Slurp the file in
undef $/;
my $file = <>;
# iterate over PAR pod clauses
while ($file =~ m/
^
=head2 # head2 pod clause
\s+
PAR # that is a PAR directive
\s+
(.*) # and contains stuff
/xgm) {
my @tokens = split / /, $1; # Tokenise the option
# process PAR/pp options
SWITCH: {
# Add files to our archive. Files can optionally be given in
# the POD block
$tokens[0] =~ /--addlist=(.*)/ && do {
my $filename = $1;
( my $addfiletext, pos $file ) = get_pod_block($file, pos $file);
write_file($filename, $addfiletext); # write out our addfile
$options .= " " . join " ", @tokens;
last SWITCH;
};
$tokens[0] =~ /-A/ && do {
my $filename = $tokens[1];
( my $addfiletext, pos $file ) = get_pod_block($file, pos $file);
write_file($filename, $addfiletext); # write out our addfile
$options .= " " . join " ", @tokens;
last SWITCH;
};
# Process simple options. Probably overkill since they're processed by
# the default action, but it does allow us to extend the code easily.
# Catch-all for simple options
$tokens[0] =~ /-[aBcCdxghmnpPrsSTV]/ && do {
$options .= " " . $tokens[0];
last SWITCH;
};
# verbose simple options
my $verbosesimpleoptions = "bundle|clean|compile|dependent|" .
"execute|gui|help|multiarch|noscan|" .
"par|perlscript|run|save|sign|" .
"tempcache|version";
$tokens[0] =~ /--[$verbosesimpleoptions]/ && do {
$options .= " " . $tokens[0];
last SWITCH;
};
# simple options with value
$tokens[0] =~ /-[eXfiINlLFMovz]/ && do {
$options .= " " . join " ", @tokens;
last SWITCH;
};
# verbose valued options
my $verbosevaluedoptions = "eval|exclude|filter|icon|info|" .
"lib|link|log|modfilter|module|" .
"output|verbose|compress";
$tokens[0] =~ /--[$verbosevaluedoptions]=(.*)/ && do {
$options .= " " . $tokens[0];
last SWITCH;
};
# Pass unknown options verbatim - the user's probably right
$options .= " " . join " ", @tokens;
}
}
# run 'pp'
system ("$pp $options $input_file") == 0 ||
die "Unable to run pp: $!";
exit 0;
####################################################################
# Function: get_pod_block
# Description: extract the body of a pod block
# Arguments: $file - the text to extract from
# $pos - the position to start matching from.
# Returns: a block of text, stripped of leading and trailing
# whitespace and the new position to start matching
# from.
####################################################################
sub get_pod_block {
my ($file, $pos) = @_;
pos $file = $pos;
$file =~ m/
\s* # leading whitespace
(.*?) # interesting stuff
\s* # trailing whitespace
^= # another pod clause
/mxgs;
my $textblock = $1;
$textblock =~ s/^ //gm; # chop off leading whitespace
# return our two values, backing up 1 char over the new pod clause
# start '='
return ($textblock, ( pos $file ) - 1);
}
####################################################################
# Function: write_file
# Description: write a file
# Arguments: $filename
# $contents
# Returns:
####################################################################
sub write_file {
my ($filename, $contents) = @_;
open FILEOUT, ">$filename" ||
die "Unable to open file $filename for writing: $!";
print FILEOUT $contents;
close FILEOUT;
}
