If I'd seen PARcompile I probably wouldn't have written pppp!  However
I have, so I'm contributing it back in the hope that it's useful. 
It's cross-platform (as far as I can tell), and has minimal standard
dependencies.  I'm sucessfully using it from within Komodo to
single-click package scripts.

It would be great to see it (and PARcompile) in the contrib directory,
if one of the maintainers has the inclination.  My next step is to
look at adding the functionality to pp.

I've added a --pod_directive=... option to allow e.g. head2 POD
clauses to be used instead of item ones.  --verbose will show you the
pp command line.

To answer some of the previous comments:

--addlist -> --addfile translation has been implemented.  A solitary
--addlist=file without a list of files is passed to pp as-is, to allow
for users actually wanting to maintain an external include file.

I haven't implemented =begin pp/=end pp, principally because I'd
started one way, and that worked and looked good enough after
pod2html-ing it.  Similarly for putting multiple arguments on a single
line, although I do think there's a small point of clarity here: the
POD shows exactly what users need to supply to pp.  "-I option1
option2" may confuse.

The code is attached below.  Feedback is of course welcome.

Robin

---BEGIN CODE---

#!/usr/bin/perl -w

####################################################################
# POD

=head1 NAME

pppp - The Perl Packager PreProcessor

=head1 SYNOPSIS

 pppp script.pl

 pppp --verbose script.pl

 pppp --pod_directive=head2 script.pl

 pppp --pod_directive=nopod script.pl

=head1 DESCRIPTION

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 "=item PAR ..." pod clauses.  Additional
information is contained within the pod section following the
"=item PAR ..." clause, e.g.

  =item 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

  =item PAR -c

=head1 OPTIONS

=over 4

=item --pod_directive=POD_DIRECTIVE

An optional directive indicating the type of POD clause to look at for PAR
configuration, e.g. item, head2 etc.

=item --verbose

Shows additional pppp information such as the pp command to run.

=back

=head1 SEE ALSO

=over 4

=item PARCompile

http://www.mail-archive.com/[email protected]/msg01163.html and
http://jenda.krynicky.cz/#PDKcompile

=item PAR

http://search.cpan.org/~autrijus/PAR/

=back

=head1 ACKNOWLEDGEMENTS

The PAR and pp authors.

Doug Smith for the idea and the name.

=head1 AUTHORS

Robin Macharg

=head1 COPYRIGHT

(c) 2005 Robin Macharg

You are free to distribute this code under the same terms as Perl.

=head1 CVS INFO

$Header: T:\\cvsarchive/development_tools/pppp/pppp.pl,v 1.5
2005/03/15 14:15:21 rmacharg Exp $

=cut

####################################################################
# Revision History
#
# $Log: pppp.pl,v $
# Revision 1.5  2005/03/15 14:15:21  rmacharg
# overnight work to fix it up so it performs as advertised.
#
# Revision 1.4  2005/03/14 17:30:57  rmacharg
# --verbose and --pod_directive options
# --addlist => --addfile transformation finished
#
# Revision 1.3  2005/03/14 08:37:08  rmacharg
# Minor POD update
#
# Revision 1.2  2005/03/14 08:34:25  rmacharg
# Edited at home.
#
# The following modifications should be noted:
#
# 12/03/2005 - RMM  - Modified --addlist/-A to avoid temp file use.
#                     Added POD comments.
# 10/03/2005 - RMM  - RMM = Robin Macharg
#                     Created.
#
####################################################################

# Pragmata
use strict;
use warnings;
use Config;
use Getopt::Long;

# Global variables
my $options = "";
my $pp = $Config{'scriptdir'} . '/pp.bat'; # pp command

####################################################################
##
## Main code
##
####################################################################

# Process command-line options
my $pod_directive = "item";
my $verbose = 0;
GetOptions(
           "pod_directive:s" => \$pod_directive,
           "verbose"         => \$verbose,
           );
my $input_file = shift @ARGV;
#print "INPUT: $input_file\n";

# Slurp the file in
undef $/;
open FILE_TO_PAR, "<$input_file";
my $file = <FILE_TO_PAR>;
close FILE_TO_PAR;

# iterate over PAR pod clauses
while ($file =~ m/
                    ^
                    =$pod_directive     # item 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 additional files to our archive.
        # One file per line in the body of block, formatted as --addfile args
        (($tokens[0] =~ /--addlist=(.*)/) ||
         (($tokens[0] =~ /-A/) && ($tokens[1] =~ /(.*)/))) && do {
            my $filename = $1;
            ( my $addfiletext, pos $file ) = get_pod_block($file, pos $file);

            # Allow for the user actually wanting to give a real --addlist
            if ((($addfiletext eq '') ||         # pod block is empty
                 ($addfiletext =~ /^\s*$/m)) &&
                ( $filename ne '')) {            # filename is not

                $options .= " --addlist=$filename";
            } else {
                foreach $file (split /\n/, $addfiletext) {
                    $options .= " --addfile=$file";
                }
            }
            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;
    }
}

my $command_line = "$pp $options $input_file";
print "Command Line:\n$command_line\n" if $verbose;

# run 'pp'
system ("$pp $options $input_file") == 0 ||
  die "Unable to run pp: $!";

####################################################################
##
## Cleanup and exit
##
####################################################################

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.
#
# Modification History
#
# Date         Author Comment
# ------------------------------------------------------------------
# 10/03/2005 - RMM  - RMM = Robin Macharg
#                     Created
####################################################################
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:
#
# Modification History
#
# Date         Author Comment
# ------------------------------------------------------------------
# 10/03/2005 - RMM  - RMM = Robin Macharg
#                     Created
####################################################################
sub write_file {
    my ($filename, $contents) = @_;
    open FILEOUT, ">$filename" ||
        die "Unable to open file $filename for writing: $!";
    print FILEOUT $contents;
    close FILEOUT;
}

Reply via email to