| perlfaq8 Dokumentation zu Perl 5.8.0 | Download als POD | Wie kann ich hier etwas ändern? |
Term::Cap Standard perl distribution
Term::ReadKey CPAN
Term::ReadLine::Gnu CPAN
Term::ReadLine::Perl CPAN
Term::Screen CPAN
Term::Cap Standard perl distribution
Curses CPAN
Term::ANSIColor CPAN
Tk CPAN
use Term::ANSIColor;
print color("red"), "Stop!\n", color("reset");
print color("green"), "Go!\n", color("reset");
Or like this:
use Term::ANSIColor qw(:constants);
print RED, "Stop!\n", RESET;
print GREEN, "Go!\n", RESET;
open(TTY, "+</dev/tty") or die "no tty: $!";
system "stty cbreak </dev/tty >/dev/tty 2>&1";
$key = getc(TTY); # perhaps this works
# OR ELSE
sysread(TTY, $key, 1); # probably this does
system "stty -cbreak </dev/tty >/dev/tty 2>&1";
The Term::ReadKey module from CPAN offers an easy-to-use interface that should be more efficient than shelling out to stty for each key. It even includes limited support for Windows.
use Term::ReadKey;
ReadMode('cbreak');
$key = ReadKey(0);
ReadMode('normal');
However, using the code requires that you have a working C compiler and can use it to build and install a CPAN module. Here's a solution using the standard POSIX module, which is already on your systems (assuming your system supports POSIX).
use HotKey;
$key = readkey();
And here's the HotKey module, which hides the somewhat mystifying calls to manipulate the POSIX termios structures.
# HotKey.pm
package HotKey;
@ISA = qw(Exporter);
@EXPORT = qw(cbreak cooked readkey);
use strict;
use POSIX qw(:termios_h);
my ($term, $oterm, $echo, $noecho, $fd_stdin);
$fd_stdin = fileno(STDIN);
$term = POSIX::Termios->new();
$term->getattr($fd_stdin);
$oterm = $term->getlflag();
$echo = ECHO | ECHOK | ICANON;
$noecho = $oterm & ~$echo;
sub cbreak {
$term->setlflag($noecho); # ok, so i don't want echo either
$term->setcc(VTIME, 1);
$term->setattr($fd_stdin, TCSANOW);
}
sub cooked {
$term->setlflag($oterm);
$term->setcc(VTIME, 0);
$term->setattr($fd_stdin, TCSANOW);
}
sub readkey {
my $key = '';
cbreak();
sysread(STDIN, $key, 1);
cooked();
return $key;
}
END { cooked() }
1;
use Term::ReadKey;
ReadMode('cbreak');
if (defined ($char = ReadKey(-1)) ) {
# input was waiting and it was $char
} else {
# no input was waiting
}
ReadMode('normal'); # restore normal tty settings
system :
system("clear");
If you have to do this a lot, save the clear string so you can print it 100 times without calling a program 100 times:
$clear_string = `clear`;
print $clear_string;
If you're planning on doing other screen manipulations, like cursor positions, etc, you might wish to use Term::Cap module:
use Term::Cap;
$terminal = Term::Cap->Tgetent( {OSPEED => 9600} );
$clear_string = $terminal->Tputs('cl');
use Term::ReadKey;
($wchar, $hchar, $wpixels, $hpixels) = GetTerminalSize();
This is more portable than the raw ioctl , but not as illustrative:
require 'sys/ioctl.ph';
die "no TIOCGWINSZ " unless defined &TIOCGWINSZ;
open(TTY, "+</dev/tty") or die "No tty: $!";
unless (ioctl(TTY, &TIOCGWINSZ, $winsize='')) {
die sprintf "$0: ioctl TIOCGWINSZ (%08x: $!)\n", &TIOCGWINSZ;
}
($row, $col, $xpixel, $ypixel) = unpack('S4', $winsize);
print "(row,col) = ($row,$col)";
print " (xpixel,ypixel) = ($xpixel,$ypixel)" if $xpixel || $ypixel;
print "\n";
use Term::ReadKey;
ReadMode('noecho');
$password = ReadLine(0);
Your system may use lockfiles to control multiple access. Make sure you follow the correct protocol. Unpredictable behavior can result from multiple processes reading from one device.
If you expect to use both read and write operations on the device, you'll have to open it for update (see perlfunc, open for details). You may wish to open it without running the risk of blocking by using sysopen() and O_RDWR|O_NDELAY|O_NOCTTY from the Fcntl module (part of the standard perl distribution). See perlfunc, sysopen for more on this approach.
Some devices will be expecting a "\r" at the end of each line rather than a "\n". In some ports of perl, "\r" and "\n" are different from their usual (Unix) ASCII values of "\012" and "\015". You may have to give the numeric values you want directly, using octal ("\015"), hex ("0x0D"), or as a control-character specification ("\cM").
print DEV "atv1\012"; # wrong, for some devices
print DEV "atv1\015"; # right, for some devices
Even though with normal text files a "\n" will do the trick, there is still no unified scheme for terminating a line that is portable between Unix, DOS/Win, and Macintosh, except to terminate ALL line ends with "\015\012", and strip what you don't need from the output. This applies especially to socket I/O and autoflushing, discussed next.
If you expect characters to get to your device when you print() them, you'll want to autoflush that filehandle. You can use select() and the $| variable to control autoflushing (see L<perlvar/$|> and perlfunc, select, or perlfaq5, ``How do I flush/unbuffer an output filehandle? Why must I do this?''):
$oldh = select(DEV);
$| = 1;
select($oldh);
You'll also see code that does this without a temporary variable, as in
select((select(DEV), $| = 1)[0]);
Or if you don't mind pulling in a few thousand lines of code just because you're afraid of a little $| variable:
use IO::Handle;
DEV->autoflush(1);
As mentioned in the previous item, this still doesn't work when using socket I/O between Unix and Macintosh. You'll need to hard code your line terminators, in that case.
If you are doing a blocking read() or sysread(), you'll have to arrange for an alarm handler to provide a timeout (see perlfunc, alarm). If you have a non-blocking open, you'll likely have a non-blocking read, which means you may have to use a 4-arg select() to determine whether I/O is ready on that device (see perlfunc, select.
sub open_modem {
use IPC::Open2;
my $stty = `/bin/stty -g`;
open2( \*MODEM_IN, \*MODEM_OUT, "cu -l$modem_device -s2400 2>&1");
# starting cu hoses /dev/tty's stty settings, even when it has
# been opened on a pipe...
system("/bin/stty $stty");
$_ = <MODEM_IN>;
chomp;
if ( !m/^Connected/ ) {
print STDERR "$0: cu printed `$_' instead of `Connected'\n";
}
}
system("cmd &")
or you could use fork as documented in perlfunc, fork, with further examples in perlipc. Some things to be aware of, if you're on a Unix-like system:
Both the main process and the backgrounded one (the "child" process) share the same STDIN, STDOUT and STDERR filehandles. If both try to access them at once, strange things can happen. You may want to close or reopen these for the child. You can get around this with open ing a pipe (see perlfunc, open) but on some systems this means that the child process cannot outlive the parent.
You'll have to catch the SIGCHLD signal, and possibly SIGPIPE too. SIGCHLD is sent when the backgrounded process finishes. SIGPIPE is sent when you write to a filehandle whose child process has closed (an untrapped SIGPIPE can cause your program to silently die). This is not an issue with system("cmd&") .
You have to be prepared to "reap" the child process when it finishes
$SIG{CHLD} = sub { wait };
See perlipc, Signals for other examples of code to do this. Zombies are not an issue with system("prog &") .
$Interrupted = 0; # to ensure it has a value
$SIG{INT} = sub {
$Interrupted++;
syswrite(STDERR, "ouch\n", 5);
}
However, because syscalls restart by default, you'll find that if you're in a "slow" call, such as <FH>, read(), connect(), or wait(), that the only way to terminate them is by "longjumping" out; that is, by raising an exception. See the time-out handler for a blocking flock() in perlipc, Signals or the section on ``Signals'' in the Camel book.
set time .
However, if all you want to do is change your time zone, you can probably get away with setting an environment variable:
$ENV{TZ} = "MST7MDT"; # unixish
$ENV{'SYS$TIMEZONE_DIFFERENTIAL'}="-5" # vms
system "trn comp.lang.perl.misc";
require 'sys/syscall.ph';
$TIMEVAL_T = "LL";
$done = $start = pack($TIMEVAL_T, ());
syscall(&SYS_gettimeofday, $start, 0) != -1
or die "gettimeofday: $!";
##########################
# DO YOUR OPERATION HERE #
##########################
syscall( &SYS_gettimeofday, $done, 0) != -1
or die "gettimeofday: $!";
@start = unpack($TIMEVAL_T, $start);
@done = unpack($TIMEVAL_T, $done);
# fix microseconds
for ($done[1], $start[1]) { $_ /= 1_000_000 }
$delta_time = sprintf "%.4f", ($done[0] + $done[1] )
-
($start[0] + $start[1] );
END {
close(STDOUT) || die "stdout close failed: $!";
}
The END block isn't called when untrapped signals kill the program, though, so if you use END blocks you should also use
use sigtrap qw(die normal-signals);
Perl's exception-handling mechanism is its eval() operator. You can use eval() as setjmp and die() as longjmp. For details of this, see the section on signals, especially the time-out handler for a blocking flock() in perlipc, Signals or the section on ``Signals'' in the Camel Book.
If exception handling is all you're interested in, try the exceptions.pl library (part of the standard perl distribution).
If you want the atexit() syntax (and an rmexit() as well), try the AtExit module available from CPAN.
errno.h , syscall.h , and socket.h were fine, but the hard ones like ioctl.h nearly always need to hand-edited. Here's how to install the *.ph files:
1. become super-user
2. cd /usr/include
3. h2ph *.h */*.h
If your system supports dynamic loading, for reasons of portability and sanity you probably ought to use h2xs (also part of the standard perl distribution). This tool converts C header files to Perl extensions. See perlxstut for how to get started with h2xs.
If your system doesn't support dynamic loading, you still probably ought to use h2xs. See perlxstut and ExtUtils::MakeMaker? for more information (in brief, just use make perl instead of a plain make to rebuild perl with a new static extension).
$exit_status = system("mail-users");
$output_string = `ls`;
system $cmd; # using system()
$output = `$cmd`; # using backticks (``)
open (PIPE, "cmd |"); # using open()
With system(), both STDOUT and STDERR will go the same place as the script's STDOUT and STDERR, unless the system() command redirects them. Backticks and open() read only the STDOUT of your command.
With any of these, you can change file descriptors before the call:
open(STDOUT, ">logfile");
system("ls");
or you can use Bourne shell file-descriptor redirection:
$output = `$cmd 2>some_file`;
open (PIPE, "cmd 2>some_file |");
You can also use file-descriptor redirection to make STDERR a duplicate of STDOUT:
$output = `$cmd 2>&1`;
open (PIPE, "cmd 2>&1 |");
Note that you cannot simply open STDERR to be a dup of STDOUT in your Perl program and avoid calling the shell to do the redirection. This doesn't work:
open(STDERR, ">&STDOUT");
$alloutput = `cmd args`; # stderr still escapes
This fails because the open() makes STDERR go to where STDOUT was going at the time of the open(). The backticks then make STDOUT go to a string, but don't change STDERR (which still goes to the old STDOUT).
Note that you must use Bourne shell (sh(1)) redirection syntax in backticks, not csh(1)! Details on why Perl's system() and backtick and pipe opens all use the Bourne shell are in the versus/csh.whynot article in the "Far More Than You Ever Wanted To Know" collection in http://www.cpan.org/olddoc/FMTEYEWTK.tgz . To capture a command's STDERR and STDOUT together:
$output = `cmd 2>&1`; # either with backticks
$pid = open(PH, "cmd 2>&1 |"); # or with an open pipe
while (<PH>) { } # plus a read
To capture a command's STDOUT but discard its STDERR:
$output = `cmd 2>/dev/null`; # either with backticks
$pid = open(PH, "cmd 2>/dev/null |"); # or with an open pipe
while (<PH>) { } # plus a read
To capture a command's STDERR but discard its STDOUT:
$output = `cmd 2>&1 1>/dev/null`; # either with backticks
$pid = open(PH, "cmd 2>&1 1>/dev/null |"); # or with an open pipe
while (<PH>) { } # plus a read
To exchange a command's STDOUT and STDERR in order to capture the STDERR but leave its STDOUT to come out our old STDERR:
$output = `cmd 3>&1 1>&2 2>&3 3>&-`; # either with backticks
$pid = open(PH, "cmd 3>&1 1>&2 2>&3 3>&-|");# or with an open pipe
while (<PH>) { } # plus a read
To read both a command's STDOUT and its STDERR separately, it's easiest and safest to redirect them separately to files, and then read from those files when the program is done:
system("program args 1>/tmp/program.stdout 2>/tmp/program.stderr");
Ordering is important in all these examples. That's because the shell processes file descriptor redirections in strictly left to right order.
system("prog args 1>tmpfile 2>&1");
system("prog args 2>&1 1>tmpfile");
The first command sends both standard out and standard error to the temporary file. The second command sends only the old standard output there, and the old standard error shows up on the old standard out.
open contains shell metacharacters, perl fork()s, then exec()s a shell to decode the metacharacters and eventually run the desired program. If the program couldn't be run, it's the shell that gets the message, not Perl. All your Perl program can find out is whether the shell itself could be successfully started. You can still capture the shell's STDERR and check it for error messages. See L<"How can I capture STDERR from an external command?"> elsewhere in this document, or use the IPC::Open3? module.
If there are no shell metacharacters in the argument of open , Perl runs the command directly, without using the shell, and can correctly report whether the command started.
system function is another; it doesn't do this.
Writing backticks in your program sends a clear message to the readers of your code that you wanted to collect the output of the command. Why send a clear message that isn't true?
Consider this line:
`cat /etc/termcap`;
You forgot to check $? to see whether the program even ran correctly. Even if you wrote
print `cat /etc/termcap`;
this code could and probably should be written as
system("cat /etc/termcap") == 0
or die "cat program failed!";
which will get the output quickly (as it is generated, instead of only at the end) and also check the return value.
system() also provides direct control over whether shell wildcard processing may take place, whereas backticks do not.
@ok = `grep @opts '$search_string' @filenames`;
You have to do this:
my @ok = ();
if (open(GREP, "-|")) {
while (<GREP>) {
chomp;
push(@ok, $_);
}
close GREP;
} else {
exec 'grep', @opts, $search_string, @filenames;
}
Just as with system(), no shell escapes happen when you exec() a list. Further examples of this can be found in perlipc, Safe Pipe Opens.
Note that if you're stuck on Microsoft, no solution to this vexing issue is even possible. Even if Perl were to emulate fork(), you'd still be hosed, because Microsoft gives no argc/argv-style API. Their API always reparses from a single string, which is fundamentally wrong, but you're not likely to get the Gods of Redmond to acknowledge this and fix it for you.
Try keeping around the seekpointer and go there, like this:
$where = tell(LOG);
seek(LOG, $where, 0);
If that doesn't work, try seeking to a different part of the file and then back.
If that doesn't work, try seeking to a different part of the file, reading something, and then seeking back.
If that doesn't work, give up on your stdio package and use sysread.
use IO::Socket; # new in 5.004
$handle = IO::Socket::INET->new('www.perl.com:80')
|| die "can't connect to port 80 on www.perl.com: $!";
$handle->autoflush(1);
if (fork()) { # XXX: undef means failure
select($handle);
print while <STDIN>; # everything from stdin to socket
} else {
print while <$handle>; # everything from socket to stdout
}
close $handle;
exit;
$0 = "orcus [accepting connections]";
In the strictest sense, it can't be done--the script executes as a different process from the shell it was started from. Changes to a process are not reflected in its parent--only in any children created after the change. There is shell magic that may allow you to fake it by eval()ing the script's output in your shell; check out the comp.unix.questions FAQ for details.
Open /dev/tty and use the TIOCNOTTY ioctl on it. See tty(4)? for details. Or better yet, you can just use the POSIX::setsid() function, so you don't have to worry about process groups.
Change directory to /
Reopen STDIN, STDOUT, and STDERR so they're not connected to the old tty.
Background yourself like this:
fork && exit;
-t STDIN and -t STDOUT can give clues, sometimes not.
if (-t STDIN && -t STDOUT) {
print "Now what? ";
}
On POSIX systems, you can test whether your own process group matches the current process group of your controlling terminal as follows:
use POSIX qw/getpgrp tcgetpgrp/;
open(TTY, "/dev/tty") or die $!;
$tpgrp = tcgetpgrp(fileno(*TTY));
$pgrp = getpgrp();
if ($tpgrp == $pgrp) {
print "foreground\n";
} else {
print "background\n";
}
$rc = system($cmd);
if ($rc & 127) { die "signal death" }
use Fcntl;
sysopen(FH, "/tmp/somefile", O_WRONLY|O_NDELAY|O_CREAT, 0644)
or die "can't open /tmp/somefile: $!":
$ perl -MCPAN -e shell
cpan shell -- CPAN exploration and modules installation (v1.59_54)
ReadLine support enabled
cpan> install Some::Module
To manually install the CPAN module, or any well-behaved CPAN module for that matter, follow these steps:
If your version of perl is compiled without dynamic loading, then you just need to replace step 3 ( make ) with make perl and you will get a new perl binary with your extension linked in.
See ExtUtils::MakeMaker? for more details on building extensions. See also the next question, ``What's the difference between require and use?''.
1) do $file is like eval `cat $file`, except the former
1.1: searches @INC and updates %INC.
1.2: bequeaths an *unrelated* lexical scope on the eval'ed code.
2) require $file is like do $file, except the former
2.1: checks for redundant loading, skipping already loaded files.
2.2: raises an exception on failure to find, compile, or execute $file.
3) require Module is like require "Module.pm", except the former
3.1: translates each "::" into your system's directory separator.
3.2: primes the parser to disambiguate class Module as an indirect object.
4) use Module is like require Module, except the former
4.1: loads the module at compile time, not run-time.
4.2: imports symbols and semantics from that package to the current one.
In general, you usually want use and a proper Perl module.
perl Makefile.PL PREFIX=/u/mydir/perl
then either set the PERL5LIB environment variable before you run scripts that use the modules/libraries (see perlrun) or say
use lib '/u/mydir/perl';
This is almost the same as
BEGIN {
unshift(@INC, '/u/mydir/perl');
}
except that the lib module checks for machine-dependent subdirectories. See Perl's lib? for more information.
use FindBin;
use lib "$FindBin::Bin";
use your_own_modules;
the PERLLIB environment variable
the PERL5LIB environment variable
the perl -Idir command line flag
the use lib pragma, as in
use lib "$ENV{HOME}/myown_perllib";
The latter is particularly useful because it knows about machine dependent architectures. The lib.pm pragmatic module was first included with the 5.002 release of Perl.
use Socket; instead.