eval 'exec perl $0 ${1+"$@"}'
               if 0;

use 5.010_000;
use strict;
use autodie;
use warnings qw[ FATAL all ];

use Symbol;
use IO::Handle;

#define exec(arg)
BEGIN { exec("cpp $0 | $^X") }  # nyah nyah nyah-NYAH nhah!!
#undef  exec

#define CPP(FN, ARG) printf(" %6s %s => %s\n", main::short("FN"), q(ARG), FN(ARG))
#define QS(ARG)      CPP(main::qual_string, ARG)
#define QG(ARG)      CPP(main::qual_glob, ARG)
#define NL           say ""

sub comma(@);
sub short($);
sub qual($);
sub qual_glob(*);
sub qual_string($);

$| = 1;

main();
exit();

sub main {

    our $GLOBAL = "/dev/null";
    open GLOBAL;

    my $new_fh = new IO::Handle;

    open(my $null, "/dev/null");

    for my $str ($GLOBAL, "hard to type") {
        no strict "refs";
        *$str = *GLOBAL{IO};
    }

    fake_qs();

    QS(  *stderr       );
    QS(  "STDOUT"      );
    QS(  *STDOUT       );
    QS(  *STDOUT{IO}   );
    QS( \*STDOUT       );
    QS( "sneezy"       );
    QS( "hard to type" );
    QS( $new_fh        );
    QS( "GLOBAL"       );
    QS( *GLOBAL        );
    QS( $GLOBAL        );
    QS( $null          );

    NL;

    fake_qg();

    QG(  *stderr       );
    QG(   STDOUT       );
    QG(  "STDOUT"      );
    QG(  *STDOUT       );
    QG(  *STDOUT{IO}   );
    QG( \*STDOUT       );
    QG(  sneezy        );
    QG( "sneezy"       );
    QG( "hard to type" );
    QG( $new_fh        );
    QG(  GLOBAL        );
    QG( $GLOBAL        );
    QG( *GLOBAL        );
    QG( $null          );

    NL;
}

package main;

sub comma(@) { join(", " => @_) }

sub qual_string($) {
    my $string = shift();
    return qual($string);
}

sub qual_glob(*) {
    my $handle = shift();
    return qual($handle);
}

sub qual($) {
    my $thingie = shift();

    my $qname = qualify($thingie);
    my $qref  = qualify_to_ref($thingie);
    my $fnum  = do { no autodie; fileno($qref) };
    $fnum = "undef" unless defined $fnum;

    return comma($qname, $qref, "fileno $fnum");
}

sub short($) {
    my $name = shift();
    $name =~ s/.*_//;
    return $name;
}

sub fake_qg { &NotMain::fake_qg }
sub fake_qs { &NotMain::fake_qs }

package NotMain;  # this is just wicked

sub fake_qg {
    say "off to NotMain";
    QG(  "stderr"      );
    QG(   stderr       );
    QG(   sneeze       );
    QG(  *sneeze       );
    QG(  *stderr       );
    QG(  *STDERR       );
    say "back to main";
}

sub fake_qs {
    say "off to NotMain";
    package NotMain;
    QS(  "stderr"      );
    QS(  *stderr       );
    QS(  *sneeze       );
    QS(  *STDERR       );
    say "back to main";
}