view release on metacpan or  search on metacpan

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

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

sub prepend {
    my $prefix = $self->current_arguments;
    map { $prefix . $_ } @_;
}

sub read_file {
    $self->assert_scalar(@_);
    my $file = shift;
    CORE::chomp $file;
    open my $fh, $file
      or die "Can't open '$file' for input:\n$!";
    CORE::join '', <$fh>;
}

sub regexp {
    $self->assert_scalar(@_);
    my $text = shift;
    my $flags = $self->current_arguments;
    if ($text =~ /\n.*?\n/s) {
        $flags = 'xism'
          unless defined $flags;
    }
    else {
        CORE::chomp($text);
    }
    $flags ||= '';
    my $regexp = eval "qr{$text}$flags";
    die $@ if $@;
    return $regexp;
}

sub reverse {
    CORE::reverse(@_);
}

sub slice {
    die "Invalid args for slice"
      unless $self->current_arguments =~ /^(\d+)(?:,(\d))?$/;
    my ($x, $y) = ($1, $2);
    $y = $x if not defined $y;
    die "Invalid args for slice"
      if $x > $y;
    return splice(@_, $x, 1 + $y - $x);
}

sub sort {
    CORE::sort(@_);