view release on metacpan or  search on metacpan

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

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;
}

sub flatten {
    $self->assert_scalar(@_);
    my $ref = shift;
    if (ref($ref) eq 'HASH') {
        return map {
            ($_, $ref->{$_});
        } sort keys %$ref;
    }
    if (ref($ref) eq 'ARRAY') {
        return @$ref;
    }
    die "Can only flatten a hash or array ref";
}

sub get_url {
    $self->assert_scalar(@_);
    my $url = shift;
    CORE::chomp($url);
    require LWP::Simple;
    LWP::Simple::get($url);
}

sub hash {
    return +{ @_ };
}

sub head {
    my $size = $self->current_arguments || 1;
    return splice(@_, 0, $size);
}

sub join {
    my $string = $self->current_arguments;
    $string = '' unless defined $string;
    CORE::join $string, @_;
}

sub lines {
    $self->assert_scalar(@_);
    my $text = shift;
    return () unless length $text;
    my @lines = ($text =~ /^(.*\n?)/gm);
    return @lines;
}

sub norm {
    $self->assert_scalar(@_);
    my $text = shift;
    $text = '' unless defined $text;
    $text =~ s/\015\012/\n/g;
    $text =~ s/\r/\n/g;
    return $text;