Upgrade to Term::Cap 1.10

p4raw-id: //depot/perl@32143

2 files changed, 348 insertions, 229 deletions

diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm
index b71c51ceba..d86e7581b2 100644
--- a/lib/Term/Cap.pm
+++ b/lib/Term/Cap.pm
@@ -2,12 +2,14 @@ package Term::Cap;
 
 # 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 {
+sub carp
+{
     require Carp;
     goto &Carp::carp;
 }
 
-sub croak {
+sub croak
+{
     require Carp;
     goto &Carp::croak;
 }
@@ -17,7 +19,7 @@ use strict;
 use vars qw($VERSION $VMS_TERMCAP);
 use vars qw($termpat $state $first $entry);
 
-$VERSION = '1.09';
+$VERSION = '1.10';
 
 # 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
@@ -47,10 +49,13 @@ $VERSION = '1.09';
 #       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.
+# Version 1.10: Thu Oct 18 16:52:20 BST 2007
+#       Don't use try to use $ENV{HOME} if it doesn't exist
+#       Give Win32 'dumb' if TERM isn't set
+#       Provide fallback 'dumb' termcap entry as last resort
 
 # TODO:
 # support Berkeley DB termcaps
-# should probably be a .xs module
 # force $FH into callers package?
 # keep $FH in object at Tgetent time?
 
@@ -95,36 +100,45 @@ output the string to $FH if specified.
 # 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;
+if ( $^O eq 'VMS' )
+{
+    chomp( my @entry = <DATA> );
+    $VMS_TERMCAP = join '', @entry;
 }
 
 # Returns a list of termcap files to check.
 
-sub termcap_path { ## private
+sub termcap_path
+{    ## private
     my @termcap_path;
+
     # $TERMCAP, if it's a filespec
-    push(@termcap_path, $ENV{TERMCAP})
-	if ((exists $ENV{TERMCAP}) &&
-	    (($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos')
-	     ? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/is
-	     : $ENV{TERMCAP} =~ /^\//s));
-    if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) {
-	# Add the users $TERMPATH
-	push(@termcap_path, split(/(:|\s+)/, $ENV{TERMPATH}))
+    push( @termcap_path, $ENV{TERMCAP} )
+      if (
+        ( exists $ENV{TERMCAP} )
+        && (
+            ( $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos' )
+            ? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/is
+            : $ENV{TERMCAP} =~ /^\//s
+        )
+      );
+    if ( ( exists $ENV{TERMPATH} ) && ( $ENV{TERMPATH} ) )
+    {
+
+        # Add the users $TERMPATH
+        push( @termcap_path, split( /(:|\s+)/, $ENV{TERMPATH} ) );
     }
-    else {
-	# Defaults
-	push(@termcap_path,
-	    $ENV{'HOME'} . '/.termcap',
-	    '/etc/termcap',
-	    '/usr/share/misc/termcap',
-	);
+    else
+    {
+
+        # Defaults
+        push( @termcap_path,
+            exists $ENV{'HOME'} ? $ENV{'HOME'} . '/.termcap' : undef,
+            '/etc/termcap', '/usr/share/misc/termcap', );
     }
 
     # return the list of those termcaps that exist
-    return grep(-f, @termcap_path);
+    return grep { defined $_ && -f $_ } @termcap_path;
 }
 
 =item B<Tgetent>
@@ -181,94 +195,143 @@ It calls C<croak> on failure.
 
 =cut
 
-sub Tgetent { ## public -- static method
+sub Tgetent
+{    ## public -- static method
     my $class = shift;
     my ($self) = @_;
 
     $self = {} unless defined $self;
     bless $self, $class;
 
-    my($term,$cap,$search,$field,$max,$tmp_term,$TERMCAP);
-    local($termpat,$state,$first,$entry);	# used inside eval
+    my ( $term, $cap, $search, $field, $max, $tmp_term, $TERMCAP );
+    local ( $termpat, $state, $first, $entry );    # used inside eval
     local $_;
 
     # Compute PADDING factor from OSPEED (to be used by Tpad)
-    if (! $self->{OSPEED}) {
-        if ( $^W ) {
-	   carp "OSPEED was not set, defaulting to 9600";
+    if ( !$self->{OSPEED} )
+    {
+        if ($^W)
+        {
+            carp "OSPEED was not set, defaulting to 9600";
         }
-	$self->{OSPEED} = 9600;
+        $self->{OSPEED} = 9600;
     }
-    if ($self->{OSPEED} < 16) {
-	# delays for old style speeds
-	my @pad = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2);
-	$self->{PADDING} = $pad[$self->{OSPEED}];
+    if ( $self->{OSPEED} < 16 )
+    {
+
+        # delays for old style speeds
+        my @pad = (
+            0,    200, 133.3, 90.9, 74.3, 66.7, 50, 33.3,
+            16.7, 8.3, 5.5,   4.1,  2,    1,    .5, .2
+        );
+        $self->{PADDING} = $pad[ $self->{OSPEED} ];
     }
-    else {
-	$self->{PADDING} = 10000 / $self->{OSPEED};
+    else
+    {
+        $self->{PADDING} = 10000 / $self->{OSPEED};
     }
 
-    $self->{TERM} = ($self->{TERM} || $ENV{TERM} || croak "TERM not set");
-    $term = $self->{TERM};	# $term is the term type we are looking for
+    unless ( $self->{TERM} )
+    {
+       if ( $ENV{TERM} )
+       {
+         $self->{TERM} =  $ENV{TERM} ;
+       }
+       else
+       {
+          if ( $^O eq 'Win32' )
+          {
+             $self->{TERM} =  'dumb';
+          }
+          else
+          {
+             croak "TERM not set";
+          }
+       }
+    }
+
+    $term = $self->{TERM};    # $term is the term type we are looking for
 
     # $tmp_term is always the next term (possibly :tc=...:) we are looking for
     $tmp_term = $self->{TERM};
-    # protect any pattern metacharacters in $tmp_term 
-    $termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
 
-    my $foo = (exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '');
+    # protect any pattern metacharacters in $tmp_term
+    $termpat = $tmp_term;
+    $termpat =~ s/(\W)/\\$1/g;
+
+    my $foo = ( exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '' );
 
     # $entry is the extracted termcap entry
-    if (($foo !~ m:^/:s) && ($foo =~ m/(^|\|)${termpat}[:|]/s)) {
-	$entry = $foo;
+    if ( ( $foo !~ m:^/:s ) && ( $foo =~ m/(^|\|)${termpat}[:|]/s ) )
+    {
+        $entry = $foo;
     }
 
     my @termcap_path = termcap_path();
 
-    unless (@termcap_path || $entry)
+    unless ( @termcap_path || $entry )
     {
-	# last resort--fake up a termcap from terminfo 
-	local $ENV{TERM} = $term;
 
-        if ( $^O eq 'VMS' ) {
-          $entry = $VMS_TERMCAP;
+        # last resort--fake up a termcap from terminfo
+        local $ENV{TERM} = $term;
+
+        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;
-                }
-              };
-           }
+        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;
+                    }
+                };
+            }
+            else
+            {
+               # this is getting desperate now
+               if ( $self->{TERM} eq 'dumb' )
+               {
+                  $entry = 'dumb|80-column dumb tty::am::co#80::bl=^G:cr=^M:do=^J:sf=^J:';
+               }
+            }
         }
     }
 
     croak "Can't find a valid termcap file" unless @termcap_path || $entry;
 
-    $state = 1;					# 0 == finished
-						# 1 == next file
-						# 2 == search again
+    $state = 1;    # 0 == finished
+                   # 1 == next file
+                   # 2 == search again
 
-    $first = 0;					# first entry (keeps term name)
+    $first = 0;    # first entry (keeps term name)
 
-    $max = 32;					# max :tc=...:'s
+    $max = 32;     # max :tc=...:'s
 
-    if ($entry) {
-	# ok, we're starting with $TERMCAP
-	$first++;				# we're the first entry
-	# do we need to continue?
-	if ($entry =~ s/:tc=([^:]+):/:/) {
-	    $tmp_term = $1;
-	    # protect any pattern metacharacters in $tmp_term 
-	    $termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
-	}
-	else {
-	    $state = 0;				# we're already finished
-	}
+    if ($entry)
+    {
+
+        # ok, we're starting with $TERMCAP
+        $first++;    # we're the first entry
+                     # do we need to continue?
+        if ( $entry =~ s/:tc=([^:]+):/:/ )
+        {
+            $tmp_term = $1;
+
+            # protect any pattern metacharacters in $tmp_term
+            $termpat = $tmp_term;
+            $termpat =~ s/(\W)/\\$1/g;
+        }
+        else
+        {
+            $state = 0;    # we're already finished
+        }
     }
 
     # This is eval'ed inside the while loop for each file
@@ -290,70 +353,87 @@ sub Tgetent { ## public -- static method
 	$entry .= $_ if $_;
     };
 
-    while ($state != 0) {
-	if ($state == 1) {
-	    # get the next TERMCAP
-	    $TERMCAP = shift @termcap_path
-		|| croak "failed termcap lookup on $tmp_term";
-	}
-	else {
-	    # do the same file again
-	    # prevent endless recursion
-	    $max-- || croak "failed termcap loop at $tmp_term";
-	    $state = 1;		# ok, maybe do a new file next time
-	}
+    while ( $state != 0 )
+    {
+        if ( $state == 1 )
+        {
+
+            # get the next TERMCAP
+            $TERMCAP = shift @termcap_path
+              || croak "failed termcap lookup on $tmp_term";
+        }
+        else
+        {
+
+            # do the same file again
+            # prevent endless recursion
+            $max-- || croak "failed termcap loop at $tmp_term";
+            $state = 1;    # ok, maybe do a new file next time
+        }
+
+        open( TERMCAP, "< $TERMCAP\0" ) || croak "open $TERMCAP: $!";
+        eval $search;
+        die $@ if $@;
+        close TERMCAP;
 
-	open(TERMCAP,"< $TERMCAP\0") || croak "open $TERMCAP: $!";
-	eval $search;
-	die $@ if $@;
-	close TERMCAP;
+        # If :tc=...: found then search this file again
+        $entry =~ s/:tc=([^:]+):/:/ && ( $tmp_term = $1, $state = 2 );
 
-	# If :tc=...: found then search this file again
-	$entry =~ s/:tc=([^:]+):/:/ && ($tmp_term = $1, $state = 2);
-	# protect any pattern metacharacters in $tmp_term 
-	$termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
+        # protect any pattern metacharacters in $tmp_term
+        $termpat = $tmp_term;
+        $termpat =~ s/(\W)/\\$1/g;
     }
 
     croak "Can't find $term" if $entry eq '';
-    $entry =~ s/:+\s*:+/:/g;				# cleanup $entry
-    $entry =~ s/:+/:/g;					# cleanup $entry
-    $self->{TERMCAP} = $entry;				# save it
-    # print STDERR "DEBUG: $entry = ", $entry, "\n";
+    $entry =~ s/:+\s*:+/:/g;    # cleanup $entry
+    $entry =~ s/:+/:/g;         # cleanup $entry
+    $self->{TERMCAP} = $entry;  # save it
+                                # print STDERR "DEBUG: $entry = ", $entry, "\n";
 
     # Precompile $entry into the object
     $entry =~ s/^[^:]*://;
-    foreach $field (split(/:[\s:\\]*/,$entry)) {
-	if (defined $field && $field =~ /^(\w\w)$/) {
-	    $self->{'_' . $field} = 1 unless defined $self->{'_' . $1};
-	    # print STDERR "DEBUG: flag $1\n";
-	}
-	elsif (defined $field && $field =~ /^(\w\w)\@/) {
-	    $self->{'_' . $1} = "";
-	    # print STDERR "DEBUG: unset $1\n";
-	}
-	elsif (defined $field && $field =~ /^(\w\w)#(.*)/) {
-	    $self->{'_' . $1} = $2 unless defined $self->{'_' . $1};
-	    # print STDERR "DEBUG: numeric $1 = $2\n";
-	}
-	elsif (defined $field && $field =~ /^(\w\w)=(.*)/) {
-	    # print STDERR "DEBUG: string $1 = $2\n";
-	    next if defined $self->{'_' . ($cap = $1)};
-	    $_ = $2;
-	    s/\\E/\033/g;
-	    s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
-	    s/\\n/\n/g;
-	    s/\\r/\r/g;
-	    s/\\t/\t/g;
-	    s/\\b/\b/g;
-	    s/\\f/\f/g;
-	    s/\\\^/\377/g;
-	    s/\^\?/\177/g;
-	    s/\^(.)/pack('c',ord($1) & 31)/eg;
-	    s/\\(.)/$1/g;
-	    s/\377/^/g;
-	    $self->{'_' . $cap} = $_;
-	}
-	# else { carp "junk in $term ignored: $field"; }
+    foreach $field ( split( /:[\s:\\]*/, $entry ) )
+    {
+        if ( defined $field && $field =~ /^(\w\w)$/ )
+        {
+            $self->{ '_' . $field } = 1 unless defined $self->{ '_' . $1 };
+
+            # print STDERR "DEBUG: flag $1\n";
+        }
+        elsif ( defined $field && $field =~ /^(\w\w)\@/ )
+        {
+            $self->{ '_' . $1 } = "";
+
+            # print STDERR "DEBUG: unset $1\n";
+        }
+        elsif ( defined $field && $field =~ /^(\w\w)#(.*)/ )
+        {
+            $self->{ '_' . $1 } = $2 unless defined $self->{ '_' . $1 };
+
+            # print STDERR "DEBUG: numeric $1 = $2\n";
+        }
+        elsif ( defined $field && $field =~ /^(\w\w)=(.*)/ )
+        {
+
+            # print STDERR "DEBUG: string $1 = $2\n";
+            next if defined $self->{ '_' . ( $cap = $1 ) };
+            $_ = $2;
+            s/\\E/\033/g;
+            s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
+            s/\\n/\n/g;
+            s/\\r/\r/g;
+            s/\\t/\t/g;
+            s/\\b/\b/g;
+            s/\\f/\f/g;
+            s/\\\^/\377/g;
+            s/\^\?/\177/g;
+            s/\^(.)/pack('c',ord($1) & 31)/eg;
+            s/\\(.)/$1/g;
+            s/\377/^/g;
+            $self->{ '_' . $cap } = $_;
+        }
+
+        # else { carp "junk in $term ignored: $field"; }
     }
     $self->{'_pc'} = "\0" unless defined $self->{'_pc'};
     $self->{'_bc'} = "\b" unless defined $self->{'_bc'};
@@ -391,20 +471,23 @@ The padded $string is returned.
 
 =cut
 
-sub Tpad { ## public
+sub Tpad
+{    ## public
     my $self = shift;
-    my($string, $cnt, $FH) = @_;
-    my($decr, $ms);
-
-    if (defined $string && $string =~ /(^[\d.]+)(\*?)(.*)$/) {
-	$ms = $1;
-	$ms *= $cnt if $2;
-	$string = $3;
-	$decr = $self->{PADDING};
-	if ($decr > .1) {
-	    $ms += $decr / 2;
-	    $string .= $self->{'_pc'} x ($ms / $decr);
-	}
+    my ( $string, $cnt, $FH ) = @_;
+    my ( $decr, $ms );
+
+    if ( defined $string && $string =~ /(^[\d.]+)(\*?)(.*)$/ )
+    {
+        $ms = $1;
+        $ms *= $cnt if $2;
+        $string = $3;
+        $decr   = $self->{PADDING};
+        if ( $decr > .1 )
+        {
+            $ms += $decr / 2;
+            $string .= $self->{'_pc'} x ( $ms / $decr );
+        }
     }
     print $FH $string if $FH;
     $string;
@@ -440,22 +523,30 @@ The appropriate string for the capability will be returned.
 
 =cut
 
-sub Tputs { ## public
+sub Tputs
+{    ## public
     my $self = shift;
-    my($cap, $cnt, $FH) = @_;
+    my ( $cap, $cnt, $FH ) = @_;
     my $string;
 
     $cnt = 0 unless $cnt;
 
-    if ($cnt > 1) {
-	$string = Tpad($self, $self->{'_' . $cap}, $cnt);
-    } else {
-	# cache result because Tpad can be slow
-	unless (exists $self->{$cap}) {
-	    $self->{$cap} = exists $self->{"_$cap"} ?
-		Tpad($self, $self->{"_$cap"}, 1) : undef;
-	}
-	$string = $self->{$cap};
+    if ( $cnt > 1 )
+    {
+        $string = Tpad( $self, $self->{ '_' . $cap }, $cnt );
+    }
+    else
+    {
+
+        # cache result because Tpad can be slow
+        unless ( exists $self->{$cap} )
+        {
+            $self->{$cap} =
+              exists $self->{"_$cap"}
+              ? Tpad( $self, $self->{"_$cap"}, 1 )
+              : undef;
+        }
+        $string = $self->{$cap};
     }
     print $FH $string if $FH;
     $string;
@@ -514,69 +605,84 @@ The output string will be returned.
 
 =cut
 
-sub Tgoto { ## public
+sub Tgoto
+{    ## public
     my $self = shift;
-    my($cap, $code, $tmp, $FH) = @_;
-    my $string = $self->{'_' . $cap};
+    my ( $cap, $code, $tmp, $FH ) = @_;
+    my $string = $self->{ '_' . $cap };
     my $result = '';
-    my $after = '';
+    my $after  = '';
     my $online = 0;
-    my @tmp = ($tmp,$code);
-    my $cnt = $code;
-
-    while ($string =~ /^([^%]*)%(.)(.*)/) {
-	$result .= $1;
-	$code = $2;
-	$string = $3;
-	if ($code eq 'd') {
-	    $result .= sprintf("%d",shift(@tmp));
-	}
-	elsif ($code eq '.') {
-	    $tmp = shift(@tmp);
-	    if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
-		if ($online) {
-		    ++$tmp, $after .= $self->{'_up'} if $self->{'_up'};
-		}
-		else {
-		    ++$tmp, $after .= $self->{'_bc'};
-		}
-	    }
-	    $result .= sprintf("%c",$tmp);
-	    $online = !$online;
-	}
-	elsif ($code eq '+') {
-	    $result .= sprintf("%c",shift(@tmp)+ord($string));
-	    $string = substr($string,1,99);
-	    $online = !$online;
-	}
-	elsif ($code eq 'r') {
-	    ($code,$tmp) = @tmp;
-	    @tmp = ($tmp,$code);
-	    $online = !$online;
-	}
-	elsif ($code eq '>') {
-	    ($code,$tmp,$string) = unpack("CCa99",$string);
-	    if ($tmp[$[] > $code) {
-		$tmp[$[] += $tmp;
-	    }
-	}
-	elsif ($code eq '2') {
-	    $result .= sprintf("%02d",shift(@tmp));
-	    $online = !$online;
-	}
-	elsif ($code eq '3') {
-	    $result .= sprintf("%03d",shift(@tmp));
-	    $online = !$online;
-	}
-	elsif ($code eq 'i') {
-	    ($code,$tmp) = @tmp;
-	    @tmp = ($code+1,$tmp+1);
-	}
-	else {
-	    return "OOPS";
-	}
+    my @tmp    = ( $tmp, $code );
+    my $cnt    = $code;
+
+    while ( $string =~ /^([^%]*)%(.)(.*)/ )
+    {
+        $result .= $1;
+        $code   = $2;
+        $string = $3;
+        if ( $code eq 'd' )
+        {
+            $result .= sprintf( "%d", shift(@tmp) );
+        }
+        elsif ( $code eq '.' )
+        {
+            $tmp = shift(@tmp);
+            if ( $tmp == 0 || $tmp == 4 || $tmp == 10 )
+            {
+                if ($online)
+                {
+                    ++$tmp, $after .= $self->{'_up'} if $self->{'_up'};
+                }
+                else
+                {
+                    ++$tmp, $after .= $self->{'_bc'};
+                }
+            }
+            $result .= sprintf( "%c", $tmp );
+            $online = !$online;
+        }
+        elsif ( $code eq '+' )
+        {
+            $result .= sprintf( "%c", shift(@tmp) + ord($string) );
+            $string = substr( $string, 1, 99 );
+            $online = !$online;
+        }
+        elsif ( $code eq 'r' )
+        {
+            ( $code, $tmp ) = @tmp;
+            @tmp = ( $tmp, $code );
+            $online = !$online;
+        }
+        elsif ( $code eq '>' )
+        {
+            ( $code, $tmp, $string ) = unpack( "CCa99", $string );
+            if ( $tmp[$[] > $code )
+            {
+                $tmp[$[] += $tmp;
+            }
+        }
+        elsif ( $code eq '2' )
+        {
+            $result .= sprintf( "%02d", shift(@tmp) );
+            $online = !$online;
+        }
+        elsif ( $code eq '3' )
+        {
+            $result .= sprintf( "%03d", shift(@tmp) );
+            $online = !$online;
+        }
+        elsif ( $code eq 'i' )
+        {
+            ( $code, $tmp ) = @tmp;
+            @tmp = ( $code + 1, $tmp + 1 );
+        }
+        else
+        {
+            return "OOPS";
+        }
     }
-    $string = Tpad($self, $result . $string . $after, $cnt);
+    $string = Tpad( $self, $result . $string . $after, $cnt );
     print $FH $string if $FH;
     $string;
 }
@@ -590,12 +696,14 @@ found.
 
 =cut
 
-sub Trequire { ## public
+sub Trequire
+{    ## public
     my $self = shift;
-    my($cap,@undefined);
-    foreach $cap (@_) {
-	push(@undefined, $cap)
-	    unless defined $self->{'_' . $cap} && $self->{'_' . $cap};
+    my ( $cap, @undefined );
+    foreach $cap (@_)
+    {
+        push( @undefined, $cap )
+          unless defined $self->{ '_' . $cap } && $self->{ '_' . $cap };
     }
     croak "Terminal does not support: (@undefined)" if @undefined;
 }
diff --git a/lib/Term/Cap.t b/lib/Term/Cap.t
index 0ea537dcdf..08f042ec57 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 || $^O eq 'VMS') {
+unless( $files || $^O eq 'VMS' ) {
     plan skip_all => 'no termcap available to test';
 }
 else {
-    plan tests => 44;
+    plan tests => 45;
 }
 
 use_ok( 'Term::Cap' );
@@ -158,6 +158,17 @@ SKIP: {
 	is( $t->{_bc}, "\b", 'should set _bc field correctly' );
 }
 
+# Windows hack
+{
+   local *^O;
+   local *ENV;
+   delete $ENV{TERM};
+   $^O = 'Win32';
+
+   my $foo = Term::Cap->Tgetent();
+   is($foo->{TERM} ,'dumb','Windows gets "dumb" by default');
+}
+
 # Tgoto has comments on the expected formats
 $t->{_test} = "a%d";
 is( $t->Tgoto('test', '', 1, *OUT), 'a1', 'Tgoto() should handle %d code' );
@@ -166,12 +177,12 @@ is( $out->read(), 'a1', 'Tgoto() should print to filehandle if passed' );
 $t->{_test} = "a%.";
 like( $t->Tgoto('test', '', 1), qr/^a\x01/, 'Tgoto() should handle %.' );
 if (ord('A') == 193) {  # EBCDIC platform
-like( $t->Tgoto('test', '', 0), qr/\x81\x01\x16/, 
-	'Tgoto() should handle %. and magic' );
-} else { # ASCII platform
-like( $t->Tgoto('test', '', 0), qr/\x61\x01\x08/, 
-	'Tgoto() should handle %. and magic' );
-}
+   like( $t->Tgoto('test', '', 0), qr/\x81\x01\x16/,
+         'Tgoto() should handle %. and magic' );
+   } else { # ASCII platform
+      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() should handle %+' );