The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use lib  qw {blib/lib};

use Regexp::Common qw /RE_zip_Norway/;
use t::Common qw /run_new_tests cross pdd dd a/;

use warnings;


my $norway      = $RE {zip} {Norway};
my $yes_prefix  = $RE {zip} {Norway} {-prefix  => 'yes'};
my $no_prefix   = $RE {zip} {Norway} {-prefix  => 'no'};
my $iso_prefix  = $RE {zip} {Norway} {-country => 'iso'};
my $cept_prefix = $RE {zip} {Norway} {-country => 'cept'};
my $own_prefix  = $RE {zip} {Norway} {-country => 'no'};

use constant       PASS => 10;
use constant       FAIL => 10;

my $valid   = [ '0000',  '9999', map {pdd 4}      1 .. -2 + PASS];
my $short   = [    '0',   '999', map {dd 1 =>  3} 1 .. -2 + FAIL];
my $long    = ['00000', '99999', map {dd 5 => 10} 1 .. -2 + FAIL];
my $letter  = [map {my $z = dd 4; substr $z, rand (4), 1, a; $z} 1 .. FAIL];
my $wrong   = [@$long, @$short, @$letter];

my %targets = (
    no_prefix    => {
        list     => $valid,
        wanted   => sub {$_, undef, $_ [0]},
    },
    iso_prefix   => {
        list     => $valid,
        query    => sub {"NO-" . $_ [0]},
        wanted   => sub {$_, "NO", $_ [0]},
    },
    cept_prefix  => {
        list     => $valid,
        query    => sub {"N-" . $_ [0]},
        wanted   => sub {$_, "N", $_ [0]},
    },
    own_prefix   => {
        list     => $valid,
        query    => sub {"no-" . $_ [0]},
        wanted   => sub {$_, "no", $_ [0]},
    },
    wrong1       => {
        list     => $wrong,
    },
    wrong2       => {
        list     => $wrong,
        query    => sub {"NO-" . $_ [0]},
    },
    wrong3       => {
        list     => $wrong,
        query    => sub {"N-" . $_ [0]},
    },
    wrong4       => {
        list     => $valid,
        query    => sub {"NO " . $_ [0]},
    },
);

my @wrongs = qw /wrong1 wrong2 wrong3 wrong4/;

my @tests = (
    {    name     =>  'basic',
         regex    =>  $norway,
         sub      =>  \&RE_zip_Norway,
         pass     =>  [qw /no_prefix iso_prefix cept_prefix/],
         fail     =>  [qw /own_prefix/, @wrongs],
    },
    {    name     =>  'yes_prefix',
         regex    =>  $yes_prefix,
         sub      =>  \&RE_zip_Norway,
         sub_args =>  [-prefix  => 'yes'],
         pass     =>  [qw /iso_prefix cept_prefix/],
         fail     =>  [qw /no_prefix own_prefix/, @wrongs],
    },
    {    name     =>  'no_prefix',
         regex    =>  $no_prefix,
         sub      =>  \&RE_zip_Norway,
         sub_args =>  [-prefix  => 'no'],
         pass     =>  [qw /no_prefix/],
         fail     =>  [qw /iso_prefix cept_prefix own_prefix/, @wrongs],
    },
    {    name     =>  'iso_prefix',
         regex    =>  $iso_prefix,
         sub      =>  \&RE_zip_Norway,
         sub_args =>  [-country  => 'iso'],
         pass     =>  [qw /no_prefix iso_prefix/],
         fail     =>  [qw /cept_prefix own_prefix/, @wrongs],
    },
    {    name     =>  'cept_prefix',
         regex    =>  $cept_prefix,
         sub      =>  \&RE_zip_Norway,
         sub_args =>  [-country  => 'cept'],
         pass     =>  [qw /no_prefix cept_prefix/],
         fail     =>  [qw /iso_prefix own_prefix/, @wrongs],
    },
    {    name     =>  'own_prefix',
         regex    =>  $own_prefix,
         sub      =>  \&RE_zip_Norway,
         sub_args =>  [-country  => 'no'],
         pass     =>  [qw /no_prefix own_prefix/],
         fail     =>  [qw /iso_prefix cept_prefix/, @wrongs],
    },
);

run_new_tests tests        => \@tests,
              targets      => \%targets,
              version_from => 'Regexp::Common::zip',
;

__END__