Three argument version of open '>-' (updated)

[choroba]

In an ancient part of the code at work, we use

open my $output, '>-' or die $!;

Perl::Critic complains about it and wants us to replace it with a three argument variant. But, what's the 3-arg variant of >-?

I thought

open my $output, '>&', *STDOUT or die $!;

might be the same, but it isn't, cf.

open my $output, '>-' or die $!;
close *STDOUT;
print {$output} "This fails with Bad file descriptor";

versus

open my $output, '>&', *STDOUT or die $!;
close *STDOUT;
print {$output} "This prints OK\n";

Then I tried with

my $output = *STDOUT;

but it's different, too:

close STDOUT;
print {$output}
    'Besides Bad file descriptor, this will also warn "print() on clos
+ed filehandle STDOUT"';

Is there a three-argument version of open that behaves the same as '>-'?

Update: Here's a SSCCE. Closing STDOUT is a global state, so call this with an argument (1, 2, 3, 4) to test a particular implementation.

#!/usr/bin/perl
use strict;
use warnings;

sub original {
    open my $output, '>-' or die $!;
    $output
}

sub assign {
    my $output = *STDOUT;
    $output
}

sub dup {
    open my $output, '>&', *STDOUT or die $!;
    $output
}

sub fn {
    open my $output, '>>&=', *STDOUT->fileno or die $!;
    $output
}

use Test::More;

sub test {
    my ($open) = @_;
    my @W;
    local $SIG{__WARN__} = sub { push @W, @_ };

    my $output = $open->();
    close *STDOUT;
    my $v = print {$output} "abc\n";

    isnt $v, 1, 'fails';
    like $!, qr/Bad file descriptor/, 'Exception';
    is scalar @W, 0, 'no warnings';
    chomp, diag "($_)" for @W;
    done_testing();
}

my %dispatch = (1 => \&original,
                2 => \&assign,
                3 => \&dup,
                4 => \&fn);

my $what = shift;
my $code = $dispatch{$what} or die 'Not associated';
test($code);

[LanX]

> Perl::Critic complains about it and wants us to replace it with a three argument variant. But, what's the 3-arg variant of >-?

From a pragmatic point of view, I'd say:

Adjust the Perl::Critic rule!

I mean it's an interesting question, but probably it's not possible to duplicate all these exact implementation details.

This particular 2 args syntax OTOH is documented and legit.

update

and by all communist gods, why would you like to have a duplicate of STDOUT which fails globally without warning?

Probably this feature is simply broken.

[jcb]

Seconding this: Perl::Critic is simply wrong here. The primary risk of two-argument open is the possibility of a "strange" filename improperly triggering the magic (How about a "file" named 'rm -rf / |'?), but in this case the filename is a literal constant and that is not possible.

This is a bug in Perl::Critic — your particular use of the two-argument syntax is fine.

[Fletch]

If the OS provides it perhaps explicitly opening /dev/stdout as the filename? Or maybe no because that's going to behave like your "prints OK" block because it'd return a new descriptor on the device.

Slightly ebil but maybe open( my $output, ">>&=", STDOUT->fileno ) would get it? (I want to say that should create a new handle instance pointing to the same underlying descriptor which seems to be what >- was doing).

[LanX]

Maybe try open $fh, '>&', STDOUT;

behavior looks consistent when autoflush is activated.

Otherwise please use a similar code-template for a SSCCE.

use v5.12;
use warnings;
use Data::Dump qw/pp dd/;




sub tst {
    my $vers = shift;

    open STDOUT, ">-";                  # restore STDOUT
    $|=1;


    say STDERR "********* testing $vers\n";

    my $fh;

    open $fh, ">-" if $vers eq "open2";
    $fh = \*STDOUT if $vers eq "copyref";
    open $fh, '>&', STDOUT if $vers eq "redirect";


    $fh->autoflush;

    say "$vers 1";

    close STDOUT;

    say $fh "$vers 2";

    say "$vers 3";
}


tst("redirect");

tst("open2");

tst("copyref");

-*- mode: compilation; default-directory: "d:/tmp/pm/" -*-
Compilation started at Mon Mar  1 23:21:00

C:/Strawberry/perl/bin\perl.exe -w d:/tmp/pm/redirect_STDOUT.pl 
********* testing redirect

redirect 1
redirect 2
say() on closed filehandle STDOUT at d:/tmp/pm/redirect_STDOUT.pl line
+ 32.
********* testing open2

open2 1
open2 2
say() on closed filehandle STDOUT at d:/tmp/pm/redirect_STDOUT.pl line
+ 32.
********* testing copyref

copyref 1
say() on closed filehandle STDOUT at d:/tmp/pm/redirect_STDOUT.pl line
+ 30.
say() on closed filehandle STDOUT at d:/tmp/pm/redirect_STDOUT.pl line
+ 32.

Compilation finished at Mon Mar  1 23:21:00

[choroba]

OP updated witn a SSCCE.

[LanX]

Thanks, it's clearer now, you want that the "copy FH" fails if STDOUT is closed, but without emitting a warning.

Sorry, no clue yet...

update

BTW: you can automatize your test-runs with an exec $0 #Test if @ARGV is empty :)

and maybe you should also consider testing different states of autoflush.

[LanX]

same behavior for me

  DB<47> open $fh,">-"

  DB<48> say $fh "bla"
bla

  DB<49> say "bla"
bla

  DB<50> close STDOUT

  DB<51> say $fh "bla"

  DB<52>

copy solution

  DB<53> say "bla"
bla

  DB<54> $fh=\*STDOUT # copy

  DB<55> say $fh "bla"
bla

  DB<56> close STDOUT

  DB<57> say $fh "bla"

  DB<58>

what am I missing?

EDIT: Both approaches warn under warnings if STDOUT was closed.

UPDATE

I just remembered that the debugger does scary redirections under the hood, so these tests may not be reliable.