*** /dev/null Sat Nov 23 01:34:11 2024
--- - Sat Nov 23 01:34:27 2024
***************
*** 0 ****
--- 1,465 ----
+ #!@PERL@
+ ##
+ ## shtoolize -- Build shtool script out of ingredient scripts
+ ## Copyright (c) 1999-2000 Ralf S. Engelschall <rse@engelschall.com>
+ ##
+ ## This file is part of shtool and 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.
+ ##
+ ## This file 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 should have received a copy of the GNU General Public License
+ ## along with this program; if not, write to the Free Software
+ ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ ## USA, or contact Ralf S. Engelschall <rse@engelschall.com>.
+ ##
+
+ require 5.000;
+ use strict;
+
+ ##
+ ## CONFIGURATION
+ ##
+
+ # General configuration
+ my $version = "@SHTOOL_VERSION_STR@";
+ my $prefix = "@prefix@";
+ my $datadir = "@datadir@";
+ my $scriptdir = "$datadir/shtool";
+
+ # Available modules
+ my @available = qw(
+ echo mdate table prop move install mkdir mkln mkshadow
+ fixperm tarball guessos arx slo scpp version path
+ );
+
+ ##
+ ## COMMAND LINE HANDLING
+ ##
+
+ my $opt_h = 0;
+ my $opt_v = 0;
+ my $opt_q = 0;
+ my $opt_o = 'shtool';
+
+ # this subroutine is derived from Perl's getopts.pl with the enhancement of
+ # the "+" metacharater at the format string to allow a list to be build by
+ # subsequent occurance of the same option. We use it here as a local copy
+ # to be maximum independent.
+ sub mygetopt {
+ my ($progname, $argumentative, @ARGV) = @_;
+ my (@args, $first, $rest, $pos);
+ my ($errs) = 0;
+ local ($_);
+ local ($[) = 0;
+
+ @args = split( / */, $argumentative);
+ while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+ ($first, $rest) = ($1,$2);
+ if ($_ =~ m|^--$|) {
+ shift(@ARGV);
+ last;
+ }
+ $pos = index($argumentative,$first);
+ if($pos >= $[) {
+ if($args[$pos+1] eq ':') {
+ shift(@ARGV);
+ if($rest eq '') {
+ unless (@ARGV) {
+ print STDERR "$progname:Error: incomplete option: `$first' (needs an argument)\n";
+ ++$errs;
+ }
+ $rest = shift(@ARGV);
+ }
+ eval "\$opt_$first = \$rest;";
+ }
+ elsif ($args[$pos+1] eq '+') {
+ shift(@ARGV);
+ if($rest eq '') {
+ unless (@ARGV) {
+ print STDERR "$progname:Error: incomplete option: `$first' (needs an argument)\n";
+ ++$errs;
+ }
+ $rest = shift(@ARGV);
+ }
+ eval "push(\@opt_$first, \$rest);";
+ }
+ else {
+ eval "\$opt_$first = 1";
+ if($rest eq '') {
+ shift(@ARGV);
+ }
+ else {
+ $ARGV[0] = "-$rest";
+ }
+ }
+ }
+ else {
+ print STDERR "$progname:Error: unknown option: `$first'\n";
+ ++$errs;
+ if($rest ne '') {
+ $ARGV[0] = "-$rest";
+ }
+ else {
+ shift(@ARGV);
+ }
+ }
+ }
+ return ($errs == 0, @ARGV);
+ }
+
+ sub usage {
+ my ($progname, $cmdline, $rc) = @_;
+ print STDERR "Usage: shtoolize [-h] [-v] [-q] [-o <script>] <module> [<module> ...]\n" if ($cmdline);
+ my $a = join(' ', @available);
+ my $a2 = '';
+ ($a, $a2) = ($1, $2) if ($a =~ m|^(.{50}.*?)\s+(.+)$|);
+ print STDERR "Available modules (use `all' for all modules):\n";
+ print STDERR " $a\n";
+ print STDERR " $a2\n" if ($a2);
+ exit($rc);
+ }
+
+ my $rc;
+ ($rc, @ARGV) = &mygetopt($0, "hvqo:", @ARGV);
+ &usage($0, 1, 1) if ($rc == 0);
+ if ($opt_v) {
+ print "GNU shtool $version\n";
+ exit(0);
+ }
+ &usage($0, 1, 0) if ($opt_h);
+
+ my @modules;
+ if ($#ARGV == -1) {
+ print STDERR "$0:Error: missing module name(s)\n";
+ &usage($0, 1, 1);
+ }
+ if ($#ARGV == 0 and $ARGV[0] eq 'all') {
+ @modules = @available;
+ }
+ else {
+ my $mod;
+ foreach $mod (@ARGV) {
+ if (not grep(/^$mod$/, @available)) {
+ print STDERR "$0:Error: unknown module name: `$mod'\n";
+ usage($0, 0, 1);
+ exit(1);
+ }
+ push(@modules, $mod);
+ }
+ }
+
+ ##
+ ## INPUT PHASE
+ ##
+
+ # Find a module
+ sub find_module {
+ my ($name) = @_;
+ return "sh.$name" if (-f "sh.$name");
+ return "$scriptdir/sh.$name";
+ }
+
+ # Read the ingredients scripts
+ my $SCRIPT = {};
+ my @used = ();
+ my @unused = ();
+ my $code;
+ my $name;
+ print(STDERR "Generating $opt_o") if (not $opt_q);
+ foreach $name (@available) {
+
+ # read script code
+ my $file = &find_module($name);
+ open(FP, "<$file") || die;
+ $code = '';
+ $code .= $_ while (<FP>);
+ close(FP);
+
+ # determine attributes
+ my $len = length($code);
+ my $oneline = '';
+ if ($code =~ m|##\s+$name\s+--\s+(.+?)\s*\n|s) {
+ $oneline = $1;
+ }
+ my $usage = '';
+ if ($code =~ m|##\s+Usage:\s+$name([^\n]*)\n|s) {
+ $usage = $1;
+ $usage =~ s|^\s+||s;
+ $usage =~ s|\s+$||s;
+ }
+ if ($code =~ m|str_usage="\s*([^"]+?)\s*"|s) {
+ $usage = $1;
+ }
+
+ # adjust script code
+ $code =~ s|^#!/bin/sh\n||s;
+ my $head = '';
+ 1 while ($code =~ s|^(##\s*\n)|$head .= $1, ''|se ||
+ $code =~ s|^(##\s+.*?\n)|$head .= $1, ''|se);
+ $head =~ s|##\s+This file is.+\n##\s+USA.+?\n##\n||s;
+ $code =~ s|\n\n+|\n\n|sg;
+ my ($code1, $code2);
+ if ($code =~ m|^(.+\n)\.\s+[^\n]*/sh\.common\n(.+)$|s) {
+ ($code1, $code2) = ($1, $2);
+ }
+ else {
+ ($code1, $code2) = (": #NOP\n", $code);
+ }
+ $code1 =~ s|^[\s\n]+||s;
+ $code1 =~ s|[\s\n]+$|\n|s;
+ $code2 =~ s|^[\s\n]+||s;
+ $code2 =~ s|[\s\n]+$|\n|s;
+ $code2 = $head.$code2;
+
+ # and remember for the output phase
+ $SCRIPT->{$name} = {};
+ $SCRIPT->{$name}->{ONELINE} = $oneline;
+ $SCRIPT->{$name}->{USAGE} = $usage;
+ $SCRIPT->{$name}->{CODE1} = $code1;
+ $SCRIPT->{$name}->{CODE2} = $code2;
+
+ # remember the module type
+ if (grep(/^$name$/, @modules)) {
+ printf(STDERR "...(%s %d/%d bytes)", $name, length($code), $len) if (not $opt_q);
+ push(@used, $name);
+ }
+ else {
+ push(@unused, $name);
+ }
+ }
+ printf(STDERR "\n") if (not $opt_q);
+
+ # Generate overview comment
+ my $overview = "## Available commands:\n";
+ foreach $name (@used) {
+ $overview .= sprintf("## %-10s %s\n", $name, $SCRIPT->{$name}->{ONELINE});
+ }
+ if (@unused) {
+ $overview .= "##\n";
+ $overview .= "## Not available commands (because module was not built-in):\n";
+ foreach $name (@unused) {
+ $overview .= sprintf("## %-10s %s\n", $name, $SCRIPT->{$name}->{ONELINE});
+ }
+ }
+ $overview =~ s|\n$||s;
+
+ # Generate usage output
+ my $usage = " echo 'Available <cmd-name> [<cmd-options>] [<cmd-args>]:'\n";
+ foreach $name (@used) {
+ my $u = $SCRIPT->{$name}->{USAGE};
+ my $u2 = '';
+ if ($u =~ m|^(.{50}.*?)\s+(.+)$|) {
+ ($u, $u2) = ($1, $2);
+ }
+ $usage .= sprintf(" echo ' %-8s %s'\n", $name, $u);
+ $usage .= sprintf(" echo ' %-8s %s'\n", '', $u2) if ($u2);
+ }
+ if (@unused) {
+ $usage .= " echo ''\n";
+ $usage .= " echo 'Not available <cmd-name> (because module was not built-in):'\n";
+ foreach $name (@unused) {
+ my $u = $SCRIPT->{$name}->{USAGE};
+ my $u2 = '';
+ if ($u =~ m|^(.{50}.*?)\s+(.+)$|) {
+ ($u, $u2) = ($1, $2);
+ }
+ $usage .= sprintf(" echo ' %-8s %s'\n", $name, $u);
+ $usage .= sprintf(" echo ' %-8s %s'\n", '', $u2) if ($u2);
+ }
+ }
+ $usage =~ s|\n$||s;
+
+ # Generate usage output
+ my $toolpat = join("|", @used);
+
+ # Determine size
+ my $size = "all available modules";
+ if (@unused) {
+ $size = sprintf("%d/%d available modules", $#used+1, $#available+1);
+ }
+
+ ##
+ ## OUTPUT PHASE
+ ##
+
+ # Create output file
+ open(OUT, ">$opt_o") || die "unable to create output file `$opt_o\': $!";
+
+ # Generate header of script
+ print OUT <<"EOT";
+ #!/bin/sh
+ ##
+ ## GNU shtool -- The GNU Portable Shell Tool
+ ## Copyright (c) 1994-2000 Ralf S. Engelschall <rse\@engelschall.com>
+ ##
+ ## See http://www.gnu.org/software/shtool/ for more information.
+ ## See ftp://ftp.gnu.org/gnu/shtool/ for latest version.
+ ##
+ ## Version ${version}
+ ## Ingredients: ${size}
+ ##
+
+ ##
+ ## This program 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.
+ ##
+ ## This program 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 should have received a copy of the GNU General Public License
+ ## along with this program; if not, write to the Free Software
+ ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+ ## USA, or contact Ralf S. Engelschall <rse\@engelschall.com>.
+ ##
+ ## Notice: Given that you include this file verbatim into your own
+ ## source tree, you are justified in saying that it remains separate
+ ## from your package, and that this way you are simply just using GNU
+ ## shtool. So, in this situation, there is no requirement that your
+ ## package itself is licensed under the GNU General Public License in
+ ## order to take advantage of GNU shtool.
+ ##
+
+ ##
+ ## Usage: shtool [<options>] [<cmd-name> [<cmd-options>] [<cmd-args>]]
+ ##
+ ${overview}
+ ##
+
+ if [ \$# -eq 0 ]; then
+ echo "\$0:Error: invalid command line" 1>&2
+ echo "\$0:Hint: run \\`\$0 -h' for usage" 1>&2
+ exit 1
+ fi
+ if [ ".\$1" = ".-h" -o ".\$1" = ".--help" ]; then
+ echo "This is GNU shtool, version ${version}"
+ echo "Copyright (c) 1994-2000 Ralf S. Engelschall <rse\@engelschall.com>"
+ echo "Report bugs to <bug-shtool\@gnu.org>"
+ echo ''
+ echo "Usage: shtool [<options>] [<cmd-name> [<cmd-options>] [<cmd-args>]]"
+ echo ''
+ echo 'Available global <options>:'
+ echo ' -v, --version display shtool version information'
+ echo ' -h, --help display shtool usage help page (this one)'
+ echo ' -d, --debug display shell trace information'
+ echo ''
+ ${usage}
+ echo ''
+ exit 0
+ fi
+ if [ ".\$1" = ".-v" -o ".\$1" = ."--version" ]; then
+ echo "GNU shtool ${version}"
+ exit 0
+ fi
+ if [ ".\$1" = ".-d" -o ".\$1" = ."--debug" ]; then
+ shift
+ set -x
+ fi
+ name=`echo "\$0" | sed -e 's;.*/\\([^/]*\\)\$;\\1;' -e 's;-sh\$;;' -e 's;\\.sh\$;;'`
+ case "\$name" in
+ ${toolpat} )
+ # implicit tool command selection
+ tool="\$name"
+ ;;
+ * )
+ # explicit tool command selection
+ tool="\$1"
+ shift
+ ;;
+ esac
+ arg_spec=""
+ opt_spec=""
+ gen_tmpfile=no
+
+ EOT
+
+ # Insert the first part of the ingredient scripts
+ my $oneline;
+ my $usage;
+ print OUT <<"EOT";
+ ##
+ ## DISPATCH INTO SCRIPT PROLOG
+ ##
+
+ case \$tool in
+ EOT
+ foreach $name (@used) {
+ print OUT " $name )\n";
+ $code = $SCRIPT->{$name}->{CODE1};
+ $code =~ s|^| |mg;
+ sub mysub {
+ my ($prolog, $code, $epilog) = @_;
+ $code =~ s|^ ||mg;
+ return $prolog.$code.$epilog;
+ }
+ $code =~ s|(\<\<['"]?EOT['"]?\n)(.+?\n)[ \t]+(EOT)|&mysub($1, $2, $3)|sge;
+ print OUT $code;
+ print OUT " ;;\n";
+ }
+ print OUT <<"EOT";
+ -* )
+ echo "\$0:Error: unknown option \\`\$tool'" 2>&1
+ echo "\$0:Hint: run \\`\$0 -h' for usage" 2>&1
+ exit 1
+ ;;
+ * )
+ echo "\$0:Error: unknown command \\`\$tool'" 2>&1
+ echo "\$0:Hint: run \\`\$0 -h' for usage" 2>&1
+ exit 1
+ ;;
+ esac
+ EOT
+
+ # Insert common part
+ my $file = &find_module("common");
+ open(FP, "<$file");
+ my $common = '';
+ $common .= $_ while (<FP>);
+ close(FP);
+ $common =~ s|^.+?\n\n|\n|s;
+ print OUT $common;
+
+ # Insert the second part of the ingredient scripts
+ print OUT <<"EOT";
+ ##
+ ## DISPATCH INTO SCRIPT BODY
+ ##
+
+ case \$tool in
+
+ EOT
+ foreach $name (@used) {
+ print OUT "$name )\n";
+ $code = $SCRIPT->{$name}->{CODE2};
+ $code =~ s|^| |mg;
+ sub mysub {
+ my ($prolog, $code, $epilog) = @_;
+ $code =~ s|^ ||mg;
+ return $prolog.$code.$epilog;
+ }
+ $code =~ s|(\<\<['"]?EOT['"]?\n)(.+?\n)[ \t]+(EOT)|&mysub($1, $2, $3)|sge;
+ $code =~ s|(IFS='\s*\n)\s+(')|$1$2|sg;
+ print OUT $code;
+ print OUT " ;;\n";
+ print OUT "\n";
+ }
+ print OUT <<"EOT";
+ esac
+
+ exit 0
+
+ ##EOF##
+ EOT
+ close(OUT);
+ chmod(0755, $opt_o);
+
+ 1;
|
