#!/usr/bin/perl # # vps version 0.5 # Copyright © 2007 Thomas A. Fine # Freely redistribute in whole or in part, provided author's credit is # preserved # http://hea-www.harvard.edu/~fine/Tech/vps.html # $|=1; @helplines=( "Cursor Motion Commands:\n", " j,^N,return down one line\n", " k,^P up one line\n", " ^E scroll data up\n", " ^Y scroll data down\n", " ^F down one screen\n", " ^B up one screen\n", " ^L redraw screen\n", "\n", "Other Commands:\n", " space rebuild process table from current system state\n", " . update data on current process\n", " e show environment variables of current process\n", " o show open files of current process (sort of)\n", " S signal current process\n", " q quit submode, or quit program\n", " number enter process ID, press return, moves cursor to PID\n", " / search forward (enter search text, press return)\n", " searches: filename, program, arguments, user, and group\n", " ? search backward (enter search text, press return)\n", " n repeat last search\n", " - use narrower indent\n", " = use wider indent\n", " h show this help\n", "\n", "Non-interactive mode: use $0 -n\n", ); %sigdesc=( "0", "+Check to see if the process is still alive", "HUP", "+Hangup, usually safest way to kill; also resets some programs", "INT", "+Interrupt - the same as control-C", "QUIT", "+Quit immediately and dump core", "ILL", " Illegal instruction", "TRAP", " Trace Trap", "ABRT", " Abort", "EMT", " Emulation Trap", "FPE", " Floating Point Error", "KILL", "+`kill -9' The kill of last resort, that should kill anything", "BUS", " Bus Error", "SEGV", " Segmentation Violation", "SYS", " Bad system call", "PIPE", " data is available on a pipe", "ALRM", " a program timer went off ", "TERM", "+Terminate - this is the default kill", "USR1", "+User defined signal 1 - performs a program-specific function", "USR2", "+User defined signal 2", "CLD", " Child process status change", "PWR", " Power failure", "WINCH", " Window size change", "URG", " Urgent socket condition", "POLL", " activity on polled channel", "STOP", "+Pause the process", "TSTP", "+Terminal Stop - the same as control-Z", "CONT", "+Continue - used after STOP or TSTP", "TTIN", " Stopped for tty input", "TTOU", " Stopped for tty output", "VTALRM", " Virtual timer expired", "PROF", " Profiling timer expired", "XCPU", " CPU time limit exceeded", "XFSZ", " File size limit exceeded", "WAITING", " threads library", "LWP", " threads library", "FREEZE", " check point freeze", "THAW", " check point thaw", "CANCEL", " threads library", "LOST", " ???", "RTMIN", " real time signal", "RTMIN+1", " real time signal", "RTMIN+2", " real time signal", "RTMIN+3", " real time signal", "RTMAX-3", " real time signal", "RTMAX-2", " real time signal", "RTMAX-1", " real time signal", "RTMAX", " real time signal", ); %fieldlen=( "pid", 5, "ppid", 5, "user", 8, "group", 16, "gid", 6, "ruser", 8, "rgroup", 16, "rgid", 6, "tty", 7, "vsz", 6, "rss", 6, "pmem", 4, "\%mem", 4, "pcpu", 4, "\%cpu", 4, "nice", 2, "pri", 2, "s", 1, "state", 4, "time", 11, "etime", 11, "stime", 8, "fname", 8, "comm", 20, "ucomm", 20, "args", 300, "command", 300, ); #possibly blank fields go last. These include fname, comm, args, #and also nice (that's weird) $ostype=&ostype(); $osrel=&osrel(); if ($ostype eq "SunOS") { @fieldorder=( "pid", "ppid", "user", "group", "ruser", "rgroup", "tty", "vsz", "rss", "pmem", "pcpu", "pri", "s", "time", "etime", "stime", "nice", "fname", "comm", "args", ); $psall="/bin/ps -e"; $psenv="/usr/ucb/ps -eww "; $psname="/usr/ucb/ps -ww "; $nameindex=4; $shortname='fname'; $commargs='args'; $state='s'; $group='group'; $rgroup='rgroup'; $stime='stime'; $pmem='pmem'; $pcpu='pcpu'; } elsif ($ostype eq "Darwin") { @fieldorder=( "pid", "ppid", "user", "gid", "ruser", "rgid", "tty", "vsz", "rss", "\%mem", "\%cpu", "pri", "state", "time", "stime", "start", "nice", "ucomm", "command", ); $psall="/bin/ps -ax"; if ($osrel >= 9) { #Leopard $psenv="/bin/ps -Eww -p"; $nameindex=3; } else { #Tiger $psenv="/bin/ps -eww -p"; $nameindex=4; } $psname="/bin/ps -ww -p"; $shortname='ucomm'; $commargs='command'; $state='state'; $group='gid'; $rgroup='rgid'; $stime='start'; $pmem='%mem'; $pcpu='%cpu'; } elsif ($ostype eq "Linux") { @fieldorder=( "pid", "ppid", "user", "group", "ruser", "rgroup", "tty", "vsz", "rss", "pmem", "pcpu", "pri", "s", "time", "etime", "stime", "nice", "fname", "comm", "args", ); $psall="/bin/ps -e"; $psenv="/bin/ps eww -p"; $psname="/bin/ps ww -p"; $nameindex=4; $shortname='fname'; $commargs='args'; $state='s'; $group='group'; $rgroup='rgroup'; $stime='stime'; $pmem='pmem'; $pcpu='pcpu'; } else { print "$ostype is not supported\n"; exit(1); } if ($ARGV[0] eq "-n") { #guess at columns if not using full cusses-lib stuff #(which would initialize bolding and such) if (defined($ENV{'COLUMNS'})) { $cols=$ENV{'COLUMNS'}; #} elsif (defined($ENV{'DISPLAY'})) { # $cols=`resize|grep COLUMNS`; # chop($cols); # $cols =~ s/[^0-9]//g; } else { $tmp=`/bin/stty size`; chop($tmp); ($rows,$cols)=split(' ',$tmp); } $Tsz=3; @Ttee=("","+","|-","|- ","|-- "); @Tend=("","-","\`-","\`- ","\`-- "); @Tpass=("","|","| ","| ","| "); @Tblank=(""," "," "," "," "); &custom_tree(); &makelines(1,"","",""); foreach $line (@lines) { print "$line"; } exit(0); } if (-x "/usr/ucb/stty") { $STTY="/usr/ucb/stty"; } elsif (-x "/usr/bin/stty") { $STTY="/usr/bin/stty"; } elsif (-x "/bin/stty") { $STTY="/bin/stty"; } else { $STTY="stty"; } &getsize; $term=$ENV{'TERM'}; require 'termcap.pl'; &Tgetent($term); #initialize some stuff #special attributes default to standout if ((! defined($TC{'us'})) || (! defined($TC{'ue'}))) { $TC{'us'}=$TC{'so'}; $TC{'ue'}=$TC{'se'}; } if (! defined($TC{'md'})) { $TC{'md'}=$TC{'us'}; $TC{'me'}=$TC{'ue'}; } $B_under=&Tputs($TC{'us'},1); $E_under=&Tputs($TC{'ue'},1); $B_stand=&Tputs($TC{'so'},1); $E_stand=&Tputs($TC{'se'},1); $B_bold= &Tputs($TC{'md'},1); $E_bold= &Tputs($TC{'me'},1); $E_all= &Tputs($TC{'me'},1); $cols=$columns; $term=$ENV{'TERM'}; if (($term eq "xterm") || ($term eq "vs100") || ($term =~ /^vt/)) { $TREE_init="(B)0"; $TREE_finish="(B)B"; @Ttee=("","t","tq","tq ","tqq "); @Tend=("","m","mq","mq ","mqq "); @Tpass=("","x","x ","x ","x "); @Tblank=(""," "," "," "," "); $Sleft=""; $Sright=""; $Sbar="q"; $Ssld="a"; } else { $TREE_init=""; $TREE_finish=""; @Ttee=("","+","|-","|- ","|-- "); @Tend=("","-","\`-","\`- ","\`-- "); @Tpass=("","|","| ","| ","| "); @Tblank=(""," "," "," "," "); # @Ttee=("","+","+-","+- ","+-- "); # @Tend=("","\\","\\-","\\- ","\\-- "); # @Tpass=("","|","| ","| ","| "); # @Tblank=(""," "," "," "," "); $Sleft=""; $Sright=""; $Sbar="-"; $Ssld="="; $Ssld="#"; } $Tsz=3; if ($cols < 60) { $Tsz=2; } $TREE_tee=$Ttee[$Tsz]; $TREE_end=$Tend[$Tsz]; $TREE_pass=$Tpass[$Tsz]; $TREE_blank=$Tblank[$Tsz]; $winy=4; $overlap=1; if ($cols < 60) { $short=1; $winy=7; } $SIG{'INT'} = 'sig_int'; $SIG{'TSTP'} = 'sig_stop'; $SIG{'CONT'} = 'sig_cont'; if ($#ARGV >= 0) { print @helplines; exit(0); } print $TREE_init; &cbreak; &custom_tree(); &makelines(1,"","",""); &browse(); &reset; #&setregion(0,$rows-1); print $TREE_finish; # # END OF MAIN # sub browse { $cursrow=0; $curscol=0; $top=0; $cline=0; local($pid,$i); &setcol; &drawscreen; while (1) { $c=&getcin("jkG\n0-9\/?n eoSh=.q\\[\\]<>-"); if ($c eq "j" || $c eq "" || $c eq "\n") { if ($cline >= $#lines) { print ""; } else { ++$cline; if (++$cursrow == $rows-1-$winy) { ++$top; --$cursrow; #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$cline]); } &setcol; &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "k" || $c eq "") { if ($cline == 0) { print ""; } else { --$cline; if (--$cursrow < 0) { --$top; $cursrow=0; #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$cline]); } &setcol; &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { $cline= $top += ($rows-1-$winy-$overlap); $cursrow=0; if ($cline >= $#lines) { $top=$cline=$#lines; } &setcol; &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "") { if ($cline == 0) { print ""; } else { $cline= $top -= ($rows-1-$winy-$overlap); $cursrow=0; if ($cline < 0) { $top=$cline=0; } &setcol; &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { ++$top; if (--$cursrow < 0) { ++$cursrow; ++$cline; } #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$top+$rows-2-$winy]); &setcol; &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "") { if ($top == 0) { print ""; } else { --$top; if (++$cursrow == $rows-1-$winy) { --$cursrow; --$cline; } #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$top]); &setcol; &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq " ") { &drawscreen; } elsif ($c eq " ") { $pid=$pids[$cline]; &clear_tree(); &custom_tree(); &makelines(1,"","",""); for ($i=0; $i<=$#lines; ++$i) { if ($pids[$i] == $pid) { last; } } if ($i == $#lines+1) { $cline=0; $top=0; $cursrow=0; } else { &gotoline($i); &setcol; &mvcurs($curscol,$cursrow); } &setcol; &showcurrent; &drawscreen; } elsif ($c eq ".") { $pid=$pids[$cline]; &update_pid($pid); $pre=$lines[$cline]; chop($pre); $pre =~ s/$pid.*$//; $lines[$cline]=&makeoneline($pre,$pid); &drawscreen; } elsif ($c eq "S") { &dokill($pids[$cline]); } elsif ($c eq "e") { &browsevars($pids[$cline]); } elsif ($c eq "o") { &browsefiles($pids[$cline]); } elsif ($c eq "h") { &browsehelp(); } elsif ($c eq "-" || $c eq "[" || $c eq "<") { if (--$Tsz < 0) { print ""; $Tsz=0; } else { undef(@lines); &makelines(1,"","",""); &setcol; &drawscreen; } } elsif ($c eq "=" || $c eq "]" || $c eq ">") { if (++$Tsz > $#Ttee) { print ""; $Tsz=$#Ttee; } else { undef(@lines); &makelines(1,"","",""); &setcol; &drawscreen; } } elsif ($c =~ /[0-9]/) { &mvcurs(0,$rows-1); &cleartoeol; print "PID> "; print $c; $newpos=$c; while (($c=getc) ne "\n") { if ($c eq "G") { last; } #quick hack to simulate vi-style G command if ($c =~ /[]/) { if (length($newpos) == 0) { $newpos=$cline+1; last; } else { print " "; $newpos =~ s/.$//; } } elsif ($c =~ /[0-9]/) { print $c; $newpos .= $c; } else { print ""; } } for ($i=0; $i<=$#pids; ++$i) { if ($newpos==$pids[$i]) { &gotoline($i); &setcol; &mvcurs($curscol,$cursrow); last; } } if ($i == $#pids+1) { print ""; &mvcurs(0,$rows-1); &cleartoeol; } &showcurrent; &mvcurs($curscol,$cursrow); } elsif ($c eq "n") { if ($spat eq "") { #empty search &mvcurs(0,$rows-1); &cleartoeol; print "No previous regular expression"; &mvcurs($curscol,$cursrow); } else { $saveline=$cline; while (($cline=($cline+$search_step)%($#lines+1)) != $saveline) { if ($piddata{$pids[$cline],$shortname} =~ /$spat/i) { last; } elsif ($piddata{$pids[$cline],$commargs} =~ /$spat/i) { last; } elsif ($piddata{$pids[$cline],'user'} =~ /$spat/i) { last; } elsif ($piddata{$pids[$cline],$group} =~ /$spat/i) { last; } elsif ("$pids[$cline]" =~ /$spat/i) { last; } } if ($cline == $saveline && ($piddata{$pids[$cline],$shortname} !~ /$spat/i) && ($piddata{$pids[$cline],$commargs} !~ /$spat/i) && ($piddata{$pids[$cline],'user'} !~ /$spat/i) && ($piddata{$pids[$cline],$group} !~ /$spat/i) && ("$pids[$cline]" !~ /$spat/i)) { &mvcurs(0,$rows-1); &cleartoeol; print "${B_stand} Pattern not found ${E_stand}"; &mvcurs($curscol,$cursrow); } else { &gotoline($cline); &setcol; &showcurrent; &mvcurs($curscol,$cursrow); } } } elsif ($c eq "/" || $c eq "?") { if ($c eq "/") { $search_step = 1; } else { $search_step = -1; } &mvcurs(0,$rows-1); &cleartoeol; print $c; $ospat=$spat; $spat=&getstring(70); if ($spat eq "") { $spat=$ospat; } if ($spat eq "") { #empty search &mvcurs(0,$rows-1); &cleartoeol; print "No previous regular expression"; &mvcurs($curscol,$cursrow); } else { #new search $saveline=$cline; while (($cline=($cline+$search_step)%($#lines+1)) != $saveline) { if ($piddata{$pids[$cline],$shortname} =~ /$spat/i) { last; } elsif ($piddata{$pids[$cline],$commargs} =~ /$spat/i) { last; } elsif ($piddata{$pids[$cline],'user'} =~ /$spat/i) { last; } elsif ($piddata{$pids[$cline],$group} =~ /$spat/i) { last; } elsif ("$pids[$cline]" =~ /$spat/i) { last; } } if ($cline == $saveline && ($piddata{$pids[$cline],$shortname} !~ /$spat/i) && ($piddata{$pids[$cline],$commargs} !~ /$spat/i) && ($piddata{$pids[$cline],'user'} !~ /$spat/i) && ($piddata{$pids[$cline],$group} !~ /$spat/i) && ("$pids[$cline]" !~ /$spat/i)) { &mvcurs(0,$rows-1); &cleartoeol; print "${B_stand} Pattern not found ${E_stand}"; &mvcurs($curscol,$cursrow); } else { &gotoline($cline); &setcol; &showcurrent; &mvcurs($curscol,$cursrow); } } } elsif ($c eq "") { &mvcurs(0,$rows-1); &cleartoeol; print "cline=$cline; top=$top; cursrow=$cursrow; curpid=$curpid"; } elsif ($c eq "q") { last; } } &mvcurs(0,$rows); &cleartoeol; } sub browsevars { local($pid)=$_[0]; local(@vars)=&getenviron($pid); local($save_cursrow,$save_curscol,$save_top,$save_cline); local(@save_lines); local($var); if ($#vars == -1) { &mvcurs(0,$rows-1); &cleartoeol; print "No environment found!"; sleep(2); &drawscreen; return; } #save stuff $save_cursrow=$cursrow; $save_curscol=$curscol; $save_top=$top; $save_cline=$cline; @save_lines=@lines; undef(@lines); @vars=sort @vars; foreach $var (@vars) { while (length($var)>$cols-1) { push(@lines,substr($var,0,$cols-1) . "\n"); $var=substr($var,$cols-1); } if (length($var)) { push(@lines,$var . "\n"); } push(@lines,"\n"); } $cursrow=0; $curscol=0; $cline=0; $top=0; &drawscreen; while (1) { $c=&getcin("jkG\n\/?n q"); if ($c eq "j" || $c eq "" || $c eq "\n") { if ($cline >= $#lines) { print ""; } else { ++$cline; if (++$cursrow == $rows-1-$winy) { ++$top; --$cursrow; #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$cline]); } &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "k" || $c eq "") { if ($cline == 0) { print ""; } else { --$cline; if (--$cursrow < 0) { --$top; $cursrow=0; #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$cline]); } &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { $cline= $top += ($rows-1-$winy-$overlap); $cursrow=0; if ($cline >= $#lines) { $top=$cline=$#lines; } &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "") { if ($cline == 0) { print ""; } else { $cline= $top -= ($rows-1-$winy-$overlap); $cursrow=0; if ($cline < 0) { $top=$cline=0; } &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { ++$top; if (--$cursrow < 0) { ++$cursrow; ++$cline; } #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$top+$rows-2-$winy]); &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "") { if ($top == 0) { print ""; } else { --$top; if (++$cursrow == $rows-1-$winy) { --$cursrow; --$cline; } #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$top]); &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "n") { if ($spat eq "") { #empty search &mvcurs(0,$rows-1); &cleartoeol; print "No previous regular expression"; &mvcurs($curscol,$cursrow); } else { $saveline=$cline; while (($cline=($cline+$search_step)%($#lines+1)) != $saveline) { if ($lines[$cline] =~ /$spat/i) { last; } } if ($cline == $saveline && ($lines[$cline] !~ /$spat/i)) { &mvcurs(0,$rows-1); &cleartoeol; print "${B_stand} Pattern not found ${E_stand}"; &mvcurs($curscol,$cursrow); } else { &gotoline($cline); &mvcurs($curscol,$cursrow); } } } elsif ($c eq "/" || $c eq "?") { if ($c eq "/") { $search_step = 1; } else { $search_step = -1; } &mvcurs(0,$rows-1); &cleartoeol; print $c; $ospat=$spat; $spat=&getstring(70); if ($spat eq "") { $spat=$ospat; } if ($spat eq "") { #empty search &mvcurs(0,$rows-1); &cleartoeol; print "No previous regular expression"; &mvcurs($curscol,$cursrow); } else { #new search $saveline=$cline; while (($cline=($cline+$search_step)%($#lines+1)) != $saveline) { if ($lines[$cline] =~ /$spat/i) { last; } } if ($cline == $saveline && ($lines[$cline] !~ /$spat/i)) { &mvcurs(0,$rows-1); &cleartoeol; print "${B_stand} Pattern not found ${E_stand}"; &mvcurs($curscol,$cursrow); } else { &gotoline($cline); &mvcurs($curscol,$cursrow); } } } elsif ($c eq "") { &mvcurs(0,$rows-1); &cleartoeol; print "cline=$cline; top=$top; cursrow=$cursrow; curpid=$curpid"; } elsif ($c eq " ") { &drawscreen; } elsif ($c eq "q") { last; } } #put stuff back $cursrow=$save_cursrow; $curscol=$save_curscol; $top=$save_top; $cline=$save_cline; @lines=@save_lines; &drawscreen; } sub browsefiles { local($pid)=$_[0]; local(@openfiles); local($save_cursrow,$save_curscol,$save_top,$save_cline); local(@save_lines,@st); local(%mdevs); local($i,$file,$line,$filename,$fs,$tmp,$ok,$pid0); #save stuff $save_cursrow=$cursrow; $save_curscol=$curscol; $save_top=$top; $save_cline=$cline; @save_lines=@lines; undef(@lines); $ok=1; if (! opendir(DIR,"/proc/$_[0]/fd/")) { $pid0=sprintf("%05d",$_[0]); if (! opendir(DIR,"/proc/$pid0/fd/")) { $ok=0; push(@lines,"/proc/$_[0]/fd/: $!\n"); if ($! == 2) { push(@lines,"Process may have died!\n"); } elsif ($! == 13) { push(@lines,"You don't own this process, and you aren't root!\n"); } push(@lines,"\n"); } } if ($ok) { @openfiles=readdir(DIR); closedir(DIR); %mdevs=&getmountdevs; push(@lines," fd Type Inode File system\n"); foreach $file (@openfiles) { next if ($file !~ /^[0-9]+$/); @st=stat("/proc/$_[0]/fd/$file"); $line=sprintf("%3s ",$file); if (-f _) { $line .= "plain "; } elsif (-d _) { $line .= "directory "; } #elsif (-l _) { $line .= "symlink "; } elsif (-p _) { $line .= "pipe "; } elsif (-S _) { $line .= "socket "; } elsif (-b _) { $line .= "blockdev "; } elsif (-c _) { $line .= "chardev "; } else { $line .= "unknown "; } $line .= sprintf("%-10d ",$st[1]); if (defined($mdevs{$st[0]})) { $line .= sprintf("%s",$mdevs{$st[0]}); } else { $line .= sprintf("unknown(%d)",$st[0]); } $line .= "\n"; push(@lines,$line); } } $cursrow=0; $curscol=0; $cline=0; $top=0; &drawscreen; while (1) { $c=&getcin("jkG\n\/?n fq"); if ($c eq "j" || $c eq "" || $c eq "\n") { if ($cline >= $#lines) { print ""; } else { ++$cline; if (++$cursrow == $rows-1-$winy) { ++$top; --$cursrow; #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$cline]); } &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "k" || $c eq "") { if ($cline == 0) { print ""; } else { --$cline; if (--$cursrow < 0) { --$top; $cursrow=0; #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$cline]); } &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { $cline= $top += ($rows-1-$winy-$overlap); $cursrow=0; if ($cline >= $#lines) { $top=$cline=$#lines; } &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "") { if ($cline == 0) { print ""; } else { $cline= $top -= ($rows-1-$winy-$overlap); $cursrow=0; if ($cline < 0) { $top=$cline=0; } &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { ++$top; if (--$cursrow < 0) { ++$cursrow; ++$cline; } #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$top+$rows-2-$winy]); &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "") { if ($top == 0) { print ""; } else { --$top; if (++$cursrow == $rows-1-$winy) { --$cursrow; --$cline; } #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$top]); &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "n") { if ($spat eq "") { #empty search &mvcurs(0,$rows-1); &cleartoeol; print "No previous regular expression"; &mvcurs($curscol,$cursrow); } else { $saveline=$cline; while (($cline=($cline+$search_step)%($#lines+1)) != $saveline) { if ($lines[$cline] =~ /$spat/i) { last; } } if ($cline == $saveline && ($lines[$cline] !~ /$spat/i)) { &mvcurs(0,$rows-1); &cleartoeol; print "${B_stand} Pattern not found ${E_stand}"; &mvcurs($curscol,$cursrow); } else { &gotoline($cline); &mvcurs($curscol,$cursrow); } } } elsif ($c eq "/" || $c eq "?") { if ($c eq "/") { $search_step = 1; } else { $search_step = -1; } &mvcurs(0,$rows-1); &cleartoeol; print $c; $ospat=$spat; $spat=&getstring(70); if ($spat eq "") { $spat=$ospat; } if ($spat eq "") { #empty search &mvcurs(0,$rows-1); &cleartoeol; print "No previous regular expression"; &mvcurs($curscol,$cursrow); } else { #new search $saveline=$cline; while (($cline=($cline+$search_step)%($#lines+1)) != $saveline) { if ($lines[$cline] =~ /$spat/i) { last; } } if ($cline == $saveline && ($lines[$cline] !~ /$spat/i)) { &mvcurs(0,$rows-1); &cleartoeol; print "${B_stand} Pattern not found ${E_stand}"; &mvcurs($curscol,$cursrow); } else { &gotoline($cline); &mvcurs($curscol,$cursrow); } } } elsif ($c eq "f") { if ($cline == 0) { print ""; } else { ($foo,$foo,$i,$fs,$filename)=split(' ',$lines[$cline]); if ($fs !~ /^\//) { print ""; } elsif ($filename eq "") { &mvcurs(0,$rows-1); &cleartoeol; print "Searching; please wait..."; $filename=`find $fs -xdev -inum $i -print 2>/dev/null`; chop($filename); &mvcurs(0,$rows-1); &cleartoeol; $tmp=80-length($lines[$cline])-2; if (length($filename) > $tmp) { $filename = "..." . substr($filename,length($filename)-$tmp+3); } $filename=sprintf("%${tmp}s",$filename); $lines[$cline] =~ s/$/ $filename/; &drawscreen; } } } elsif ($c eq "") { &mvcurs(0,$rows-1); &cleartoeol; print "cline=$cline; top=$top; cursrow=$cursrow; curpid=$curpid"; } elsif ($c eq " ") { &drawscreen; } elsif ($c eq "q") { last; } } #put stuff back $cursrow=$save_cursrow; $curscol=$save_curscol; $top=$save_top; $cline=$save_cline; @lines=@save_lines; &drawscreen; } sub setcol { local($tmp)=$lines[$cline]; local($i); $foo=$E_stand; $foo =~ s/([\[\]\(\)])/\\\1/g; $tmp =~ s/$foo//g; $foo=$B_stand; $foo =~ s/([\[\]\(\)])/\\\1/g; $tmp =~ s/$foo//g; $tmp =~ s/[]//g; $tmp =~ s/[0-9]/Q/g; $i=index($tmp,"Q"); $curscol=index(substr($tmp,$i), " ")+$i; #$curscol=index($tmp,"Q"); $curpid=$pids[$cline]; } sub browsehelp { local($pid)=$_[0]; local($save_cursrow,$save_curscol,$save_top,$save_cline); local(@save_lines); #save stuff $save_cursrow=$cursrow; $save_curscol=$curscol; $save_top=$top; $save_cline=$cline; @save_lines=@lines; undef(@lines); @lines=@helplines; $cursrow=0; $curscol=0; $cline=0; $top=0; &drawscreen; while (1) { $c=&getcin(" bjkG\n q"); if ($c eq "j" || $c eq "" || $c eq "\n") { if ($cline >= $#lines) { print ""; } else { ++$cline; if (++$cursrow == $rows-1-$winy) { ++$top; --$cursrow; #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$cline]); } &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "k" || $c eq "") { if ($cline == 0) { print ""; } else { --$cline; if (--$cursrow < 0) { --$top; $cursrow=0; #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$cline]); } &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "" || $c eq " ") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { $cline= $top += ($rows-1-$winy-$overlap); $cursrow=0; if ($cline >= $#lines) { $top=$cline=$#lines; } &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "" || $c eq "b" || $c eq "") { if ($cline == 0) { print ""; } else { $cline= $top -= ($rows-1-$winy-$overlap); $cursrow=0; if ($cline < 0) { $top=$cline=0; } &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { ++$top; if (--$cursrow < 0) { ++$cursrow; ++$cline; } #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$top+$rows-2-$winy]); &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "") { if ($top == 0) { print ""; } else { --$top; if (++$cursrow == $rows-1-$winy) { --$cursrow; --$cline; } #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$top]); &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq " ") { &drawscreen; } elsif ($c eq "q") { last; } } #put stuff back $cursrow=$save_cursrow; $curscol=$save_curscol; $top=$save_top; $cline=$save_cline; @lines=@save_lines; &drawscreen; } sub showshortcurrent { local($m,$n,$o); $m=$cols*$top/($#lines+1); $n=$cols*($top+$rows-1-$winy)/($#lines+1)-$m; if (($m+$n) >= $cols) { $n=$cols-$m; } $o=$cols-$m-$n; &mvcurs(0,$rows-$winy-1); &cleartoeol; print $Sleft . $Sbar x $m . $Ssld x $n . $Sbar x $o . $Sright . "\n"; &cleartoeol; $c_1=$cols-1; $c_10=$cols-10; if ($piddata{$curpid,'dead'}) { print $B_stand; printf(" R.I.P. "); print $E_stand; printf(" %-${c_10}.${c_10}s\n",$piddata{$curpid,$commargs}); } else { printf("%-${c_1}.${c_1}s\n",$piddata{$curpid,$commargs}); } &cleartoeol; printf("%-${c_1}.${c_1}s\n",substr($piddata{$curpid,$commargs},$cols-1)); &cleartoeol; printf("%-5d ",$curpid); printf("%-7.7s ",$piddata{$curpid,'tty'}); if ($piddata{$curpid,'ruser'} eq $piddata{$curpid,'user'}) { printf("%-8.8s ",$piddata{$curpid,'user'}); } else { print "$piddata{$curpid,'ruser'}->$piddata{$curpid,'user'} " } if ($piddata{$curpid,$rgroup} eq $piddata{$curpid,$group}) { printf("%-12.12s ",$piddata{$curpid,$group}); } else { print "$piddata{$curpid,$rgroup}->$piddata{$curpid,$group} " } #printf("%1.1s ",$piddata{$curpid,$state}); print "\n"; &cleartoeol; printf("mem=%6.6s, %6.6s res (%4.4s%%)\n", $piddata{$curpid,'vsz'}, $piddata{$curpid,'rss'}, $piddata{$curpid,$pmem}); &cleartoeol; printf("Strt:%-8.8s ",$piddata{$curpid,$stime}); printf("elps:%-11.11s ",$piddata{$curpid,'etime'}); print "\n"; &cleartoeol; printf("sys:%-11.11s ",$piddata{$curpid,'time'}); printf("%4.4s%% ",$piddata{$curpid,$pcpu}); print "\n"; &cleartoeol; } sub showcurrent { if ($cols < 60) { return(&showshortcurrent); } local($m,$n,$o); $m=$cols*$top/($#lines+1); $n=$cols*($top+$rows-1-$winy)/($#lines+1)-$m; if (($m+$n) >= $cols) { $n=$cols-$m; } $o=$cols-$m-$n; &mvcurs(0,$rows-$winy-1); &cleartoeol; print $Sleft . $Sbar x $m . $Ssld x $n . $Sbar x $o . $Sright . "\n"; &cleartoeol; $c_1=$cols-1; $c_10=$cols-10; if ($piddata{$curpid,'dead'}) { print $B_stand; printf(" R.I.P. "); print $E_stand; printf(" %-${c_10}.${c_10}s\n",$piddata{$curpid,$commargs}); } else { printf("%-${c_1}.${c_1}s\n",$piddata{$curpid,$commargs}); } &cleartoeol; printf("%-5d ",$curpid); printf("%-7.7s ",$piddata{$curpid,'tty'}); if ($piddata{$curpid,'ruser'} eq $piddata{$curpid,'user'}) { printf("%-8.8s ",$piddata{$curpid,'user'}); } else { print "$piddata{$curpid,'ruser'}->$piddata{$curpid,'user'} " } if ($piddata{$curpid,$rgroup} eq $piddata{$curpid,$group}) { printf("%-12.12s ",$piddata{$curpid,$group}); } else { print "$piddata{$curpid,$rgroup}->$piddata{$curpid,$group} " } #printf("%1.1s ",$piddata{$curpid,$state}); printf("mem=%6.6s, %6.6s res (%4.4s%%)\n", $piddata{$curpid,'vsz'}, $piddata{$curpid,'rss'}, $piddata{$curpid,$pmem}); &cleartoeol; printf("Strt:%-8.8s ",$piddata{$curpid,$stime}); printf("elps:%-11.11s ",$piddata{$curpid,'etime'}); printf("sys:%-11.11s ",$piddata{$curpid,'time'}); printf("%4.4s%% ",$piddata{$curpid,$pcpu}); print "\n"; &cleartoeol; } sub dokill { local($pid)=$_[0]; local($save_cursrow,$save_curscol,$save_top,$save_cline); local(@save_lines); local(@sigs); local($i,$sig); #save stuff $save_cursrow=$cursrow; $save_curscol=$curscol; $save_top=$top; $save_cline=$cline; @save_lines=@lines; undef(@lines); @sigs=split(' ',`/usr/bin/kill -l`); if ($sigs[1] eq "HUP") { shift(@sigs); } push(@lines," Select signal, and use `S' to send it. `q' to cancel\n"); push(@lines," Commonly used signals are marked with a plus sign\n"); push(@lines," 0 Test to see if the process is alive\n"); for ($i=0; $i<=$#sigs; ++$i) { push(@lines,sprintf(" %2d %-7s %s\n", $i+1, $sigs[$i], $sigdesc{$sigs[$i]})); } $cursrow=0; $curscol=0; $cline=0; $top=0; &drawscreen; while (1) { $c=&getcin("jkG\n S.q"); if ($c eq "j" || $c eq "" || $c eq "\n") { if ($cline >= $#lines) { print ""; } else { ++$cline; if (++$cursrow == $rows-1-$winy) { ++$top; --$cursrow; #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$cline]); } &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "k" || $c eq "") { if ($cline == 0) { print ""; } else { --$cline; if (--$cursrow < 0) { --$top; $cursrow=0; #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$cline]); } &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { $cline= $top += ($rows-1-$winy-$overlap); $cursrow=0; if ($cline >= $#lines) { $top=$cline=$#lines; } &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "") { if ($cline == 0) { print ""; } else { $cline= $top -= ($rows-1-$winy-$overlap); $cursrow=0; if ($cline < 0) { $top=$cline=0; } &mvcurs($curscol,$cursrow); &drawscreen; } } elsif ($c eq "") { if ($top+($rows-2-$winy) >= $#lines) { print ""; } else { ++$top; if (--$cursrow < 0) { ++$cursrow; ++$cline; } #&setregion(0,$rows-1-$winy); &scrregup(0,$rows-1-$winy-1,$lines[$top+$rows-2-$winy]); &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "") { if ($top == 0) { print ""; } else { --$top; if (++$cursrow == $rows-1-$winy) { --$cursrow; --$cline; } #&setregion(0,$rows-1-$winy); &scrregdown(0,$rows-1-$winy-1,$lines[$top]); &showcurrent; &mvcurs($curscol,$cursrow); } } elsif ($c eq "S") { $sig=$cline-2; if ($sig < 0) { print ""; } elsif ($sig == 0) { &mvcurs(0,$rows-1); &cleartoeol; if (kill($sig,$curpid)) { print "This process is still alive."; } else { print "Signal Problem: $!"; } &mvcurs($curscol,$cursrow); } else { if (&yorn("Really send $sigs[$sig-1]?")) { &mvcurs(0,$rows-1); &cleartoeol; if (kill($sig,$curpid)) { print "Signal Sent!"; sleep(1); &update_pid($curpid); &showcurrent; } else { print "Signal Problem: $!"; } &mvcurs($curscol,$cursrow); } } } elsif ($c eq ".") { &update_pid($curpid); &showcurrent; &mvcurs($curscol,$cursrow); } elsif ($c eq " ") { &drawscreen; } elsif ($c eq "q") { last; } } #put stuff back $cursrow=$save_cursrow; $curscol=$save_curscol; $top=$save_top; $cline=$save_cline; #@lines=@save_lines; undef(@lines); &makelines(1,"","",""); &drawscreen; } sub gotoline { if ($_[0] > $#lines || $_[0] < 0) { print ""; &mvcurs(0,$rows-1); &cleartoeol; &mvcurs($curscol,$cursrow); } else { $cline=$_[0]; $cursrow=$cline-$top; if ($cline < $top || $cline > $top+$rows-$winy-2) { $top=$cline-int(($rows-$winy-1)/2); if ($top<0) { $top=0; } if ($#lines-$top < $rows-$winy-2) { $top=$#lines-($rows-$winy-2); } $cursrow=$cline-$top; &drawscreen; } &showcurrent; } } sub drawscreen { local($sln)=0; &clearscreen; while ($sln < $rows-1-$winy && $sln+$top <= $#lines) { #if ($sln+$top == $cline) { print $B_stand; } print $lines[$sln+$top]; #if ($sln+$top == $cline) { print $E_stand; } ++$sln; } &showcurrent; &mvcurs($curscol,$cursrow); } sub makelines { local($cpid)=$_[0]; local($prefix)=$_[1]; local($point_symbol)=$_[2]; local($pass_symbol)=$_[3]; local(@kids); local($i); push(@lines,&makeoneline("$prefix$point_symbol",$cpid)); push(@pids,$cpid); if ($children{$cpid} ne "") { @kids=sort numsort split(' ',$children{$cpid}); for ($i=0; $i<=$#kids; ++$i) { if ($i == $#kids) { &makelines($kids[$i],"$prefix$pass_symbol",$Tend[$Tsz],$Tblank[$Tsz]); } else { &makelines($kids[$i],"$prefix$pass_symbol",$Ttee[$Tsz],$Tpass[$Tsz]); } } } } sub makeoneshort { local($treestuff,$cpid)=($_[0],$_[1]); local($i,$line,$tmp,$linestart,$displen,$reallen,$flen); $linestart="$treestuff"; if ($piddata{$cpid,'dead'}) { $linestart .= "$B_stand"; } $linestart .= "$cpid"; if ($piddata{$cpid,'dead'}) { $linestart .= "$E_stand"; } $linestart .= " $piddata{$cpid,$shortname}"; $tmp=$linestart; $tmp =~ s/[]//g; $foo=$E_stand; $foo =~ s/([\[\]\(\)])/\\\1/g; $tmp =~ s/$foo//g; $foo=$B_stand; $foo =~ s/([\[\]\(\)])/\\\1/g; $tmp =~ s/$foo//g; $displen=length($tmp); $reallen=length($linestart); $flen=($cols-8-1)+($reallen-$displen); if ($displen>($cols-8-1)) { $x="*"; } else { $x=" "; } $line=sprintf("%-${flen}.${flen}s$x",$linestart); if ($piddata{$cpid,'ruser'} ne $piddata{$cpid,'user'}) { $line .= "$B_bold"; } $line .= sprintf("%-8s", $piddata{$cpid,'user'}); if ($piddata{$cpid,'ruser'} ne $piddata{$cpid,'user'}) { $line .= "$E_bold"; } return($line); } sub makeoneline { local($treestuff,$cpid)=($_[0],$_[1]); local($i,$line,$tmp,$linestart,$displen,$reallen,$flen); if ($cols<60) { return &makeoneshort($treestuff,$cpid); } $linestart="$treestuff"; if ($piddata{$cpid,'dead'}) { $linestart .= "$B_stand"; } $linestart .= "$cpid"; if ($piddata{$cpid,'dead'}) { $linestart .= "$E_stand"; } $linestart .= " $piddata{$cpid,$shortname}"; $tmp=$linestart; $tmp =~ s/[]//g; $foo=$E_stand; $foo =~ s/([\[\]\(\)])/\\\1/g; $tmp =~ s/$foo//g; $foo=$B_stand; $foo =~ s/([\[\]\(\)])/\\\1/g; $tmp =~ s/$foo//g; $displen=length($tmp); $reallen=length($linestart); $flen=($cols-27)+($reallen-$displen); if ($displen>($cols-27)) { $x="*"; } else { $x=" "; } $line=sprintf("%-${flen}.${flen}s$x",$linestart); if ($piddata{$cpid,'ruser'} ne $piddata{$cpid,'user'}) { $line .= "$B_bold"; } $line .= sprintf("%-8.8s", $piddata{$cpid,'user'}); if ($piddata{$cpid,'ruser'} ne $piddata{$cpid,'user'}) { $line .= "$E_bold"; } $vsz_string=$piddata{$cpid,'vsz'}; if (length($vsz_string) > 5) { $vsz_string = sprintf("%4dM",$vsz_string/1024); } $line .= sprintf(" %8s %-5.5s %1.1s\n", $piddata{$cpid,$stime}, $vsz_string, $piddata{$cpid,$state}); return($line); } sub custom_tree { local($comm)=$psall; local($tot)=0; local(@fields); local($f,$i,$pid); local($let)="A"; foreach $f (@fieldorder) { $comm .= " -o $f=" . $let x ($fieldlen{$f}+1); $tot += ($fieldlen{$f}+1); ++$let; } $ENV{'COLUMNS'}=$tot; open(PS,"$comm|"); while() { chop; @fields=split(' ',$_,$#fieldorder+1); $pid=$fields[0]; for ($i=1; $i<=$#fields; ++$i) { $piddata{$pid,$fieldorder[$i]}=$fields[$i]; } $children{$piddata{$pid,'ppid'}} .= " $pid"; } close(PS); } sub update_pid { local($uppid)=$_[0]; local($comm)="/usr/bin/ps "; local($tot)=0; local(@fields); local($f,$i,$pid); foreach $f (@fieldorder) { $comm .= " -o $f=" . "H" x ($fieldlen{$f}+1); $tot += ($fieldlen{$f}+1); } $comm .= " -p $uppid"; $ENV{'COLUMNS'}=$tot; open(PS,"$comm|"); ; #eat the header $_=; close(PS); chop; if ($_ eq "") { $piddata{$uppid,'dead'}=1; } else { @fields=split(' ',$_,$#fieldorder+1); $pid=$fields[0]; for ($i=1; $i<=$#fields; ++$i) { $piddata{$pid,$fieldorder[$i]}=$fields[$i]; } } } sub clear_tree { undef(%piddata); undef(%children); undef(@pids); undef(@lines); } sub getmountdevs { local($_,$dir,$foo); local(%ret); open(MNT,"mount|"); while() { ($dir,$foo)=split(' '); $ret{(stat($dir))[0]}=$dir; } close(MNT); return(%ret); } sub getenviron { local($pid)=$_[0]; local($tmp,$procname); local(@ret); open(PS,"$psname $_[0]|"); ; $tmp=; chop($tmp); close(PS); if ($tmp eq "") { push(@ret,"Process no longer exists!\n"); return(@ret); } my @foo=split(' ',$tmp,$nameindex+1); $procname=$foo[$nameindex]; #($foo,$foo,$foo,$foo,$procname)=split(' ',$tmp,5); open(PS,"$psenv $_[0]|"); ; $tmp=; chop($tmp); close(PS); $procname =~ s/\(/\\(/g; $procname =~ s/\)/\\)/g; $tmp =~ s/^.*$procname\s*//; $tmp =~ s/\s([^\s=]*=)/$;\1/g; @ret=split($;,$tmp); return(@ret); } sub ostype { if (-x "/usr/bin/uname") { $uname="/usr/bin/uname"; } elsif (-x "/bin/uname") { $uname="/bin/uname"; } elsif (-x "/usr/sbin/uname") { $uname="/usr/sbin/uname"; } elsif (-x "/sbin/uname") { $uname="/sbin/uname"; } else { $uname="/bin/uname"; } my ($os)=`$uname -s`; chop($os); return($os); } sub osrel { if (-x "/usr/bin/uname") { $uname="/usr/bin/uname"; } elsif (-x "/bin/uname") { $uname="/bin/uname"; } elsif (-x "/usr/sbin/uname") { $uname="/usr/sbin/uname"; } elsif (-x "/sbin/uname") { $uname="/sbin/uname"; } else { $uname="/bin/uname"; } my ($osr)=`$uname -r`; chop($osr); return($osr); } sub hosttype { if (-r "/etc/sysinfo") { open(HT,"/etc/sysinfo"); $si=; close(HT); ($HOSTTYPE,$foo)=split(/:/,$si); } else { open(HT,"uname -m|"); $si=; close(HT); $HOSTTYPE=$si; chop($HOSTTYPE); } } sub uid2name { local($uid)=$_[0]; if (! defined $uidcache{$uid}) { $uidcache{$uid}=(getpwuid($uid))[0]; } return($uidcache{$uid}); } sub numsort { $a-$b; } sub revsort { $b-$a; } # sort procs without kids first, with kids second # sort based on start time sub sig_int { &reset; #&setregion(0,$rows-1); &clearscreen; exit(0); } sub sig_stop { &reset; #&setregion(0,$rows-1); &clearscreen; kill "STOP",$$; } sub sig_cont { &cbreak; &drawscreen; } sub getsize { local ($_); if ($hosttype eq "mips" || $hosttype eq "decstation") { system("$STTY all 2>/tmp/decsucks.$$"); open(ROW,"/tmp/decsucks.$$"); unlink("/tmp/decsucks.$$"); while () { chop; if (/[0-9]+ +rows/) { $rows=$_; $rows =~ s/ +rows.*$//; $rows =~ s/^.* +//; } if (/[0-9]+ +columns/) { $columns=$_; $columns =~ s/ +columns.*$//; $columns =~ s/^.* +//; } } close(ROW); } #them that can't do stty size elsif ($hosttype eq "hp300") { #doesn't seem to have size available thru stty size #will set these at end $rows=0; $columns=0; } else { open(ROW,"$STTY size |"); $_=; chop; ($rows,$columns)=split(' ',$_); close(ROW); } if ($rows == 0) { if (defined($ENV{'LINES'})) { $rows=$ENV{'LINES'}; } elsif (defined($TC{'li'})) { $rows=$TC{'li'}; } else { $rows=24; } } if ($columns == 0) { if (defined($ENV{'COLUMNS'})) { $columns=$ENV{'COLUMNS'}; } elsif (defined($TC{'co'})) { $columns=$TC{'co'}; } else { $columns=80; } } #force the LINES and COLUMNS variables to fit $ENV{'LINES'}=$rows; $ENV{'COLUMNS'}=$columns; } sub cbreak { &savestty; $|=1; if ($hosttype eq "hp300" || $hosttype eq "hp700") { system("$STTY -icanon min 1 -echo"); } elsif ($hosttype eq "pyr") { system("$STTY cbreak -echo"); } else { system("$STTY cbreak min 1 -echo"); } system("$STTY dsusp ''"); } sub savestty { if ($hosttype eq "mips" || $hosttype eq "decstation") { system("stty all 2>/tmp/decsucks.$$"); open(SV,"/tmp/decsucks.$$"); unlink("/tmp/decsucks.$$"); } elsif ($hosttype eq "pyr") { open(SV,"att stty -g |"); } else { open(SV,"$STTY -g |"); } if (! defined ($CUSSsavetty)) { $CUSSsavetty=; close(SV); chop $CUSSsavetty; } } sub reset { if ($hosttype eq "pyr") { system("att stty $CUSSsavetty"); } else { system("$STTY $CUSSsavetty"); } } sub getcin { local($pattern) = $_[0]; local($function) = $_[1]; local($c); if ($pattern eq "") { $pattern="\000-\177"; } while (!(($c=getc)=~/[$pattern]/)) { if ($function eq "") { &beep; } else { &$function; } } $c; } sub getstring { local($maxlen) = $_[0]; local($pattern) = $_[1]; if ($pattern eq "") { $pattern="\000-\177"; } local($default) = $_[2]; local($ret) = $default; local($c); local($done)=0; local($nc)=length($default); print $default; while (! $done) { $c=&getcin("\n$pattern"); if ($c eq "" || $c eq "") { if ($nc == 0) { print ""; } else { print " "; $ret =~ s/.$//; --$nc; } } elsif ($c eq "\n") { $done=1; } else { if ($maxlen != 0 && $nc == $maxlen) { print ""; } else { print $c; $ret .= $c; ++$nc; } } } $ret; } sub showmess { &mvcurs(0,$rows); &cleartoeol; print $_[0], " ('any' key to continue)"; getc; &mvcurs(0,$rows); &cleartoeol; &mvcurs($curscol,$cursrow); } sub yorn { if (&ask("$_[0] (y or n)") eq "y") { return(1); } return(0); } sub ask { $ret=0; &mvcurs(0,$rows); &cleartoeol; print $_[0]; $ret=getc; &mvcurs(0,$rows); &cleartoeol; &mvcurs($curscol,$cursrow); $ret; } sub cleartoeol { &Tputs($TC{'ce'},1,STDOUT); } sub clearscreen { &Tputs($TC{'cl'},1,STDOUT); } sub scrollup { if (defined($TC{'cs'})) { &setregion(0,$rows-1); &mvcurs(0,$rows-1); print $_[0]; if (index($_[0],"\n") < 0) { &Tputs($TC{'do'},1,STDOUT); } } else { &mvcurs(0,$rows-1); &Tputs($TC{'al'},1,STDOUT); print $_[0]; if (index($_[0],"\n") < 0) { print "\n"; } } &mvcurs($curscol,$cursrow); } sub scrolldown { if (defined($TC{'cs'})) { &setregion(0,$rows-1); } &mvcurs(0,0); &Tputs($TC{'sr'},1,STDOUT); print $_[0]; &mvcurs(0,$rows-1); &cleartoeol; &mvcurs($curscol,$cursrow); } sub scrregup { &mvcurs(0,$_[0]); &Tputs($TC{'dl'},1,STDOUT); &mvcurs(0,$_[1]); &Tputs($TC{'al'},1,STDOUT); print $_[2]; } sub scrregdown { &mvcurs(0,$_[1]); &Tputs($TC{'dl'},1,STDOUT); &mvcurs(0,$_[0]); &Tputs($TC{'al'},1,STDOUT); print $_[2]; } sub setregion { if (! defined($TC{'cs'})) { return; } &Tputs(&Tgoto($TC{'cs'},$_[0],$_[1]), 0, STDOUT); } sub mvcurs { &Tputs(&Tgoto($TC{'cm'},$_[0],$_[1]), 0, STDOUT); } sub beep { &Tputs($TC{'bl'},1,STDOUT); }