From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

#!/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/;
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__