Front page | perl.perl5.porters |
Postings from March 2007
tied filehandles do not honour write
Thread Next
From:
H.Merijn Brand
Date:
March 5, 2007 10:00
Subject:
tied filehandles do not honour write
Message ID:
20070305185957.700e780f@pc09
OK, I know, nobody uses format/write, but still there is a syncing
problem in using write to a tied file handle, as I discovered while
preparing my DPWS talk. Somewhat cut-down example below.
I get:
--8<---
PRINT OUT 1
FORMAT OUT 1
PRINT OUT 2
FORMAT OUT 2
PRINT OUT 3
-->8---
I expect:
--8<---
PRINT OUT 1
FORMAT OUT 1
PRINT OUT 2
FORMAT OUT 2
PRINT OUT 3
-->8---
--8<--- stdouttie.pl (also attached)
#!/pro/bin/perl
package STDTIE;
use strict;
use Carp;
sub TIEHANDLE
{
my ($class, $lm, $io, $fno) = @_;
$lm //= 4;
$io //= *STDOUT;
ref $lm || $lm !~ m/^\d+$/ and
croak "OutputFilter tie's 1st arg must be numeric";
my $fh;
if (ref $io eq "GLOB" and ref *{$io}{IO} eq "IO::Handle") {
open $fh, ">&", *{$io}{IO};
}
elsif (ref $io eq "SCALAR") {
open $fh, ">", $io;
}
else {
$fno = fileno $io;
defined $fno && $fno >= 0 or
croak "OutputFilter tie's 2nd arg must be the output handle\n";
open $fh, ">&", $fno;
}
$fh or croak "OutputFilter cannot dup the output handle: $!";
select ((select ($fh), $| = 1)[0]);
bless {
pfx => " " x $lm,
io => $fh,
line => "",
closed => 0,
}, $class;
} # TIEHANDLE
sub PRINT
{
my $self = shift;
my ($pfx, $io) = @{$self}{qw( pfx io )};
$self->{closed} and croak "Cannot print to closed filehandle";
my $fsep = $, // "";
my $line = $self->{line} . (join $fsep => @_) . ($\ // "");
my @line = split m/\n/, $line, -1;
$self->{line} = pop @line;
print { $io } "$pfx$_\n" for @line;
} # PRINT
sub CLOSE
{
my $self = shift;
my ($pfx, $io, $line) = @{$self}{qw( pfx io line )};
if ($line ne "") {
print { $io } "$pfx$_" for $line;
}
$self->{closed} or close $io;
$self->{line} = "";
$self->{closed}++;
} # CLOSE
sub UNTIE
{
my $self = shift;
$self->{closed} or $self->CLOSE;
$self;
} # UNTIE
sub DESTROY
{
my $self = shift;
$self->{closed} or $self->CLOSE;
%$self = ();
undef $self;
} # DESTROY
1;
package main;
use strict;
use warnings;
sub wryte ($)
{
local $~ = shift;
write;
} # wryte
format STDOUT1 =
FORMAT OUT 1
.
format STDOUT2 =
FORMAT OUT 2
.
$| = 1;
print "PRINT OUT 1\n";
wryte "STDOUT1";
tie *STDOUT, "STDTIE", 4;
print "PRINT OUT 2\n";
wryte "STDOUT2";
untie *STDOUT;
print "PRINT OUT 3\n";
-->8---
--
H.Merijn Brand Amsterdam Perl Mongers (http://amsterdam.pm.org/)
using & porting perl 5.6.2, 5.8.x, 5.9.x on HP-UX 10.20, 11.00, 11.11,
& 11.23, SuSE 10.0 & 10.2, AIX 4.3 & 5.2, and Cygwin. http://qa.perl.org
http://mirrors.develooper.com/hpux/ http://www.test-smoke.org
http://www.goldmark.org/jeff/stupid-disclaimers/
Thread Next
-
tied filehandles do not honour write
by H.Merijn Brand