ossp-pkg/shtool/shtoolize.in
1.41
#!@PERL@
##
## shtoolize -- Build shtool script out of ingredient scripts
## Copyright (c) 1999-2008 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 $datarootdir = "@datarootdir@";
my $datadir = "@datadir@";
my $scriptdir = "$datadir/shtool";
# Available modules
my @available = qw(
echo mdate table prop move install mkdir mkln mkshadow
fixperm rotate tarball subst platform 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);
# strip away embedded documentation
$code =~ s|##\n##\s+manual\s+page\n##\s+.+$||si;
# 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 = '';
my $u3 = '';
my $u4 = '';
my $u5 = '';
my $u6 = '';
if ($u =~ m|^(.{50}.*?)\s+(.+)$|) {
($u, $u2) = ($1, $2);
}
if ($u2 =~ m|^(.{50}.*?)\s+(.+)$|) {
($u2, $u3) = ($1, $2);
}
if ($u3 =~ m|^(.{50}.*?)\s+(.+)$|) {
($u3, $u4) = ($1, $2);
}
if ($u4 =~ m|^(.{50}.*?)\s+(.+)$|) {
($u4, $u5) = ($1, $2);
}
if ($u5 =~ m|^(.{50}.*?)\s+(.+)$|) {
($u5, $u6) = ($1, $2);
}
$usage .= sprintf(" echo ' %-8s %s'\n", $name, $u);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u2) if ($u2);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u3) if ($u3);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u4) if ($u4);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u5) if ($u5);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u6) if ($u6);
}
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 = '';
my $u3 = '';
my $u4 = '';
my $u5 = '';
my $u6 = '';
if ($u =~ m|^(.{50}.*?)\s+(.+)$|) {
($u, $u2) = ($1, $2);
}
if ($u2 =~ m|^(.{50}.*?)\s+(.+)$|) {
($u2, $u3) = ($1, $2);
}
if ($u3 =~ m|^(.{50}.*?)\s+(.+)$|) {
($u3, $u4) = ($1, $2);
}
if ($u4 =~ m|^(.{50}.*?)\s+(.+)$|) {
($u4, $u5) = ($1, $2);
}
if ($u5 =~ m|^(.{50}.*?)\s+(.+)$|) {
($u5, $u6) = ($1, $2);
}
$usage .= sprintf(" echo ' %-8s %s'\n", $name, $u);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u2) if ($u2);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u3) if ($u3);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u4) if ($u4);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u5) if ($u5);
$usage .= sprintf(" echo ' %-8s %s'\n", '', $u6) if ($u6);
}
}
$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);
}
# Generate recreation command
my $recreate = "shtoolize -o${opt_o}";
if ($#unused == -1) {
$recreate .= " all";
}
else {
foreach $name (@used) {
$recreate .= " $name";
}
}
##
## 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-2008 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}
## Contents: ${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}
##
# maximum Bourne-Shell compatibility
if [ ".\$ZSH_VERSION" != . ] && (emulate sh) >/dev/null 2>&1; then
# reconfigure zsh(1)
emulate sh
NULLCMD=:
alias -g '\${1+"\$@"}'='"\$@"'
elif [ ".\$BASH_VERSION" != . ] && (set -o posix) >/dev/null 2>&1; then
# reconfigure bash(1)
set -o posix
fi
# maximum independence of NLS nuisances
for var in \\
LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \\
LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \\
LC_TELEPHONE LC_TIME
do
if (set +x; test -z "`(eval \$var=C; export \$var) 2>&1`"); then
eval \$var=C; export \$var
else
unset \$var
fi
done
# initial command line handling
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" ] || [ ".\$1" = ".--help" ]; then
echo "This is GNU shtool, version ${version}"
echo 'Copyright (c) 1994-2008 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 ' -r, --recreate recreate this shtool script via shtoolize'
echo ''
${usage}
echo ''
exit 0
fi
if [ ".\$1" = ".-v" ] || [ ".\$1" = ".--version" ]; then
echo "GNU shtool ${version}"
exit 0
fi
if [ ".\$1" = ".-r" ] || [ ".\$1" = ".--recreate" ]; then
${recreate}
exit 0
fi
if [ ".\$1" = ".-d" ] || [ ".\$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|^(.)| $1|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|^(.)| $1|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
shtool_exit 0
EOT
close(OUT);
chmod(0755, $opt_o);
1;
