1#@!#!123s

: / bin / X11 /
Filename : shtoolize
back
#!/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;