package Cases;

use strict;

use warnings;

use Test::More;

use Capture::Tiny ':all';

require Exporter;

our @ISA = 'Exporter';

our @EXPORT_OK = qw(

  run_test

);

my $locale_ok = eval {

    my $err = capture_stderr { system($^X, '-we', 1) };

    $err !~ /setting locale failed/i;

};

my $have_diff = eval {

  require Test::Differences;

  Test::Differences->import;

  $Test::Differences::VERSION < 0.60; # 0.60+ is causing strange failures

};

sub _is_or_diff {

  my ($g,$e,$l) = @_;

  if ( $have_diff ) { eq_or_diff( $g, $e, $l ); }

  else { is( $g, $e, $l ); }

}

sub _binmode {

  my $text = shift;

  return $text eq 'unicode' ? 'binmode(STDOUT,q{:utf8}); binmode(STDERR,q{:utf8});' : '';

}

sub _set_utf8 {

  my $t = shift;

  return unless $t eq 'unicode';

  my %seen;

  my @orig_layers = (

    [ grep {$_ ne 'unix' and $_ ne 'perlio' and $seen{stdout}{$_}++} PerlIO::get_layers(\*STDOUT) ],

    [ grep {$_ ne 'unix' and $_ ne 'perlio' and $seen{stderr}{$_}++} PerlIO::get_layers(\*STDERR) ],

  );

  binmode(STDOUT, ":utf8") if fileno(STDOUT);

  binmode(STDERR, ":utf8") if fileno(STDERR);

  return @orig_layers;

}

sub _restore_layers {

  my ($t, @orig_layers) = @_;

  return unless $t eq 'unicode';

  binmode(STDOUT, join( ":", "", "raw", @{$orig_layers[0]})) if fileno(STDOUT);

  binmode(STDERR, join( ":", "", "raw", @{$orig_layers[1]})) if fileno(STDERR);

}

#--------------------------------------------------------------------------#

my %texts = (

  short => 'Hello World',

  multiline => 'First line\nSecond line\n',

  ( $] lt "5.008" ? () : ( unicode => 'Hi! \x{263a}\n') ),

);

#--------------------------------------------------------------------------#

#  fcn($perl_code_string) => execute the perl in current process or subprocess

#--------------------------------------------------------------------------#

my %methods = (

  perl    => sub { eval $_[0] },

  sys  => sub { system($^X, '-e', $_[0]) },

);

#--------------------------------------------------------------------------#

my %channels = (

  stdout  => {

    output => sub { _binmode($_[0]) . "print STDOUT qq{STDOUT:$texts{$_[0]}}" },

    expect => sub { eval "qq{STDOUT:$texts{$_[0]}}", "" },

  },

  stderr  => {

    output => sub { _binmode($_[0]) . "print STDERR qq{STDERR:$texts{$_[0]}}" },

    expect => sub { "", eval "qq{STDERR:$texts{$_[0]}}" },

  },

  both    => {

    output => sub { _binmode($_[0]) . "print STDOUT qq{STDOUT:$texts{$_[0]}}; print STDERR qq{STDERR:$texts{$_[0]}}" },

    expect => sub { eval "qq{STDOUT:$texts{$_[0]}}", eval "qq{STDERR:$texts{$_[0]}}" },

  },

  empty   => {

    output => sub { _binmode($_[0]) . "print STDOUT qq{}; print STDERR qq{}" },

    expect => sub { "", "" },

  },

  nooutput=> {

    output => sub { _binmode($_[0]) },

    expect => sub { "", "" },

  },

);

#--------------------------------------------------------------------------#

my %tests = (

  capture => {

    cnt   => 2,

    test  => sub {

      my ($m, $c, $t, $l) = @_;

      my ($got_out, $got_err) = capture {

        $methods{$m}->( $channels{$c}{output}->($t) );

      };

      my @expected = $channels{$c}{expect}->($t);

      _is_or_diff( $got_out, $expected[0], "$l|$m|$c|$t - got STDOUT" );

      _is_or_diff( $got_err, $expected[1], "$l|$m|$c|$t - got STDERR" );

    },

  },

  capture_scalar => {

    cnt   => 1,

    test  => sub {

      my ($m, $c, $t, $l) = @_;

      my $got_out = capture {

        $methods{$m}->( $channels{$c}{output}->($t) );

      };

      my @expected = $channels{$c}{expect}->($t);

      _is_or_diff( $got_out, $expected[0], "$l|$m|$c|$t - got STDOUT" );

    },

  },

  capture_stdout => {

    cnt   => 3,

    test  => sub {

      my ($m, $c, $t, $l) = @_;

      my ($inner_out, $inner_err);

      my ($outer_out, $outer_err) = capture {

        $inner_out = capture_stdout {

          $methods{$m}->( $channels{$c}{output}->($t) );

        };

      };

      my @expected = $channels{$c}{expect}->($t);

      _is_or_diff( $inner_out, $expected[0], "$l|$m|$c|$t - inner STDOUT" );

      _is_or_diff( $outer_out, "",           "$l|$m|$c|$t - outer STDOUT" );

      _is_or_diff( $outer_err, $expected[1], "$l|$m|$c|$t - outer STDERR" );

    },

  },

  capture_stderr => {

    cnt   => 3,

    test  => sub {

      my ($m, $c, $t, $l) = @_;

      my ($inner_out, $inner_err);

      my ($outer_out, $outer_err) = capture {

        $inner_err = capture_stderr {

          $methods{$m}->( $channels{$c}{output}->($t) );

        };

      };

      my @expected = $channels{$c}{expect}->($t);

      _is_or_diff( $inner_err, $expected[1], "$l|$m|$c|$t - inner STDERR" );

      _is_or_diff( $outer_out, $expected[0], "$l|$m|$c|$t - outer STDOUT" );

      _is_or_diff( $outer_err, "",           "$l|$m|$c|$t - outer STDERR" );

    },

  },

  capture_merged => {

    cnt   => 2,

    test  => sub {

      my ($m, $c, $t, $l) = @_;

      my $got_out = capture_merged {

        $methods{$m}->( $channels{$c}{output}->($t) );

      };

      my @expected = $channels{$c}{expect}->($t);

      like( $got_out, qr/\Q$expected[0]\E/, "$l|$m|$c|$t - got STDOUT" );

      like( $got_out, qr/\Q$expected[1]\E/, "$l|$m|$c|$t - got STDERR" );

    },

  },

  tee => {

    cnt => 4,

    test => sub {

      my ($m, $c, $t, $l) = @_;

      my ($got_out, $got_err);

      my ($tee_out, $tee_err) = capture {

        ($got_out, $got_err) = tee {

          $methods{$m}->( $channels{$c}{output}->($t) );

        };

      };

      my @expected = $channels{$c}{expect}->($t);

      _is_or_diff( $got_out, $expected[0], "$l|$m|$c|$t - got STDOUT" );

      _is_or_diff( $tee_out, $expected[0], "$l|$m|$c|$t - tee STDOUT" );

      _is_or_diff( $got_err, $expected[1], "$l|$m|$c|$t - got STDERR" );

      _is_or_diff( $tee_err, $expected[1], "$l|$m|$c|$t - tee STDERR" );

    }

  },

  tee_scalar => {

    cnt => 3,

    test => sub {

      my ($m, $c, $t, $l) = @_;

      my ($got_out, $got_err);

      my ($tee_out, $tee_err) = capture {

        $got_out = tee {

          $methods{$m}->( $channels{$c}{output}->($t) );

        };

      };

      my @expected = $channels{$c}{expect}->($t);

      _is_or_diff( $got_out, $expected[0], "$l|$m|$c|$t - got STDOUT" );

      _is_or_diff( $tee_out, $expected[0], "$l|$m|$c|$t - tee STDOUT" );

      _is_or_diff( $tee_err, $expected[1], "$l|$m|$c|$t - tee STDERR" );

    }

  },

  tee_stdout => {

    cnt => 3,

    test => sub {

      my ($m, $c, $t, $l) = @_;

      my ($inner_out, $inner_err);

      my ($tee_out, $tee_err) = capture {

        $inner_out = tee_stdout {

          $methods{$m}->( $channels{$c}{output}->($t) );

        };

      };

      my @expected = $channels{$c}{expect}->($t);

      _is_or_diff( $inner_out, $expected[0], "$l|$m|$c|$t - inner STDOUT" );

      _is_or_diff( $tee_out, $expected[0], "$l|$m|$c|$t - teed STDOUT" );

      _is_or_diff( $tee_err, $expected[1], "$l|$m|$c|$t - unmodified STDERR" );

    }

  },

  tee_stderr => {

    cnt => 3,

    test => sub {

      my ($m, $c, $t, $l) = @_;

      my ($inner_out, $inner_err);

      my ($tee_out, $tee_err) = capture {

        $inner_err = tee_stderr {

          $methods{$m}->( $channels{$c}{output}->($t) );

        };

      };

      my @expected = $channels{$c}{expect}->($t);

      _is_or_diff( $inner_err, $expected[1], "$l|$m|$c|$t - inner STDOUT" );

      _is_or_diff( $tee_out, $expected[0], "$l|$m|$c|$t - unmodified STDOUT" );

      _is_or_diff( $tee_err, $expected[1], "$l|$m|$c|$t - teed STDERR" );

    }

  },

  tee_merged => {

    cnt => 5,

    test => sub {

      my ($m, $c, $t, $l) = @_;

      my ($got_out, $got_err);

      my ($tee_out, $tee_err) = capture {

        $got_out = tee_merged {

          $methods{$m}->( $channels{$c}{output}->($t) );

        };

      };

      my @expected = $channels{$c}{expect}->($t);

      like( $got_out, qr/\Q$expected[0]\E/, "$l|$m|$c|$t - got STDOUT" );

      like( $got_out, qr/\Q$expected[1]\E/, "$l|$m|$c|$t - got STDERR" );

      like( $tee_out, qr/\Q$expected[0]\E/, "$l|$m|$c|$t - tee STDOUT (STDOUT)" );

      like( $tee_out, qr/\Q$expected[1]\E/, "$l|$m|$c|$t - tee STDOUT (STDERR)" );

      _is_or_diff( $tee_err, '', "$l|$m|$c|$t - tee STDERR" );

    }

  },

);

#--------------------------------------------------------------------------#

# What I want to be able to do:

#

# test_it(

#   input => 'short',

#   channels => 'both',

#   method => 'perl'

# )

sub run_test {

  my $test_type = shift or return;

  my $todo = shift || '';

  my $skip_utf8 = shift || '';

  local $ENV{PERL_CAPTURE_TINY_TIMEOUT} = 0; # don't timeout during testing

  for my $m ( keys %methods ) {

    if ( ($m eq 'sys' || substr($test_type,0,3) eq 'tee' ) && ! $locale_ok ) {

        SKIP: {

            skip "Perl could not initialize locale", 1

        };

        next;

    }

    for my $c ( keys %channels ) {

      for my $t ( keys %texts     ) {

        next if $t eq 'unicode' && $skip_utf8;

        my @orig_layers = _set_utf8($t);

        local $TODO = "not supported on all platforms"

          if $t eq $todo;

        $tests{$test_type}{test}->($m, $c, $t, $test_type);

        _restore_layers($t, @orig_layers);

      }

    }

  }

}

1;