#!/usr/bin/perl

use strict;
use lib qw {blib/lib}, ".";

use Regex::Common;
use t::Common;

$^W    = 1;
$DEBUG = 1;

sub create_parts;

my $prospero = $RE{URI}{prospero};

# No point in crosschecking, URI creation is tag independent.
my @tests =
  ( [ prospero => $prospero => { prospero => NORMAL_PASS | FAIL } ], );

my ( $good, $bad ) = create_parts;

run_tests
  version => "Regex::Common::URI::prospero",
  tests   => \@tests,
  good    => $good,
  bad     => $bad,
  query   => \&prospero,
  wanted  => \&wanted,
  filter  => \&filter,
  ;

sub prospero {
    my ( $tag, $host, $port, $ppath, $fieldnames, $fieldvalues ) =
      ( $_[0], @{ $_[1] } );

    my $prospero = "prospero://";
    $prospero .= $host     if defined $host;
    $prospero .= ":$port"  if defined $port;
    $prospero .= "/$ppath" if defined $ppath;
    if ( defined $fieldnames ) {
        foreach my $i ( 0 .. $#$fieldnames ) {
            $prospero .= ";$fieldnames->[$i]";
            $prospero .= "=$fieldvalues->[$i]" if defined $fieldvalues->[$i];
        }
    }

    $prospero;
}

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

    my @wanted;
    $wanted[0] = $_;
    $wanted[1] = "prospero";
    $wanted[2] = $$parts[0];    # host.
    $wanted[3] = $$parts[1];    # port.
    $wanted[4] = $$parts[2];    # ppart.
    $wanted[5] = "";
    if ( defined $$parts[3] ) {
        foreach my $i ( 0 .. $#{ $$parts[3] } ) {
            $wanted[5] .= ";${$$parts [3]}[$i]=${$$parts [4]}[$i]";
        }
    }

    \@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, 1525 ];
    $bad[1]  = [ "",    qw /: port/ ];

    # Ppart
    $good[2] = [ "",    qw {part foo/bar fnord:&=?%FF} ];
    $bad[2]  = [ undef, qw {~}, ' ' ];

    # Fieldname
    $good[3] = [
        undef,              [qw /name/],
        [qw /name1 name2/], [""],
        [ "", "" ],         [ "", qw /name/ ],
        [qw /fnord:&?%FF/]
    ];
    $bad[3] = [ [qw /name==/], ['~'] ];

    # Fieldvalue
    $good[4] = [
        undef,                [qw /value/],
        [qw /value1 value2/], [""],
        [ "", "" ],           [ "", qw /value/ ],
        [qw /fnord:&?%FF/]
    ];
    $bad[4] = [ [qw /value==/], ['~'], [undef], [ undef, undef ] ];

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

sub filter {
    return 1 if !defined ${ $_[0] }[3] && !defined ${ $_[0] }[4];
    return 0
      if defined ${ $_[0] }[3]  && !defined ${ $_[0] }[4]
      || !defined ${ $_[0] }[3] && defined ${ $_[0] }[4];
    return 0 if @{ ${ $_[0] }[3] } != @{ ${ $_[0] }[4] };

    return 1;
}

__END__
