r1234 - in packages/libterm-readkey-perl/trunk: . debian
Gunnar Wolf
gwolf at costa.debian.org
Tue Jul 12 17:58:44 UTC 2005
Author: gwolf
Date: 2005-07-12 17:58:43 +0000 (Tue, 12 Jul 2005)
New Revision: 1234
Added:
packages/libterm-readkey-perl/trunk/META.yml
Modified:
packages/libterm-readkey-perl/trunk/Configure.pm
packages/libterm-readkey-perl/trunk/MANIFEST
packages/libterm-readkey-perl/trunk/Makefile.PL
packages/libterm-readkey-perl/trunk/README
packages/libterm-readkey-perl/trunk/ReadKey.pm
packages/libterm-readkey-perl/trunk/ReadKey.xs
packages/libterm-readkey-perl/trunk/debian/changelog
packages/libterm-readkey-perl/trunk/debian/rules
packages/libterm-readkey-perl/trunk/genchars.pl
packages/libterm-readkey-perl/trunk/ppport.h
packages/libterm-readkey-perl/trunk/test.pl
Log:
New upstream version
Modified: packages/libterm-readkey-perl/trunk/Configure.pm
===================================================================
--- packages/libterm-readkey-perl/trunk/Configure.pm 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/Configure.pm 2005-07-12 17:58:43 UTC (rev 1234)
@@ -8,7 +8,7 @@
# merging into the original, please contact me at kjahds at kjahds.com or
# CIS:70705,126
#
-# $Id: Configure.pm,v 1.2 2002/01/28 18:40:18 gellyfish Exp $
+# $Id: Configure.pm,v 2.21 2004/03/02 20:28:11 jonathan Exp $
#
# Todo: clean up redudant code in CPP, Compile, Link, and Execute
Modified: packages/libterm-readkey-perl/trunk/MANIFEST
===================================================================
--- packages/libterm-readkey-perl/trunk/MANIFEST 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/MANIFEST 2005-07-12 17:58:43 UTC (rev 1234)
@@ -7,3 +7,4 @@
genchars.pl
ppport.h
test.pl
+META.yml Module meta-data (added by MakeMaker)
Copied: packages/libterm-readkey-perl/trunk/META.yml (from rev 1233, packages/libterm-readkey-perl/branches/upstream/current/META.yml)
Modified: packages/libterm-readkey-perl/trunk/Makefile.PL
===================================================================
--- packages/libterm-readkey-perl/trunk/Makefile.PL 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/Makefile.PL 2005-07-12 17:58:43 UTC (rev 1234)
@@ -1,5 +1,5 @@
# Term::ReadKey Makefile.PL Version 2.18
-# $Id: Makefile.PL,v 1.3 2002/01/28 18:40:18 gellyfish Exp $
+# $Id: Makefile.PL,v 2.21 2004/03/02 20:28:11 jonathan Exp $
use ExtUtils::MakeMaker;
use Carp;
Modified: packages/libterm-readkey-perl/trunk/README
===================================================================
--- packages/libterm-readkey-perl/trunk/README 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/README 2005-07-12 17:58:43 UTC (rev 1234)
@@ -1,7 +1,7 @@
- Term::ReadKey 2.21 - Change terminal modes, and perform non-blocking reads.
+ Term::ReadKey 2.30 - Change terminal modes, and perform non-blocking reads.
Copyright (C) 1994-1999 Kenneth Albanowski.
- 2001,2002 Jonathan Stowe
+ 2001-2005 Jonathan Stowe and others
Unlimited distribution and/or modification is allowed as long as this
copyright notice remains intact.
Modified: packages/libterm-readkey-perl/trunk/ReadKey.pm
===================================================================
--- packages/libterm-readkey-perl/trunk/ReadKey.pm 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/ReadKey.pm 2005-07-12 17:58:43 UTC (rev 1234)
@@ -1,6 +1,6 @@
#
-# $Id: ReadKey.pm,v 1.7 2002/07/28 12:01:18 gellyfish Exp $
-#
+# $Id: ReadKey.pm,v 2.23 2005/01/11 21:16:31 jonathan Exp $
+#
=head1 NAME
@@ -210,9 +210,8 @@
package Term::ReadKey;
+$VERSION = '2.30';
-$VERSION = '2.21';
-
require Exporter;
require AutoLoader;
require DynaLoader;
@@ -223,18 +222,17 @@
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
- at EXPORT = qw(
- ReadKey
- ReadMode
- ReadLine
- GetTerminalSize
- SetTerminalSize
- GetSpeed
- GetControlChars
- SetControlChars
- );
+ at EXPORT = qw(
+ ReadKey
+ ReadMode
+ ReadLine
+ GetTerminalSize
+ SetTerminalSize
+ GetSpeed
+ GetControlChars
+ SetControlChars
+);
-
@EXPORT_OK = qw();
bootstrap Term::ReadKey;
@@ -242,7 +240,6 @@
# Preloaded methods go here. Autoload methods go after __END__, and are
# processed by the autosplit program.
-
# Should we use LINES and COLUMNS to try and get the terminal size?
# Change this to zero if you have systems where these are commonly
# set to erroneous values. (But if either are nero zero, they won't be
@@ -250,109 +247,130 @@
$UseEnv = 1;
+%modes = (
+ original => 0,
+ restore => 0,
+ normal => 1,
+ noecho => 2,
+ cbreak => 3,
+ raw => 4,
+ 'ultra-raw' => 5
+);
-%modes=( original => 0,
- restore => 0,
- normal => 1,
- noecho => 2,
- cbreak => 3,
- raw => 4,
- 'ultra-raw' => 5);
-
-sub ReadMode {
- my($mode) = $modes{$_[0]};
- my($fh) = normalizehandle((@_>1?$_[1]:\*STDIN));
- if(defined($mode))
- { SetReadMode($mode,$fh) }
- elsif( $_[0] =~ /^\d/)
- { SetReadMode($_[0],$fh) }
- else
- { croak("Unknown terminal mode `$_[0]'"); }
+sub ReadMode
+{
+ my ($mode) = $modes{ $_[0] };
+ my ($fh) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
+ if ( defined($mode) ) { SetReadMode( $mode, $fh ) }
+ elsif ( $_[0] =~ /^\d/ ) { SetReadMode( $_[0], $fh ) }
+ else { croak("Unknown terminal mode `$_[0]'"); }
}
-sub normalizehandle {
- my($file) = @_;
-# print "Handle = $file\n";
- if(ref($file)) { return $file; } # Reference is fine
-# if($file =~ /^\*/) { return $file; } # Type glob is good
- if (ref(\$file) eq 'GLOB') { return $file; } # Glob is good
-# print "Caller = ",(caller(1))[0],"\n";
- return \*{((caller(1))[0])."::$file"};
-}
+sub normalizehandle
+{
+ my ($file) = @_;
+ # print "Handle = $file\n";
+ if ( ref($file) ) { return $file; } # Reference is fine
-sub GetTerminalSize {
- my($file) = normalizehandle((@_>1?$_[1]:\*STDOUT));
- my(@results) = ();
- my(@fail);
-
- if(&termsizeoptions() & 1) # VIO
- {
- @results = GetTermSizeVIO($file);
- push(@fail,"VIOGetMode call");
- } elsif(&termsizeoptions() & 2) # GWINSZ
- {
- @results = GetTermSizeGWINSZ($file);
- push(@fail,"TIOCGWINSZ ioctl");
- } elsif(&termsizeoptions() & 4) # GSIZE
- {
- @results = GetTermSizeGSIZE($file);
- push(@fail,"TIOCGSIZE ioctl");
- } elsif(&termsizeoptions() & 8) # WIN32
- {
- @results = GetTermSizeWin32($file);
- push(@fail,"Win32 GetConsoleScreenBufferInfo call");
- } else
- {
- @results = ();
- }
-
- if(@results<4 and $UseEnv) {
- my($C) = defined($ENV{COLUMNS}) ? $ENV{COLUMNS} : 0;
- my($L) = defined($ENV{LINES}) ? $ENV{LINES} : 0;
- if(($C >= 2) and ($L >=2)) {
- @results = ($C+0,$L+0,0,0);
- }
- push(@fail,"COLUMNS and LINES environment variables");
- }
-
- if(@results<4) {
- my($prog) = "resize";
-
- # Workaround for Solaris path sillyness
- if(-f "/usr/openwin/bin/resize") { $prog = "/usr/openwin/bin/resize"}
-
- my($resize) = scalar(`$prog 2>/dev/null`);
- if(defined $resize and ($resize =~ /COLUMNS\s*=\s*(\d+)/ or
- $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/)) {
- $results[0] = $1;
- if( $resize =~ /LINES\s*=\s*(\d+)/ or
- $resize =~ /setenv\s+LINES\s+'?(\d+)/) {
- $results[1] = $1;
- @results[2,3] = (0,0);
- } else {
- @results = ();
- }
- } else {
- @results = ();
- }
- push(@fail,"resize program");
- }
-
- if(@results<4) {
- die "Unable to get Terminal Size.".join("", map(" The $_ didn't work.", at fail));
- }
-
- @results;
+ # if($file =~ /^\*/) { return $file; } # Type glob is good
+ if ( ref( \$file ) eq 'GLOB' ) { return $file; } # Glob is good
+
+ # print "Caller = ",(caller(1))[0],"\n";
+ return \*{ ( ( caller(1) )[0] ) . "::$file" };
}
+sub GetTerminalSize
+{
+ my ($file) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDOUT ) );
+ my (@results) = ();
+ my (@fail);
+ if ( &termsizeoptions() & 1 ) # VIO
+ {
+ @results = GetTermSizeVIO($file);
+ push( @fail, "VIOGetMode call" );
+ }
+ elsif ( &termsizeoptions() & 2 ) # GWINSZ
+ {
+ @results = GetTermSizeGWINSZ($file);
+ push( @fail, "TIOCGWINSZ ioctl" );
+ }
+ elsif ( &termsizeoptions() & 4 ) # GSIZE
+ {
+ @results = GetTermSizeGSIZE($file);
+ push( @fail, "TIOCGSIZE ioctl" );
+ }
+ elsif ( &termsizeoptions() & 8 ) # WIN32
+ {
+ @results = GetTermSizeWin32($file);
+ push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
+ }
+ else
+ {
+ @results = ();
+ }
-if(&blockoptions() & 1) # Use nodelay
+ if ( @results < 4 and $UseEnv )
+ {
+ my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
+ my ($L) = defined( $ENV{LINES} ) ? $ENV{LINES} : 0;
+ if ( ( $C >= 2 ) and ( $L >= 2 ) )
+ {
+ @results = ( $C + 0, $L + 0, 0, 0 );
+ }
+ push( @fail, "COLUMNS and LINES environment variables" );
+ }
+
+ if ( @results < 4 )
+ {
+ my ($prog) = "resize";
+
+ # Workaround for Solaris path sillyness
+ if ( -f "/usr/openwin/bin/resize" ) {
+ $prog = "/usr/openwin/bin/resize";
+ }
+
+ my ($resize) = scalar(`$prog 2>/dev/null`);
+ if (
+ defined $resize
+ and ( $resize =~ /COLUMNS\s*=\s*(\d+)/
+ or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
+ )
+ {
+ $results[0] = $1;
+ if ( $resize =~ /LINES\s*=\s*(\d+)/
+ or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
+ {
+ $results[1] = $1;
+ @results[ 2, 3 ] = ( 0, 0 );
+ }
+ else
+ {
+ @results = ();
+ }
+ }
+ else
+ {
+ @results = ();
+ }
+ push( @fail, "resize program" );
+ }
+
+ if ( @results < 4 )
+ {
+ die "Unable to get Terminal Size."
+ . join( "", map( " The $_ didn't work.", @fail ) );
+ }
+
+ @results;
+}
+
+if ( &blockoptions() & 1 ) # Use nodelay
{
- if(&blockoptions() & 2) #poll
- {
- eval <<'DONE';
+ if ( &blockoptions() & 2 ) #poll
+ {
+ eval <<'DONE';
sub ReadKey {
my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
if (defined $_[0] && $_[0] > 0) {
@@ -387,10 +405,10 @@
$value;
}
DONE
- }
- elsif(&blockoptions() & 4) #select
- {
- eval <<'DONE';
+ }
+ elsif ( &blockoptions() & 4 ) #select
+ {
+ eval <<'DONE';
sub ReadKey {
my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
if(defined $_[0] && $_[0]>0) {
@@ -412,8 +430,10 @@
$value;
}
DONE
- } else { #nothing
- eval <<'DONE';
+ }
+ else
+ { #nothing
+ eval <<'DONE';
sub ReadKey {
my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
if(defined $_[0] && $_[0]>0) {
@@ -457,11 +477,11 @@
$value;
}
DONE
- }
+ }
}
-elsif(&blockoptions() & 2) # Use poll
+elsif ( &blockoptions() & 2 ) # Use poll
{
- eval <<'DONE';
+ eval <<'DONE';
sub ReadKey {
my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
if(defined $_[0] && $_[0] != 0) {
@@ -478,9 +498,9 @@
}
DONE
}
-elsif(&blockoptions() & 4) # Use select
+elsif ( &blockoptions() & 4 ) # Use select
{
- eval <<'DONE';
+ eval <<'DONE';
sub ReadKey {
my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
if(defined $_[0] && $_[0] !=0 ) {
@@ -497,9 +517,9 @@
}
DONE
}
-elsif(&blockoptions() & 8) # Use Win32
+elsif ( &blockoptions() & 8 ) # Use Win32
{
- eval <<'DONE';
+ eval <<'DONE';
sub ReadKey {
my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
if ($_[0]) {
@@ -522,7 +542,7 @@
}
else
{
- eval <<'DONE';
+ eval <<'DONE';
sub ReadKey {
my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
if($_[0])
@@ -538,7 +558,7 @@
DONE
}
-package Term::ReadKey; # return to package ReadKey so AutoSplit is happy
+package Term::ReadKey; # return to package ReadKey so AutoSplit is happy
1;
__END__;
Modified: packages/libterm-readkey-perl/trunk/ReadKey.xs
===================================================================
--- packages/libterm-readkey-perl/trunk/ReadKey.xs 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/ReadKey.xs 2005-07-12 17:58:43 UTC (rev 1234)
@@ -18,7 +18,7 @@
Maintained by Jonathan Stowe <jns at gellyfish.com>
- $Id: ReadKey.xs,v 1.8 2002/07/28 12:01:18 gellyfish Exp $
+ $Id: ReadKey.xs,v 2.22 2005/01/11 21:15:17 jonathan Exp $
Version 2.21, Sun Jul 28 12:57:56 BST 2002
Fix to improve the chances of automated testing succeeding
@@ -200,11 +200,14 @@
# define DONT_USE_SELECT
# define DONT_USE_POLL
-# define DONT_USE_TERMIO
+# define DONT_USE_TERMIOS
# define DONT_USE_SGTTY
-# define I_TERMIOS
-# define CC_TERMIOS
+# define I_TERMIO
+# define CC_TERMIO
+/* This flag should be off in the lflags when we enable termio mode */
+# define TRK_IDEFAULT IDEFAULT
+
# define INCL_SUB
# define INCL_DOS
@@ -348,6 +351,10 @@
# endif
#endif
+#ifndef TRK_IDEFAULT
+/* This flag should be off in the lflags when we enable termio mode */
+# define TRK_IDEFAULT 0
+#endif
/* Fix up the disappearance of the '_' macro in Perl 5.7.2 */
@@ -1117,7 +1124,7 @@
memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
work.c_lflag &= ~(ECHO | ISIG | ICANON | XCASE);
- work.c_lflag &= ~(ECHOE | ECHOK | ECHONL);
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL | TRK_IDEFAULT);
work.c_iflag &= ~(IXON | IXOFF | IXANY | ICRNL | BRKINT);
if((work.c_cflag | PARENB)!=PARENB ) {
work.c_iflag &= ~(ISTRIP|INPCK);
@@ -1135,7 +1142,7 @@
memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
work.c_lflag &= ~(ECHO | ISIG | ICANON);
- work.c_lflag &= ~(ECHOE | ECHOK | ECHONL);
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL TRK_IDEFAULT);
work.c_iflag = savebuf.c_iflag;
work.c_iflag &= ~(IXON | IXOFF | IXANY | BRKINT);
work.c_oflag = savebuf.c_oflag;
@@ -1149,7 +1156,7 @@
memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
work.c_lflag &= ~(ECHO | ICANON);
- work.c_lflag &= ~(ECHOE | ECHOK | ECHONL);
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL | TRK_IDEFAULT);
work.c_lflag |= ISIG;
work.c_iflag = savebuf.c_iflag;
work.c_iflag &= ~(IXON | IXOFF | IXANY);
@@ -1166,7 +1173,7 @@
work.c_lflag |= (ISIG | ICANON);
work.c_lflag &= ~ECHO;
- work.c_lflag &= ~(ECHOE | ECHOK | ECHONL);
+ work.c_lflag &= ~(ECHOE | ECHOK | ECHONL | TRK_IDEFAULT);
work.c_iflag = savebuf.c_iflag;
work.c_iflag &= ~(IXON | IXOFF | IXANY);
work.c_iflag |= savebuf.c_iflag & (IXON|IXOFF|IXANY);
@@ -1190,6 +1197,7 @@
memcpy((void*)&work,(void*)&savebuf,sizeof(struct tbuffer));
work.c_lflag |= (ECHO | ISIG | ICANON);
+ work.c_iflag &= ~TRK_IDEFAULT;
work.c_iflag = savebuf.c_iflag;
work.c_iflag &= ~(IXON | IXOFF | IXANY);
work.c_iflag |= savebuf.c_iflag & (IXON|IXOFF|IXANY);
Modified: packages/libterm-readkey-perl/trunk/debian/changelog
===================================================================
--- packages/libterm-readkey-perl/trunk/debian/changelog 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/debian/changelog 2005-07-12 17:58:43 UTC (rev 1234)
@@ -1,3 +1,9 @@
+libterm-readkey-perl (2.30-1) unstable; urgency=low
+
+ * New upstream release (Closes: #303584)
+
+ -- Gunnar Wolf <gwolf at debian.org> Tue, 12 Jul 2005 20:29:27 +0300
+
libterm-readkey-perl (2.21-2) unstable; urgency=low
* New maintainer: The pkg-perl group
Modified: packages/libterm-readkey-perl/trunk/debian/rules
===================================================================
--- packages/libterm-readkey-perl/trunk/debian/rules 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/debian/rules 2005-07-12 17:58:43 UTC (rev 1234)
@@ -29,6 +29,7 @@
$(PERL) Makefile.PL INSTALLDIRS=vendor
$(MAKE) OPTIMIZE="$(OPTIMIZE)" LD_RUN_PATH=""
# $(MAKE) all LDLOADLIBS=-lc LD_RUN_PATH="" CFLAG=$(CFLAGS)
+ $(MAKE) test
touch build-stamp
Modified: packages/libterm-readkey-perl/trunk/genchars.pl
===================================================================
--- packages/libterm-readkey-perl/trunk/genchars.pl 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/genchars.pl 2005-07-12 17:58:43 UTC (rev 1234)
@@ -1,7 +1,7 @@
#!/usr/bin/perl
#
-# $Id: genchars.pl,v 1.3 2002/01/28 18:40:18 gellyfish Exp $
+# $Id: genchars.pl,v 2.22 2005/01/11 21:15:17 jonathan Exp $
#
##############################
$version="1.97";
@@ -165,7 +165,7 @@
if(tcgetattr(PerlIO_fileno(file),&s))
#else
# ifdef CC_TERMIO
- if(ioctl(fileno(PerlIO_file),TCGETA,&s))
+ if(ioctl(PerlIO_fileno(file),TCGETA,&s))
# endif
#endif
croak(\"Unable to read terminal settings in GetControlChars\");
@@ -203,7 +203,7 @@
if(tcgetattr(PerlIO_fileno(file),&s))
#else
# ifdef CC_TERMIO
- if(ioctl(fileno(PerlIO_file),TCGETA,&s))
+ if(ioctl(PerlIO_fileno(file),TCGETA,&s))
# endif
#endif
croak(\"Unable to read terminal settings in SetControlChars\");
@@ -230,7 +230,7 @@
if(tcsetattr(PerlIO_fileno(file),TCSANOW,&s))
#else
# ifdef CC_TERMIO
- if(ioctl(fileno(PerlIO_file),TCSETA,&s))
+ if(ioctl(PerlIO_fileno(file),TCSETA,&s))
# endif
#endif
croak(\"Unable to write terminal settings in SetControlChars\");
Modified: packages/libterm-readkey-perl/trunk/ppport.h
===================================================================
--- packages/libterm-readkey-perl/trunk/ppport.h 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/ppport.h 2005-07-12 17:58:43 UTC (rev 1234)
@@ -1,65 +1,84 @@
-/* Perl/Pollution/Portability Version 2.0000 */
-/* Automatically Created by Devel::PPPort on Fri Nov 23 07:08:17 2001 */
+/* ppport.h -- Perl/Pollution/Portability Version 2.003
+ *
+ * Automatically Created by Devel::PPPort on Tue Jan 11 21:00:54 2005
+ *
+ * Do NOT edit this file directly! -- Edit PPPort.pm instead.
+ *
+ * Version 2.x, Copyright (C) 2001, Paul Marquess.
+ * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+ * This code may be used and distributed under the same license as any
+ * version of Perl.
+ *
+ * This version of ppport.h is designed to support operation with Perl
+ * installations back to 5.004, and has been tested up to 5.8.0.
+ *
+ * If this version of ppport.h is failing during the compilation of this
+ * module, please check if a newer version of Devel::PPPort is available
+ * on CPAN before sending a bug report.
+ *
+ * If you are using the latest version of Devel::PPPort and it is failing
+ * during compilation of this module, please send a report to perlbug at perl.com
+ *
+ * Include all following information:
+ *
+ * 1. The complete output from running "perl -V"
+ *
+ * 2. This file.
+ *
+ * 3. The name & version of the module you were trying to build.
+ *
+ * 4. A full log of the build that failed.
+ *
+ * 5. Any other information that you think could be relevant.
+ *
+ *
+ * For the latest version of this code, please retreive the Devel::PPPort
+ * module from CPAN.
+ *
+ */
-/* Do NOT edit this file directly! -- edit PPPort.pm instead. */
-
-
-#ifndef _P_P_PORTABILITY_H_
-#define _P_P_PORTABILITY_H_
-
-/* Copyright (C) 1999, Kenneth Albanowski. This code may be used and
- distributed under the same license as any version of Perl. */
-
-/* For the latest version of this code, please retreive the Devel::PPPort
- module from CPAN, contact the author at <kjahds at kjahds.com>, or check
- with the Perl maintainers. */
-
-/* If you needed to customize this file for your project, please mention
- your changes, and visible alter the version number. */
-
-
/*
- In order for a Perl extension module to be as portable as possible
- across differing versions of Perl itself, certain steps need to be taken.
- Including this header is the first major one, then using dTHR is all the
- appropriate places and using a PL_ prefix to refer to global Perl
- variables is the second.
-*/
+ * In order for a Perl extension module to be as portable as possible
+ * across differing versions of Perl itself, certain steps need to be taken.
+ * Including this header is the first major one, then using dTHR is all the
+ * appropriate places and using a PL_ prefix to refer to global Perl
+ * variables is the second.
+ *
+ */
/* If you use one of a few functions that were not present in earlier
- versions of Perl, please add a define before the inclusion of ppport.h
- for a static include, or use the GLOBAL request in a single module to
- produce a global definition that can be referenced from the other
- modules.
-
- Function: Static define: Extern define:
- newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
-
-*/
+ * versions of Perl, please add a define before the inclusion of ppport.h
+ * for a static include, or use the GLOBAL request in a single module to
+ * produce a global definition that can be referenced from the other
+ * modules.
+ *
+ * Function: Static define: Extern define:
+ * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+ *
+ */
/* To verify whether ppport.h is needed for your module, and whether any
- special defines should be used, ppport.h can be run through Perl to check
- your source code. Simply say:
-
- perl -x ppport.h *.c *.h *.xs foo/*.c [etc]
-
- The result will be a list of patches suggesting changes that should at
- least be acceptable, if not necessarily the most efficient solution, or a
- fix for all possible problems. It won't catch where dTHR is needed, and
- doesn't attempt to account for global macro or function definitions,
- nested includes, typemaps, etc.
-
- In order to test for the need of dTHR, please try your module under a
- recent version of Perl that has threading compiled-in.
-
-*/
+ * special defines should be used, ppport.h can be run through Perl to check
+ * your source code. Simply say:
+ *
+ * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
+ *
+ * The result will be a list of patches suggesting changes that should at
+ * least be acceptable, if not necessarily the most efficient solution, or a
+ * fix for all possible problems. It won't catch where dTHR is needed, and
+ * doesn't attempt to account for global macro or function definitions,
+ * nested includes, typemaps, etc.
+ *
+ * In order to test for the need of dTHR, please try your module under a
+ * recent version of Perl that has threading compiled-in.
+ *
+ */
/*
-
#!/usr/bin/perl
@ARGV = ("*.xs") if !@ARGV;
%badmacros = %funcs = %macros = (); $replace = 0;
@@ -146,10 +165,16 @@
__DATA__
*/
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
#ifndef PERL_REVISION
# ifndef __PATCHLEVEL_H_INCLUDED__
-# include "patchlevel.h"
+# include <patchlevel.h>
# endif
+# if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
+# include <could_not_find_Perl_patchlevel.h>
+# endif
# ifndef PERL_REVISION
# define PERL_REVISION (5)
/* Replace: 1 */
@@ -162,6 +187,13 @@
#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
+/* It is very unlikely that anyone will try to use this with Perl 6
+ (or greater), but who knows.
+ */
+#if PERL_REVISION != 5
+# error ppport.h only works with Perl version 5
+#endif /* PERL_REVISION != 5 */
+
#ifndef ERRSV
# define ERRSV perl_get_sv("@",FALSE)
#endif
@@ -175,6 +207,7 @@
# define PL_curstash curstash
# define PL_defgv defgv
# define PL_dirty dirty
+# define PL_dowarn dowarn
# define PL_hints hints
# define PL_na na
# define PL_perldb perldb
@@ -187,29 +220,85 @@
/* Replace: 0 */
#endif
+#ifdef HASATTRIBUTE
+# if defined(__GNUC__) && defined(__cplusplus)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+#else
+# define PERL_UNUSED_DECL
+#endif
+
+#ifndef dNOOP
+# define NOOP (void)0
+# define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dTHR
+# define dTHR dNOOP
+#endif
+
+#ifndef dTHX
+# define dTHX dNOOP
+# define dTHXa(x) dNOOP
+# define dTHXoa(x) dNOOP
+#endif
+
#ifndef pTHX
-# define pTHX
+# define pTHX void
# define pTHX_
# define aTHX
# define aTHX_
#endif
-#ifndef PTR2IV
-# define PTR2IV(d) (IV)(d)
+/* IV could also be a quad (say, a long long), but Perls
+ * capable of those should have IVSIZE already. */
+#if !defined(IVSIZE) && defined(LONGSIZE)
+# define IVSIZE LONGSIZE
#endif
-
-#ifndef INT2PTR
-# define INT2PTR(any,d) (any)(d)
+#ifndef IVSIZE
+# define IVSIZE 4 /* A bold guess, but the best we can make. */
#endif
-#ifndef dTHR
-# ifdef WIN32
-# define dTHR extern int Perl___notused
+#ifndef UVSIZE
+# define UVSIZE IVSIZE
+#endif
+
+#ifndef NVTYPE
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
+# define NVTYPE long double
+# else
+# define NVTYPE double
+# endif
+typedef NVTYPE NV;
+#endif
+
+#ifndef INT2PTR
+
+#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
+# define PTRV UV
+# define INT2PTR(any,d) (any)(d)
+#else
+# if PTRSIZE == LONGSIZE
+# define PTRV unsigned long
# else
-# define dTHR extern int errno
+# define PTRV unsigned
# endif
+# define INT2PTR(any,d) (any)(PTRV)(d)
#endif
+#define NUM2PTR(any,d) (any)(PTRV)(d)
+#define PTR2IV(p) INT2PTR(IV,p)
+#define PTR2UV(p) INT2PTR(UV,p)
+#define PTR2NV(p) NUM2PTR(NV,p)
+#if PTRSIZE == LONGSIZE
+# define PTR2ul(p) (unsigned long)(p)
+#else
+# define PTR2ul(p) INT2PTR(unsigned long,p)
+#endif
+#endif /* !INT2PTR */
+
#ifndef boolSV
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif
@@ -246,7 +335,7 @@
nsv; \
})
# else
-# if defined(CRIPPLED_CC) || defined(USE_THREADS)
+# if defined(USE_THREADS)
static SV * newRV_noinc (SV * sv)
{
SV *nsv = (SV*)newRV(sv);
@@ -268,7 +357,7 @@
#if defined(NEED_newCONSTSUB)
static
#else
-extern void newCONSTSUB _((HV * stash, char * name, SV *sv));
+extern void newCONSTSUB(HV * stash, char * name, SV *sv);
#endif
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
@@ -317,7 +406,6 @@
#endif /* newCONSTSUB */
-
#ifndef START_MY_CXT
/*
@@ -347,8 +435,7 @@
* case below uses it to declare the data as static. */
#define START_MY_CXT
-#if PERL_REVISION == 5 && \
- (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
+#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
/* Fetches the SV that keeps the per-interpreter data. */
#define dMY_CXT_SV \
SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
@@ -389,20 +476,6 @@
#else /* single interpreter */
-#ifndef NOOP
-# define NOOP (void)0
-#endif
-
-#ifdef HASATTRIBUTE
-# define PERL_UNUSED_DECL __attribute__((unused))
-#else
-# define PERL_UNUSED_DECL
-#endif
-
-#ifndef dNOOP
-# define dNOOP extern int Perl___notused PERL_UNUSED_DECL
-#endif
-
#define START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV dNOOP
#define dMY_CXT dNOOP
@@ -420,5 +493,87 @@
#endif /* START_MY_CXT */
+#ifndef IVdf
+# if IVSIZE == LONGSIZE
+# define IVdf "ld"
+# define UVuf "lu"
+# define UVof "lo"
+# define UVxf "lx"
+# define UVXf "lX"
+# else
+# if IVSIZE == INTSIZE
+# define IVdf "d"
+# define UVuf "u"
+# define UVof "o"
+# define UVxf "x"
+# define UVXf "X"
+# endif
+# endif
+#endif
+#ifndef NVef
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
+ defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
+# define NVef PERL_PRIeldbl
+# define NVff PERL_PRIfldbl
+# define NVgf PERL_PRIgldbl
+# else
+# define NVef "e"
+# define NVff "f"
+# define NVgf "g"
+# endif
+#endif
+
+#ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */
+# define AvFILLp AvFILL
+#endif
+
+#ifdef SvPVbyte
+# if PERL_REVISION == 5 && PERL_VERSION < 7
+ /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
+# undef SvPVbyte
+# define SvPVbyte(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
+ static char *
+ my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
+ {
+ sv_utf8_downgrade(sv,0);
+ return SvPV(sv,*lp);
+ }
+# endif
+#else
+# define SvPVbyte SvPV
+#endif
+
+#ifndef SvPV_nolen
+# define SvPV_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_nolen(sv))
+ static char *
+ sv_2pv_nolen(pTHX_ register SV *sv)
+ {
+ STRLEN n_a;
+ return sv_2pv(sv, &n_a);
+ }
+#endif
+
+#ifndef get_cv
+# define get_cv(name,create) perl_get_cv(name,create)
+#endif
+
+#ifndef get_sv
+# define get_sv(name,create) perl_get_sv(name,create)
+#endif
+
+#ifndef get_av
+# define get_av(name,create) perl_get_av(name,create)
+#endif
+
+#ifndef get_hv
+# define get_hv(name,create) perl_get_hv(name,create)
+#endif
+
#endif /* _P_P_PORTABILITY_H_ */
+
+/* End of File ppport.h */
Modified: packages/libterm-readkey-perl/trunk/test.pl
===================================================================
--- packages/libterm-readkey-perl/trunk/test.pl 2005-07-12 17:32:25 UTC (rev 1233)
+++ packages/libterm-readkey-perl/trunk/test.pl 2005-07-12 17:58:43 UTC (rev 1234)
@@ -14,11 +14,10 @@
#ReadMode 0;
#__END__;
+my $interactive = ( @ARGV && $ARGV[0] =~ /interactive/ );
-my $interactive = (@ARGV && $ARGV[0] =~ /interactive/ );
-
BEGIN { print "1 .. 8\n"; }
-END { print "not ok 1\n" unless $loaded }
+END { print "not ok 1\n" unless $loaded }
use Term::ReadKey;
$loaded = 1;
@@ -28,182 +27,216 @@
if ( not exists $ENV{COLUMNS} )
{
- $ENV{COLUMNS} = 80;
- $ENV{LINES} = 24;
+ $ENV{COLUMNS} = 80;
+ $ENV{LINES} = 24;
}
-if ($^O =~ /Win32/i) {
- sysopen(IN,'CONIN$',O_RDWR) or die "Unable to open console input:$!";
- sysopen(OUT,'CONOUT$',O_RDWR) or die "Unable to open console output:$!";
-} else {
-
- if ( open(IN,"</dev/tty") ) {
- *OUT = *IN;
- die "Foo" unless -t OUT;
- }
- else {
- die "Can't open /dev/tty - $!\n";
- }
+if ( $^O =~ /Win32/i )
+{
+ sysopen( IN, 'CONIN$', O_RDWR ) or die "Unable to open console input:$!";
+ sysopen( OUT, 'CONOUT$', O_RDWR ) or die "Unable to open console output:$!";
}
+else
+{
-*IN=*IN; # Make single-use warning go away
-$|=1;
+ if ( open( IN, "</dev/tty" ) )
+ {
+ *OUT = *IN;
+ die "Foo" unless -t OUT;
+ }
+ else
+ {
+ # Okay we are going to cheat a skip
+ foreach my $skip ( 2 .. 8 )
+ {
+ print "ok $skip # skip /dev/tty is absent\n";
+ }
+ exit;
+ }
+}
+*IN = *IN; # Make single-use warning go away
+$| = 1;
-my $size1 = join(",",GetTerminalSize(\IN));
-my $size2 = join(",",GetTerminalSize("IN"));
-my $size3 = join(",",GetTerminalSize(*IN));
-my $size4 = join(",",GetTerminalSize(\*IN));
+my $size1 = join( ",", GetTerminalSize( \IN ) );
+my $size2 = join( ",", GetTerminalSize("IN") );
+my $size3 = join( ",", GetTerminalSize(*IN) );
+my $size4 = join( ",", GetTerminalSize( \*IN ) );
-if (($size1 eq $size2) && ($size2 eq $size3) && ($size3 eq $size4 ))
+if ( ( $size1 eq $size2 ) && ( $size2 eq $size3 ) && ( $size3 eq $size4 ) )
{
- print "ok 2\n";
+ print "ok 2\n";
}
else
{
- print "not ok 2\n";
+ print "not ok 2\n";
}
-sub makenicelist {
- my(@list) = @_;
- my($i,$result);
- $result="";
- for($i=0;$i<@list;$i++) {
- $result .= ", " if $i>0;
- $result .= "and " if $i==@list-1 and @list>1;
- $result .= $list[$i];
- }
- $result;
+sub makenicelist
+{
+ my (@list) = @_;
+ my ( $i, $result );
+ $result = "";
+ for ( $i = 0 ; $i < @list ; $i++ )
+ {
+ $result .= ", " if $i > 0;
+ $result .= "and " if $i == @list - 1 and @list > 1;
+ $result .= $list[$i];
+ }
+ $result;
}
-sub makenice {
- my($char) = $_[0];
- if(ord($char)<32) { $char = "^" . pack("c",ord($char)+64) }
- elsif(ord($char)>126) { $char = ord($char) }
- $char;
+sub makenice
+{
+ my ($char) = $_[0];
+ if ( ord($char) < 32 ) { $char = "^" . pack( "c", ord($char) + 64 ) }
+ elsif ( ord($char) > 126 ) { $char = ord($char) }
+ $char;
}
-sub makeunnice {
- my($char) = $_[0];
- $char =~ s/^\^(.)$/pack("c",ord($1)-64)/eg;
- $char =~ s/(\d{1,3})/pack("c",$1+0)/eg;
- $char;
+sub makeunnice
+{
+ my ($char) = $_[0];
+ $char =~ s/^\^(.)$/pack("c",ord($1)-64)/eg;
+ $char =~ s/(\d{1,3})/pack("c",$1+0)/eg;
+ $char;
}
-
my $response;
eval {
-if( &Term::ReadKey::termoptions() == 1) {
- $response = "Term::ReadKey is using TERMIOS, as opposed to TERMIO or SGTTY.\n";
-} elsif( &Term::ReadKey::termoptions() == 2) {
- $response = "Term::ReadKey is using TERMIO, as opposed to TERMIOS or SGTTY.\n";
-} elsif( &Term::ReadKey::termoptions() == 3) {
- $response = "Term::ReadKey is using SGTTY, as opposed to TERMIOS or TERMIO.\n";
-} elsif( &Term::ReadKey::termoptions() == 4) {
- $response = "Term::ReadKey is trying to make do with stty; facilites may be limited.\n";
-} elsif( &Term::ReadKey::termoptions() == 5) {
- $response = "Term::ReadKey is using Win32 functions.\n";
-} else {
- $response = "Term::ReadKey could not find any way to manipulate the terminal.\n";
-}
+ if ( &Term::ReadKey::termoptions() == 1 )
+ {
+ $response =
+ "Term::ReadKey is using TERMIOS, as opposed to TERMIO or SGTTY.\n";
+ }
+ elsif ( &Term::ReadKey::termoptions() == 2 )
+ {
+ $response =
+ "Term::ReadKey is using TERMIO, as opposed to TERMIOS or SGTTY.\n";
+ }
+ elsif ( &Term::ReadKey::termoptions() == 3 )
+ {
+ $response =
+ "Term::ReadKey is using SGTTY, as opposed to TERMIOS or TERMIO.\n";
+ }
+ elsif ( &Term::ReadKey::termoptions() == 4 )
+ {
+ $response =
+"Term::ReadKey is trying to make do with stty; facilites may be limited.\n";
+ }
+ elsif ( &Term::ReadKey::termoptions() == 5 )
+ {
+ $response = "Term::ReadKey is using Win32 functions.\n";
+ }
+ else
+ {
+ $response =
+ "Term::ReadKey could not find any way to manipulate the terminal.\n";
+ }
- print "ok 3\n";
+ print "ok 3\n";
};
print "not ok 3\n" if $@;
print $response if $interactive;
-eval
-{
- push(@modes,"O_NODELAY") if &Term::ReadKey::blockoptions() & 1;
- push(@modes,"poll()") if &Term::ReadKey::blockoptions() & 2;
- push(@modes,"select()") if &Term::ReadKey::blockoptions() & 4;
- push(@modes,"Win32") if &Term::ReadKey::blockoptions() & 8;
+eval {
+ push( @modes, "O_NODELAY" ) if &Term::ReadKey::blockoptions() & 1;
+ push( @modes, "poll()" ) if &Term::ReadKey::blockoptions() & 2;
+ push( @modes, "select()" ) if &Term::ReadKey::blockoptions() & 4;
+ push( @modes, "Win32" ) if &Term::ReadKey::blockoptions() & 8;
- print "ok 4\n";
+ print "ok 4\n";
};
print "not ok 4\n" if $@;
-if ($interactive )
+if ($interactive)
{
- if(&Term::ReadKey::blockoptions()==0)
- {
- print "No methods found to implement non-blocking reads.\n";
- print " (If your computer supports poll(), you might like to read through ReadKey.xs)\n";
- }
- else
- {
- print "Non-blocking reads possible via ",makenicelist(@modes),".\n";
- print $modes[0]." will be used. " if @modes>0;
- print $modes[1]." will be used for timed reads." if @modes>1 and $modes[0] eq "O_NODELAY";
- print "\n";
- }
+ if ( &Term::ReadKey::blockoptions() == 0 )
+ {
+ print "No methods found to implement non-blocking reads.\n";
+ print
+" (If your computer supports poll(), you might like to read through ReadKey.xs)\n";
+ }
+ else
+ {
+ print "Non-blocking reads possible via ", makenicelist(@modes), ".\n";
+ print $modes[0] . " will be used. " if @modes > 0;
+ print $modes[1] . " will be used for timed reads."
+ if @modes > 1
+ and $modes[0] eq "O_NODELAY";
+ print "\n";
+ }
}
-
-eval
-{
- @size = GetTerminalSize(OUT);
- print "ok 5\n";
+eval {
+ @size = GetTerminalSize(OUT);
+ print "ok 5\n";
};
print "not ok 5\n" if $@;
-if ( $interactive )
+if ($interactive)
{
- if(!@size) {
- print "GetTerminalSize was incapable of finding the size of your terminal.";
- } else {
- print "Using GetTerminalSize, it appears that your terminal is\n";
- print "$size[0] characters wide by $size[1] high.\n\n";
- }
+ if ( !@size )
+ {
+ print
+ "GetTerminalSize was incapable of finding the size of your terminal.";
+ }
+ else
+ {
+ print "Using GetTerminalSize, it appears that your terminal is\n";
+ print "$size[0] characters wide by $size[1] high.\n\n";
+ }
}
-eval
-{
- @speeds = GetSpeed();
- print "ok 6\n";
+eval {
+ @speeds = GetSpeed();
+ print "ok 6\n";
};
print "not ok 6\n" if $@;
-if ( $interactive )
+if ($interactive)
{
- if(@speeds) {
- print "Apparently, you are connected at ",join("/", at speeds)," baud.\n";
- } else {
- print "GetSpeed couldn't tell your connection baud rate.\n\n";
- }
- print "\n";
+ if (@speeds)
+ {
+ print "Apparently, you are connected at ", join( "/", @speeds ),
+ " baud.\n";
+ }
+ else
+ {
+ print "GetSpeed couldn't tell your connection baud rate.\n\n";
+ }
+ print "\n";
}
-eval
-{
- %chars = GetControlChars(IN);
- print "ok 7\n";
+eval {
+ %chars = GetControlChars(IN);
+ print "ok 7\n";
};
print "not ok 7\n" if $@;
%origchars = %chars;
-if ( $interactive )
+if ($interactive)
{
- for $c (keys %chars) { $chars{$c} = makenice($chars{$c}) }
+ for $c ( keys %chars ) { $chars{$c} = makenice( $chars{$c} ) }
- print "Control chars = (",join(', ',map("$_ => $chars{$_}",keys %chars)),")\n";
+ print "Control chars = (",
+ join( ', ', map( "$_ => $chars{$_}", keys %chars ) ), ")\n";
}
-eval
-{
- SetControlChars(%origchars, IN);
- print "ok 8\n";
+eval {
+ SetControlChars( %origchars, IN );
+ print "ok 8\n";
};
print "not ok 8\n" if $@;
@@ -211,13 +244,14 @@
#SetControlChars("FOOFOO"=>"Q");
#SetControlChars("INTERRUPT"=>"\x5");
-END { ReadMode 0, IN; } # Just if something goes weird
+END { ReadMode 0, IN; } # Just if something goes weird
exit(0) unless $interactive;
print "\nAnd now for the interactive tests.\n";
-print "\nThis is ReadMode 1. It's guarranteed to give you cooked input. All the\n";
+print
+ "\nThis is ReadMode 1. It's guarranteed to give you cooked input. All the\n";
print "signals and editing characters may be used as usual.\n";
ReadMode 1, IN;
@@ -232,7 +266,8 @@
ReadMode 2, IN;
-print "\nThis is ReadMode 2. It's just like #1, but echo is turned off. Great\n";
+print
+ "\nThis is ReadMode 2. It's just like #1, but echo is turned off. Great\n";
print "for passwords.\n";
print "\nYou may enter some invisible text here: ";
@@ -243,31 +278,38 @@
print "\nYou entered `$t'.\n";
-
ReadMode 3, IN;
-print "\nI won't demonstrate ReadMode 3 here. It's your standard cbreak mode,\n";
-print "with editing characters disabled, single character at a time input, but\n";
+print
+ "\nI won't demonstrate ReadMode 3 here. It's your standard cbreak mode,\n";
+print
+ "with editing characters disabled, single character at a time input, but\n";
print "with the control characters still enabled.\n";
print "\n";
-print "I'm now putting the terminal into ReadMode 4 and using non-blocking reads.\n";
-print "All signals should be disabled, including xon-xoff. You should only be\n";
+print
+"I'm now putting the terminal into ReadMode 4 and using non-blocking reads.\n";
+print
+ "All signals should be disabled, including xon-xoff. You should only be\n";
print "able to exit this loop via 'q'.\n";
ReadMode 4, IN;
$k = "";
+
#$in = *STDIN;
-$in = \*IN; # or *IN or "IN"
-while($k ne "q")
+$in = \*IN; # or *IN or "IN"
+while ( $k ne "q" )
{
- print "Press a key, or \"q\" to stop: ";
- $count=0;
- #print "IN = $in\n";
- $count++ while !defined($k=ReadKey(-1, $in));
- #print "IN2 = $in\n";
- print "\nYou pressed `",makenice($k),"' after the loop rolled over $count times\n";
+ print "Press a key, or \"q\" to stop: ";
+ $count = 0;
+
+ #print "IN = $in\n";
+ $count++ while !defined( $k = ReadKey( -1, $in ) );
+
+ #print "IN2 = $in\n";
+ print "\nYou pressed `", makenice($k),
+ "' after the loop rolled over $count times\n";
}
ReadMode 0, IN;
@@ -275,44 +317,49 @@
ReadMode 4, IN;
$k = "";
+
#$in = *STDIN;
-$in = \*IN; # or *IN or "IN"
-while($k ne "q")
+$in = \*IN; # or *IN or "IN"
+while ( $k ne "q" )
{
- print "Press a key, or \"q\" to stop: ";
- $count=0;
- #print "IN = $in\n";
- print "Timeout! " while !defined($k=ReadKey(2, $in));
- #print "IN2 = $in\n";
- print "\nYou pressed `",makenice($k),"'\n";
+ print "Press a key, or \"q\" to stop: ";
+ $count = 0;
+
+ #print "IN = $in\n";
+ print "Timeout! " while !defined( $k = ReadKey( 2, $in ) );
+
+ #print "IN2 = $in\n";
+ print "\nYou pressed `", makenice($k), "'\n";
}
-print "\nLastly, ReadMode 5, which also affects output (except under Win32).\n\n";
+print
+ "\nLastly, ReadMode 5, which also affects output (except under Win32).\n\n";
ReadMode 5, IN;
-print "This should be a diagonal line (except under Win32): *\n*\n*\n\*\n*\n*\r\n\r\n";
+print
+"This should be a diagonal line (except under Win32): *\n*\n*\n\*\n*\n*\r\n\r\n";
print "And this should be a moving spot:\r\n\r\n";
-$width = (GetTerminalSize(OUT))[0];
-$width/=2;
+$width = ( GetTerminalSize(OUT) )[0];
+$width /= 2;
$width--;
-if($width<10) { $width=10;}
+if ( $width < 10 ) { $width = 10; }
-for ($i=0;$i<20;$i+=.15) {
- print "\r";
- print (" " x ((cos($i)+1)*$width));
- print "*";
- select(undef, undef, undef, 0.01);
- print "\r";
- print (" " x ((cos($i)+1)*$width));
- print " ";
+for ( $i = 0 ; $i < 20 ; $i += .15 )
+{
+ print "\r";
+ print( " " x ( ( cos($i) + 1 ) * $width ) );
+ print "*";
+ select( undef, undef, undef, 0.01 );
+ print "\r";
+ print( " " x ( ( cos($i) + 1 ) * $width ) );
+ print " ";
}
print "\r ";
print "\n\r\n";
-
ReadMode 0, IN;
print "That's all, folks!\n";
More information about the Pkg-perl-cvs-commits
mailing list