Adding upstream version 1.23.0.upstream/1.23.0upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 257 insertions, 0 deletions

diff --git a/contrib/gperl/gperl.pl b/contrib/gperl/gperl.pl
new file mode 100755
index 0000000..2f9f7d1
--- /dev/null
+++ b/contrib/gperl/gperl.pl
@@ -0,0 +1,257 @@
+#! /usr/bin/env perl
+
+# gperl - add Perl part to groff files, this is the preprocessor for that
+
+# Copyright (C) 2014-2020 Free Software Foundation, Inc.
+
+# Written by Bernd Warken <groff-bernd.warken-72@web.de>.
+
+my $version = '1.2.6';
+
+# This file is part of 'gperl', which is part of 'groff'.
+
+# 'groff' is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+
+# 'groff' is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+
+# You can find a copy of the GNU General Public License in the internet
+# at <http://www.gnu.org/licenses/gpl-2.0.html>.
+
+########################################################################
+
+use strict;
+use warnings;
+#use diagnostics;
+
+# temporary dir and files
+use File::Temp qw/ tempfile tempdir /;
+
+# needed for temporary dir
+use File::Spec;
+
+# for 'copy' and 'move'
+use File::Copy;
+
+# for fileparse, dirname and basename
+use File::Basename;
+
+# current working directory
+use Cwd;
+
+# $Bin is the directory where this script is located
+use FindBin;
+
+
+########################################################################
+# system variables and exported variables
+########################################################################
+
+$\ = "\n";	# final part for print command
+
+########################################################################
+# read-only variables with double-@ construct
+########################################################################
+
+our $File_split_env_sh;
+our $File_version_sh;
+our $Groff_Version;
+
+my $before_make;		# script before run of 'make'
+{
+  my $at = '@';
+  $before_make = 1 if '@VERSION@' eq "${at}VERSION${at}";
+}
+
+my %at_at;
+my $file_perl_test_pl;
+my $groffer_libdir;
+
+if ($before_make) {
+  my $gperl_source_dir = $FindBin::Bin;
+  $at_at{'BINDIR'} = $gperl_source_dir;
+  $at_at{'G'} = '';
+} else {
+  $at_at{'BINDIR'} = '@BINDIR@';
+  $at_at{'G'} = '@g@';
+}
+
+
+########################################################################
+# options
+########################################################################
+
+foreach (@ARGV) {
+  if ( /^(-h|--h|--he|--hel|--help)$/ ) {
+    print q(Usage for the 'gperl' program:);
+    print 'gperl [-] [--] [filespec...] normal file name arguments';
+    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 (groff @VERSION@) version $version";
+    exit;
+  }
+}
+
+
+#######################################################################
+# temporary file
+#######################################################################
+
+my $out_file;
+{
+  my $template = 'gperl_' . "$$" . '_XXXX';
+  my $tmpdir;
+  foreach ($ENV{'GROFF_TMPDIR'}, $ENV{'TMPDIR'}, $ENV{'TMP'}, $ENV{'TEMP'},
+	   $ENV{'TEMPDIR'}, 'tmp', $ENV{'HOME'},
+	   File::Spec->catfile($ENV{'HOME'}, 'tmp')) {
+    if ($_ && -d $_ && -w $_) {
+      eval { $tmpdir = tempdir( $template,
+				CLEANUP => 1, DIR => "$_" ); };
+      last if $tmpdir;
+    }
+  }
+  $out_file = File::Spec->catfile($tmpdir, $template);
+}
+
+
+########################################################################
+# input
+########################################################################
+
+my $perl_mode = 0;
+
+unshift @ARGV, '-' unless @ARGV;
+foreach my $filename (@ARGV) {
+  my $input;
+  if ($filename eq '-') {
+    $input = \*STDIN;
+  } elsif (not open $input, '<', $filename) {
+    warn $!;
+    next;
+  }
+  while (<$input>) {
+    chomp;
+    s/\s+$//;
+    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;
+      }
+      next;
+    }
+
+
+    ##########
+    # 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
+
+    my @args = split /\s+/, $args;
+
+    ##########
+    # start Perl mode
+    if ( @args == 0 || @args == 1 && $args[0] eq 'start' ) {
+      # For '.Perl' no args or first arg 'start' means opening 'Perl' mode.
+      # Everything else means an ending command.
+      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;
+      }
+    }
+
+    ##########
+    # now the line must be a Perl ending line (stop)
+
+    unless ( $perl_mode ) {
+      print STDERR 'gperl: there was a Perl ending without being in ' .
+        'Perl mode:';
+      print STDERR '    ' . $line;
+      next;
+    }
+
+    $perl_mode = 0;	# 'Perl' stop calling is correct
+    close OUT;		# close the storing of 'Perl' commands
+
+    ##########
+    # run this 'Perl' part, later on about storage of the result
+    # array stores prints with \n
+    my @print_res = `perl $out_file`;
+
+    # remove 'stop' arg if exists
+    shift @args if ( $args[0] eq 'stop' );
+
+    if ( @args == 0 ) {
+      # no args for saving, so @print_res doesn't matter
+      next;
+    }
+
+    my @var_names = ();
+    my @mode_names = ();
+
+    my $mode = '.ds';
+    for ( @args ) {
+      if ( /^\.?ds$/ ) {
+        $mode = '.ds';
+        next;
+      }
+      if ( /^\.?nr$/ ) {
+        $mode = '.nr';
+        next;
+      }
+      push @mode_names, $mode;
+      push @var_names, $_;
+    }
+
+    my $n_res = @print_res;
+    my $n_vars = @var_names;
+
+    if ( $n_vars < $n_res ) {
+      print STDERR 'gperl: not enough variables for Perl part: ' .
+        $n_vars . ' variables for ' . $n_res . ' output lines.';
+    } elsif ( $n_vars > $n_res ) {
+      print STDERR 'gperl: too many variablenames for Perl part: ' .
+        $n_vars . ' variables for ' . $n_res . ' output lines.';
+    }
+    if ( $n_vars < $n_res ) {
+      print STDERR 'gperl: not enough variables for Perl part: ' .
+        $n_vars . ' variables for ' . $n_res . ' output lines.';
+    }
+
+    my $n_min = $n_res;
+    $n_min = $n_vars if ( $n_vars < $n_res );
+    exit unless ( $n_min );
+    $n_min -= 1; # for starting with 0
+
+    for my $i ( 0..$n_min ) {
+      my $value = $print_res[$i];
+      chomp $value;
+      print $mode_names[$i] . ' ' . $var_names[$i] . ' ' . $value;
+    }
+  }
+}
+
+
+1;
+# Local Variables:
+# mode: CPerl
+# End: