#!perl
# This is a sandbox for experiments with referencing and dereferencing.
# It is not part of a test suite, not even an "author" test suite.
use strict;
use warnings;
use Scalar::Util qw(reftype weaken);
use Data::Dumper;
use Carp;
use English qw( -no_match_vars );
use Fatal qw(open);
sub try_dumper {
my $probe_ref = shift;
my @warnings = ();
local $SIG{__WARN__} = sub { push @warnings, $_[0]; };
printf {*STDERR} 'Dumper: %s', Data::Dumper::Dumper( ${$probe_ref} )
or Carp::croak("Cannot print to STDERR: $ERRNO");
for my $warning (@warnings) {
print {*STDERR} "Dumper warning: $warning"
or Carp::croak("Cannot print to STDERR: $ERRNO");
}
return scalar @warnings;
}
my $array_ref = \@{ [qw(42)] };
my $hash_ref = { a => 1, b => 2 };
my $scalar_ref = \42;
my $ref_ref = \$scalar_ref;
my $regexp_ref = qr/./xms;
## no critic (Subroutines::ProhibitCallsToUndeclaredSubs)
my $vstring_ref = \(v1.2.3.4);
## use critic
my $code_ref = \&try_dumper;
## no critic (Miscellanea::ProhibitFormats,References::ProhibitDoubleSigils,Subroutines::ProhibitCallsToUndeclaredSubs)
format fmt =
@<<<<<<<<<<<<<<<
$_
.
## use critic
## no critic (Subroutines::ProhibitCallsToUndeclaredSubs)
my $format_ref = *fmt{FORMAT};
my $glob_ref = *STDOUT{GLOB};
my $io_ref = *STDOUT{IO};
my $fh_ref = do {
no warnings qw(deprecated);
*STDOUT{FILEHANDLE};
};
## use critic
## no critic (InputOutput::RequireBriefOpen)
open my $autoviv_ref, q{>&STDERR};
## use critic
my $string = 'abc' x 40;
my $lvalue_ref = \( pos $string );
${$lvalue_ref} = 7;
my %data = (
'scalar' => $scalar_ref,
'array' => $array_ref,
'hash' => $hash_ref,
'ref' => $ref_ref,
'code' => $code_ref,
'regexp' => $regexp_ref,
'vstring' => $vstring_ref,
'format' => $format_ref,
'glob' => $glob_ref,
'io' => $io_ref,
'fh' => $fh_ref,
'autoviv' => $autoviv_ref,
'lvalue' => $lvalue_ref,
);
REF:
while ( my ( $name, $ref ) = each %data ) {
printf {*STDERR} "==== $name, %s, %s ====\n", ( ref $ref ),
( reftype $ref)
or Carp::croak("Cannot print to STDERR: $ERRNO");
try_dumper( \$ref );
}
REF:
for my $data_name (qw(scalar vstring regexp ref )) {
my $ref = $data{$data_name};
printf {*STDERR} "=== Deref test $data_name, %s, %s ===\n", ( ref $ref ),
( reftype $ref )
or Carp::croak("Cannot print to STDERR: $ERRNO");
my $old_probe = \$ref;
try_dumper($old_probe);
my $new_probe = \${ ${$old_probe} };
try_dumper($new_probe);
}
REF: for my $ref ($format_ref) {
my $probe = \$ref;
print {*STDERR} 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ),
"\n"
or Carp::croak("Cannot print to STDERR: $ERRNO");
try_dumper($probe);
# How to dereference ?
}
REF: for my $ref ($lvalue_ref) {
my $probe = \$ref;
print {*STDERR} 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ),
"\n"
or Carp::croak("Cannot print to STDERR: $ERRNO");
try_dumper($probe);
my $new_probe = \${ ${$probe} };
printf {*STDERR} "pos is %d\n", ${$lvalue_ref};
${$lvalue_ref} = 11;
printf {*STDERR} "pos is %d\n", ${$lvalue_ref};
}
REF: for my $ref ($io_ref) {
my $probe = \$ref;
print {*STDERR} 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ),
"\n"
or Carp::croak("Cannot print to STDERR: $ERRNO");
try_dumper($probe);
my $new_probe = \*{ ${$probe} };
print { ${$new_probe} } "Printing via IO ref\n"
or Carp::croak("Cannot print via IO ref: $ERRNO");
}
REF: for my $ref ($fh_ref) {
my $probe = \$ref;
print {*STDERR} 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ),
"\n"
or Carp::croak("Cannot print to STDERR: $ERRNO");
try_dumper($probe);
my $new_probe = \*{ ${$probe} };
print { ${$new_probe} } "Printing via FH ref\n"
or Carp::croak("Cannot print via FH ref: $ERRNO");
}
REF: for my $ref ($glob_ref) {
my $probe = \$ref;
print 'Trying to deref ', ( ref $probe ), q{ }, ( ref $ref ), "\n"
or Carp::croak("Cannot print to STDERR: $ERRNO");
try_dumper($probe);
my $new_probe = \*{ ${$probe} };
print { ${$new_probe} } "Printing via GLOB ref\n"
or Carp::croak("Cannot print via GLOB ref: $ERRNO");
}
REF:
for my $data_name (qw( glob autoviv )) {
my $ref = $data{$data_name};
printf {*STDERR} "=== Deref test $data_name, %s, %s ===\n", ( ref $ref ),
( reftype $ref )
or Carp::croak("Cannot print to STDERR: $ERRNO");
my $old_probe = \$ref;
try_dumper($old_probe);
my $new_probe = \*{ ${$old_probe} };
print { ${$new_probe} } "Printing via $data_name ref\n"
or Carp::croak("Cannot print via $data_name ref: $ERRNO");
try_dumper($new_probe);
}
REF:
while ( my ( $name, $ref ) = each %data ) {
my $ref_value = ref $ref;
my $reftype_value = reftype $ref;
printf
"==== scalar ref test of $name, ref=$ref_value, reftype=$reftype_value\n"
or Carp::croak("Cannot print to STDERR: $ERRNO");
my $eval_result = eval { my $deref = ${$ref}; 1 };
if ( defined $eval_result ) {
print "scalar deref of $reftype_value ok\n"
or Carp::croak("Cannot print to STDOUT: $ERRNO");
}
else {
print "scalar deref of $reftype_value failed: $EVAL_ERROR"
or Carp::croak("Cannot print to STDOUT: $ERRNO");
}
} ## end while ( my ( $name, $ref ) = each %data )