Front page | perl.perl5.porters |
Postings from March 2000
[ID 20000325.010] warnings stuff
Thread Previous
|
Thread Next
From:
Tom Christiansen
Date:
March 25, 2000 22:47
Subject:
[ID 20000325.010] warnings stuff
Message ID:
24922.954053272@chthon
Here's a lexical warnings demo using with the sysreadline() function
that doubtless we've all written a zillion times. It brings
up two matters about warnings::warn and warnings::enabled --
1) I think Perl need's a warn to pass one's caller's warnings
mask to one's callees. Otherwise, when you have a level
of indirection as I have here, you lose everything.
2) How does one control carp/croak vs cluck/confess? I seem to be
getting the second set, but the source seems to show getting the
first set.
--tom
use Symbol 'qualify_to_ref';
use Carp qw/:DEFAULT cluck/;
use strict;
sub sysreadline(*;$);
sub _readupto(*$;$);
sub sysreadline(*;$) {
# HOW DO I get my caller's mask to pass to my child?
# how come he doesn't percolate up through to a different
# package? oh. cause it's lexical. hm...
if (@_ == 1) { return _readupto($_[0], "\n") }
elsif (@_ == 2) { return _readupto($_[0], "\n", $_[1]) }
else { confess "usage: \$data = sysreadline(FH, [timeout])" }
# XXX: don't break the proto!
}
sub _readupto(*$;$) {
my $fh = qualify_to_ref(shift, caller);
unless (defined fileno($fh)) {
# THIS DOES NOT "WORK" to get the right ones
if (warnings::enabled("closed")) {
warnings::warn("closed", "sysreadline from closed filehandle\n");
}
return undef;
}
my $EOL = shift;
my $timeout = @_ ? shift : undef;
my $buffer = '';
my $starttime = time();
my($inmask,$outmask) = ('', '');
vec($inmask, fileno($fh), 1) = 1;
until (length($buffer) && substr($buffer, -length($EOL)) eq $EOL) {
unless (select($outmask = $inmask, undef, undef, $timeout)) {
return $buffer;
}
$timeout -= time() - $starttime if defined $timeout;
my $char;
unless (sysread($fh, $char, 1)) {
return length($buffer) ? $buffer : undef;
}
$buffer .= $char;
last if defined $timeout && $timeout < 0;
}
return $buffer;
}
my $pid = open(KID, "|-");
die "cannot fork: $!" unless defined $pid;
if ($pid) {
select((select(KID), $|=1)[0]);
print KID "ready "; sleep 1;
print KID "or not\nboys\nfor "; sleep 2;
print KID "here we come!\n"; sleep 3;
close KID;
print "status $?\n";
exit;
}
# KID is below
# this doesn't work!
use warnings qw/FATAL io/;
my $data;
while (1) {
$data = sysreadline(STDIN);
#$data = sysreadline(STDIN,0.75); # shows time-out argument
#$data = sysreadline(XSTDIN); # shows error on bad FH
#$data = _readupto(STDIN,'r',0.5);
unless (defined $data) {
print "[End of file]\n";
last;
}
unless (length $data) {
print "[Time out]\n";
next;
}
print "child got <$data>\n";
}
exit !close STDIN;
Thread Previous
|
Thread Next