line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Term::Cap; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Since the debugger uses Term::ReadLine which uses Term::Cap, we want |
4
|
|
|
|
|
|
|
# to load as few modules as possible. This includes Carp.pm. |
5
|
|
|
|
|
|
|
sub carp |
6
|
|
|
|
|
|
|
{ |
7
|
1
|
|
|
1
|
0
|
6
|
require Carp; |
8
|
1
|
|
|
|
|
108
|
goto &Carp::carp; |
9
|
|
|
|
|
|
|
} |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub croak |
12
|
|
|
|
|
|
|
{ |
13
|
7
|
|
|
7
|
0
|
56
|
require Carp; |
14
|
7
|
|
|
|
|
1128
|
goto &Carp::croak; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
1
|
|
|
1
|
|
15473
|
use strict; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
62
|
|
18
|
|
|
|
|
|
|
|
19
|
1
|
|
|
1
|
|
6
|
use vars qw($VERSION $VMS_TERMCAP); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
132
|
|
20
|
1
|
|
|
1
|
|
10
|
use vars qw($termpat $state $first $entry); |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
3152
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
$VERSION = '1.18'; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# TODO: |
25
|
|
|
|
|
|
|
# support Berkeley DB termcaps |
26
|
|
|
|
|
|
|
# force $FH into callers package? |
27
|
|
|
|
|
|
|
# keep $FH in object at Tgetent time? |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 NAME |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Term::Cap - Perl termcap interface |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 SYNOPSIS |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
require Term::Cap; |
36
|
|
|
|
|
|
|
$terminal = Term::Cap->Tgetent({ TERM => undef, OSPEED => $ospeed }); |
37
|
|
|
|
|
|
|
$terminal->Trequire(qw/ce ku kd/); |
38
|
|
|
|
|
|
|
$terminal->Tgoto('cm', $col, $row, $FH); |
39
|
|
|
|
|
|
|
$terminal->Tputs('dl', $count, $FH); |
40
|
|
|
|
|
|
|
$terminal->Tpad($string, $count, $FH); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 DESCRIPTION |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
These are low-level functions to extract and use capabilities from |
45
|
|
|
|
|
|
|
a terminal capability (termcap) database. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
More information on the terminal capabilities will be found in the |
48
|
|
|
|
|
|
|
termcap manpage on most Unix-like systems. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head2 METHODS |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
The output strings for B are cached for counts of 1 for performance. |
53
|
|
|
|
|
|
|
B and B do not cache. C<$self-E{_xx}> is the raw termcap |
54
|
|
|
|
|
|
|
data and C<$self-E{xx}> is the cached version. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
print $terminal->Tpad($self->{_xx}, 1); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
B, B, and B return the string and will also |
59
|
|
|
|
|
|
|
output the string to $FH if specified. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=cut |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Preload the default VMS termcap. |
65
|
|
|
|
|
|
|
# If a different termcap is required then the text of one can be supplied |
66
|
|
|
|
|
|
|
# in $Term::Cap::VMS_TERMCAP before Tgetent is called. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
if ( $^O eq 'VMS' ) |
69
|
|
|
|
|
|
|
{ |
70
|
|
|
|
|
|
|
chomp( my @entry = ); |
71
|
|
|
|
|
|
|
$VMS_TERMCAP = join '', @entry; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Returns a list of termcap files to check. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub termcap_path |
77
|
|
|
|
|
|
|
{ ## private |
78
|
8
|
|
|
8
|
0
|
1539
|
my @termcap_path; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# $TERMCAP, if it's a filespec |
81
|
|
|
|
|
|
|
push( @termcap_path, $ENV{TERMCAP} ) |
82
|
|
|
|
|
|
|
if ( |
83
|
|
|
|
|
|
|
( exists $ENV{TERMCAP} ) |
84
|
|
|
|
|
|
|
&& ( |
85
|
|
|
|
|
|
|
( $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos' ) |
86
|
|
|
|
|
|
|
? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/is |
87
|
8
|
50
|
33
|
|
|
89
|
: $ENV{TERMCAP} =~ /^\//s |
|
|
100
|
100
|
|
|
|
|
88
|
|
|
|
|
|
|
) |
89
|
|
|
|
|
|
|
); |
90
|
8
|
100
|
66
|
|
|
36
|
if ( ( exists $ENV{TERMPATH} ) && ( $ENV{TERMPATH} ) ) |
91
|
|
|
|
|
|
|
{ |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Add the users $TERMPATH |
94
|
6
|
|
|
|
|
78
|
push( @termcap_path, split( /:|\s+/, $ENV{TERMPATH} ) ); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
else |
97
|
|
|
|
|
|
|
{ |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# Defaults |
100
|
|
|
|
|
|
|
push( @termcap_path, |
101
|
2
|
100
|
|
|
|
13
|
exists $ENV{'HOME'} ? $ENV{'HOME'} . '/.termcap' : undef, |
102
|
|
|
|
|
|
|
'/etc/termcap', '/usr/share/misc/termcap', ); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# return the list of those termcaps that exist |
106
|
8
|
100
|
|
|
|
19
|
return grep { defined $_ && -f $_ } @termcap_path; |
|
45
|
|
|
|
|
581
|
|
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=over 4 |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=item B |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
Returns a blessed object reference which the user can |
114
|
|
|
|
|
|
|
then use to send the control strings to the terminal using B |
115
|
|
|
|
|
|
|
and B. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
The function extracts the entry of the specified terminal |
118
|
|
|
|
|
|
|
type I (defaults to the environment variable I) from the |
119
|
|
|
|
|
|
|
database. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
It will look in the environment for a I variable. If |
122
|
|
|
|
|
|
|
found, and the value does not begin with a slash, and the terminal |
123
|
|
|
|
|
|
|
type name is the same as the environment string I, the |
124
|
|
|
|
|
|
|
I string is used instead of reading a termcap file. If |
125
|
|
|
|
|
|
|
it does begin with a slash, the string is used as a path name of |
126
|
|
|
|
|
|
|
the termcap file to search. If I does not begin with a |
127
|
|
|
|
|
|
|
slash and name is different from I, B searches the |
128
|
|
|
|
|
|
|
files F<$HOME/.termcap>, F, and F, |
129
|
|
|
|
|
|
|
in that order, unless the environment variable I exists, |
130
|
|
|
|
|
|
|
in which case it specifies a list of file pathnames (separated by |
131
|
|
|
|
|
|
|
spaces or colons) to be searched B. Whenever multiple |
132
|
|
|
|
|
|
|
files are searched and a tc field occurs in the requested entry, |
133
|
|
|
|
|
|
|
the entry it names must be found in the same file or one of the |
134
|
|
|
|
|
|
|
succeeding files. If there is a C<:tc=...:> in the I |
135
|
|
|
|
|
|
|
environment variable string it will continue the search in the |
136
|
|
|
|
|
|
|
files as above. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
The extracted termcap entry is available in the object |
139
|
|
|
|
|
|
|
as C<$self-E{TERMCAP}>. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
It takes a hash reference as an argument with two optional keys: |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=over 2 |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=item OSPEED |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
The terminal output bit rate (often mistakenly called the baud rate) |
148
|
|
|
|
|
|
|
for this terminal - if not set a warning will be generated |
149
|
|
|
|
|
|
|
and it will be defaulted to 9600. I can be specified as |
150
|
|
|
|
|
|
|
either a POSIX termios/SYSV termio speeds (where 9600 equals 9600) or |
151
|
|
|
|
|
|
|
an old DSD-style speed ( where 13 equals 9600). |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=item TERM |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
The terminal type whose termcap entry will be used - if not supplied it will |
157
|
|
|
|
|
|
|
default to $ENV{TERM}: if that is not set then B will croak. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=back |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
It calls C on failure. |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub Tgetent |
166
|
|
|
|
|
|
|
{ ## public -- static method |
167
|
8
|
|
|
8
|
1
|
10497
|
my $class = shift; |
168
|
8
|
|
|
|
|
18
|
my ($self) = @_; |
169
|
|
|
|
|
|
|
|
170
|
8
|
100
|
|
|
|
23
|
$self = {} unless defined $self; |
171
|
8
|
|
|
|
|
14
|
bless $self, $class; |
172
|
|
|
|
|
|
|
|
173
|
8
|
|
|
|
|
14
|
my ( $term, $cap, $search, $field, $max, $tmp_term, $TERMCAP ); |
174
|
8
|
|
|
|
|
11
|
local ( $termpat, $state, $first, $entry ); # used inside eval |
175
|
8
|
|
|
|
|
11
|
local $_; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# Compute PADDING factor from OSPEED (to be used by Tpad) |
178
|
8
|
100
|
|
|
|
18
|
if ( !$self->{OSPEED} ) |
179
|
|
|
|
|
|
|
{ |
180
|
2
|
100
|
|
|
|
12
|
if ($^W) |
181
|
|
|
|
|
|
|
{ |
182
|
1
|
|
|
|
|
3
|
carp "OSPEED was not set, defaulting to 9600"; |
183
|
|
|
|
|
|
|
} |
184
|
2
|
|
|
|
|
57
|
$self->{OSPEED} = 9600; |
185
|
|
|
|
|
|
|
} |
186
|
8
|
100
|
|
|
|
20
|
if ( $self->{OSPEED} < 16 ) |
187
|
|
|
|
|
|
|
{ |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# delays for old style speeds |
190
|
5
|
|
|
|
|
14
|
my @pad = ( |
191
|
|
|
|
|
|
|
0, 200, 133.3, 90.9, 74.3, 66.7, 50, 33.3, |
192
|
|
|
|
|
|
|
16.7, 8.3, 5.5, 4.1, 2, 1, .5, .2 |
193
|
|
|
|
|
|
|
); |
194
|
5
|
|
|
|
|
14
|
$self->{PADDING} = $pad[ $self->{OSPEED} ]; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
else |
197
|
|
|
|
|
|
|
{ |
198
|
3
|
|
|
|
|
8
|
$self->{PADDING} = 10000 / $self->{OSPEED}; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
8
|
100
|
|
|
|
17
|
unless ( $self->{TERM} ) |
202
|
|
|
|
|
|
|
{ |
203
|
5
|
100
|
|
|
|
13
|
if ( $ENV{TERM} ) |
204
|
|
|
|
|
|
|
{ |
205
|
1
|
|
|
|
|
2
|
$self->{TERM} = $ENV{TERM} ; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
else |
208
|
|
|
|
|
|
|
{ |
209
|
4
|
100
|
|
|
|
15
|
if ( $^O eq 'MSWin32' ) |
210
|
|
|
|
|
|
|
{ |
211
|
1
|
|
|
|
|
7
|
$self->{TERM} = 'dumb'; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
else |
214
|
|
|
|
|
|
|
{ |
215
|
3
|
|
|
|
|
6
|
croak "TERM not set"; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
5
|
|
|
|
|
8
|
$term = $self->{TERM}; # $term is the term type we are looking for |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
# $tmp_term is always the next term (possibly :tc=...:) we are looking for |
223
|
5
|
|
|
|
|
67
|
$tmp_term = $self->{TERM}; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# protect any pattern metacharacters in $tmp_term |
226
|
5
|
|
|
|
|
10
|
$termpat = $tmp_term; |
227
|
5
|
|
|
|
|
15
|
$termpat =~ s/(\W)/\\$1/g; |
228
|
|
|
|
|
|
|
|
229
|
5
|
100
|
|
|
|
13
|
my $foo = ( exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '' ); |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# $entry is the extracted termcap entry |
232
|
5
|
50
|
33
|
|
|
143
|
if ( ( $foo !~ m:^/:s ) && ( $foo =~ m/(^|\|)${termpat}[:|]/s ) ) |
233
|
|
|
|
|
|
|
{ |
234
|
0
|
|
|
|
|
0
|
$entry = $foo; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
5
|
|
|
|
|
20
|
my @termcap_path = termcap_path(); |
238
|
|
|
|
|
|
|
|
239
|
5
|
50
|
66
|
|
|
22
|
if ( !@termcap_path && !$entry ) |
240
|
|
|
|
|
|
|
{ |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# last resort--fake up a termcap from terminfo |
243
|
2
|
|
|
|
|
9
|
local $ENV{TERM} = $term; |
244
|
|
|
|
|
|
|
|
245
|
2
|
50
|
|
|
|
5
|
if ( $^O eq 'VMS' ) |
246
|
|
|
|
|
|
|
{ |
247
|
0
|
|
|
|
|
0
|
$entry = $VMS_TERMCAP; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
else |
250
|
|
|
|
|
|
|
{ |
251
|
2
|
100
|
|
|
|
8
|
if ( grep { -x "$_/infocmp" } split /:/, $ENV{PATH} ) |
|
9
|
|
|
|
|
141
|
|
252
|
|
|
|
|
|
|
{ |
253
|
1
|
|
|
|
|
2
|
eval { |
254
|
1
|
|
|
|
|
7288
|
my $tmp = `infocmp -C 2>/dev/null`; |
255
|
1
|
|
|
|
|
21
|
$tmp =~ s/^#.*\n//gm; # remove comments |
256
|
1
|
50
|
33
|
|
|
89
|
if ( ( $tmp !~ m%^/%s ) |
257
|
|
|
|
|
|
|
&& ( $tmp =~ /(^|\|)${termpat}[:|]/s ) ) |
258
|
|
|
|
|
|
|
{ |
259
|
0
|
|
|
|
|
0
|
$entry = $tmp; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
}; |
262
|
1
|
50
|
|
|
|
30
|
warn "Can't run infocmp to get a termcap entry: $@" if $@; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
else |
265
|
|
|
|
|
|
|
{ |
266
|
|
|
|
|
|
|
# this is getting desperate now |
267
|
1
|
50
|
|
|
|
4
|
if ( $self->{TERM} eq 'dumb' ) |
268
|
|
|
|
|
|
|
{ |
269
|
1
|
|
|
|
|
8
|
$entry = 'dumb|80-column dumb tty::am::co#80::bl=^G:cr=^M:do=^J:sf=^J:'; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
5
|
100
|
100
|
|
|
58
|
croak "Can't find a valid termcap file" unless @termcap_path || $entry; |
276
|
|
|
|
|
|
|
|
277
|
4
|
|
|
|
|
6
|
$state = 1; # 0 == finished |
278
|
|
|
|
|
|
|
# 1 == next file |
279
|
|
|
|
|
|
|
# 2 == search again |
280
|
|
|
|
|
|
|
|
281
|
4
|
|
|
|
|
14
|
$first = 0; # first entry (keeps term name) |
282
|
|
|
|
|
|
|
|
283
|
4
|
|
|
|
|
11
|
$max = 32; # max :tc=...:'s |
284
|
|
|
|
|
|
|
|
285
|
4
|
100
|
|
|
|
13
|
if ($entry) |
286
|
|
|
|
|
|
|
{ |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# ok, we're starting with $TERMCAP |
289
|
1
|
|
|
|
|
3
|
$first++; # we're the first entry |
290
|
|
|
|
|
|
|
# do we need to continue? |
291
|
1
|
50
|
|
|
|
7
|
if ( $entry =~ s/:tc=([^:]+):/:/ ) |
292
|
|
|
|
|
|
|
{ |
293
|
0
|
|
|
|
|
0
|
$tmp_term = $1; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# protect any pattern metacharacters in $tmp_term |
296
|
0
|
|
|
|
|
0
|
$termpat = $tmp_term; |
297
|
0
|
|
|
|
|
0
|
$termpat =~ s/(\W)/\\$1/g; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
else |
300
|
|
|
|
|
|
|
{ |
301
|
1
|
|
|
|
|
2
|
$state = 0; # we're already finished |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# This is eval'ed inside the while loop for each file |
306
|
4
|
|
|
|
|
5
|
$search = q{ |
307
|
|
|
|
|
|
|
while () { |
308
|
|
|
|
|
|
|
next if /^\\t/ || /^#/; |
309
|
|
|
|
|
|
|
if ($_ =~ m/(^|\\|)${termpat}[:|]/o) { |
310
|
|
|
|
|
|
|
chomp; |
311
|
|
|
|
|
|
|
s/^[^:]*:// if $first++; |
312
|
|
|
|
|
|
|
$state = 0; |
313
|
|
|
|
|
|
|
while ($_ =~ s/\\\\$//) { |
314
|
|
|
|
|
|
|
defined(my $x = ) or last; |
315
|
|
|
|
|
|
|
$_ .= $x; chomp; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
last; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
defined $entry or $entry = ''; |
321
|
|
|
|
|
|
|
$entry .= $_ if $_; |
322
|
|
|
|
|
|
|
}; |
323
|
|
|
|
|
|
|
|
324
|
4
|
|
|
|
|
20
|
while ( $state != 0 ) |
325
|
|
|
|
|
|
|
{ |
326
|
37
|
100
|
|
|
|
84
|
if ( $state == 1 ) |
327
|
|
|
|
|
|
|
{ |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# get the next TERMCAP |
330
|
4
|
|
66
|
|
|
30
|
$TERMCAP = shift @termcap_path |
331
|
|
|
|
|
|
|
|| croak "failed termcap lookup on $tmp_term"; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
else |
334
|
|
|
|
|
|
|
{ |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# do the same file again |
337
|
|
|
|
|
|
|
# prevent endless recursion |
338
|
33
|
100
|
|
|
|
62
|
$max-- || croak "failed termcap loop at $tmp_term"; |
339
|
32
|
|
|
|
|
47
|
$state = 1; # ok, maybe do a new file next time |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
35
|
50
|
|
|
|
1082
|
open( TERMCAP, "< $TERMCAP\0" ) || croak "open $TERMCAP: $!"; |
343
|
35
|
|
|
|
|
6467
|
eval $search; |
344
|
35
|
50
|
|
|
|
152
|
die $@ if $@; |
345
|
35
|
|
|
|
|
465
|
close TERMCAP; |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# If :tc=...: found then search this file again |
348
|
35
|
100
|
|
|
|
394
|
$entry =~ s/:tc=([^:]+):/:/ && ( $tmp_term = $1, $state = 2 ); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# protect any pattern metacharacters in $tmp_term |
351
|
35
|
|
|
|
|
72
|
$termpat = $tmp_term; |
352
|
35
|
|
|
|
|
104
|
$termpat =~ s/(\W)/\\$1/g; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
2
|
50
|
|
|
|
8
|
croak "Can't find $term" if $entry eq ''; |
356
|
2
|
|
|
|
|
20
|
$entry =~ s/:+\s*:+/:/g; # cleanup $entry |
357
|
2
|
|
|
|
|
17
|
$entry =~ s/:+/:/g; # cleanup $entry |
358
|
2
|
|
|
|
|
13
|
$self->{TERMCAP} = $entry; # save it |
359
|
|
|
|
|
|
|
# print STDERR "DEBUG: $entry = ", $entry, "\n"; |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
# Precompile $entry into the object |
362
|
2
|
|
|
|
|
10
|
$entry =~ s/^[^:]*://; |
363
|
2
|
|
|
|
|
18
|
foreach $field ( split( /:[\s:\\]*/, $entry ) ) |
364
|
|
|
|
|
|
|
{ |
365
|
11
|
100
|
66
|
|
|
107
|
if ( defined $field && $field =~ /^(\w{2,})$/ ) |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
366
|
|
|
|
|
|
|
{ |
367
|
3
|
50
|
|
|
|
25
|
$self->{ '_' . $field } = 1 unless defined $self->{ '_' . $1 }; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
# print STDERR "DEBUG: flag $1\n"; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
elsif ( defined $field && $field =~ /^(\w{2,})\@/ ) |
372
|
|
|
|
|
|
|
{ |
373
|
1
|
|
|
|
|
4
|
$self->{ '_' . $1 } = ""; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# print STDERR "DEBUG: unset $1\n"; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
elsif ( defined $field && $field =~ /^(\w{2,})#(.*)/ ) |
378
|
|
|
|
|
|
|
{ |
379
|
2
|
50
|
|
|
|
12
|
$self->{ '_' . $1 } = $2 unless defined $self->{ '_' . $1 }; |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
# print STDERR "DEBUG: numeric $1 = $2\n"; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
elsif ( defined $field && $field =~ /^(\w{2,})=(.*)/ ) |
384
|
|
|
|
|
|
|
{ |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
# print STDERR "DEBUG: string $1 = $2\n"; |
387
|
5
|
50
|
|
|
|
17
|
next if defined $self->{ '_' . ( $cap = $1 ) }; |
388
|
5
|
|
|
|
|
8
|
$_ = $2; |
389
|
5
|
|
|
|
|
7
|
if ( ord('A') == 193 ) |
390
|
|
|
|
|
|
|
{ |
391
|
|
|
|
|
|
|
s/\\E/\047/g; |
392
|
|
|
|
|
|
|
s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg; |
393
|
|
|
|
|
|
|
s/\\n/\n/g; |
394
|
|
|
|
|
|
|
s/\\r/\r/g; |
395
|
|
|
|
|
|
|
s/\\t/\t/g; |
396
|
|
|
|
|
|
|
s/\\b/\b/g; |
397
|
|
|
|
|
|
|
s/\\f/\f/g; |
398
|
|
|
|
|
|
|
s/\\\^/\337/g; |
399
|
|
|
|
|
|
|
s/\^\?/\007/g; |
400
|
|
|
|
|
|
|
s/\^(.)/pack('c',ord($1) & 31)/eg; |
401
|
|
|
|
|
|
|
s/\\(.)/$1/g; |
402
|
|
|
|
|
|
|
s/\337/^/g; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
else |
405
|
|
|
|
|
|
|
{ |
406
|
5
|
|
|
|
|
8
|
s/\\E/\033/g; |
407
|
5
|
|
|
|
|
12
|
s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg; |
|
0
|
|
|
|
|
0
|
|
408
|
5
|
|
|
|
|
8
|
s/\\n/\n/g; |
409
|
5
|
|
|
|
|
7
|
s/\\r/\r/g; |
410
|
5
|
|
|
|
|
7
|
s/\\t/\t/g; |
411
|
5
|
|
|
|
|
6
|
s/\\b/\b/g; |
412
|
5
|
|
|
|
|
6
|
s/\\f/\f/g; |
413
|
5
|
|
|
|
|
7
|
s/\\\^/\377/g; |
414
|
5
|
|
|
|
|
7
|
s/\^\?/\177/g; |
415
|
5
|
|
|
|
|
16
|
s/\^(.)/pack('c',ord($1) & 31)/eg; |
|
4
|
|
|
|
|
16
|
|
416
|
5
|
|
|
|
|
10
|
s/\\(.)/$1/g; |
417
|
5
|
|
|
|
|
12
|
s/\377/^/g; |
418
|
|
|
|
|
|
|
} |
419
|
5
|
|
|
|
|
16
|
$self->{ '_' . $cap } = $_; |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# else { carp "junk in $term ignored: $field"; } |
423
|
|
|
|
|
|
|
} |
424
|
2
|
50
|
|
|
|
12
|
$self->{'_pc'} = "\0" unless defined $self->{'_pc'}; |
425
|
2
|
50
|
|
|
|
5
|
$self->{'_bc'} = "\b" unless defined $self->{'_bc'}; |
426
|
2
|
|
|
|
|
50
|
$self; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
# $terminal->Tpad($string, $cnt, $FH); |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=item B |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
Outputs a literal string with appropriate padding for the current terminal. |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
It takes three arguments: |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=over 2 |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=item B<$string> |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
The literal string to be output. If it starts with a number and an optional |
442
|
|
|
|
|
|
|
'*' then the padding will be increased by an amount relative to this number, |
443
|
|
|
|
|
|
|
if the '*' is present then this amount will be multiplied by $cnt. This part |
444
|
|
|
|
|
|
|
of $string is removed before output/ |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=item B<$cnt> |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
Will be used to modify the padding applied to string as described above. |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=item B<$FH> |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
An optional filehandle (or IO::Handle ) that output will be printed to. |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=back |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
The padded $string is returned. |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=cut |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub Tpad |
461
|
|
|
|
|
|
|
{ ## public |
462
|
17
|
|
|
17
|
1
|
422
|
my $self = shift; |
463
|
17
|
|
|
|
|
49
|
my ( $string, $cnt, $FH ) = @_; |
464
|
17
|
|
|
|
|
26
|
my ( $decr, $ms ); |
465
|
|
|
|
|
|
|
|
466
|
17
|
100
|
100
|
|
|
102
|
if ( defined $string && $string =~ /(^[\d.]+)(\*?)(.*)$/ ) |
467
|
|
|
|
|
|
|
{ |
468
|
2
|
|
|
|
|
5
|
$ms = $1; |
469
|
2
|
50
|
|
|
|
9
|
$ms *= $cnt if $2; |
470
|
2
|
|
|
|
|
8
|
$string = $3; |
471
|
2
|
|
|
|
|
8
|
$decr = $self->{PADDING}; |
472
|
2
|
50
|
|
|
|
5
|
if ( $decr > .1 ) |
473
|
|
|
|
|
|
|
{ |
474
|
2
|
|
|
|
|
5
|
$ms += $decr / 2; |
475
|
2
|
|
|
|
|
13
|
$string .= $self->{'_pc'} x ( $ms / $decr ); |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
} |
478
|
17
|
100
|
|
|
|
45
|
print $FH $string if $FH; |
479
|
17
|
|
|
|
|
78
|
$string; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# $terminal->Tputs($cap, $cnt, $FH); |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=item B |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
Output the string for the given capability padded as appropriate without |
487
|
|
|
|
|
|
|
any parameter substitution. |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
It takes three arguments: |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=over 2 |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=item B<$cap> |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
The capability whose string is to be output. |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
=item B<$cnt> |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
A count passed to Tpad to modify the padding applied to the output string. |
500
|
|
|
|
|
|
|
If $cnt is zero or one then the resulting string will be cached. |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=item B<$FH> |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
An optional filehandle (or IO::Handle ) that output will be printed to. |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=back |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
The appropriate string for the capability will be returned. |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=cut |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
sub Tputs |
513
|
|
|
|
|
|
|
{ ## public |
514
|
3
|
|
|
3
|
1
|
6
|
my $self = shift; |
515
|
3
|
|
|
|
|
14
|
my ( $cap, $cnt, $FH ) = @_; |
516
|
3
|
|
|
|
|
5
|
my $string; |
517
|
|
|
|
|
|
|
|
518
|
3
|
100
|
|
|
|
24
|
$cnt = 0 unless $cnt; |
519
|
|
|
|
|
|
|
|
520
|
3
|
100
|
|
|
|
20
|
if ( $cnt > 1 ) |
521
|
|
|
|
|
|
|
{ |
522
|
1
|
|
|
|
|
4
|
$string = Tpad( $self, $self->{ '_' . $cap }, $cnt ); |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
else |
525
|
|
|
|
|
|
|
{ |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
# cache result because Tpad can be slow |
528
|
2
|
100
|
|
|
|
8
|
unless ( exists $self->{$cap} ) |
529
|
|
|
|
|
|
|
{ |
530
|
|
|
|
|
|
|
$self->{$cap} = |
531
|
|
|
|
|
|
|
exists $self->{"_$cap"} |
532
|
1
|
50
|
|
|
|
6
|
? Tpad( $self, $self->{"_$cap"}, 1 ) |
533
|
|
|
|
|
|
|
: undef; |
534
|
|
|
|
|
|
|
} |
535
|
2
|
|
|
|
|
4
|
$string = $self->{$cap}; |
536
|
|
|
|
|
|
|
} |
537
|
3
|
100
|
|
|
|
9
|
print $FH $string if $FH; |
538
|
3
|
|
|
|
|
15
|
$string; |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# $terminal->Tgoto($cap, $col, $row, $FH); |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=item B |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
B decodes a cursor addressing string with the given parameters. |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
There are four arguments: |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=over 2 |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
=item B<$cap> |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
The name of the capability to be output. |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
=item B<$col> |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
The first value to be substituted in the output string ( usually the column |
558
|
|
|
|
|
|
|
in a cursor addressing capability ) |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
=item B<$row> |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
The second value to be substituted in the output string (usually the row |
563
|
|
|
|
|
|
|
in cursor addressing capabilities) |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
=item B<$FH> |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
An optional filehandle (or IO::Handle ) to which the output string will be |
568
|
|
|
|
|
|
|
printed. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=back |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
Substitutions are made with $col and $row in the output string with the |
573
|
|
|
|
|
|
|
following sprintf() line formats: |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
%% output `%' |
576
|
|
|
|
|
|
|
%d output value as in printf %d |
577
|
|
|
|
|
|
|
%2 output value as in printf %2d |
578
|
|
|
|
|
|
|
%3 output value as in printf %3d |
579
|
|
|
|
|
|
|
%. output value as in printf %c |
580
|
|
|
|
|
|
|
%+x add x to value, then do %. |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
%>xy if value > x then add y, no output |
583
|
|
|
|
|
|
|
%r reverse order of two parameters, no output |
584
|
|
|
|
|
|
|
%i increment by one, no output |
585
|
|
|
|
|
|
|
%B BCD (16*(value/10)) + (value%10), no output |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
%n exclusive-or all parameters with 0140 (Datamedia 2500) |
588
|
|
|
|
|
|
|
%D Reverse coding (value - 2*(value%16)), no output (Delta Data) |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
The output string will be returned. |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
=cut |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
sub Tgoto |
595
|
|
|
|
|
|
|
{ ## public |
596
|
12
|
|
|
12
|
1
|
1191
|
my $self = shift; |
597
|
12
|
|
|
|
|
32
|
my ( $cap, $code, $tmp, $FH ) = @_; |
598
|
12
|
|
|
|
|
28
|
my $string = $self->{ '_' . $cap }; |
599
|
12
|
|
|
|
|
20
|
my $result = ''; |
600
|
12
|
|
|
|
|
16
|
my $after = ''; |
601
|
12
|
|
|
|
|
14
|
my $online = 0; |
602
|
12
|
|
|
|
|
24
|
my @tmp = ( $tmp, $code ); |
603
|
12
|
|
|
|
|
21
|
my $cnt = $code; |
604
|
|
|
|
|
|
|
|
605
|
12
|
|
|
|
|
80
|
while ( $string =~ /^([^%]*)%(.)(.*)/ ) |
606
|
|
|
|
|
|
|
{ |
607
|
14
|
|
|
|
|
32
|
$result .= $1; |
608
|
14
|
|
|
|
|
25
|
$code = $2; |
609
|
14
|
|
|
|
|
24
|
$string = $3; |
610
|
14
|
100
|
|
|
|
57
|
if ( $code eq 'd' ) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
611
|
|
|
|
|
|
|
{ |
612
|
2
|
|
|
|
|
11
|
$result .= sprintf( "%d", shift(@tmp) ); |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
elsif ( $code eq '.' ) |
615
|
|
|
|
|
|
|
{ |
616
|
2
|
|
|
|
|
3
|
$tmp = shift(@tmp); |
617
|
2
|
50
|
66
|
|
|
22
|
if ( $tmp == 0 || $tmp == 4 || $tmp == 10 ) |
|
|
|
66
|
|
|
|
|
618
|
|
|
|
|
|
|
{ |
619
|
1
|
50
|
|
|
|
4
|
if ($online) |
620
|
|
|
|
|
|
|
{ |
621
|
0
|
0
|
|
|
|
0
|
++$tmp, $after .= $self->{'_up'} if $self->{'_up'}; |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
else |
624
|
|
|
|
|
|
|
{ |
625
|
1
|
|
|
|
|
2
|
++$tmp, $after .= $self->{'_bc'}; |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
} |
628
|
2
|
|
|
|
|
8
|
$result .= sprintf( "%c", $tmp ); |
629
|
2
|
|
|
|
|
6
|
$online = !$online; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
elsif ( $code eq '+' ) |
632
|
|
|
|
|
|
|
{ |
633
|
3
|
|
|
|
|
12
|
$result .= sprintf( "%c", shift(@tmp) + ord($string) ); |
634
|
3
|
|
|
|
|
8
|
$string = substr( $string, 1, 99 ); |
635
|
3
|
|
|
|
|
8
|
$online = !$online; |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
elsif ( $code eq 'r' ) |
638
|
|
|
|
|
|
|
{ |
639
|
1
|
|
|
|
|
8
|
( $code, $tmp ) = @tmp; |
640
|
1
|
|
|
|
|
2
|
@tmp = ( $tmp, $code ); |
641
|
1
|
|
|
|
|
7
|
$online = !$online; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
elsif ( $code eq '>' ) |
644
|
|
|
|
|
|
|
{ |
645
|
1
|
|
|
|
|
15
|
( $code, $tmp, $string ) = unpack( "CCa99", $string ); |
646
|
1
|
50
|
|
|
|
4
|
if ( $tmp[0] > $code ) |
647
|
|
|
|
|
|
|
{ |
648
|
0
|
|
|
|
|
0
|
$tmp[0] += $tmp; |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
elsif ( $code eq '2' ) |
652
|
|
|
|
|
|
|
{ |
653
|
2
|
|
|
|
|
20
|
$result .= sprintf( "%02d", shift(@tmp) ); |
654
|
2
|
|
|
|
|
6
|
$online = !$online; |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
elsif ( $code eq '3' ) |
657
|
|
|
|
|
|
|
{ |
658
|
1
|
|
|
|
|
5
|
$result .= sprintf( "%03d", shift(@tmp) ); |
659
|
1
|
|
|
|
|
3
|
$online = !$online; |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
elsif ( $code eq 'i' ) |
662
|
|
|
|
|
|
|
{ |
663
|
1
|
|
|
|
|
2
|
( $code, $tmp ) = @tmp; |
664
|
1
|
|
|
|
|
8
|
@tmp = ( $code + 1, $tmp + 1 ); |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
else |
667
|
|
|
|
|
|
|
{ |
668
|
1
|
|
|
|
|
6
|
return "OOPS"; |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
} |
671
|
11
|
|
|
|
|
34
|
$string = Tpad( $self, $result . $string . $after, $cnt ); |
672
|
11
|
100
|
|
|
|
45
|
print $FH $string if $FH; |
673
|
11
|
|
|
|
|
84
|
$string; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
# $terminal->Trequire(qw/ce ku kd/); |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=item B |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
Takes a list of capabilities as an argument and will croak if one is not |
681
|
|
|
|
|
|
|
found. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
=cut |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
sub Trequire |
686
|
|
|
|
|
|
|
{ ## public |
687
|
2
|
|
|
2
|
1
|
505
|
my $self = shift; |
688
|
2
|
|
|
|
|
4
|
my ( $cap, @undefined ); |
689
|
2
|
|
|
|
|
4
|
foreach $cap (@_) |
690
|
|
|
|
|
|
|
{ |
691
|
|
|
|
|
|
|
push( @undefined, $cap ) |
692
|
2
|
100
|
66
|
|
|
20
|
unless defined $self->{ '_' . $cap } && $self->{ '_' . $cap }; |
693
|
|
|
|
|
|
|
} |
694
|
2
|
100
|
|
|
|
11
|
croak "Terminal does not support: (@undefined)" if @undefined; |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=back |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=head1 EXAMPLES |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
use Term::Cap; |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
# Get terminal output speed |
704
|
|
|
|
|
|
|
require POSIX; |
705
|
|
|
|
|
|
|
my $termios = POSIX::Termios->new; |
706
|
|
|
|
|
|
|
$termios->getattr; |
707
|
|
|
|
|
|
|
my $ospeed = $termios->getospeed; |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
# Old-style ioctl code to get ospeed: |
710
|
|
|
|
|
|
|
# require 'ioctl.pl'; |
711
|
|
|
|
|
|
|
# ioctl(TTY,$TIOCGETP,$sgtty); |
712
|
|
|
|
|
|
|
# ($ispeed,$ospeed) = unpack('cc',$sgtty); |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
# allocate and initialize a terminal structure |
715
|
|
|
|
|
|
|
my $terminal = Term::Cap->Tgetent({ TERM => undef, OSPEED => $ospeed }); |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
# require certain capabilities to be available |
718
|
|
|
|
|
|
|
$terminal->Trequire(qw/ce ku kd/); |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
# Output Routines, if $FH is undefined these just return the string |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
# Tgoto does the % expansion stuff with the given args |
723
|
|
|
|
|
|
|
$terminal->Tgoto('cm', $col, $row, $FH); |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
# Tputs doesn't do any % expansion. |
726
|
|
|
|
|
|
|
$terminal->Tputs('dl', $count = 1, $FH); |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
Copyright 1995-2015 (c) perl5 porters. |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
This software is free software and can be modified and distributed under |
733
|
|
|
|
|
|
|
the same terms as Perl itself. |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
Please see the file README in the Perl source distribution for details of |
736
|
|
|
|
|
|
|
the Perl license. |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
=head1 AUTHOR |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
This module is part of the core Perl distribution and is also maintained |
741
|
|
|
|
|
|
|
for CPAN by Jonathan Stowe . |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
The code is hosted on Github: https://github.com/jonathanstowe/Term-Cap |
744
|
|
|
|
|
|
|
please feel free to fork, submit patches etc, etc there. |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
=head1 SEE ALSO |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
termcap(5) |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=cut |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
# Below is a default entry for systems where there are terminals but no |
753
|
|
|
|
|
|
|
# termcap |
754
|
|
|
|
|
|
|
1; |
755
|
|
|
|
|
|
|
__DATA__ |