From: Jonathan Stowe <gellyfish@gellyfish.com>
Date: Tue, 11 Dec 2001 07:28:45 +0000 (+0000)
Subject: Sync changes in CPAN version
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d2492938eb072e03ead75c841f11237d3b984c72;p=p5sagit%2Fp5-mst-13.2.git

Sync changes in CPAN version
Message-ID: <Pine.LNX.4.33.0112110720470.31242-100000@orpheus.gellyfish.com>

p4raw-id: //depot/perl@13620
---

diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm
index a44601a..0e34d7a 100644
--- a/lib/Term/Cap.pm
+++ b/lib/Term/Cap.pm
@@ -3,10 +3,10 @@ package Term::Cap;
 use Carp;
 use strict;
 
-use vars qw($VERSION);
+use vars qw($VERSION $VMS_TERMCAP);
 use vars qw($termpat $state $first $entry);
 
-$VERSION = '1.05';
+$VERSION = '1.06';
 
 # 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
@@ -23,7 +23,9 @@ $VERSION = '1.05';
 #       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.
 
 # TODO:
 # support Berkeley DB termcaps
@@ -68,7 +70,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
@@ -89,6 +101,7 @@ sub termcap_path { ## private
 	    '/usr/share/misc/termcap',
 	);
     }
+
     # return the list of those termcaps that exist
     return grep(-f, @termcap_path);
 }
@@ -160,7 +173,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) {
@@ -195,8 +210,7 @@ sub Tgetent { ## public -- static method
 	local $ENV{TERM} = $term;
 
         if ( $^O eq 'VMS' ) {
-          chomp(my @entry = <DATA>);
-          $entry = join '', @entry;
+          $entry = $VMS_TERMCAP;
         }
         else {
            eval
diff --git a/lib/Term/Cap.t b/lib/Term/Cap.t
index 587e00e..5014aca 100644
--- a/lib/Term/Cap.t
+++ b/lib/Term/Cap.t
@@ -24,11 +24,11 @@ my $files = join '',
 	( $ENV{HOME} . '/.termcap', # we assume pretty UNIXy system anyway
 	  '/etc/termcap', 
 	  '/usr/share/misc/termcap' );
-unless( $files ) {
+unless( $files || $^O eq 'VMS') {
     plan skip_all => 'no termcap available to test';
 }
 else {
-    plan tests => 43;
+    plan tests => 44;
 }
 
 use_ok( 'Term::Cap' );
@@ -98,11 +98,16 @@ local $SIG{__WARN__} = sub {
 # test the first few features by forcing Tgetent() to croak (line 156)
 undef $ENV{TERM};
 my $vals = {};
-eval { $t = Term::Cap->Tgetent($vals) };
+eval { local $^W = 1; $t = Term::Cap->Tgetent($vals) };
 like( $@, qr/TERM not set/, 'Tgetent() should croaks without TERM' );
 like( $warn, qr/OSPEED was not set/, 'Tgetent() should set default OSPEED' );
+
 is( $vals->{PADDING}, 10000/9600, 'Default OSPEED implies default PADDING' );
 
+$warn = 'xxxx';
+eval { local $^W = 0; $t = Term::Cap->Tgetent($vals) };
+is($warn,'xxxx',"Tgetent() doesn't carp() without warnings on");
+
 # check values for very slow speeds
 $vals->{OSPEED} = 1;
 $warn = '';
@@ -110,12 +115,17 @@ eval { $t = Term::Cap->Tgetent($vals) };
 is( $warn, '', 'Tgetent() should not work if OSPEED is provided' );
 is( $vals->{PADDING}, 200, 'Tgetent() should set slow PADDING when needed' );
 
-# now see if lines 177 or 180 will fail
-$ENV{TERM} = 'foo';
-$ENV{TERMPATH} = '!';
-$ENV{TERMCAP} = '';
-eval { $t = Term::Cap->Tgetent($vals) };
-isn't( $@, '', 'Tgetent() should catch bad termcap file' );
+
+SKIP: {
+        skip('Tgetent() bad termcap test, since using a fixed termcap',1)
+              if $^O eq 'VMS';
+        # now see if lines 177 or 180 will fail
+        $ENV{TERM} = 'foo';
+        $ENV{TERMPATH} = '!';
+        $ENV{TERMCAP} = '';
+        eval { $t = Term::Cap->Tgetent($vals) };
+        isn't( $@, '', 'Tgetent() should catch bad termcap file' );
+}
 
 SKIP: {
 	skip( "Can't write 'tcout' file for tests", 9 ) unless $writable;
@@ -159,7 +169,7 @@ like( $t->Tgoto('test', '', 0), qr/\x61\x01\x08/,
 	'Tgoto() should handle %. and magic' );
 
 $t->{_test} = 'a%+';
-like( $t->Tgoto('test', '', 1), qr/a\x01/, 'Tgoto() shoudl handle %+' );
+like( $t->Tgoto('test', '', 1), qr/a\x01/, 'Tgoto() should handle %+' );
 $t->{_test} = 'a%+a';
 is( $t->Tgoto('test', '', 1), 'ab', 'Tgoto() should handle %+char' );
 $t->{_test} .= 'a' x 99;