[groff] 01/01: gperl: rewrite without subs; restrict storage to strings

[Bernd Warken]

bwarken pushed a commit to branch master
in repository groff.

commit 3c32c8c15feb391cd96a11a0bfcdf60ba72f3072
Author: Bernd Warken <address@hidden>
Date:   Sat Jun 14 21:55:34 2014 +0200

    gperl: rewrite without subs; restrict storage to strings
---
 contrib/gperl/ChangeLog |    6 +
 contrib/gperl/gperl.man |  267 +++++++++++++++++++++++++++++++++--------------
 contrib/gperl/gperl.pl  |  169 +++++++++++++++---------------
 3 files changed, 278 insertions(+), 164 deletions(-)

diff --git a/contrib/gperl/ChangeLog b/contrib/gperl/ChangeLog
index 042601f..d5ece27 100644
--- a/contrib/gperl/ChangeLog
+++ b/contrib/gperl/ChangeLog
@@ -1,3 +1,9 @@
+2014-06-14  Bernd Warken  <address@hidden>
+
+       * gperl.pl: Version 1.1.  New structure without subs.
+
+       * gperl.man: Major rewrite.  Omit `.nr'.
+
 2014-02-27  Bernd Warken  <address@hidden>
 
        * gperl.pl: Admit file name arguments.  Handle correct temporary
diff --git a/contrib/gperl/gperl.man b/contrib/gperl/gperl.man
index 52431cc..7b89b7f 100644
--- a/contrib/gperl/gperl.man
+++ b/contrib/gperl/gperl.man
@@ -9,11 +9,13 @@ gperl \- groff preprocessor for Perl parts in roff files
 .\" Legalese
 .\" --------------------------------------------------------------------
 .
-.de author
+.de authors
 This file was written by Bernd Warken <address@hidden>.
+.
+Latest update: 14 Jun 2014
 ..
 .
-.de co
+.de copyright
 Copyright (C) 2014 Free Software Foundation, Inc.
 .
 .P
@@ -43,7 +45,11 @@ The license text is available in the internet at
 .\" Setup
 .\" --------------------------------------------------------------------
 .
-.ds Ellipsis "\&.\|.\|.\&\"
+.
+.char \[Ellipsis] \f[S]\N'188'\fP
+.
+.\" ds Ellipsis \[el]
+.\" ds Ellipsis "\&.\|.\|.\&\"
 .
 .\" --------------------------------------------------------------------
 .\" Macro definitions
@@ -78,6 +84,21 @@ The license text is available in the internet at
 .  Text \\$*
 .  ft
 ..
+.
+.\" --------------------------------------------------------------------
+.\" .Topic  ([<indent>])
+.\"
+.\" A bulleted paragraph
+.\"
+.de Topic
+.  ie \\n[.$]=0 \
+.    ds @indent 2m\"
+.  el \
+.    ds @indent \\$1\"
+.  IP \[bu] address@hidden
+.  rm @indent
+..
+.
 .\" End of macro definitions
 .
 .
@@ -86,9 +107,9 @@ The license text is available in the internet at
 .\" --------------------------------------------------------------------
 .
 .SY gperl
-.OP option \*[Ellipsis]
+.OP \fIoption \[Ellipsis]
 .OP --
-.OP \%filespec \*[Ellipsis]
+.OP \fI\%filespec \[Ellipsis]
 .YS
 .
 .SY gperl
@@ -115,40 +136,24 @@ files.
 .
 The result of a
 .I Perl part
-can be stored in
-.I roff
-strings
-.RB ( .ds )
-or numerical registers
-.RB ( .rn ).
-.
-.
-.\" --------------------------------------------------------------------
-.SH "OPTION OVERVIEW"
-.\" --------------------------------------------------------------------
-.
-.TP
-.I breaking options
-.RS
-.P
-.SY
-.OP -h\~\fR|\fB\~--help
-.OP -v\~\fR|\fB\~--version
-.YS
-.RE
+can be stored in a
+.I groff string
+within the final line of a
+.IR "Perl part" .
 .
 .
 .\" --------------------------------------------------------------------
-.SH "OPTION DETAILS"
+.SH "OPTIONS"
 .\" --------------------------------------------------------------------
 .
-As soon as one of these options is found on the command line it is
-executed, printed to standard output, and the running
-.B \%gperl
-preprocessor is finished thereafter.
+So far, there are only
+.IR "breaking options" ,
+that means that the program writes the asked for information and
+stops a running program line.
 .
 All other arguments are ignored.
 .
+These options are
 .
 .TP
 .B -h\~\fR|\fB\~--help
@@ -168,76 +173,173 @@ Print version information to standard output.
 .I Perl
 parts in
 .I groff files
-are created by the new command
-.BR .Perl .
+are enclosed by two
+.B .Perl
+requests with different arguments, a
+.I starting
+and an
+.I ending
+command.
 .
 .
-.P
-A
-.I Perl part
-is started either by the request
-.B .Perl
-wiothout arguments, or by a request that's has the term
+.\" --------------------------------------------------------------------
+.SS "Starting Perl Mode"
+.\" --------------------------------------------------------------------
+.
+The starting
+.I Perl request
+can either be without arguments, or by a request that has the term
 .B start
 as its first argument.
+.RS
+.Topic
+.B \&.Perl
+.Topic
+.B \&.Perl start
+.RE
 .
+All arguments after
+.B start
+are ignored.
 .
-.P
-All
+.
+.\" --------------------------------------------------------------------
+.SS "Ending Perl Mode without Storage"
+.\" --------------------------------------------------------------------
+.
+A
 .B .Perl
-command lines with other arguments finish a running
+command line with an argument different from
+.B start
+finishes a running
 .IR "Perl part" .
 .
-So one can add arbitrary arguments for closing.
-.
-It would be reasonable to add the argument
-.BI stop ;
+Of course, it would be reasonable to add the argument
+.BR stop ;
 that's possible, but not necessary.
 .
+.RS
+.Topic
+.B \&.Perl stop
+.Topic
+.BI \&.Perl " other_than_start"
+.RE
+.
+The argument
+.I other_than_start
+can additionally used as a variable name for storage, see next
+section.
+.
+.
+.\" --------------------------------------------------------------------
+.SS "Ending Perl Mode with Storage"
+.\" --------------------------------------------------------------------
+.
+A useful feature of
+.B gperl
+is to store some result from the
+.IR "Perl mode" .
+.
 .
 .P
-A useful feature is to store the standard output of a
+That can be done by running the
 .I Perl part
-into a
-.I roff
-string or register.
+within
+.B gperl
+using one of the
+.I Perl commands
+from
+.BR IPC::System::Simple .
 .
-Storable data can be reached by
-.I printing to standard output
-with the
-.I Perl
-command
-.BR print .
+We use now the program
+.B capture
+for running the
+.IR "Perl parts" .
 .
 .
 .P
-Numerical output can be stored into a
-.IR "roff register" ,
-by adding the following 2 arguments to a
-.B .Perl
-stopping command line; the argument
-.B ds
-or
-.B .ds
-and a suitable variable name.
+The related storage information comes from the collection of all
+printing to standard output with the normal Perl
+.B print
+command in a
+.IR "Perl part" .
+.
+This pseudo-printing information does not go to
+.I STDOUT
+as normally, but is received as the result from the program, which
+runs the
+.IR "Perl part" .
 .
 .
 .P
-String output can be stored into a
-.IR "roff string" ,
-by adding the following 2 arguments to a
-.B .Perl
-stopping command line; the argument
-.B nr
-or
-.B .nr
-and a suitable variable name.
+But the printing towards
+.IR STDERR ,
+(standard error) works as usual.
+.
+All error information goes to the real normal
+.IR "standard error" ,
+without other automatical storage.
 .
 .
 .P
-Other arguments in a
+To use that output from the
+.I Perl part
+for
+.IR roff ,
+.B gperl
+creates automatically a line with the string defining roff command
+.BR .ds .
+.
+Because of the Perl-structure of the result, only string output can be
+used, not
+.IR "numerical roff registers" .
+.
+In
+.BR \%groff (@MAN7EXT@),
+one can create registers from strings.
+.
+.
+.B
+As the
+.I Perl mode
+must first be finished to get the information, this storage can only
+be done by arguments in the final
 .B .Perl
-command line are just ignored.
+command.
+.
+Possible arguments are
+.
+.RS
+.Topic
+.BI .Perl " var_name"
+.Topic
+.BI ".Perl ds" " var_name"
+.Topic
+.BI ".Perl .ds" " var_name"
+.Topic
+.BI ".Perl stop" " var_name"
+.Topic
+.BI ".Perl stop ds" " var_name"
+.Topic
+.BI ".Perl stop .ds" " var_name"
+.RE
+.
+.
+.P
+The
+.I var_name
+is some word that will be used by
+.B gperl
+for a
+.B .ds
+roff string definition.
+.
+If this
+.I var_name
+is the only argument, it must be different from
+.BR start ,
+at other argument places it can be chosen arbitrarily, but without
+spaces.
 .
 .
 .\" --------------------------------------------------------------------
@@ -252,10 +354,10 @@ could look like that:
 .RS
 .EX
 before
-.Perl start
+\&.Perl start
 my $result = 'some data';
 print $result . \[rq]\[rs]n\[rq];
-.Perl stop .ds some_string 
+\&.Perl stop .ds some_string 
 after
 .EE
 .RE
@@ -274,6 +376,11 @@ such that the following line is printed:
 \&.ds some_string some data
 .EE
 .RE
+by
+.B gperl
+as food for the coming
+.B groff
+run.
 .
 .
 .\" --------------------------------------------------------------------
@@ -292,13 +399,13 @@ such that the following line is printed:
 .\" --------------------------------------------------------------------
 .SH "AUTHOR"
 .\" --------------------------------------------------------------------
-.author
+.authors
 .
 .
 .\" --------------------------------------------------------------------
 .SH "COPYING"
 .\" --------------------------------------------------------------------
-.co
+.copyright
 .
 .
 .\" --------------------------------------------------------------------
diff --git a/contrib/gperl/gperl.pl b/contrib/gperl/gperl.pl
index 93fbb28..ccb1670 100755
--- a/contrib/gperl/gperl.pl
+++ b/contrib/gperl/gperl.pl
@@ -10,8 +10,8 @@
 
 # Written by Bernd Warken <address@hidden>.
 
-# Last update: 27 Feb 2014
-my $version = '1.0';
+my $Latest_Update = '14 Jun 2014';
+my $version = '1.1';
 
 # This file is part of `gperl', which is part of `groff'.
 
@@ -54,14 +54,14 @@ use Cwd;
 use FindBin;
 
 # for running perl scripts
-use IPC::System::Simple qw(system capture);
+use IPC::System::Simple qw(system systemx capture capturex);
 
 
 ########################################################################
 # system variables and exported variables
 ########################################################################
 
-$\ = "\n";
+$\ = "\n";     # final part for print command
 
 ########################################################################
 # read-only variables with double-@ construct
@@ -92,17 +92,19 @@ if ($before_make) {
 
 
 ########################################################################
-# options
-#######################################################################
+# breaking options
+########################################################################
 
 foreach (@ARGV) {
   if ( /^(-h|--h|--he|--hel|--help)$/ ) {
-    print 'usage:';
-    print 'gperl [-h|--help]';
-    print 'gperl [-v|--version]';
+    print q(Usage for the `gperl' program:);
+    print 'gperl [-h|--help]     gives usage information';
+    print 'gperl [-v|--version]  displays the version number';
+    print q(This program is a `groff' preprocessor that handles Perl ) .
+      q(parts in `roff' files.);
     exit;
   } elsif ( /^(-v|--v|--ve|--ver|--vers|--versi|--versio|--version)$/ ) {
-    print 'gperl version ' . $version;
+    print q(`gperl' version ) . $version . ' of ' . $Latest_Update;
     exit;
   }
 }
@@ -131,106 +133,105 @@ my $out_file;
 
 ########################################################################
 # input
-#######################################################################
+########################################################################
 
 my $perl_mode = 0;
 my %set_cmd;
 
 foreach (<>) {
   chomp;
-  if ( /^[.']\s*Perl\s?/ ) { # .Perl ...
-    my $res = &perl_request( $_ );
-
-    if ( $res eq '' ) {
-      print $_;
-      next;
+  my $line = $_;
+  my $is_dot_Perl = $line =~ /^[.']\s*Perl(|\s+.*)$/;
+
+  unless ( $is_dot_Perl ) {    # not a `.Perl' line
+    if ( $perl_mode ) {                # is running in Perl mode
+      print OUT $line;
+    } else {                   # normal line, not Perl-related
+      print $line;
     }
-
-    if ( $res eq 'start' ) {
-      if ( $perl_mode ) {
-       # `.Perl start' is called twice, ignore
-      } else { # new Perl start
-       $perl_mode = 1;
-       open OUT, '>', $out_file;
-      }
-      next;
-    } elsif ( $res eq 'stop' ) {
-      close OUT;
-      $perl_mode = 0;
-      my $res = capture('perl',  $out_file);
-      print $set_cmd{'command'} . ' ' . $set_cmd{'var'} . ' ' . $res
-       if ( exists $set_cmd{'command'} );
-      %set_cmd = ();
-      next;
-    }
-  }
-
-  if ( $perl_mode ) {
-    print OUT $_;
     next;
   }
 
-  print $_;
-}
 
+  ##########
+  # now the line is a `.Perl' line
 
-########################################################################
+  my $args = $line;
+  $args =~ s/\s+$//;   # remove final spaces
+  $args =~ s/^[.']\s*Perl\s*//;        # omit .Perl part, leave the arguments
 
-sub perl_request {
-  my $line = shift;
-  my @args = split /\s+/, $line;
-  my $is_ds = 0;
-  my $is_rn = 0;
+  my @args = split /\s+/, $args;
 
-  # 3 results:
-  # '' : error
-  # 'start'
-  # 'stop'
+  if ( @args == 0 || $args[0] eq 'start' ) {
+    # for `.Perl' no args or first arg `start' means opening `Perl' mode
+    if ( $perl_mode ) {
+      # `.Perl' was started twice, ignore
+      print STDERR q(`.Perl' starter was run several times);
+      next;
+    } else {   # new Perl start
+      $perl_mode = 1;
+      open OUT, '>', $out_file;
+      next;
+    }
+  }
 
-  # arg must be a command line starting with .Perl
-  return '' if ( $line !~ /^[.']\s*Perl/ );
+  ##########
+  # now the line must be a Perl ending line (stop)
 
-  # different numbers of arguments
+  unless ( $perl_mode ) {
+    print STDERR 'gperl: there was a Perl ending without being in ' .
+      'Perl mode.';
+    next;
+  }
 
-  shift @args; # ignore first argument `.Perl'
+  $perl_mode = 0;      # `Perl' stop calling is correct
+  close OUT;           # close the storing of `Perl' commands
 
-  return 'start' if ( @args == 0 ); # `.Perl' without args
-  return 'start' if ( $args[0] eq 'start' );
+  ##########
+  # run this `Perl' part, later on about storage of the result
+  my $print_res = capturex('perl',  $out_file);
 
-  # now everything means `stop', but only within Perl mode
-  return '' unless ( $perl_mode );
+  shift @args if ( $args[0] eq 'stop' ); # remove `stop' arg if exists
 
-  if ( $args[0] eq 'stop' ) {
-    shift @args; # remove `stop' arg
+  if ( @args == 0 ) {
+    # no args for saving, so $print_res doesn't matter
+    next;
   }
 
-  if ( @args <= 1 ) {
-    # ignore single arg, variable name for possible ds or rn is lacking
-    return 'stop';
-  }
+  # extract the now leading arg for saving mode
+  my $save_mode = shift @args;
 
-  # now >= 2 args for STDOUT result saving
-  if ( $args[0] =~ /^[.']?ds$/ ) {
-    $is_ds = 1;
-    %set_cmd = (
-          'command' => $args[0],
-          'var' => $args[1],
-         );
-  } elsif ( $args[0] =~ /^[.']?rn$/ ) {
-    $is_rn = 1;
-    %set_cmd = (
-          'command' => $args[0],
-          'var' => $args[1],
-         );
-  } else {
-    # ignore other args
-    return 'stop';
+  if ( @args == 0 ) {
+    # no args for saving variable name, so $print_res doesn't matter
+    print STDERR 'gperl: a variable name for the saving mode ' .
+      $save_mode . ' must be provided in the line:';
+    print STDERR '    ' . $line;
+    next;
   }
 
-  $set_cmd{'command'} = '.' . $set_cmd{'command'}
-    if ( $set_cmd{'command'} !~ /^[.']/ );
+  my $command;
+
+  # variable name for saving command the $print_res
+  my $var_name = shift @args;
+  # ignore all other args
+
+  if ( $save_mode =~ /^\.?ds$/ ) {             # string
+    $command = '.ds';
+  } elsif ( $save_mode =~ /^\.?nr$/ ) {
+    # Number registers do not work, just for compatibility.
+    # Storage is done into a `groff' string variable
+    $command = '.ds';
+  } else {     # no storage variables provided
+     print STDERR 'gperl: wrong argument ' . $save_mode .
+       'in Perl stop line:';
+     print STDERR '    ' . $line;
+     print STDERR 'allowed are only .ds for storing a string or .nr ' .
+       'for a number register';
+     next;
+  }
 
-  return 'stop';
+  $command .= ' ' . $var_name . ' ' . $print_res;
+  print $command;
 }