The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

# autoprint => 1 causes EzDD obj to print to STDOUT if called in void
# context.  autoprint => 2 sends output STDERR
use strict;
use Test::More (tests => 24);

pass "test void-context calls";
use_ok qw( Data::Dumper::EasyOO );

my $ddez = Data::Dumper::EasyOO->new(indent=>1);
isa_ok ($ddez, 'Data::Dumper::EasyOO', "new() retval");

cleanup(); $!=0;

sub content_matches {		# Mojo, the helper monkey
    my ($fname, $rex) = @_;
    open (my $fh, $fname) or die "$!: $fname";
    local $/ = undef;
    my $buf = <$fh>;
    return 1 if $buf =~ m/$rex/;
    print "failed content-check, got: $buf, expected $rex\n";
    return 0;
}

sub write2it {
    my ($it, $i, $tag, $what) = @_;
    my $ddez = Data::Dumper::EasyOO->new(indent=>1);
    $ddez->Set(indent => $i, autoprint => $it);
    $ddez->($tag => $what);
}

SKIP: {
    eval "use Test::Output";
    skip "need Test::Output to test autoprint to stdout,stderr", 9 if $@;

    stdout_is(sub{write2it(0, 1, 'foo','to stdout')},
	      '',
	      "stdout is empty, as expected");

    stdout_is(sub{write2it(1, 1, 'foo','to stdout')},
	      qq{\$foo = 'to stdout';\n},
	      "stdout has expected output");

    stderr_is(sub{write2it(2,1, 'foo','to stderr')},
	      qq{\$foo = 'to stderr';\n},
	      "stderr has expected output");

    stdout_is(sub{write2it(\*STDOUT,1, 'foo','to stdout')},
	      qq{\$foo = 'to stdout';\n},
	      '\*STDOUT has expected output');

    stderr_is(sub{write2it(\*STDERR,1, 'foo','to stderr')},
	      qq{\$foo = 'to stderr';\n},
	      '\*STDERR has expected output');

    stdout_is(sub{write2it(1, 1, 'bar',{a=>1, b=>2})},
	      <<'EORef', "stdout has expected hashdump");
$bar = {
  'a' => 1,
  'b' => 2
};
EORef

    stdout_is(sub{write2it(1, 2, 'bar',{a=>1, b=>2})},
	      <<'EORef', "stdout has expected hashdump");
$bar = {
         'a' => 1,
         'b' => 2
       };
EORef

    stderr_is(sub{write2it(2, 1, 'baz',[qw(foo bar bum)])},
	      <<'EORef', "stderr has expected arraydump");
$baz = [
  'foo',
  'bar',
  'bum'
];
EORef

    stderr_is(sub{write2it(2, 2, 'baz',[qw(foo bar bum)])},
	      <<'EORef', "stderr has expected arraydump");
$baz = [
         'foo',
         'bar',
         'bum'
       ];
EORef
}


SKIP: {
    skip "- open(my \$fh) not in 5.00503", 3 unless $] >= 5.006;
    pass "testing autoprint to open filehandle (ie GLOB)";

    open (my $fh, ">out.autoprint") or die "cant open out.autoprint: $!";
    $ddez->Set(autoprint => $fh);
    $ddez->(foo => 'to file');
    close $fh;

    # diag ("Note: expecting \$! warning: print() on closed filehandle \$fh");
    local $SIG{__WARN__} = sub {}; # silence the warning

    eval { $ddez->(foo => 'to file') };
    like ($!, qr/Bad file (number|descriptor)/,
	  "got expected err writing to closed file: $!");

    ok (content_matches("out.autoprint", qr/^\$foo = 'to file';$/),
	"out.autoprint has expected content");
}

SKIP: {
    eval "use IO::String";
    skip "these tests need IO::String", 2 if $@;
    pass "testing autoprint => IO using IO::string";

    my $io = IO::String->new(my $var);
    $ddez->Set(autoprint => $io);
    $ddez->(foo => 'bar to iostring obj');
    is ($var, "\$foo = 'bar to iostring obj';\n",
	"autoprint to IO::string storage");
}

SKIP: {
    skip "these tests need 5.8.0", 2 if $] < 5.008;
    pass "testing autoprint => IO using 5.8 open (H, '>', \\\$scalar)";
    my ($var,$io);
    # w/o eval, this breaks compile under 5.5.3 
    eval "open (\$io, '>', \\\$var)";
    warn $@ if $@;

    $ddez->Set(autoprint => $io);
    $ddez->(foo => 'bar to opened scalar-ref');
    is ($var, "\$foo = 'bar to opened scalar-ref';\n",
	"autoprint to opened scalar ref");
}

SKIP: {
    eval "use Test::Warn";
    skip("these tests need Test::Warn", 5) if $@;

    pass("testing autoprint invocation w.o setup");

    my $ddez = Data::Dumper::EasyOO->new(indent=>1);
    # warning_like is more relaxed vs carp vs warn
    warning_like ( sub { $ddez->(foo=>'bar') },
		   qr/called in void context, without autoprint defined/,
		   "expected warning b4 setup");

    open (my $fh, ">out.autoprint") or die "cant open out.autoprint: $!";
    $ddez->Set(autoprint => $fh);
    $ddez->(ok => 'yeah');
    $ddez->(foo => 'to file');

    close $fh;

    ok (content_matches("out.autoprint",
			qr/^\$ok = 'yeah';\n\$foo = 'to file';$/),
	"out.autoprint has expected content");

    $ddez->Set(autoprint => undef);
    warning_like ( sub { $ddez->(foo=>'bar') },
		   qr/called in void context, without autoprint defined/,
		   "expected warning after autoprint reset to undef");

    {	# test package, which cannot print
	package Foo;
	sub new { bless {}, shift}
    }
    
    $ddez->Set(autoprint => new Foo);
    local $SIG{__WARN__} = sub {}; # silence the warning to the terminal
    $ddez->(\%INC);
    warning_like ( sub { $ddez->(foo=>'bar') },
		   qr/illegal autoprint value: Foo=HASH/,
		   "expected warning when autoprinting to un-capable object");
}



unless ($ENV{TEST_VERBOSE}) {
    cleanup();
} else {
    diag "to see output files (normally deleted), set TEST_VERBOSE b4 test";
}

sub cleanup {
    unlink "auto.stderr2","auto.stdout2";
    unlink "auto.stderr1","auto.stdout1";
    unlink "auto.stderr","auto.stdout";
    unlink "out.autoprint";
}

__END__