1 warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
3 ;# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $
5 # This library is no longer being maintained, and is included for backward
6 # compatibility with Perl 4 programs which may require it.
7 # This legacy library is deprecated and will be removed in a future
10 # In particular, this should not be used as an example of modern Perl
11 # programming techniques.
13 # Suggested alternative: Term::Cap
18 ;# require 'ioctl.pl';
19 ;# ioctl(TTY,$TIOCGETP,$foo);
20 ;# ($ispeed,$ospeed) = unpack('cc',$foo);
21 ;# require 'termcap.pl';
22 ;# &Tgetent('vt100'); # sets $TC{'cm'}, etc.
23 ;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE');
24 ;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE');
28 local($TERMCAP,$_,$entry,$loop,$field);
30 # warn "Tgetent: no ospeed set" unless $ospeed;
31 foreach $key (keys %TC) {
34 $TERM = $ENV{'TERM'} unless $TERM;
35 $TERM =~ s/(\W)/\\$1/g;
36 $TERMCAP = $ENV{'TERMCAP'};
37 $TERMCAP = '/etc/termcap' unless $TERMCAP;
38 if ($TERMCAP !~ m:^/:) {
39 if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
40 $TERMCAP = '/etc/termcap';
43 if ($TERMCAP =~ m:^/:) {
47 open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\";
51 if (/(^|\\|)${TERM}[:\\|]/) {
53 while (chop eq '\\\\') {
65 } while s/:tc=([^:]+):/:/ && ($TERM = $1);
69 foreach $field (split(/:[\s:\\]*/,$TERMCAP)) {
70 if ($field =~ /^\w\w$/) {
73 elsif ($field =~ /^(\w\w)#(.*)/) {
74 $TC{$1} = $2 if $TC{$1} eq '';
76 elsif ($field =~ /^(\w\w)=(.*)/) {
80 s/\\(200)/pack('c',0)/eg; # NUL character
81 s/\\(0\d\d)/pack('c',oct($1))/eg; # octal
82 s/\\(0x[0-9A-Fa-f][0-9A-Fa-f])/pack('c',hex($1))/eg; # hex
83 s/\\(\d\d\d)/pack('c',$1 & 0177)/eg;
91 s/\^(.)/pack('c',ord($1) & 31)/eg;
94 $TC{$entry} = $_ if $TC{$entry} eq '';
97 $TC{'pc'} = "\0" if $TC{'pc'} eq '';
98 $TC{'bc'} = "\b" if $TC{'bc'} eq '';
101 @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);
104 local($string,$affcnt,$FH) = @_;
106 if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
108 $ms *= $affcnt if $2;
110 $decr = $Tputs[$ospeed];
113 $string .= $TC{'pc'} x ($ms / $decr);
116 print $FH $string if $FH;
121 local($string) = shift(@_);
124 local($code,$tmp) = @_;
128 while ($string =~ /^([^%]*)%(.)(.*)/) {
133 $result .= sprintf("%d",shift(@tmp));
135 elsif ($code eq '.') {
137 if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
139 ++$tmp, $after .= $TC{'up'} if $TC{'up'};
142 ++$tmp, $after .= $TC{'bc'};
145 $result .= sprintf("%c",$tmp);
148 elsif ($code eq '+') {
149 $result .= sprintf("%c",shift(@tmp)+ord($string));
150 $string = substr($string,1,99);
153 elsif ($code eq 'r') {
158 elsif ($code eq '>') {
159 ($code,$tmp,$string) = unpack("CCa99",$string);
160 if ($tmp[0] > $code) {
164 elsif ($code eq '2') {
165 $result .= sprintf("%02d",shift(@tmp));
168 elsif ($code eq '3') {
169 $result .= sprintf("%03d",shift(@tmp));
172 elsif ($code eq 'i') {
174 @tmp = ($code+1,$tmp+1);
180 $result . $string . $after;