#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#	pt.pl
#	pt.1
#	README
#	Makefile
#	Configure
#	Test
#	Install
# This archive created: Thu Jul  2 12:44:40 1992
export PATH; PATH=/bin:/usr/bin:$PATH
if test -f 'pt.pl'
then
	echo shar: "will not over-write existing file 'pt.pl'"
else
cat << \SHAR_EOF > 'pt.pl'
#
# pt -- print process tree
# 	Tom Christiansen <tchrist@convex.com>
#       version 1.0, Tuesday Jun 30 18:29:49 CDT 1992
#	
#    Modification History
#	version 1.1, Wed Jul  1 14:58:54 CDT 1992
#	    Chop long lines to winsize unless -w supplied
#	    Add -a for all procs irrespective of platform
#	    Changed parse bailout to warning
#	    Added Configure script
#	    Numerous hacks to deal with various braindead
#		vendors garbled ps output
#		
#
# run ps and display process hierarchy indented
# under parents.
#
# Options:
# 	[-l level]	limits level of children printed
# 	[-i indent]	change indent level from default
#	[-w] 		allow lines to be as long as you want.
#
# 


# don't use require so that it runs on ancient versions of perl
    # require 'getopts.pl';
    $file = 'getopts.pl';
    $return = do $file;
    die "couldn't parse $file: $@" if $@;
    die "couldn't do $file: $!" unless defined $return;
    die "couldn't run $file" unless $return;

$VERSION = '1.1';
$AUTHOR = 'tchrist@convex.com';

$| = 1;

#$$# $PS = "ps";			# a path to ps, usually /bin
#$$# $TIOCGWINSZ = 0x40087468;       	# should be require sys/ioctl.ph
#$$# $DEATH_STAR = 0;			# ARGS: ps -el, not ps wwaxl
#$$# $FLAG_WIDTH = 7;
#$$# $FIRST_SPLIT = '^(\s*[\da-fA-F]+)\s*([\-\d]+)\s+(\d+)\s+(\d+)';

die "Didn't you run Configure?"
	unless 4 == grep(defined,$PS,$TIOCGWINSZ,$DEATH_STAR,$FLAG_WIDTH);

$indent = 2;  			 # reset via -i switch

$debug = 0;


########################################################

if ($DEATH_STAR) {
    $PS_ARGS = "-l"; 
    $EVERYBODY = "e";
} else {
    $PS_ARGS = "xlww";
    $EVERYBODY = "a";
}

########################################################

$maxlevel = 10_000_000;  # reset via -l switch

sub usage {
    local($msg) = shift;
    print STDERR "$0: $msg\n" if $msg;
    die <<EOF;
usage: $0 [-a] [-d] [-w] [ps args] [pid list]
	    (version: $VERSION   author: $AUTHOR)

	-w 	wide output (don't trunc at winsize)
	-a	all processes, not just mine
	-d	print out debugging information
EOF
} 

&Getopts('dl:i:wa') || &usage();

$maxlevel = $opt_l if $opt_l;
$indent = $opt_i if $opt_i;
$wide = $opt_w;
$debug = $opt_d;

while (defined($_ = shift)) {  # curse pid 0
    if (/^(\d+)$/) {
	$pids{$1}++;
	$pids++;  # needed for ancient perl, who can't do if %pids
    } else {
	$PS_ARGS .= "$_ ";
    }
} 

$wide || &getwin;

$PS_ARGS =~ s/^(-?)/${1}${EVERYBODY}/ if $pids || $opt_a;

$ps = "$PS $PS_ARGS";

print "opening pipe to $ps\n" if $debug;

open(PS, "$ps |") || die "can't fork: $!";
<PS>; # header

printf("%-8s %5s %8s %7s %s\n", 'USER', "PID", "TTY", "TIME","COMMAND");

while (<PS>) {
    ($flags, $uid, $pid, $ppid) = /$FIRST_SPLIT/o;
    ($tty, $time, $secs, $command) = /(\S+)\s*(\d+:\d+(\.\d\d)?)\s+(.*)/;

    unless (grep(defined,$uid,$pid,$ppid,$tty,$time,$command) == 6) {
	warn "skipping unparsable line from ps:\n$_";
	$oops++;
	next;
    }

    if ($debug) {
	print <<EOF;
flags are <$flags>, uid is <$uid>, pid is <$pid>, ppid is <$ppid>
tty is <$tty>, time is <$time>, command is <$command>

EOF
    } 

    # incredibly disgusting hack should FLAGS and UID collide
    # why oh why must vendors be so damn sysadmin-hostile?
    # don't they understand we have to parse this stuff??
    # 	maybe should try $flags =~ /^\s/ here as well?
    # i give no guarantees that this works.
    if (!$DEATH_STAR && length($flags) > $FLAG_WIDTH  &&
          (($ppid == 0 && $pid > 10 && $uid) 
	      || 
	  length($flags) > 2+$FLAG_WIDTH))
    {
	print "hack 1\n" if $debug;
	$ppid = $pid;
	$pid = $uid;
	$uid = substr($flags, 
                      $FLAG_WIDTH + 1 - (substr($flags,0,1) eq ' ' ||
                                    length($flags > $FLAG_WIDTH + 2)),
		      10);
	substr($flags, -length($uid), 10) = '';

	# hold on to your lunch, folks...
	if (!defined $id{$uid}) {
	    $extra = substr($flags,-1,1);
	    $uid = $extra . $uid if defined $id{$extra.$uid};
	} 
    } 

    # stupid hack should PPID and CP collide
    if ($ppid > 32_000 && $pid < 32_000) {
	print "hack 2\n" if $debug;
	$ppid = substr($ppid,0,length($pid));
    }

    # stupid hack should TT and TIME collide
    if (length($tty) > 2 && $tty =~ /:/) {
	print "hack 3\n" if $debug;
	$time = substr($tty, 2, 10) . $time;
	$tty = substr($tty,0,2);
    } 

    $lines{$pid} = sprintf("%-8s %5d %8s %7s#%s\n", 
		&id($uid), $pid, $tty, $time, $command);
    unless ($pid == $ppid) {
	$parent{$pid} = $ppid;
	$children{$ppid} .= "$pid ";
    }
} 
if (!close(PS)) {
    warn "\"$ps\" exited badly!\n";
    $oops++;
}

@pids = keys %pids;
if (@pids) {
    foreach $pid (@pids) {
	&save_the_children($pid);
	&save_our_parent($pid);
    } 
    %lines = %nlines;
} 

sub bynum { $a - $b; } 

# find the heads of the chains...
@pids = grep(!defined $lines{$parent{$_}},keys %lines);

for $pid (sort bynum @pids) {
    &children($pid); 
} 

exit($oops != 0);

sub children {
    local($pid) = $_[0];
    local($_) = $lines{$pid};
    substr($_, index($_, '#'), 1) = ' ' x (1+ $indent * $level);
    if (!$wide && length() > $cols) {
	substr($_, $cols, 10_000) = "\n";
    } 
    print;
    if ($level++ < $maxlevel) {
	local(@kids) = split(' ',$children{$pid});
	for $pid (@kids) {
	    &children($pid);
	}
    } 
    $level--;
} 

sub id {
    local($id) = shift;
    $id{$id} = (getpwuid($id))[0] || "($id)" unless defined $id{$id};
    $id{$id};
} 

sub save_the_children {
    local($parent) = shift;
    foreach $kid (split(' ',$children{$parent})) {
	&save_the_children($kid);
    } 
    &keepline($parent);
} 
    
sub save_our_parent {
    local($kid) = shift;
    local($dad) = $parent{$kid};

    &keepline($kid);

    if ($dad || $dad eq '0') { # beware $dad == 0
	&save_our_parent($dad);
    }
} 

sub keepline {
    $nlines{$_[0]}  = $lines{$_[0]} 
	unless defined $nlines{$_[0]};
} 


sub getwin {
    local($winsize);
    # is someone can get SS_DC_TIOCSWINSZ on MIPS working, tell me
    if ($TIOCGWINSZ && ioctl(STDERR, $TIOCGWINSZ, $winsize)) {
        ($rows, $cols) = unpack('S4', $winsize);
    } else {
        $cols = $ENV{'COLUMNS'} || ($ENV{'TERMCAP'} =~ /:co#(\d+):/)[0];
    }
    $cols = 80 unless $cols;
    print "cols are $cols\n" if $debug;
}
SHAR_EOF
fi
if test -f 'pt.1'
then
	echo shar: "will not over-write existing file 'pt.1'"
else
cat << \SHAR_EOF > 'pt.1'
.TH PT 1L local
.de M           \" man page reference
\\fI\\$1\\fR\\|(\\$2\)\\$3
..
.de T           \" switch to typewriter font
.ft TA          \" probably want CW if you don't have TA font
..
.\"
.de TY          \" put $1 in typewriter font
.if t .T
.if n ``\c
\\$1\c
.if t .ft P
.if n \&''\c
\\$2
..
.SH NAME
pt \- postprocess ps output into hierarchical form
.SH SYNOPSIS
.B pt
[
.B \-a
]
[
.B \-w
]
[
.I "ps args"
]
[
.I "pid list"
]
.SH "DESCRIPTION"
The 
.I pt
program is a 
.I perl 
front end to 
.I ps
that
displays a 
.I ps 
listing with processes arranged in a tree format.  That is,
processes are listed under their parents, indented to the right.
.PP
For example:
.sp
.nf
.na
USER       PID   TTY    TIME COMMAND
tchrist   9341    p3    1:02 -tcsh
tchrist  10423    p3    0:11   vi pt.pl
tchrist  27045    p3    0:00   vi pt
tchrist  28371    p3    0:04   trn
tchrist  29366    p3    0:00     /bin/sh -c Pnews -h /mnt/tchris
tchrist  29367    p3    0:00       sh /usr/local/bin/Pnews -h /m
tchrist  29394    p3    0:00         perl sigspell
tchrist  29395    p3    0:00           vi /mnt/tchrist/.article 
tchrist  29080    p3    0:01   vi pt.1
tchrist  29831    p3    0:00     sh -c ./pt
tchrist  29833    p3    0:00       perl ./pt
tchrist  29834    p3    0:00         /bin/ps xlww
tchrist   9361    p3    0:08 monthd -i5
tchrist   9500    pb    0:30 -tcsh
tchrist  23345    pb    0:18   perl plum
tchrist  29726    pb    0:00     perl now-what
tchrist  29729    pb    0:00       perl sigspell
tchrist  29734    pb    0:00         vi /mnt/tchrist/Mail/drafts
tchrist   9522    p3   23:59 perl newsclip 07/02/92 09:15
tchrist   9527    p3    0:07   perl pmeter 
tchrist  19660    q9    0:47 perl sigrand
.fi 
.ad
.PP
The first listed process is the shell, and all those 
indented under it are its direct children.  
Thus
.I
Pnews is a child of 
.IR trn , 
which itself has several children of its own.
.PP
Normally, 
.I pt
will truncate at the width of your screen.  The
.B \-w
option will allow output as wide as
.I ps
returns.
.PP
To list all processes, use the 
.B \-a
option, even if your system expects to pass 
.I ps
something other than an 
.B a
flag; 
.I pt
should know to pass the appropriate flag to ps.
.PP
You can also pass 
.I pt
a list of pids to restrict output to those process
trees contains those pids.  Any processes below the named
pids will be listed in full.  Those above will be listed
only if they are direct ancestors.  For example (reading
this output in from the editor):
.sp
.nf
.na
:r!pt $$
USER       PID   TTY    TIME COMMAND
root         0     ?    0:00 swapout
root         1     ?    1:53   init
root      9339     ?    8:26     xterm -display 130.168.190.14:0
tchrist   9341    p3    1:02       -tcsh
tchrist  29080    p3    0:05         vi pt.1
tchrist    731    p3    0:00           sh -c ./pt $$
tchrist    732    p3    0:00             perl ./pt 731
tchrist    733    p3    0:02               /bin/ps axlww
.fi 
.ad
.sp
This allows you to trace both parents and children of a given process.
.SH "RETURN VALUE"
.I pt
will exit with a value of 1
if it encounteres difficulty parsing the output of
.I ps
or if 
.I ps
should itself exit non-zero.
.SH ENVIRONMENT
In order to truncate at your current window size, 
.I pt
will use the 
.B TIOCGWINSZ
.I ioctl(2)
if supported on your system.  Otherwise, it consults
your environment for either a 
.B COLUMNS
variable, or else checks your current
.B TERMCAP
variable for a 
.B ":co:"
entry.
.SH "FILES"
getopts.pl\h'|2i'perl getopts library 
.SH "SEE ALSO"
.M ps 1 ,
.M pstat 1 ,
.M perl 1 .
.SH NOTES
The
.I pt
distribution
comes with a 
.I Makefile
and a 
.I Configure 
script that should be used to properly select what 
form of 
.I ps
you're using, paths, etc.
.SH DIAGNOSTICS
.TY "skipping unparsable line from ps:\en%s"
.in +5n
.br
This means that 
.I ps 
output a line which 
.I pt
couldn't make heads or tails of (probably tails).
.in -5n
.sp
.TY "ps exited badly!"
.in +5n
.I ps 
returned a non-zero exit status.
.in -5n
.sp
.TY "couldn't parse getopts.pl: %s"
.br
.TY "couldn't do getopts.pl: %s"
.br
.TY "couldn't run getopts.pl: %s"
.br
.in +5n
All these mean the getopts library couldn't be loaded.
An appropriate message should be printed.
.sp
.in -5n
.TY "Didn't you run Configure?"
.in +5n
You are running a raw version of 
.I pt
that hasn't been configured yet.  
.sp
.in -5n
.TY "can't fork: %s at line %d of pt"
.in +5n
.I pt
was unable to fork a child of itself
to run 
.I ps
with.
.br
.in -5n
.SH BUGS
.I pt
is at the mercy of your 
.I ps
command, and it would appear that very few vendors
make any effort to produce output that can be parsed
by humans or computers.  
.I pt
therefore undergoes numerous convolutions to try to 
demangle braindead 
.I ps 
output.
It is not always successful.  File a bug report with 
your vendor is your 
.I ps
fields ever run together \(em it's a real pain.
.PP
The 
.B \-d
option prints out debugging information which may 
help you diagnose difficulties you may be encountering.
.SH AUTHOR
Tom Christiansen <tchrist@convex.com>,
July 2nd, 1992.
SHAR_EOF
fi
if test -f 'README'
then
	echo shar: "will not over-write existing file 'README'"
else
cat << \SHAR_EOF > 'README'
This really ought to work right out of the box now.
Unshar, type 'make test' and watch.  If that works,
go for 'make install'.

The Configure script should be smarter now, but I've
introduced a lot of gratuitous hacks because most
vendors, especially the ones with the workstations on 
our desks.   

If this DOESN'T work for you, please tell me the
following things:

    type of hardware 
    operating system version
    perl version
    ps axlww or ps -aefl output


--tom
SHAR_EOF
fi
if test -f 'Makefile'
then
	echo shar: "will not over-write existing file 'Makefile'"
else
cat << \SHAR_EOF > 'Makefile'
BIN=/usr/local/bin
MAN=/usr/local/man/man1
PROG=pt

# it's really rude, but if i don't say this, it 
# assumes your current shell on some systems.
# how brain dead can you get?
SHELL=/bin/sh

${PROG}: ${PROG}.pl Configure
	@perl Configure < ${PROG}.pl > test${PROG}
	@mv test${PROG} ${PROG}
	@chmod +x ${PROG}

test: ${PROG}
	@perl Test

install: test
	perl Install ${MAN} ${BIN} 

clean:
	rm -f ${PROG} core test getwin.c a.out

shar: 
	shar pt.pl pt.1  README Makefile Configure Test Install > pt.shar
SHAR_EOF
fi
if test -f 'Configure'
then
	echo shar: "will not over-write existing file 'Configure'"
else
cat << \SHAR_EOF > 'Configure'

$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";
}

SHAR_EOF
fi
if test -f 'Test'
then
	echo shar: "will not over-write existing file 'Test'"
else
cat << \SHAR_EOF > 'Test'

$user = (getpwuid($>))[0];

$PT = './pt';

$| = 1;

print <<EOF;
Running tests for pt..

Should anything fail, this make will abort.
if it doesn't look right, just hit ^C.

EOF

&cr;

print "First, I'll run pt on just your processes:\n\n";

&run($PT);
while(<PT>) {
    print;
    &test1;
} 
&ran;
&result1;
&cr;

print <<EOF;
Ok, next test: run pt on just this process, tracing back to the root:

EOF

&run ("$PT $$");

while (<PT>) {
    print;
    &test2;
} 
&ran;

&result2;

&cr;

print "\nNow for all processes:\n\n";

&run("$PT -a");

$init = $sawme = $warned = $sawpt = 0;

while (<PT>) {
    print;
    &test3;
} 
&ran;
&result3;


system("touch ./test") && die "can't touch \"test\" semaphore file: $!";

print "\nLooks good, now go for the install!\n";

sub run {
    $Args = shift;
    print "$ $Args\n";
    open(PT, "$Args |") || die "couldn't fork: $!";
} 

sub ran {
    die "\"$Args\" exited badly: $!" unless close(PT);
} 

sub cr {
    print "\nHit <CR> to continue, ^C to abort: ";
    <STDIN>;
    print "\n";
} 

sub more {
    print "$_[0]; continue? [n] ";
    exit 1 unless <STDIN> =~ /^\s*y/i;
} 

sub test1 {
    $sawpt += /pt/;
    $sawme += /\b$user\b/i;
    if (/^\(\d+\)/ && !$warned++) {
	@pw = getpwuid($1);
	if  ($pw[0]) {
	    &more("Hmmm, uid $1 didn't convert to $pw[0]");
	} else {
	    print "Oops, you don't have a uid $1 here\n";
	    &more("Maybe the ps line is mangled;");
	} 
    } 
}

sub test2 { 
    $init += /^\w+\s+1\b.+\binit\b/; 
}

sub result1 {
    &more("Your uid should have appeared here") unless $sawme;
    &more("The pt program should have appeared here") unless $sawpt;
}

sub result2 {
    &more("Didn't see init (process 1)") unless $init;
    &more("Saw init $init times") if $init > 1;
}

sub test3 {
    &test1;
    &test2;
}

sub result3 {
    &result1;
    &result2;
} 
SHAR_EOF
fi
if test -f 'Install'
then
	echo shar: "will not over-write existing file 'Install'"
else
cat << \SHAR_EOF > 'Install'
($defman, $defbin) = @ARGV;

$mdir = &finddir($defman,
          '/usr/local/man/man1', '/usr/man/local/man1',
	  '/usr/man/man.L', '/usr/man/manl',
	  '/usr/man/mann', '/usr/man/u_man/man1', '/usr/man/man1'
      );

print "\nWhat directory would you like your man page in?\n\t[$mdir] ";

chop($dir = <STDIN>);
$dir = $mdir if $dir =~ /^\s*$/;
if (-d $dir) {
    ($suffix) = ($dir =~ m#man([^/]+$)#);
    $mpage = "$dir/pt.$suffix";
} else {
    die "$dir: not a directory";
} 

&run("cp pt.1 $mpage");

$bin = &finddir($defbin, '/usr/local/scripts', '/usr/local/bin', 
		    split(':', $ENV{'PATH'}));

print "\nWhat directory would you like your script in?\n\t[$bin] ";

chop($hisbin = <STDIN>);

$bin = $hisbin unless $hisbin eq '';

chmod (0755, 'pt');
&run("cp pt $bin");

sub finddir {
    for $dir (@_) {
	next if $dir eq '';
	return $dir if -d $dir;
    } 
    '';
} 

sub run {
    local($cmd) = shift;
    print "\n$ $cmd\n";
    system($cmd) && die;
} 
SHAR_EOF
fi
exit 0
#	End of shell archive
