← Index
NYTProf Performance Profile   « line view »
For /Users/brian/bin/perls/cpan5.26.1
  Run on Sat Dec 30 01:41:10 2017
Reported on Sat Dec 30 01:44:14 2017

Filename/usr/local/perls/perl-5.26.1/lib/5.26.1/Term/Cap.pm
StatementsExecuted 1513 statements in 48.5ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11137.0ms37.0msTerm::Cap::::CORE:backtickTerm::Cap::CORE:backtick (opcode)
1112.74ms43.7msTerm::Cap::::TgetentTerm::Cap::Tgetent
10111.57ms1.57msTerm::Cap::::CORE:fteexecTerm::Cap::CORE:fteexec (opcode)
3111.27ms1.27msTerm::Cap::::CORE:ftfileTerm::Cap::CORE:ftfile (opcode)
930181573µs573µsTerm::Cap::::CORE:substTerm::Cap::CORE:subst (opcode)
33941403µs403µsTerm::Cap::::CORE:matchTerm::Cap::CORE:match (opcode)
221101µs101µsTerm::Cap::::CORE:regcompTerm::Cap::CORE:regcomp (opcode)
121183µs112µsTerm::Cap::::TputsTerm::Cap::Tputs
11158µs1.32msTerm::Cap::::termcap_pathTerm::Cap::termcap_path
71123µs23µsTerm::Cap::::CORE:packTerm::Cap::CORE:pack (opcode)
11121µs25µsTerm::Cap::::BEGIN@17Term::Cap::BEGIN@17
41121µs29µsTerm::Cap::::TpadTerm::Cap::Tpad
11119µs85µsTerm::Cap::::BEGIN@19Term::Cap::BEGIN@19
141111µs11µsTerm::Cap::::CORE:substcontTerm::Cap::CORE:substcont (opcode)
11110µs100µsTerm::Cap::::BEGIN@20Term::Cap::BEGIN@20
0000s0sTerm::Cap::::TgotoTerm::Cap::Tgoto
0000s0sTerm::Cap::::TrequireTerm::Cap::Trequire
0000s0sTerm::Cap::::carpTerm::Cap::carp
0000s0sTerm::Cap::::croakTerm::Cap::croak
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package 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.
5sub carp
6{
7 require Carp;
8 goto &Carp::carp;
9}
10
11sub croak
12{
13 require Carp;
14 goto &Carp::croak;
15}
16
17290µs229µs
# spent 25µs (21+4) within Term::Cap::BEGIN@17 which was called: # once (21µs+4µs) by Term::ReadLine::TermCap::LoadTermCap at line 17
use strict;
# spent 25µs making 1 call to Term::Cap::BEGIN@17 # spent 4µs making 1 call to strict::import
18
19241µs2151µs
# spent 85µs (19+66) within Term::Cap::BEGIN@19 which was called: # once (19µs+66µs) by Term::ReadLine::TermCap::LoadTermCap at line 19
use vars qw($VERSION $VMS_TERMCAP);
# spent 85µs making 1 call to Term::Cap::BEGIN@19 # spent 66µs making 1 call to vars::import
2024.42ms2190µs
# spent 100µs (10+90) within Term::Cap::BEGIN@20 which was called: # once (10µs+90µs) by Term::ReadLine::TermCap::LoadTermCap at line 20
use vars qw($termpat $state $first $entry);
# spent 100µs making 1 call to Term::Cap::BEGIN@20 # spent 90µs making 1 call to vars::import
21
2211µs$VERSION = '1.17';
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
31Term::Cap - Perl termcap interface
32
33=head1 SYNOPSIS
34
35 require Term::Cap;
36 $terminal = Tgetent Term::Cap { 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
44These are low-level functions to extract and use capabilities from
45a terminal capability (termcap) database.
46
47More information on the terminal capabilities will be found in the
48termcap manpage on most Unix-like systems.
49
50=head2 METHODS
51
52The output strings for B<Tputs> are cached for counts of 1 for performance.
53B<Tgoto> and B<Tpad> do not cache. C<$self-E<gt>{_xx}> is the raw termcap
54data and C<$self-E<gt>{xx}> is the cached version.
55
56 print $terminal->Tpad($self->{_xx}, 1);
57
58B<Tgoto>, B<Tputs>, and B<Tpad> return the string and will also
59output 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
6813µsif ( $^O eq 'VMS' )
69{
70 chomp( my @entry = <DATA> );
71 $VMS_TERMCAP = join '', @entry;
72}
73
74# Returns a list of termcap files to check.
75
76sub termcap_path
77
# spent 1.32ms (58µs+1.27) within Term::Cap::termcap_path which was called: # once (58µs+1.27ms) by Term::Cap::Tgetent at line 237
{ ## private
7810s 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
8711µs : $ENV{TERMCAP} =~ /^\//s
88 )
89 );
9012µs if ( ( exists $ENV{TERMPATH} ) && ( $ENV{TERMPATH} ) )
91 {
92
93 # Add the users $TERMPATH
94 push( @termcap_path, split( /(:|\s+)/, $ENV{TERMPATH} ) );
95 }
96 else
97 {
98
99 # Defaults
100 push( @termcap_path,
10114µs 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
10611.32ms31.27ms return grep { defined $_ && -f $_ } @termcap_path;
# spent 1.27ms making 3 calls to Term::Cap::CORE:ftfile, avg 422µs/call
107}
108
109=over 4
110
111=item B<Tgetent>
112
113Returns a blessed object reference which the user can
114then use to send the control strings to the terminal using B<Tputs>
115and B<Tgoto>.
116
117The function extracts the entry of the specified terminal
118type I<TERM> (defaults to the environment variable I<TERM>) from the
119database.
120
121It will look in the environment for a I<TERMCAP> variable. If
122found, and the value does not begin with a slash, and the terminal
123type name is the same as the environment string I<TERM>, the
124I<TERMCAP> string is used instead of reading a termcap file. If
125it does begin with a slash, the string is used as a path name of
126the termcap file to search. If I<TERMCAP> does not begin with a
127slash and name is different from I<TERM>, B<Tgetent> searches the
128files F<$HOME/.termcap>, F</etc/termcap>, and F</usr/share/misc/termcap>,
129in that order, unless the environment variable I<TERMPATH> exists,
130in which case it specifies a list of file pathnames (separated by
131spaces or colons) to be searched B<instead>. Whenever multiple
132files are searched and a tc field occurs in the requested entry,
133the entry it names must be found in the same file or one of the
134succeeding files. If there is a C<:tc=...:> in the I<TERMCAP>
135environment variable string it will continue the search in the
136files as above.
137
138The extracted termcap entry is available in the object
139as C<$self-E<gt>{TERMCAP}>.
140
141It takes a hash reference as an argument with two optional keys:
142
143=over 2
144
145=item OSPEED
146
147The terminal output bit rate (often mistakenly called the baud rate)
148for this terminal - if not set a warning will be generated
149and it will be defaulted to 9600. I<OSPEED> can be specified as
150either a POSIX termios/SYSV termio speeds (where 9600 equals 9600) or
151an old DSD-style speed ( where 13 equals 9600).
152
153
154=item TERM
155
156The terminal type whose termcap entry will be used - if not supplied it will
157default to $ENV{TERM}: if that is not set then B<Tgetent> will croak.
158
159=back
160
161It calls C<croak> on failure.
162
163=cut
164
165sub Tgetent
166
# spent 43.7ms (2.74+41.0) within Term::Cap::Tgetent which was called: # once (2.74ms+41.0ms) by Term::ReadLine::TermCap::LoadTermCap at line 372 of Term/ReadLine.pm
{ ## public -- static method
16711µs my $class = shift;
16811µs my ($self) = @_;
169
17011µs $self = {} unless defined $self;
17111µs bless $self, $class;
172
17310s my ( $term, $cap, $search, $field, $max, $tmp_term, $TERMCAP );
17411µs local ( $termpat, $state, $first, $entry ); # used inside eval
17510s local $_;
176
177 # Compute PADDING factor from OSPEED (to be used by Tpad)
17818µs if ( !$self->{OSPEED} )
179 {
180 if ($^W)
181 {
182 carp "OSPEED was not set, defaulting to 9600";
183 }
184 $self->{OSPEED} = 9600;
185 }
18612µs if ( $self->{OSPEED} < 16 )
187 {
188
189 # delays for old style speeds
190 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 $self->{PADDING} = $pad[ $self->{OSPEED} ];
195 }
196 else
197 {
19812µs $self->{PADDING} = 10000 / $self->{OSPEED};
199 }
200
20112µs unless ( $self->{TERM} )
202 {
203 if ( $ENV{TERM} )
204 {
205 $self->{TERM} = $ENV{TERM} ;
206 }
207 else
208 {
209 if ( $^O eq 'MSWin32' )
210 {
211 $self->{TERM} = 'dumb';
212 }
213 else
214 {
215 croak "TERM not set";
216 }
217 }
218 }
219
22010s $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
22311µs $tmp_term = $self->{TERM};
224
225 # protect any pattern metacharacters in $tmp_term
22611µs $termpat = $tmp_term;
227114µs13µs $termpat =~ s/(\W)/\\$1/g;
# spent 3µs making 1 call to Term::Cap::CORE:subst
228
22911µs my $foo = ( exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '' );
230
231 # $entry is the extracted termcap entry
232177µs351µs if ( ( $foo !~ m:^/:s ) && ( $foo =~ m/(^|\|)${termpat}[:|]/s ) )
# spent 50µs making 1 call to Term::Cap::CORE:regcomp # spent 1µs making 2 calls to Term::Cap::CORE:match, avg 500ns/call
233 {
234 $entry = $foo;
235 }
236
23713µs11.32ms my @termcap_path = termcap_path();
# spent 1.32ms making 1 call to Term::Cap::termcap_path
238
239114µs if ( !@termcap_path && !$entry )
240 {
241
242 # last resort--fake up a termcap from terminfo
24318µs local $ENV{TERM} = $term;
244
245185µs if ( $^O eq 'VMS' )
246 {
247 $entry = $VMS_TERMCAP;
248 }
249 else
250 {
25111.63ms101.57ms if ( grep { -x "$_/infocmp" } split /:/, $ENV{PATH} )
# spent 1.57ms making 10 calls to Term::Cap::CORE:fteexec, avg 157µs/call
252 {
25311µs eval {
254137.0ms137.0ms my $tmp = `infocmp -C 2>/dev/null`;
# spent 37.0ms making 1 call to Term::Cap::CORE:backtick
255136µs127µs $tmp =~ s/^#.*\n//gm; # remove comments
# spent 27µs making 1 call to Term::Cap::CORE:subst
256179µs359µs if ( ( $tmp !~ m%^/%s )
# spent 51µs making 1 call to Term::Cap::CORE:regcomp # spent 8µs making 2 calls to Term::Cap::CORE:match, avg 4µs/call
257 && ( $tmp =~ /(^|\|)${termpat}[:|]/s ) )
258 {
25911µs $entry = $tmp;
260 }
261 };
26210s warn "Can't run infocmp to get a termcap entry: $@" if $@;
263 }
264 else
265 {
266 # this is getting desperate now
267 if ( $self->{TERM} eq 'dumb' )
268 {
269 $entry = 'dumb|80-column dumb tty::am::co#80::bl=^G:cr=^M:do=^J:sf=^J:';
270 }
271 }
272 }
273 }
274
27512µs croak "Can't find a valid termcap file" unless @termcap_path || $entry;
276
27711µs $state = 1; # 0 == finished
278 # 1 == next file
279 # 2 == search again
280
28110s $first = 0; # first entry (keeps term name)
282
28312µs $max = 32; # max :tc=...:'s
284
28511µs if ($entry)
286 {
287
288 # ok, we're starting with $TERMCAP
28910s $first++; # we're the first entry
290 # do we need to continue?
291127µs14µs if ( $entry =~ s/:tc=([^:]+):/:/ )
# spent 4µs making 1 call to Term::Cap::CORE:subst
292 {
293 $tmp_term = $1;
294
295 # protect any pattern metacharacters in $tmp_term
296 $termpat = $tmp_term;
297 $termpat =~ s/(\W)/\\$1/g;
298 }
299 else
300 {
30110s $state = 0; # we're already finished
302 }
303 }
304
305 # This is eval'ed inside the while loop for each file
30613µs $search = q{
307 while (<TERMCAP>) {
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 = <TERMCAP>) or last;
315 $_ .= $x; chomp;
316 }
317 last;
318 }
319 }
320 defined $entry or $entry = '';
321 $entry .= $_ if $_;
322 };
323
32411µs while ( $state != 0 )
325 {
326 if ( $state == 1 )
327 {
328
329 # get the next TERMCAP
330 $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 $max-- || croak "failed termcap loop at $tmp_term";
339 $state = 1; # ok, maybe do a new file next time
340 }
341
342 open( TERMCAP, "< $TERMCAP\0" ) || croak "open $TERMCAP: $!";
343 eval $search;
344 die $@ if $@;
345 close TERMCAP;
346
347 # If :tc=...: found then search this file again
348 $entry =~ s/:tc=([^:]+):/:/ && ( $tmp_term = $1, $state = 2 );
349
350 # protect any pattern metacharacters in $tmp_term
351 $termpat = $tmp_term;
352 $termpat =~ s/(\W)/\\$1/g;
353 }
354
35511µs croak "Can't find $term" if $entry eq '';
356129µs124µs $entry =~ s/:+\s*:+/:/g; # cleanup $entry
# spent 24µs making 1 call to Term::Cap::CORE:subst
357166µs161µs $entry =~ s/:+/:/g; # cleanup $entry
# spent 61µs making 1 call to Term::Cap::CORE:subst
35812µs $self->{TERMCAP} = $entry; # save it
359 # print STDERR "DEBUG: $entry = ", $entry, "\n";
360
361 # Precompile $entry into the object
362111µs16µs $entry =~ s/^[^:]*://;
# spent 6µs making 1 call to Term::Cap::CORE:subst
363182µs foreach $field ( split( /:[\s:\\]*/, $entry ) )
364 {
365881.02ms331386µs if ( defined $field && $field =~ /^(\w{2,})$/ )
# spent 386µs making 331 calls to Term::Cap::CORE:match, avg 1µs/call
366 {
367 $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 $self->{ '_' . $1 } = "";
374
375 # print STDERR "DEBUG: unset $1\n";
376 }
377 elsif ( defined $field && $field =~ /^(\w{2,})#(.*)/ )
378 {
379 $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";
3877783µs next if defined $self->{ '_' . ( $cap = $1 ) };
3887729µs $_ = $2;
3897722µs 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 {
40677302µs77160µs s/\\E/\033/g;
# spent 160µs making 77 calls to Term::Cap::CORE:subst, avg 2µs/call
40777135µs7729µs s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
# spent 29µs making 77 calls to Term::Cap::CORE:subst, avg 377ns/call
40877139µs7722µs s/\\n/\n/g;
# spent 22µs making 77 calls to Term::Cap::CORE:subst, avg 286ns/call
40977116µs7729µs s/\\r/\r/g;
# spent 29µs making 77 calls to Term::Cap::CORE:subst, avg 377ns/call
41077140µs7738µs s/\\t/\t/g;
# spent 38µs making 77 calls to Term::Cap::CORE:subst, avg 494ns/call
41177133µs7723µs s/\\b/\b/g;
# spent 23µs making 77 calls to Term::Cap::CORE:subst, avg 299ns/call
41277143µs7720µs s/\\f/\f/g;
# spent 20µs making 77 calls to Term::Cap::CORE:subst, avg 260ns/call
41377113µs7725µs s/\\\^/\377/g;
# spent 25µs making 77 calls to Term::Cap::CORE:subst, avg 325ns/call
41477104µs7723µs s/\^\?/\177/g;
# spent 23µs making 77 calls to Term::Cap::CORE:subst, avg 299ns/call
41577221µs9877µs s/\^(.)/pack('c',ord($1) & 31)/eg;
# spent 43µs making 77 calls to Term::Cap::CORE:subst, avg 558ns/call # spent 23µs making 7 calls to Term::Cap::CORE:pack, avg 3µs/call # spent 11µs making 14 calls to Term::Cap::CORE:substcont, avg 786ns/call
41677115µs7722µs s/\\(.)/$1/g;
# spent 22µs making 77 calls to Term::Cap::CORE:subst, avg 286ns/call
41777137µs7714µs s/\377/^/g;
# spent 14µs making 77 calls to Term::Cap::CORE:subst, avg 182ns/call
418 }
41977175µs $self->{ '_' . $cap } = $_;
420 }
421
422 # else { carp "junk in $term ignored: $field"; }
423 }
42415µs $self->{'_pc'} = "\0" unless defined $self->{'_pc'};
42513µs $self->{'_bc'} = "\b" unless defined $self->{'_bc'};
426118µs $self;
427}
428
429# $terminal->Tpad($string, $cnt, $FH);
430
431=item B<Tpad>
432
433Outputs a literal string with appropriate padding for the current terminal.
434
435It takes three arguments:
436
437=over 2
438
439=item B<$string>
440
441The 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,
443if the '*' is present then this amount will be multiplied by $cnt. This part
444of $string is removed before output/
445
446=item B<$cnt>
447
448Will be used to modify the padding applied to string as described above.
449
450=item B<$FH>
451
452An optional filehandle (or IO::Handle ) that output will be printed to.
453
454=back
455
456The padded $string is returned.
457
458=cut
459
460sub Tpad
461
# spent 29µs (21+8) within Term::Cap::Tpad which was called 4 times, avg 7µs/call: # 4 times (21µs+8µs) by Term::Cap::Tputs at line 528, avg 7µs/call
{ ## public
46241µs my $self = shift;
46343µs my ( $string, $cnt, $FH ) = @_;
46440s my ( $decr, $ms );
465
466418µs48µs if ( defined $string && $string =~ /(^[\d.]+)(\*?)(.*)$/ )
# spent 8µs making 4 calls to Term::Cap::CORE:match, avg 2µs/call
467 {
468 $ms = $1;
469 $ms *= $cnt if $2;
470 $string = $3;
471 $decr = $self->{PADDING};
472 if ( $decr > .1 )
473 {
474 $ms += $decr / 2;
475 $string .= $self->{'_pc'} x ( $ms / $decr );
476 }
477 }
47841µs print $FH $string if $FH;
479412µs $string;
480}
481
482# $terminal->Tputs($cap, $cnt, $FH);
483
484=item B<Tputs>
485
486Output the string for the given capability padded as appropriate without
487any parameter substitution.
488
489It takes three arguments:
490
491=over 2
492
493=item B<$cap>
494
495The capability whose string is to be output.
496
497=item B<$cnt>
498
499A count passed to Tpad to modify the padding applied to the output string.
500If $cnt is zero or one then the resulting string will be cached.
501
502=item B<$FH>
503
504An optional filehandle (or IO::Handle ) that output will be printed to.
505
506=back
507
508The appropriate string for the capability will be returned.
509
510=cut
511
512sub Tputs
513
# spent 112µs (83+29) within Term::Cap::Tputs which was called 12 times, avg 9µs/call: # 12 times (83µs+29µs) by Term::ReadLine::TermCap::ornaments at line 388 of Term/ReadLine.pm, avg 9µs/call
{ ## public
514125µs my $self = shift;
515128µs my ( $cap, $cnt, $FH ) = @_;
516122µs my $string;
517
518123µs $cnt = 0 unless $cnt;
519
520127µs if ( $cnt > 1 )
521 {
522 $string = Tpad( $self, $self->{ '_' . $cap }, $cnt );
523 }
524 else
525 {
526
527 # cache result because Tpad can be slow
5281219µs429µs unless ( exists $self->{$cap} )
# spent 29µs making 4 calls to Term::Cap::Tpad, avg 7µs/call
529 {
530 $self->{$cap} =
531 exists $self->{"_$cap"}
532 ? Tpad( $self, $self->{"_$cap"}, 1 )
533 : undef;
534 }
535124µs $string = $self->{$cap};
536 }
537120s print $FH $string if $FH;
5381281µs $string;
539}
540
541# $terminal->Tgoto($cap, $col, $row, $FH);
542
543=item B<Tgoto>
544
545B<Tgoto> decodes a cursor addressing string with the given parameters.
546
547There are four arguments:
548
549=over 2
550
551=item B<$cap>
552
553The name of the capability to be output.
554
555=item B<$col>
556
557The first value to be substituted in the output string ( usually the column
558in a cursor addressing capability )
559
560=item B<$row>
561
562The second value to be substituted in the output string (usually the row
563in cursor addressing capabilities)
564
565=item B<$FH>
566
567An optional filehandle (or IO::Handle ) to which the output string will be
568printed.
569
570=back
571
572Substitutions are made with $col and $row in the output string with the
573following 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
590The output string will be returned.
591
592=cut
593
594sub Tgoto
595{ ## public
596 my $self = shift;
597 my ( $cap, $code, $tmp, $FH ) = @_;
598 my $string = $self->{ '_' . $cap };
599 my $result = '';
600 my $after = '';
601 my $online = 0;
602 my @tmp = ( $tmp, $code );
603 my $cnt = $code;
604
605 while ( $string =~ /^([^%]*)%(.)(.*)/ )
606 {
607 $result .= $1;
608 $code = $2;
609 $string = $3;
610 if ( $code eq 'd' )
611 {
612 $result .= sprintf( "%d", shift(@tmp) );
613 }
614 elsif ( $code eq '.' )
615 {
616 $tmp = shift(@tmp);
617 if ( $tmp == 0 || $tmp == 4 || $tmp == 10 )
618 {
619 if ($online)
620 {
621 ++$tmp, $after .= $self->{'_up'} if $self->{'_up'};
622 }
623 else
624 {
625 ++$tmp, $after .= $self->{'_bc'};
626 }
627 }
628 $result .= sprintf( "%c", $tmp );
629 $online = !$online;
630 }
631 elsif ( $code eq '+' )
632 {
633 $result .= sprintf( "%c", shift(@tmp) + ord($string) );
634 $string = substr( $string, 1, 99 );
635 $online = !$online;
636 }
637 elsif ( $code eq 'r' )
638 {
639 ( $code, $tmp ) = @tmp;
640 @tmp = ( $tmp, $code );
641 $online = !$online;
642 }
643 elsif ( $code eq '>' )
644 {
645 ( $code, $tmp, $string ) = unpack( "CCa99", $string );
646 if ( $tmp[0] > $code )
647 {
648 $tmp[0] += $tmp;
649 }
650 }
651 elsif ( $code eq '2' )
652 {
653 $result .= sprintf( "%02d", shift(@tmp) );
654 $online = !$online;
655 }
656 elsif ( $code eq '3' )
657 {
658 $result .= sprintf( "%03d", shift(@tmp) );
659 $online = !$online;
660 }
661 elsif ( $code eq 'i' )
662 {
663 ( $code, $tmp ) = @tmp;
664 @tmp = ( $code + 1, $tmp + 1 );
665 }
666 else
667 {
668 return "OOPS";
669 }
670 }
671 $string = Tpad( $self, $result . $string . $after, $cnt );
672 print $FH $string if $FH;
673 $string;
674}
675
676# $terminal->Trequire(qw/ce ku kd/);
677
678=item B<Trequire>
679
680Takes a list of capabilities as an argument and will croak if one is not
681found.
682
683=cut
684
685sub Trequire
686{ ## public
687 my $self = shift;
688 my ( $cap, @undefined );
689 foreach $cap (@_)
690 {
691 push( @undefined, $cap )
692 unless defined $self->{ '_' . $cap } && $self->{ '_' . $cap };
693 }
694 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 = new POSIX::Termios;
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 $terminal = Tgetent Term::Cap { 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
730Copyright 1995-2015 (c) perl5 porters.
731
732This software is free software and can be modified and distributed under
733the same terms as Perl itself.
734
735Please see the file README in the Perl source distribution for details of
736the Perl license.
737
738=head1 AUTHOR
739
740This module is part of the core Perl distribution and is also maintained
741for CPAN by Jonathan Stowe <[email protected]>.
742
743The code is hosted on Github: https://github.com/jonathanstowe/Term-Cap
744please feel free to fork, submit patches etc, etc there.
745
746=head1 SEE ALSO
747
748termcap(5)
749
750=cut
751
752# Below is a default entry for systems where there are terminals but no
753# termcap
75418µs1;
755__DATA__
 
# spent 37.0ms within Term::Cap::CORE:backtick which was called: # once (37.0ms+0s) by Term::Cap::Tgetent at line 254
sub Term::Cap::CORE:backtick; # opcode
# spent 1.57ms within Term::Cap::CORE:fteexec which was called 10 times, avg 157µs/call: # 10 times (1.57ms+0s) by Term::Cap::Tgetent at line 251, avg 157µs/call
sub Term::Cap::CORE:fteexec; # opcode
# spent 1.27ms within Term::Cap::CORE:ftfile which was called 3 times, avg 422µs/call: # 3 times (1.27ms+0s) by Term::Cap::termcap_path at line 106, avg 422µs/call
sub Term::Cap::CORE:ftfile; # opcode
# spent 403µs within Term::Cap::CORE:match which was called 339 times, avg 1µs/call: # 331 times (386µs+0s) by Term::Cap::Tgetent at line 365, avg 1µs/call # 4 times (8µs+0s) by Term::Cap::Tpad at line 466, avg 2µs/call # 2 times (8µs+0s) by Term::Cap::Tgetent at line 256, avg 4µs/call # 2 times (1µs+0s) by Term::Cap::Tgetent at line 232, avg 500ns/call
sub Term::Cap::CORE:match; # opcode
# spent 23µs within Term::Cap::CORE:pack which was called 7 times, avg 3µs/call: # 7 times (23µs+0s) by Term::Cap::Tgetent at line 415, avg 3µs/call
sub Term::Cap::CORE:pack; # opcode
# spent 101µs within Term::Cap::CORE:regcomp which was called 2 times, avg 50µs/call: # once (51µs+0s) by Term::Cap::Tgetent at line 256 # once (50µs+0s) by Term::Cap::Tgetent at line 232
sub Term::Cap::CORE:regcomp; # opcode
# spent 573µs within Term::Cap::CORE:subst which was called 930 times, avg 616ns/call: # 77 times (160µs+0s) by Term::Cap::Tgetent at line 406, avg 2µs/call # 77 times (43µs+0s) by Term::Cap::Tgetent at line 415, avg 558ns/call # 77 times (38µs+0s) by Term::Cap::Tgetent at line 410, avg 494ns/call # 77 times (29µs+0s) by Term::Cap::Tgetent at line 407, avg 377ns/call # 77 times (29µs+0s) by Term::Cap::Tgetent at line 409, avg 377ns/call # 77 times (25µs+0s) by Term::Cap::Tgetent at line 413, avg 325ns/call # 77 times (23µs+0s) by Term::Cap::Tgetent at line 411, avg 299ns/call # 77 times (23µs+0s) by Term::Cap::Tgetent at line 414, avg 299ns/call # 77 times (22µs+0s) by Term::Cap::Tgetent at line 416, avg 286ns/call # 77 times (22µs+0s) by Term::Cap::Tgetent at line 408, avg 286ns/call # 77 times (20µs+0s) by Term::Cap::Tgetent at line 412, avg 260ns/call # 77 times (14µs+0s) by Term::Cap::Tgetent at line 417, avg 182ns/call # once (61µs+0s) by Term::Cap::Tgetent at line 357 # once (27µs+0s) by Term::Cap::Tgetent at line 255 # once (24µs+0s) by Term::Cap::Tgetent at line 356 # once (6µs+0s) by Term::Cap::Tgetent at line 362 # once (4µs+0s) by Term::Cap::Tgetent at line 291 # once (3µs+0s) by Term::Cap::Tgetent at line 227
sub Term::Cap::CORE:subst; # opcode
# spent 11µs within Term::Cap::CORE:substcont which was called 14 times, avg 786ns/call: # 14 times (11µs+0s) by Term::Cap::Tgetent at line 415, avg 786ns/call
sub Term::Cap::CORE:substcont; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.