lib/Term/Cap.pm

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