#!/usr/bin/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 = "2.0.8 (18-Jul-2008)";
my $prefix = "/usr";
my $datarootdir = "${prefix}/share";
my $datadir = "${datarootdir}";
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;
King Pictures is a Canadian based company who offer a huge and ever growing range of high quality eLearning solutions that teach using studio quality narrated videos backed-up with practical hands-on examples and comprehensive working files. All courses are created by trained educators and experts in video based education.
The emphasis is on teaching real life skills that are essential for progressing in today's commercial environment.
