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_US/;
use t::Common qw /run_new_tests cross gimme sample pdd/;

use warnings;


my $basic   = $RE {zip} {US};
my $ext_yes = $RE {zip} {US} {-extended => 'yes'};
my $ext_no  = $RE {zip} {US} {-extended => 'no'};
my $prf_yes = $RE {zip} {US} {-prefix   => 'yes'};
my $prf_no  = $RE {zip} {US} {-prefix   => 'no'};
my $sep_sp  = $basic -> {-sep => " "};
my $sep_dsh = $basic -> {-sep => "--"};
my $sep_rg  = $basic -> {-sep => "[- ]"};
my $iso     = $RE {zip} {US} {-country  => 'iso'};
my $cept    = $RE {zip} {US} {-country  => 'cept'};
my $usa     = $RE {zip} {US} {-country  => 'usa'};
my $iso_py  = $iso  -> {-prefix => 'yes'};
my $iso_pn  = $iso  -> {-prefix => 'no'};
my $cept_py = $cept -> {-prefix => 'yes'};
my $cept_pn = $cept -> {-prefix => 'no'};
my $all     = $RE {zip} {US} {-country  => 'iso'} {-prefix => 'yes'}
                             {-extended => 'yes'} {-sep    => '[- ]'};

my @zips    = ("00000", gimme 10, sub {pdd 5});
my @ext     = ("0000",  gimme  5, sub {pdd 4});
my @zip_ext = (["00000", "0000"],
               cross (["00000"], [gimme 2 => sub {pdd 4}]),
               cross ([gimme 2 => sub {pdd 5}], ["0000"]),
               sample 10 => cross [gimme 5 => sub {pdd 5}],
                                  [gimme 5 => sub {pdd 4}]);
my @bad_zip = ("0000", "000000",
                gimme (10 => sub {pdd 2, 4}),   # Too short.
                gimme (10 => sub {pdd 6, 8}));  # Too long.
my @bad_ext = ("000", "0000",
                gimme (10 => sub {pdd 1, 3}),   # Too short.
                gimme (10 => sub {pdd 5, 8}));  # Too long.

my @baddies   =  @bad_zip;    # Basic bad zips.
push @baddies => map {join "-" => @_} 
                 sample 10 => cross \@zips, \@bad_ext; # Bad extensions.
push @baddies => map {join ["\n", qw {_ ! & ---}] -> [rand 5] => @_}
                 sample 10 => cross \@zips, \@ext;     # Bad separator.
push @baddies => map {"USS-$_"} @zips;                 # Bad countries.

my (@tests, %targets);

$targets {simple} = {
    list      =>  \@zips,
    wanted    =>  sub {$_, undef, join ("-" => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       undef, undef,
                       undef, undef,},
};

$targets {simple_USA} = {
    list      =>  [@zips [0 .. 4]],
    query     =>  sub {join "-" => "USA", $_ [0]},
    wanted    =>  sub {$_, "USA", join ("-" => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       undef, undef,
                       undef, undef,},
};

$targets {simple_US} = {
    list      =>  [@zips [0 .. 4]],
    query     =>  sub {join "-" => "US", $_ [0]},
    wanted    =>  sub {$_, "US", join ("-" => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       undef, undef,
                       undef, undef,},
};

$targets {simple_usa} = {
    list      =>  [@zips [0 .. 4]],
    query     =>  sub {join "-" => "usa", $_ [0]},
    wanted    =>  sub {$_, "usa", join ("-" => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       undef, undef,
                       undef, undef,},
};

$targets {extended} = {
    list      =>  \@zip_ext,
    query     =>  sub {join "-" => @_},
    wanted    =>  sub {$_, undef, join ("-" => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       "-", $_ [1],
                       substr ($_ [1], 0, 2), substr ($_ [1], 2, 2)},
};

$targets {extended_USA} = {
    list      =>  \@zip_ext,
    query     =>  sub {join "-" => "USA", @_},
    wanted    =>  sub {$_, "USA", join ("-" => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       "-", $_ [1],
                       substr ($_ [1], 0, 2), substr ($_ [1], 2, 2)},
};

$targets {extended_US} = {
    list      =>  \@zip_ext,
    query     =>  sub {join "-" => "US", @_},
    wanted    =>  sub {$_, "US", join ("-" => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       "-", $_ [1],
                       substr ($_ [1], 0, 2), substr ($_ [1], 2, 2)},
};

$targets {extended_US_sp} = {
    list      =>  \@zip_ext,
    query     =>  sub {"US-" . $_ [0] . " " . $_ [1]},
    wanted    =>  sub {$_, "US", join (" " => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       " ", $_ [1],
                       substr ($_ [1], 0, 2), substr ($_ [1], 2, 2)},
};

$targets {sep_sp} = {
    list      =>  \@zip_ext,
    query     =>  sub {join " " => @_},
    wanted    =>  sub {$_, undef, join (" " => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       " ", $_ [1],
                       substr ($_ [1], 0, 2), substr ($_ [1], 2, 2)},
};

$targets {sep_dashes} = {
    list      =>  \@zip_ext,
    query     =>  sub {join "--" => @_},
    wanted    =>  sub {$_, undef, join ("--" => @_), $_ [0],
                       substr ($_ [0], 0, 3), substr ($_ [0], 3, 2),
                       "--", $_ [1],
                       substr ($_ [1], 0, 2), substr ($_ [1], 2, 2)},
};

$targets {bad_zip} = {
    list      =>  \@baddies,
};


push @tests   => {
    name      =>  'basic',
    regex     =>  $basic,
    sub       =>  \&RE_zip_US,
    pass      =>  [qw /simple simple_USA simple_US extended extended_USA
                       extended_US/],
    fail      =>  [qw /bad_zip sep_sp sep_dashes simple_usa extended_US_sp/],
};

push @tests   => {
    name      =>  'usa',
    regex     =>  $usa,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-country => 'usa'],
    pass      =>  [qw /simple simple_usa extended/],
    fail      =>  [qw /bad_zip sep_sp sep_dashes simple_USA extended_USA
                       simple_US extended_US extended_US_sp/],
};

push @tests   => {
    name      =>  'iso',
    regex     =>  $iso,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-country => 'iso'],
    pass      =>  [qw /simple simple_US extended extended_US/],
    fail      =>  [qw /bad_zip sep_sp sep_dashes simple_USA extended_USA
                       simple_usa extended_US_sp/],
};

push @tests   => {
    name      =>  'iso_py',
    regex     =>  $iso_py,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-country => 'iso', -prefix => 'yes'],
    pass      =>  [qw /simple_US extended_US/],
    fail      =>  [qw /bad_zip sep_sp sep_dashes simple_USA extended_USA
                       extended_US_sp simple extended simple_usa/],
};

push @tests   => {
    name      =>  'iso_pn',
    regex     =>  $iso_pn,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-country => 'iso', -prefix => 'no'],
    pass      =>  [qw /simple extended/],
    fail      =>  [qw /bad_zip sep_sp sep_dashes simple_USA extended_USA
                       extended_US extended_US_sp simple_US simple_usa/],
};

push @tests   => {
    name      =>  'cept_py',
    regex     =>  $cept_py,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-country => 'cept', -prefix => 'yes'],
    pass      =>  [qw /simple_USA extended_USA/],
    fail      =>  [qw /bad_zip sep_sp sep_dashes simple_US simple extended
                       extended_US extended_US_sp simple_usa/],
};

push @tests   => {
    name      =>  'cept_pn',
    regex     =>  $cept_pn,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-country => 'cept', -prefix => 'no'],
    pass      =>  [qw /simple extended/],
    fail      =>  [qw /bad_zip sep_sp sep_dashes simple_USA extended_USA
                       extended_US extended_US_sp simple_US simple_usa/],
};

push @tests   => {
    name      =>  'cept',
    regex     =>  $cept,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-country => 'cept'],
    pass      =>  [qw /simple simple_USA extended extended_USA/],
    fail      =>  [qw /bad_zip sep_sp sep_dashes simple_US simple_usa
                       extended_US extended_US_sp/],
};

push @tests   => {
    name      =>  'ext_yes',
    regex     =>  $ext_yes,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-extended => 'yes'],
    pass      =>  [qw /extended extended_USA extended_US/],
    fail      =>  [qw /simple simple_USA simple_US bad_zip sep_sp sep_dashes
                       simple_usa extended_USA_sp/],
};

push @tests   => {
    name      =>  'ext_no',
    regex     =>  $ext_no,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-extended => 'no'],
    pass      =>  [qw /simple simple_USA simple_US/],
    fail      =>  [qw /extended extended_USA bad_zip sep_sp sep_dashes
                       simple_usa extended_US_sp extended_US/],
};

push @tests   => {
    name      =>  'prf_yes',
    regex     =>  $prf_yes,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-prefix => 'yes'],
    pass      =>  [qw /simple_USA simple_US extended_USA extended_US/],
    fail      =>  [qw /simple extended bad_zip sep_sp sep_dashes simple_usa
                       extended_US_sp/],
};

push @tests   => {
    name      =>  'prf_no',
    regex     =>  $prf_no,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-prefix => 'no'],
    pass      =>  [qw /simple extended/],
    fail      =>  [qw /simple_USA simple_US extended_USA bad_zip sep_sp
                       extended_US extended_US_sp sep_dashes simple_usa/],
};

push @tests   => {
    name      =>  'sep space',
    regex     =>  $sep_sp,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-sep => ' '],
    pass      =>  [qw /simple simple_USA simple_US sep_sp extended_US_sp/],
    fail      =>  [qw /bad_zip sep_dashes extended extended_USA extended_US
                       simple_usa/],
};

push @tests   => {
    name      =>  'sep dashes',
    regex     =>  $sep_dsh,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-sep => '--'],
    pass      =>  [qw /simple simple_USA simple_US sep_dashes/],
    fail      =>  [qw /bad_zip sep_sp extended extended_USA simple_usa 
                       extended_US extended_US_sp/],
};

push @tests   => {
    name      =>  'sep regex',
    regex     =>  $sep_rg,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-sep => '[- ]'],
    pass      =>  [qw /simple simple_USA simple_US sep_sp
                       extended extended_USA extended_US extended_US_sp/],
    fail      =>  [qw /bad_zip sep_dashes simple_usa/],
};

push @tests   => {
    name      =>  'all',
    regex     =>  $all,
    sub       =>  \&RE_zip_US,
    sub_args  =>  [-country  => 'iso', -prefix => 'yes', 
                   -extended => 'yes', -sep    => '[- ]'],
    pass      =>  [qw /extended_US extended_US_sp/],
    fail      =>  [qw /simple simple_USA simple_US bad_zip sep_sp sep_dashes
                       simple_usa extended extended_USA/],
};


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


__END__