If we use @{[]} (a.k.a. baby-cart) interpolation, we got warnings

[p5sagit/p5-mst-13.2.git] / lib / Term / Cap.pm

diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm
index 92015b5..b71c51c 100644 (file)
--- a/lib/Term/Cap.pm
+++ b/lib/Term/Cap.pm
@@ -1,10 +1,23 @@
 package Term::Cap;
 
-use Carp;
+# Since the debugger uses Term::ReadLine which uses Term::Cap, we want
+# to load as few modules as possible.  This includes Carp.pm.
+sub carp {
+    require Carp;
+    goto &Carp::carp;
+}
+
+sub croak {
+    require Carp;
+    goto &Carp::croak;
+}
 
-use vars qw($VERSION);
+use strict;
 
-$VERSION = '1.03';
+use vars qw($VERSION $VMS_TERMCAP);
+use vars qw($termpat $state $first $entry);
+
+$VERSION = '1.09';
 
 # Version undef: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com
 # Version 1.00:  Thu Nov 30 23:34:29 EST 2000 by schwern@pobox.com
@@ -17,6 +30,23 @@ $VERSION = '1.03';
 #       Fixed no argument Tgetent()
 # Version 1.03:  Wed Nov 28 10:09:38 GMT 2001
 #       VMS Support from Charles Lane <lane@DUPHY4.Physics.Drexel.Edu>
+# Version 1.04:  Thu Nov 29 16:22:03 GMT 2001
+#       Fixed warnings in test
+# Version 1.05:  Mon Dec  3 15:33:49 GMT 2001
+#       Don't try to fall back on infocmp if it's not there. From chromatic.
+# Version 1.06:  Thu Dec  6 18:43:22 GMT 2001
+#       Preload the default VMS termcap from Charles Lane
+#       Don't carp at setting OSPEED unless warnings are on.
+# Version 1.07:  Wed Jan  2 21:35:09 GMT 2002
+#       Sanity check on infocmp output from Norton Allen
+#       Repaired INSTALLDIRS thanks to Michael Schwern
+# Version 1.08:  Sat Sep 28 11:33:15 BST 2002
+#       Late loading of 'Carp' as per Michael Schwern
+# Version 1.09:  Tue Apr 20 12:06:51 BST 2004
+#       Merged in changes from and to Core
+#       Core (Fri Aug 30 14:15:55 CEST 2002):
+#       Cope with comments lines from 'infocmp' from Brendan O'Dea
+#       Allow for EBCDIC in Tgoto magic test.
 
 # TODO:
 # support Berkeley DB termcaps
@@ -61,7 +91,17 @@ output the string to $FH if specified.
 
 =cut
 
+# Preload the default VMS termcap.
+# If a different termcap is required then the text of one can be supplied
+# in $Term::Cap::VMS_TERMCAP before Tgetent is called.
+
+if ( $^O eq 'VMS') {
+       chomp (my @entry = <DATA>);
+       $VMS_TERMCAP = join '', @entry;
+}
+
 # Returns a list of termcap files to check.
+
 sub termcap_path { ## private
     my @termcap_path;
     # $TERMCAP, if it's a filespec
@@ -82,6 +122,7 @@ sub termcap_path { ## private
            '/usr/share/misc/termcap',
        );
     }
+
     # return the list of those termcaps that exist
     return grep(-f, @termcap_path);
 }
@@ -153,7 +194,9 @@ sub Tgetent { ## public -- static method
 
     # Compute PADDING factor from OSPEED (to be used by Tpad)
     if (! $self->{OSPEED}) {
-       carp "OSPEED was not set, defaulting to 9600";
+        if ( $^W ) {
+          carp "OSPEED was not set, defaulting to 9600";
+        }
        $self->{OSPEED} = 9600;
     }
     if ($self->{OSPEED} < 16) {
@@ -187,17 +230,21 @@ sub Tgetent { ## public -- static method
        # last resort--fake up a termcap from terminfo 
        local $ENV{TERM} = $term;
 
-         if ( $^O eq 'VMS' ) {
-            chomp(my @entry = <DATA>);
-            $entry = join '', @entry;
-         }
-         else {
-            eval
-            {
-                $entry = `infocmp -C 2>/dev/null`;
-            }
-        }
-
+        if ( $^O eq 'VMS' ) {
+          $entry = $VMS_TERMCAP;
+        }
+        else {
+           if ( grep { -x "$_/infocmp" } split /:/, $ENV{PATH} ) {
+              eval
+              {
+                my $tmp = `infocmp -C 2>/dev/null`;
+                $tmp =~ s/^#.*\n//gm; # remove comments
+                if (( $tmp !~ m%^/%s ) && ( $tmp =~ /(^|\|)${termpat}[:|]/s)) {
+                   $entry = $tmp;
+                }
+              };
+           }
+        }
     }
 
     croak "Can't find a valid termcap file" unless @termcap_path || $entry;
@@ -276,19 +323,19 @@ sub Tgetent { ## public -- static method
     # Precompile $entry into the object
     $entry =~ s/^[^:]*://;
     foreach $field (split(/:[\s:\\]*/,$entry)) {
-       if ($field =~ /^(\w\w)$/) {
+       if (defined $field && $field =~ /^(\w\w)$/) {
            $self->{'_' . $field} = 1 unless defined $self->{'_' . $1};
            # print STDERR "DEBUG: flag $1\n";
        }
-       elsif ($field =~ /^(\w\w)\@/) {
+       elsif (defined $field && $field =~ /^(\w\w)\@/) {
            $self->{'_' . $1} = "";
            # print STDERR "DEBUG: unset $1\n";
        }
-       elsif ($field =~ /^(\w\w)#(.*)/) {
+       elsif (defined $field && $field =~ /^(\w\w)#(.*)/) {
            $self->{'_' . $1} = $2 unless defined $self->{'_' . $1};
            # print STDERR "DEBUG: numeric $1 = $2\n";
        }
-       elsif ($field =~ /^(\w\w)=(.*)/) {
+       elsif (defined $field && $field =~ /^(\w\w)=(.*)/) {
            # print STDERR "DEBUG: string $1 = $2\n";
            next if defined $self->{'_' . ($cap = $1)};
            $_ = $2;
@@ -349,7 +396,7 @@ sub Tpad { ## public
     my($string, $cnt, $FH) = @_;
     my($decr, $ms);
 
-    if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
+    if (defined $string && $string =~ /(^[\d.]+)(\*?)(.*)$/) {
        $ms = $1;
        $ms *= $cnt if $2;
        $string = $3;
@@ -602,7 +649,7 @@ termcap(5)
 # Below is a default entry for systems where there are terminals but no
 # termcap
 1;
-__END__
+__DATA__
 vt220|vt200|DEC VT220 in vt100 emulation mode:
 am:mi:xn:xo:
 co#80:li#24: