#define exec(arg)
BEGIN { exec("cpp $0 | $^X") } # nyah nyah nyah-NYAH nyah!!
#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 ""
####
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";
}
####
@12 = 12->(12);