Merge pull request #8 from cxw42/script-parms

Support passing parameters from the command line into scripts via `-s` and `%S`.

Author: cxw42

Makefile

@@ -4,5 +4,8 @@ all: test
 
 test:
 	perl -e 'use Test::Harness "runtests"; runtests @ARGV;' -- t/*.t 2>/dev/null
-	#Pure shell: for f in t/*.t ; do echo "$$f" ; perl "$$f" ; done 2>/dev/null
+
+
+#Note: if you don't have Test::Harness, you can use:
+#	for f in t/*.t ; do echo "$$f" ; perl "$$f" ; done 2>/dev/null
 

README.md

@@ -8,6 +8,9 @@ No external modules are required, just a single file.
 	Usage: perl perlpp.pl [options] [filename]
 	Options:
 		-o, --output filename    Output to the file instead of STDOUT.
+		-s, --set name=value	 Set $S{name}=value in the generated code.
+					 The hash %S always exists, but is empty
+					 if you haven't specified any -s options.
 		-e, --eval expression    Evaluate the expression(s) before any Perl code.
 		-d, --debug              Don't evaluate Perl code, just write it to STDERR.
 		-h, --help               Usage help.
@@ -124,7 +127,7 @@ the perl code produces will be included verbatim in the script output.
 This can be used to dynamically select which files you want to include,
 using
 
-	<?:macro Include "whatever_filename"; ?>
+	<?:macro my $fn="some_name"; Include $fn; ?>
 
 Capturing
 ---------

perlpp.pl

@@ -434,13 +434,20 @@ sub Main {
 	StartOB();
 	print "package PPP_${Package};\nuse strict;\nuse warnings;\n";
 
-	# TODO transfer parameters from the command line to the processed file.
-	# Per commit 7bbe05c, %DEF is for those parameters.
-	print "my %DEF = ();\n";
+	# Transfer parameters from the command line (-s) to the processed file.
+	# The parameters are in %S, by analogy with -s.
+	print "my %S = (\n";
+	for my $defname (keys %{$opts{DEFS}}) {
+		print "    $defname => ", ${$opts{DEFS}}{$defname}, ",\n";
+	}
+	print ");\n";
 
+	# Initial code from the command line, if any
 	print $opts{EVAL}, "\n" if $opts{EVAL};
 
+	# The input file
 	ProcessFile( $opts{INPUT_FILENAME} );
+
 	my $script = EndOB();							# The generated Perl script
 
 	if ( $opts{DEBUG} ) {
@@ -479,6 +486,24 @@ =head1 OPTIONS
 
 Output to B<filename> instead of STDOUT.
 
+=item -s, --set B<name>=B<value>
+
+In the generated script, set C<< $S{B<name>} >> to B<value>.
+The hash C<%S> always exists, but is empty if no B<-s> options are
+given on the command line.
+
+Note: If your shell strips quotes, you may need to escape them.  B<value> must
+be a valid Perl expression.  So, under bash, this works:
+
+    perlpp -s name=\"Hello, world!\"
+
+The backslashes (C<\"> instead of C<">) are required to prevent bash
+from removing the double-quotes.  Alternatively, this works:
+
+    perlpp -s 'name="Hello, World"'
+
+with the whole argument to B<-s> in single quotes.
+
 =item -e, --eval B<statement>
 
 Evaluate the B<statement> before any other Perl code in the generated
@@ -492,6 +517,14 @@ =head1 OPTIONS
 
 Usage help.
 
+=item --man
+
+Full documentation
+
+=item -?, --usage
+
+Shows just the usage summary
+
 =back
 
 =head1 COPYRIGHT

t/cmdline.t

@@ -2,7 +2,7 @@
 # Tests of perlpp command-line options
 use strict;
 use warnings;
-use Test::More;
+use Test::More 'no_plan';
 use IPC::Run3;
 use constant CMD => 'perl perlpp.pl';
 
@@ -18,9 +18,18 @@ my @testcases=(
 	['--eval \'my $foo=42;\'','<?= $foo ?>', qr/^42$/],
 	['-d -e \'my $foo=42;\'','<?= $foo ?>', qr/^my \$foo=42;/m],
 	['--debug --eval \'my $foo=42;\'','<?= $foo ?>', qr/^print\s+\$foo\s*;/m],
+	['-s foo=1', '<?= $S{foo} ?>',qr/^1$/],
+	['-s foo=\"blah\"', '<?= $S{foo} ?>',qr/^blah$/],
+		# Have to escape the double-quotes so perl sees it as a string
+		# literal instead of a bareword.
+	['-s foo=42 -s bar=127', '<?= $S{foo} * $S{bar} ?>',qr/^5334$/],
+	['', '<? $S{x}="%S always exists even if empty"; ?><?= $S{x} ?>',
+		qr/^%S always exists even if empty$/],
 ); #@testcases
 
-plan tests => scalar @testcases;
+#plan tests => scalar @testcases;
+# TODO count the out_re and err_re in @testcases, since the number of
+# tests is the sum of those counts.
 
 for my $lrTest (@testcases) {
 	my ($opts, $testin, $out_re, $err_re) = @$lrTest;