view release on metacpan or  search on metacpan

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

#line 1
#. TODO:
#.

#===============================================================================
# This is the default class for handling Test::Base data filtering.
#===============================================================================
package Test::Base::Filter;
use Spiffy -Base;
use Spiffy ':XXX';

field 'current_block';

our $arguments;
sub current_arguments {
    return undef unless defined $arguments;
    my $args = $arguments;
    $args =~ s/(\\s)/ /g;
    $args =~ s/(\\[a-z])/'"' . $1 . '"'/gee;
    return $args;
}

sub assert_scalar {
    return if @_ == 1;
    require Carp;
    my $filter = (caller(1))[3];
    $filter =~ s/.*:://;
    Carp::croak "Input to the '$filter' filter must be a scalar, not a list";
}

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

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