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;
use t::Common;

$^W = 1;


sub create_parts;

my $nntp  = $RE {URI} {NNTP};

my @tests = (
   [nntp  => $nntp  => {nntp  => NORMAL_PASS | FAIL}],
);

my ($good, $bad) = create_parts;

run_tests version   =>   "Regexp::Common::URI::news",
          tests     =>  \@tests,
          good      =>   $good,
          bad       =>   $bad,
          query     =>  \&nntp,
          wanted    =>  \&wanted;

sub nntp {
    my ($tag, $host, $port, $group, $digits) = ($_ [0], @{$_ [1]});

    my $nntp  =  "nntp://";
       $nntp .=   $host    if defined $host;
       $nntp .= ":$port"   if defined $port;
       $nntp .= "/$group"  if defined $group;
       $nntp .= "/$digits" if defined $digits;

    $nntp;
}

sub wanted {
    my ($tag, $parts) = @_;

    my @wanted;
       $wanted [0]  = $_;
       $wanted [1]  = "nntp";
       $wanted [2]  = join "/" => grep {defined}
                            join (":" => grep {defined} @$parts [0, 1]),
                                                        @$parts [2, 3];
       $wanted [3]  = join ":" => grep {defined} @$parts [0, 1];
       $wanted [4]  = $$parts [0];
       $wanted [5]  = $$parts [1];
       $wanted [6]  = $$parts [2];
       $wanted [7]  = $$parts [3];

    \@wanted;
}


sub create_parts {
    my (@good, @bad);

    # Hosts.
    $good [0] = [qw /www.abigail.be www.PERL.com a.b.c.d.e.f.g.h.i.j.k.x
                     127.0.0.1 w--w--w.abigail.be w3.abigail.be/];
    $bad  [0] = [qw /www.example..com w+w.example.com w--.example.com
                     127.0.0.0.1 -w.example.com www.example.1com/];

    # Ports.
    $good [1] = [undef, 119];
    $bad  [2] = ["", qw /-19 : port/];

    # Group.
    $good [2] = [qw /a comp.lang.perl.misc comp.lang.c++ hello_kitty_
                     foo-1234567890/];
    $bad  [2] = [undef, "", qw /1234567890 ** really? (!!make-$$$-fast**)
                                _hello_kitty_/];

    # Digits.
    $good [3] = [undef, qw /0 0000 12345/];
    $bad  [3] = ["", qw /fnurd -19 */, "1234/", "/12", "/"];

    return (\@good, \@bad);
}


__END__