#!/usr/bin/perl

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

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

$^W = 1;

sub create_parts;

my $wais = $RE{URI}{WAIS};

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

my ( $good, $bad ) = create_parts;

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

sub wais {
    my ( $tag, $host, $port, $database, $search, $wtype, $wpath ) =
      ( $_[0], @{ $_[1] } );

    my $wais = "wais://";
    $wais .= $host        if defined $host;
    $wais .= ":$port"     if defined $port;
    $wais .= "/$database" if defined $database;
    $wais .= "?$search"   if defined $search;
    $wais .= "/$wtype"    if defined $wtype;
    $wais .= "/$wpath"    if defined $wpath;

    $wais;
}

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

    my @wanted;
    $wanted[0] = $_;
    $wanted[1] = "wais";
    $wanted[2] = $$parts[0];    # host.
    $wanted[3] = $$parts[1];    # port.
    $wanted[4] = $$parts[2];    # database.
    $wanted[4] .= "?" . $$parts[3] if defined $$parts[3];
    $wanted[4] .= "/" . $$parts[4] if defined $$parts[4];
    $wanted[4] .= "/" . $$parts[5] if defined $$parts[5];
    $wanted[5] = $$parts[2];    # database.
    $wanted[6] = undef;
    $wanted[6] .= "?" . $$parts[3] if defined $$parts[3];
    $wanted[6] .= "/" . $$parts[4] if defined $$parts[4];
    $wanted[6] .= "/" . $$parts[5] if defined $$parts[5];
    $wanted[7] = $$parts[3];    # search.
    $wanted[8] = $$parts[4];    # wtype.
    $wanted[9] = $$parts[5];    # wpath.

    \@wanted;
}

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

    # Hosts.
    # Host/ports are tested with other URIs as well, we're not using
    # all the combinations here.
    $good[0] = [qw /www.abigail.be 127.0.0.1 w--w--w3.ABIGAIL.nl/];
    $bad[0]  = [qw /www.example..com w+w.example.com 127.0.0.0.1/];

    # Ports.
    $good[1] = [ undef, 210 ];
    $bad[1]  = [ "",    qw /: port/ ];

    # Database
    $good[2] = [ "",    qw /database 0/, '%00%FF-!*,' ];
    $bad[2]  = [ undef, qw /~/ ];

    # Search
    $good[3] = [ undef, "", qw /database 0/, '%00%FF-!*,' ];
    $bad[3]  = [qw {~ []}];

    # Wtype
    $good[4] = [ undef, "", qw /wtype 0/, '%00%FF-!*,' ];
    $bad[4]  = [qw {~ []}];

    # Wpath
    $good[5] = [ undef, "", qw /wpath 0/, '%00%FF-!*,' ];
    $bad[5]  = [qw {~ []}];

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

sub filter_passes {

    # Good URIs have either both a wtype and a wpath, or none at all.
    return 0 if defined $_[0]->[4] xor defined $_[0]->[5];
    return 1;
}

sub filter {

    # At most one of 'search' and 'wtype/wpath' should be defined.
    return 0
      if defined $_[0]->[3]
      && ( defined $_[0]->[4]
        || defined $_[0]->[5] );

    return 0 if !defined $_[0]->[2] && grep { defined } @{ $_[0] }[ 3 .. 5 ];

    return 1;
}

__END__
