view release on metacpan or  search on metacpan

inc/Test/Base/Filter.pm  view on Meta::CPAN

sub _split_array {
    map {
        [$self->split($_)];
    } @_;
}

sub _peel_deepest {
    return () unless @_;
    if (ref $_[0] eq 'ARRAY') {
        if (ref $_[0]->[0] eq 'ARRAY') {
            for my $aref (@_) {
                @$aref = $self->_peel_deepest(@$aref);
            }
            return @_;
        }
        return map { $_->[0] } @_;
    }
    return @_;
}

#===============================================================================
# these filters work on the leaves of nested arrays
#===============================================================================
sub Join { $self->_peel_deepest($self->_apply_deepest(join => @_)) }
sub Reverse { $self->_apply_deepest(reverse => @_) }
sub Split { $self->_apply_deepest(_split_array => @_) }
sub Sort { $self->_apply_deepest(sort => @_) }


sub append {
    my $suffix = $self->current_arguments;
    map { $_ . $suffix } @_;
}

sub array {
    return [@_];
}

sub base64_decode {
    $self->assert_scalar(@_);
    require MIME::Base64;
    MIME::Base64::decode_base64(shift);
}

sub base64_encode {
    $self->assert_scalar(@_);
    require MIME::Base64;
    MIME::Base64::encode_base64(shift);
}

sub chomp {
    map { CORE::chomp; $_ } @_;
}

sub chop {
    map { CORE::chop; $_ } @_;
}

sub dumper {
    no warnings 'once';
    require Data::Dumper;
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Indent = 1;
    local $Data::Dumper::Terse = 1;
    Data::Dumper::Dumper(@_);
}

sub escape {
    $self->assert_scalar(@_);
    my $text = shift;
    $text =~ s/(\\.)/eval "qq{$1}"/ge;
    return $text;
}

sub eval {
    $self->assert_scalar(@_);
    my @return = CORE::eval(shift);
    return $@ if $@;
    return @return;
}

sub eval_all {
    $self->assert_scalar(@_);
    my $out = '';
    my $err = '';
    Test::Base::tie_output(*STDOUT, $out);
    Test::Base::tie_output(*STDERR, $err);
    my $return = CORE::eval(shift);
    no warnings;
    untie *STDOUT;
    untie *STDERR;
    return $return, $@, $out, $err;
}

sub eval_stderr {
    $self->assert_scalar(@_);
    my $output = '';
    Test::Base::tie_output(*STDERR, $output);
    CORE::eval(shift);
    no warnings;
    untie *STDERR;
    return $output;
}

sub eval_stdout {
    $self->assert_scalar(@_);
    my $output = '';
    Test::Base::tie_output(*STDOUT, $output);
    CORE::eval(shift);
    no warnings;
    untie *STDOUT;
    return $output;
}

sub exec_perl_stdout {
    my $tmpfile = "/tmp/test-blocks-$$";
    $self->_write_to($tmpfile, @_);
    open my $execution, "$^X $tmpfile 2>&1 |"
      or die "Couldn't open subprocess: $!\n";
    local $/;
    my $output = <$execution>;
    close $execution;
    unlink($tmpfile)
      or die "Couldn't unlink $tmpfile: $!\n";
    return $output;