view release on metacpan or  search on metacpan

t/01-translate.t  view on Meta::CPAN

#!/usr/bin/perl -w

use strict;
use warnings;
use Test::More tests => 37;
use Carp qw(verbose);
use File::Temp;
use File::Basename;
my $PATH;
BEGIN { $PATH = &{ sub { dirname ( (caller)[1] ) } }; }
use lib $PATH;

my $WARNINGS;
sub catchwarn {
    my ($expected_warning, $how_many) = @_;
    if (not defined $expected_warning) {
        $expected_warning = qr/.*/;
    }
    if (not defined $how_many) {
        $how_many = 1;
    }
    my $n = 0;
    $WARNINGS = 0;
    if ($how_many == 0) {
        $SIG{__WARN__} = 'DEFAULT';
        return
    }
    $SIG{__WARN__} = sub {
        my ($warning) = @_;
        if ($warning =~ $expected_warning) {
            if (++$n >= $how_many) {
                $SIG{__WARN__} = 'DEFAULT';
            }
            $WARNINGS++;
        }
        else {
            print STDERR $warning;
        }
    };
}

# This is copied from List/MoreUtils.pm
sub zip {
    my $max = -1;
    $max < $#$_  &&  ($max = $#$_)  for @_;

    map { my $ix = $_; map $_->[$ix], @_; } 0..$max;
}

{
    package Basic;
    use base qw(Data::FeatureFactory);
    our @features = (
        { name => 'first_letter', 'values' => ['V' .. 'Z'], postproc => sub { return '_'.$_[0].'_' } },
        { name => 'second_letter', 'values' => ['m' .. 'q'], format => 'normal' },
        { name => 'num_letters', type => 'integer', range => '1 .. 5' },
        { name => 'bin_letters', type => 'integer', range => '1 .. 5', format => 'binary', code => \&num_letters },
        { name => 'upcase', type => 'boolean' },
        { name => 'id', label => 'skipped' },
    );
    sub first_letter {
        return uc substr $_[0], 0, 1
    }
    sub second_letter {
        return lc substr $_[0], 1, 1
    }
    sub num_letters {
        my $l = length $_[0];
        return $l <= 5 ? $l : undef
    }