#!/usr/bin/perl

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

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

$^W = 1;

sub create_parts;

my $http  = $RE{URI}{HTTP};
my $https = $http->{ -scheme => 'https' };
my $any   = $http->{ -scheme => 'https?' };

my @tests = (
    [ http  => $http  => { http => NORMAL_PASS | FAIL, https => NORMAL_FAIL } ],
    [ https => $https => { http => NORMAL_FAIL, https => NORMAL_PASS | FAIL } ],
    [ any   => $any   => { http => NORMAL_PASS, https => NORMAL_PASS } ],
);

my ( $good, $bad ) = create_parts;

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

sub uri {
    my ( $scheme, $host, $port, $path, $query ) = ( $_[0], @{ $_[1] } );

    my $uri = "$scheme://$host";
    $uri .= ":$port"  if defined $port;
    $uri .= "/$path"  if defined $path;
    $uri .= "?$query" if defined $query && defined $path;

    $uri;
}

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

    my $abs = $parts->[2];
    $abs .= "?$parts->[3]" if defined $abs && defined $parts->[3];

    my @wanted;
    $wanted[0] = $_;
    $wanted[1] = $scheme;
    $wanted[2] = $parts->[0];
    $wanted[3] = $parts->[1];
    $wanted[4] = "/$abs" if defined $abs;
    $wanted[5] = $abs    if defined $abs;
    $wanted[6] = $parts->[2];
    $wanted[7] = undef;
    $wanted[7] = $parts->[3] if defined $parts->[2];

    \@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.1 127.0.0.0.1 -w.example.com www.example.1com/
    ];

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

    # Paths.
    $good[2] = [
        undef, "",
        qw {foo foo/bar/baz/bingo foo%00bar foo%EFbar
          %12%34%E6%7B %12%34/%E6%7B %12%34%E6%7B/foo
          ()() fnurd&.!~@}
    ];
    $bad[2] = [ qw {foo<> foo<>bar %GGfoo foo%F %FOfoo}, '#hubba' ];

    # Queries.
    $good[3] = [
        undef, "", qw {hubba fnurd=many&woozle=yes
          %3E%FF barra?femmy??dopey}
    ];
    $bad[3] = [ 'query#', '#query', 'qu#ry' ];

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

sub filter {
    return !defined $_[0]->[2] && defined $_[0]->[3] ? 0 : 1;
}

__END__
