1*0Sstevel@tonic-gate;# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $ 2*0Sstevel@tonic-gate# 3*0Sstevel@tonic-gate# This library is no longer being maintained, and is included for backward 4*0Sstevel@tonic-gate# compatibility with Perl 4 programs which may require it. 5*0Sstevel@tonic-gate# 6*0Sstevel@tonic-gate# In particular, this should not be used as an example of modern Perl 7*0Sstevel@tonic-gate# programming techniques. 8*0Sstevel@tonic-gate# 9*0Sstevel@tonic-gate# Suggested alternative: Term::Cap 10*0Sstevel@tonic-gate# 11*0Sstevel@tonic-gate;# 12*0Sstevel@tonic-gate;# Usage: 13*0Sstevel@tonic-gate;# require 'ioctl.pl'; 14*0Sstevel@tonic-gate;# ioctl(TTY,$TIOCGETP,$foo); 15*0Sstevel@tonic-gate;# ($ispeed,$ospeed) = unpack('cc',$foo); 16*0Sstevel@tonic-gate;# require 'termcap.pl'; 17*0Sstevel@tonic-gate;# &Tgetent('vt100'); # sets $TC{'cm'}, etc. 18*0Sstevel@tonic-gate;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE'); 19*0Sstevel@tonic-gate;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE'); 20*0Sstevel@tonic-gate;# 21*0Sstevel@tonic-gatesub Tgetent { 22*0Sstevel@tonic-gate local($TERM) = @_; 23*0Sstevel@tonic-gate local($TERMCAP,$_,$entry,$loop,$field); 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate # warn "Tgetent: no ospeed set" unless $ospeed; 26*0Sstevel@tonic-gate foreach $key (keys %TC) { 27*0Sstevel@tonic-gate delete $TC{$key}; 28*0Sstevel@tonic-gate } 29*0Sstevel@tonic-gate $TERM = $ENV{'TERM'} unless $TERM; 30*0Sstevel@tonic-gate $TERM =~ s/(\W)/\\$1/g; 31*0Sstevel@tonic-gate $TERMCAP = $ENV{'TERMCAP'}; 32*0Sstevel@tonic-gate $TERMCAP = '/etc/termcap' unless $TERMCAP; 33*0Sstevel@tonic-gate if ($TERMCAP !~ m:^/:) { 34*0Sstevel@tonic-gate if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) { 35*0Sstevel@tonic-gate $TERMCAP = '/etc/termcap'; 36*0Sstevel@tonic-gate } 37*0Sstevel@tonic-gate } 38*0Sstevel@tonic-gate if ($TERMCAP =~ m:^/:) { 39*0Sstevel@tonic-gate $entry = ''; 40*0Sstevel@tonic-gate do { 41*0Sstevel@tonic-gate $loop = " 42*0Sstevel@tonic-gate open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\"; 43*0Sstevel@tonic-gate while (<TERMCAP>) { 44*0Sstevel@tonic-gate next if /^#/; 45*0Sstevel@tonic-gate next if /^\t/; 46*0Sstevel@tonic-gate if (/(^|\\|)${TERM}[:\\|]/) { 47*0Sstevel@tonic-gate chop; 48*0Sstevel@tonic-gate while (chop eq '\\\\') { 49*0Sstevel@tonic-gate \$_ .= <TERMCAP>; 50*0Sstevel@tonic-gate chop; 51*0Sstevel@tonic-gate } 52*0Sstevel@tonic-gate \$_ .= ':'; 53*0Sstevel@tonic-gate last; 54*0Sstevel@tonic-gate } 55*0Sstevel@tonic-gate } 56*0Sstevel@tonic-gate close TERMCAP; 57*0Sstevel@tonic-gate \$entry .= \$_; 58*0Sstevel@tonic-gate "; 59*0Sstevel@tonic-gate eval $loop; 60*0Sstevel@tonic-gate } while s/:tc=([^:]+):/:/ && ($TERM = $1); 61*0Sstevel@tonic-gate $TERMCAP = $entry; 62*0Sstevel@tonic-gate } 63*0Sstevel@tonic-gate 64*0Sstevel@tonic-gate foreach $field (split(/:[\s:\\]*/,$TERMCAP)) { 65*0Sstevel@tonic-gate if ($field =~ /^\w\w$/) { 66*0Sstevel@tonic-gate $TC{$field} = 1; 67*0Sstevel@tonic-gate } 68*0Sstevel@tonic-gate elsif ($field =~ /^(\w\w)#(.*)/) { 69*0Sstevel@tonic-gate $TC{$1} = $2 if $TC{$1} eq ''; 70*0Sstevel@tonic-gate } 71*0Sstevel@tonic-gate elsif ($field =~ /^(\w\w)=(.*)/) { 72*0Sstevel@tonic-gate $entry = $1; 73*0Sstevel@tonic-gate $_ = $2; 74*0Sstevel@tonic-gate s/\\E/\033/g; 75*0Sstevel@tonic-gate s/\\(200)/pack('c',0)/eg; # NUL character 76*0Sstevel@tonic-gate s/\\(0\d\d)/pack('c',oct($1))/eg; # octal 77*0Sstevel@tonic-gate s/\\(0x[0-9A-Fa-f][0-9A-Fa-f])/pack('c',hex($1))/eg; # hex 78*0Sstevel@tonic-gate s/\\(\d\d\d)/pack('c',$1 & 0177)/eg; 79*0Sstevel@tonic-gate s/\\n/\n/g; 80*0Sstevel@tonic-gate s/\\r/\r/g; 81*0Sstevel@tonic-gate s/\\t/\t/g; 82*0Sstevel@tonic-gate s/\\b/\b/g; 83*0Sstevel@tonic-gate s/\\f/\f/g; 84*0Sstevel@tonic-gate s/\\\^/\377/g; 85*0Sstevel@tonic-gate s/\^\?/\177/g; 86*0Sstevel@tonic-gate s/\^(.)/pack('c',ord($1) & 31)/eg; 87*0Sstevel@tonic-gate s/\\(.)/$1/g; 88*0Sstevel@tonic-gate s/\377/^/g; 89*0Sstevel@tonic-gate $TC{$entry} = $_ if $TC{$entry} eq ''; 90*0Sstevel@tonic-gate } 91*0Sstevel@tonic-gate } 92*0Sstevel@tonic-gate $TC{'pc'} = "\0" if $TC{'pc'} eq ''; 93*0Sstevel@tonic-gate $TC{'bc'} = "\b" if $TC{'bc'} eq ''; 94*0Sstevel@tonic-gate} 95*0Sstevel@tonic-gate 96*0Sstevel@tonic-gate@Tputs = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2); 97*0Sstevel@tonic-gate 98*0Sstevel@tonic-gatesub Tputs { 99*0Sstevel@tonic-gate local($string,$affcnt,$FH) = @_; 100*0Sstevel@tonic-gate local($ms); 101*0Sstevel@tonic-gate if ($string =~ /(^[\d.]+)(\*?)(.*)$/) { 102*0Sstevel@tonic-gate $ms = $1; 103*0Sstevel@tonic-gate $ms *= $affcnt if $2; 104*0Sstevel@tonic-gate $string = $3; 105*0Sstevel@tonic-gate $decr = $Tputs[$ospeed]; 106*0Sstevel@tonic-gate if ($decr > .1) { 107*0Sstevel@tonic-gate $ms += $decr / 2; 108*0Sstevel@tonic-gate $string .= $TC{'pc'} x ($ms / $decr); 109*0Sstevel@tonic-gate } 110*0Sstevel@tonic-gate } 111*0Sstevel@tonic-gate print $FH $string if $FH; 112*0Sstevel@tonic-gate $string; 113*0Sstevel@tonic-gate} 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gatesub Tgoto { 116*0Sstevel@tonic-gate local($string) = shift(@_); 117*0Sstevel@tonic-gate local($result) = ''; 118*0Sstevel@tonic-gate local($after) = ''; 119*0Sstevel@tonic-gate local($code,$tmp) = @_; 120*0Sstevel@tonic-gate local(@tmp); 121*0Sstevel@tonic-gate @tmp = ($tmp,$code); 122*0Sstevel@tonic-gate local($online) = 0; 123*0Sstevel@tonic-gate while ($string =~ /^([^%]*)%(.)(.*)/) { 124*0Sstevel@tonic-gate $result .= $1; 125*0Sstevel@tonic-gate $code = $2; 126*0Sstevel@tonic-gate $string = $3; 127*0Sstevel@tonic-gate if ($code eq 'd') { 128*0Sstevel@tonic-gate $result .= sprintf("%d",shift(@tmp)); 129*0Sstevel@tonic-gate } 130*0Sstevel@tonic-gate elsif ($code eq '.') { 131*0Sstevel@tonic-gate $tmp = shift(@tmp); 132*0Sstevel@tonic-gate if ($tmp == 0 || $tmp == 4 || $tmp == 10) { 133*0Sstevel@tonic-gate if ($online) { 134*0Sstevel@tonic-gate ++$tmp, $after .= $TC{'up'} if $TC{'up'}; 135*0Sstevel@tonic-gate } 136*0Sstevel@tonic-gate else { 137*0Sstevel@tonic-gate ++$tmp, $after .= $TC{'bc'}; 138*0Sstevel@tonic-gate } 139*0Sstevel@tonic-gate } 140*0Sstevel@tonic-gate $result .= sprintf("%c",$tmp); 141*0Sstevel@tonic-gate $online = !$online; 142*0Sstevel@tonic-gate } 143*0Sstevel@tonic-gate elsif ($code eq '+') { 144*0Sstevel@tonic-gate $result .= sprintf("%c",shift(@tmp)+ord($string)); 145*0Sstevel@tonic-gate $string = substr($string,1,99); 146*0Sstevel@tonic-gate $online = !$online; 147*0Sstevel@tonic-gate } 148*0Sstevel@tonic-gate elsif ($code eq 'r') { 149*0Sstevel@tonic-gate ($code,$tmp) = @tmp; 150*0Sstevel@tonic-gate @tmp = ($tmp,$code); 151*0Sstevel@tonic-gate $online = !$online; 152*0Sstevel@tonic-gate } 153*0Sstevel@tonic-gate elsif ($code eq '>') { 154*0Sstevel@tonic-gate ($code,$tmp,$string) = unpack("CCa99",$string); 155*0Sstevel@tonic-gate if ($tmp[$[] > $code) { 156*0Sstevel@tonic-gate $tmp[$[] += $tmp; 157*0Sstevel@tonic-gate } 158*0Sstevel@tonic-gate } 159*0Sstevel@tonic-gate elsif ($code eq '2') { 160*0Sstevel@tonic-gate $result .= sprintf("%02d",shift(@tmp)); 161*0Sstevel@tonic-gate $online = !$online; 162*0Sstevel@tonic-gate } 163*0Sstevel@tonic-gate elsif ($code eq '3') { 164*0Sstevel@tonic-gate $result .= sprintf("%03d",shift(@tmp)); 165*0Sstevel@tonic-gate $online = !$online; 166*0Sstevel@tonic-gate } 167*0Sstevel@tonic-gate elsif ($code eq 'i') { 168*0Sstevel@tonic-gate ($code,$tmp) = @tmp; 169*0Sstevel@tonic-gate @tmp = ($code+1,$tmp+1); 170*0Sstevel@tonic-gate } 171*0Sstevel@tonic-gate else { 172*0Sstevel@tonic-gate return "OOPS"; 173*0Sstevel@tonic-gate } 174*0Sstevel@tonic-gate } 175*0Sstevel@tonic-gate $result . $string . $after; 176*0Sstevel@tonic-gate} 177*0Sstevel@tonic-gate 178*0Sstevel@tonic-gate1; 179