InfoMagic Source Code 1993 July/THE_SOURCE_CODE_CD_ROM.iso/languages/perl/scripts-convex/pt.shar/pt/Configure

Text File | 1993-05-26 | 4.2 KB | 187 lines

$STD_PERL = '/usr/bin/perl';

select(STDERR);

print "Configuring pt...\n\n";

sub findpath {
    local($path);
    local($arg) = shift;
    for $dir (split(/:/,$ENV{'PATH'})) {
    if (-x "$dir/$arg" && -f _) {
        $path = "$dir/$arg";
        last;
    }
    }
    $path;
}

&getperl();

if ($path = &findpath('ps')) {
    $PS = $path;
    print "Your ps lives in $path.\n";
} else {
    die "You don't have a ps on this system, bailing out";
}

$DEATH_STAR = 0;
$FLAG_WIDTH = 0;

$_ = `$PS l1 2>/dev/null`;
if ($?) {
    # maybe system V
    $_ = `$PS -ef -p 1 2>/dev/null`;
    if ($? == 0) {
    $DEATH_STAR = 1;
    print "You have a SysV-style ps; this may be boring.\n";
    } else {
    print "Your ps doesn't like either BSD or SysV syntax!\n";
    }
} else {
    print "Congratulations, your ps groks BSD syntax.\n";

    if (/^\s*F/) {
    if (!/\n(\s*[a-f\d]+)/) {
        print "No flag width -- assuming 7\n";
        $FLAG_WIDTH = 7;
    } else {
        $FLAG_WIDTH = length($1);
        print "Your ps flags width appears to be $FLAG_WIDTH.\n";
        if (/F\s+S\s+UID/) {
        print "Your ps interposes STAT between FLAGS and UID\n";
        $early_stat++;
        }
    }
    } else {
    # bsd 4.4?
    print <<EOF;
But you have no ps flags; don't worry, you're
proabably better off that way.
EOF
    }
}

$FIRST_SPLIT = $DEATH_STAR   # cursed be
        ? '^\s*([\da-fA-F]+)\s+\S+\s+([\-\d]+)\s+(\d+)\s+(\d+)'
        : $FLAG_WIDTH
            ? $early_stat
            ? '^(\s*[\da-fA-F]+)\s*\w+\s*([\-\d]+)\s+(\d+)\s+(\d+)'
            : '^(\s*[\da-fA-F]+)\s*([\-\d]+)\s+(\d+)\s+(\d+)'
            : '^(\s*)([\da-fA-F]+)\s*([\-\d]+)\s+(\d+)\s+(\d+)';

print "\n";

$PROG = 'getwin.c';

open(PROG, ">$PROG") || die "can't creat $PROG: $!";
print PROG <<'EOF';
#include <sys/ioctl.h>
main() { printf("0x%08x\n", TIOCGWINSZ); }
EOF
close(PROG) || die "can't close $PROG: $!";

unless ($CC_PATH = &findpath('cc')) {
    print "No C compiler found, trying gcc\n";
    if ($CC_PATH = &getpath('gcc'))  {
    print "What luck -- you have a gcc\n";
    } else {
    print "SNAFU: No C compiler -- guessing TIOCGWINSZ is 0x40087468\n";
    $TIOCGWINSZ = 0x40087468;
    if (ioctl(STDERR, $TIOCGWINSZ, $winsize)) {
        ($rows, $cols) = unpack('S4', $winsize);
        if ($cols > 20 && $cols < 200) {
        print "Ok, TIOCGWINSZ seems ok as 0x40087468\n";
        $TIOCGWINSZ = '0x40087468';
        } else {
    print "TIOCGWINSZ doesn't seem to work, will grope environment\n";
        }
    }
    }
} else {
    print "Your C compiler lives in $CC_PATH.\n";

    print "Testing for window-size awareness...";
    if (system("$CC_PATH getwin.c >/dev/null 2>&1") == 0) {
    print "done.\n";
    chop($TIOCGWINSZ = `./a.out`);
    print "Great -- your TIOCGWINSZ is $TIOCGWINSZ.\n";;
    } else {
    print "oops!\n";
    print "Bummer -- you have no TIOCGWINSZ!\n";
    $TIOCGWINSZ = 0;
    }

    unlink('a.out', $PROG);
}

select(STDOUT);

while (<>) {
    if (s/#\$\$#\s*//) {
    s/TIOCGWINSZ\s*=[^;]*/TIOCGWINSZ = $TIOCGWINSZ/o
        ||
    s/PS\s*=\s*\"[^"]*"/PS = "$PS"/o
        ||
    s/DEATH_STAR\s*=[^;]*/DEATH_STAR = $DEATH_STAR/o
        ||
    s/FLAG_WIDTH\s*=[^;]*/FLAG_WIDTH = $FLAG_WIDTH/o
        ||
    s/FIRST_SPLIT\s*=[^;]*/FIRST_SPLIT = '$FIRST_SPLIT'/o
        ;
    }
    print;
}
close(STDOUT) || die "can't close STDOUT: $!";




print STDERR "\nDone with Configure.\n\n";
exit;

sub getperl {
    if (-e $STD_PERL && -f _ && -x _) { # stat, !lstat
    print <<EOF;
Good, I see that perl lives in the standard place ($STD_PERL)
EOF
    print "How 'bout I use that one, ok? [y] ";
    open(TTY, "</dev/tty") || die "can't open /dev/tty: $!";
    if (<TTY> !~ /^\s*n/i)  {
        print STDOUT "#!$STD_PERL\n";
        print "\n";
        return;
    }
    print "Ok, fine, let's grope about your system then...\n";
    } else {
    $whine++;
    }

    if ($path = &findpath('perl')) {
    print "Your perl lives in $path.\n";
    print STDOUT "#!$path\n";
    $whine && print <<EOF;

You know, life would be easier if you just made $STD_PERL
a symlink to where it where it really lives.
EOF
    } else {
    print <<EOF;

What, no perl on your system?  Then just who is running this script?
Ok, we'll configure up your script so it tries to find whatever perl is
in the user's path, something you don't seem to have.

EOF
    print STDOUT <<'EOF';
#!/bin/sh -- # wish we had a perl
eval "exec perl -S $0 $*"
    if $running_under_some_shell;

EOF
    }
    print "\n";
}