use strict;
use warnings;

use Test::More;

BEGIN {
  $ENV{URI_HAS_RESERVED_SQUARE_BRACKETS} = 0;
}

use URI ();

sub show {
  diag explain("self: ", shift);
}


#-- test bugfix of https://github.com/libwww-perl/URI/issues/99


is( URI::HAS_RESERVED_SQUARE_BRACKETS, 0, "constant indicates NOT to treat square brackets as reserved characters" );

{
  my $u = URI->new("http://[::1]/path_with_square_[brackets]?par=value[1]");
  is( $u->canonical,
      "http://[::1]/path_with_square_%5Bbrackets%5D?par=value%5B1%5D",
      "sqb in path and request"
    ) or show $u;
}


{
  my $u = URI->new("http://[::1]/path_with_square_[brackets]?par=value[1]#fragment[2]");
  is( $u->canonical,
      "http://[::1]/path_with_square_%5Bbrackets%5D?par=value%5B1%5D#fragment%5B2%5D",
      "sqb in path and request and fragment"
    ) or show $u;
}


{
  my $u = URI->new("http://root[user]@[::1]/path_with_square_[brackets]?par=value[1]#fragment[2]");
  is( $u->canonical,
      "http://root%5Buser%5D@[::1]/path_with_square_%5Bbrackets%5D?par=value%5B1%5D#fragment%5B2%5D",
      "sqb in userinfo, host, path, request and fragment"
    ) or show $u;
}


{
  my $u = URI->new("http://root[user]@[::1]/path_with_square_[brackets]?par=value[1]&par[2]=value[2]#fragment[2]");
  is( $u->canonical,
      "http://root%5Buser%5D@[::1]/path_with_square_%5Bbrackets%5D?par=value%5B1%5D&par%5B2%5D=value%5B2%5D#fragment%5B2%5D",
      "sqb in userinfo, host, path, request and fragment"
    ) or show $u;

  is( $u->scheme()                , "http",           "scheme");
  is( $u->userinfo()              , "root%5Buser%5D", "userinfo");
  is( $u->host()                  , "::1",            "host");
  is( $u->ihost()                 , "::1",            "ihost");
  is( $u->port()                  , "80",             "port");
  is( $u->default_port()          , "80",             "default_port");
  is( $u->host_port()             , "[::1]:80",       "host_port");
  is( $u->secure()                , "0",              "is_secure" );
  is( $u->path()                  , "/path_with_square_%5Bbrackets%5D", "path");
  is( $u->opaque()                , "//root%5Buser%5D@[::1]/path_with_square_%5Bbrackets%5D?par=value%5B1%5D&par%5B2%5D=value%5B2%5D", "opaque");
  is( $u->fragment()              , "fragment%5B2%5D", "fragment");
  is( $u->query()                 , "par=value%5B1%5D&par%5B2%5D=value%5B2%5D", "query");
  is( $u->as_string()             , "http://root%5Buser%5D@[::1]/path_with_square_%5Bbrackets%5D?par=value%5B1%5D&par%5B2%5D=value%5B2%5D#fragment%5B2%5D", "as_string");
  is( $u->has_recognized_scheme() , "1", "has_recognized_scheme");
  is( $u->as_iri()                , "http://root%5Buser%5D@[::1]/path_with_square_%5Bbrackets%5D?par=value%5B1%5D&par%5B2%5D=value%5B2%5D#fragment%5B2%5D", "as_iri"); #TODO: utf8

  is( $u->abs( "/BASEDIR")->as_string() , "http://root%5Buser%5D@[::1]/path_with_square_%5Bbrackets%5D?par=value%5B1%5D&par%5B2%5D=value%5B2%5D#fragment%5B2%5D", "abs (no change)");
  is( $u->rel("../BASEDIR")             , "http://root%5Buser%5D@[::1]/path_with_square_%5Bbrackets%5D?par=value%5B1%5D&par%5B2%5D=value%5B2%5D#fragment%5B2%5D", "rel");

  is( $u->authority()                   , "root%5Buser%5D@[::1]", "authority" );
  is( $u->path_query()                  , "/path_with_square_%5Bbrackets%5D?par=value%5B1%5D&par%5B2%5D=value%5B2%5D", "path_query");
  is( $u->query_keywords()              , undef, "query_keywords");

  my @segments = $u->path_segments();
  is( join(" | ", @segments), " | path_with_square_[brackets]", "segments");
}


{ #-- form/query related tests
  my $u = URI->new("http://root[user]@[::1]/path_with_square_[brackets]/segment[2]?par=value[1]&par[2]=value[2]#fragment[2]");

  is( $u->query_form(), "4", "scalar: query_form");
  is( join(" | ", $u->query_form()), "par | value[1] | par[2] | value[2]", "list: query_form");

  $u->query_form( {} );
  is( $u->query(), undef, "query removed");
  is( join(" | ", $u->query_form()), "", "list: query_form");
  is( $u->canonical(), "http://root%5Buser%5D@[::1]/path_with_square_%5Bbrackets%5D/segment%5B2%5D#fragment%5B2%5D", "query removed: canonical");

  $u->query_form( key1 => 'val1', key2 => 'val[2]' );
  is( $u->query(), "key1=val1&key2=val%5B2%5D", "query");
}


{ #-- path segments
  my $u = URI->new("http://root[user]@[::1]/path_with_square_[brackets]/segment[2]?par=value[1]#fragment[2]");
  my @segments = $u->path_segments();
  is( join(" | ", @segments), " | path_with_square_[brackets] | segment[2]", "segments");
}


{ #-- rel
  my $u = URI->new("http://root[user]@[::1]/oldbase/next/path_with_square_[brackets]/segment[2]?par=value[1]#fragment[2]");
  #TODO: is userinfo@ optional?
  is( $u->rel("http://root%5Buser%5D@[::1]/oldbase/next/")->canonical(),
      "path_with_square_%5Bbrackets%5D/segment%5B2%5D?par=value%5B1%5D#fragment%5B2%5D",
      "rel/canonical"
    );
}


{ #-- various setters
 my $ip6 = 'fedc:ba98:7654:3210:fedc:ba98:7654:3210';
 my $u = URI->new("http://\[" . uc($ip6) . "\]/index.html");
 is ($u->canonical(), "http://[$ip6]/index.html", "basic IPv6 URI");

 $u->scheme("https");
 is ($u->canonical(), "https://[$ip6]/index.html", "basic IPv6 URI");

 $u->userinfo("user[42]"); #-- tolerate unescaped '[', ']'
 is ($u->canonical(), "https://user%5B42%5D@[$ip6]/index.html", "userinfo added (unescaped)");
 is ($u->userinfo(), "user%5B42%5D", "userinfo is escaped");

 $u->userinfo("user%5B77%5D"); #-- already escaped
 is ($u->canonical(), "https://user%5B77%5D@[$ip6]/index.html", "userinfo replaced (escaped)");
 is ($u->userinfo(), "user%5B77%5D", "userinfo is escaped");

 $u->userinfo( q(weird.al$!:secret*[1]++) );
 is ($u->canonical(), "https://weird.al\$!:secret*%5B1%5D++@[$ip6]/index.html", "userinfo replaced (escaped2)");
 is ($u->userinfo(),  "weird.al\$!:secret*%5B1%5D++", "userinfo is escaped2");

 $u->userinfo( q(j.doe@example.com:secret) );
 is ($u->canonical(), "https://j.doe%40example.com:secret@[$ip6]/index.html", "userinfo replaced (escaped3)");
 is ($u->userinfo() , "j.doe%40example.com:secret", "userinfo is escaped3");

 $u->host("example.com");
 is ($u->canonical(), "https://j.doe%40example.com:secret\@example.com/index.html", "hostname replaced");

 $u->host("127.0.0.1");
 is ($u->canonical(), "https://j.doe%40example.com:secret\@127.0.0.1/index.html", "hostname replaced");

 for my $host ( qw(example.com 127.0.0.1)) {
   $u->host( $host );
   my $expect = "https://j.doe%40example.com:secret\@$host/index.html";
   is ($u->canonical(), $expect, "host: $host");
   is ($u->host(), $host, "same hosts ($host)");
 }

 for my $host6 ( $ip6, qw(::1) ) {
   $u->host( $host6 );
   my $expect = "https://j.doe%40example.com:secret\@[$host6]/index.html";
   is ($u->canonical(), $expect, "IPv6 host: $host6");
   is ($u->host(), $host6, "same IPv6 hosts ($host6)");
 }

 $u->host($ip6);
 $u->path("/subdir/index[1].html");
 is( $u->canonical(), "https://j.doe%40example.com:secret@[$ip6]/subdir/index%5B1%5D.html", "path replaced");

 $u->fragment("fragment[xyz]");
 is( $u->canonical(), "https://j.doe%40example.com:secret@[$ip6]/subdir/index%5B1%5D.html#fragment%5Bxyz%5D", "fragment added");

 $u->authority("user[doe]@[::1]");
 is( $u->canonical(), "https://user%5Bdoe%5D@[::1]/subdir/index%5B1%5D.html#fragment%5Bxyz%5D", "authority replaced");

 $u->authority("::1");
 is( $u->canonical(), "https://[::1]/subdir/index%5B1%5D.html#fragment%5Bxyz%5D", "authority replaced");

 $u->authority("[::1]:19999");
 is( $u->canonical(), "https://[::1]:19999/subdir/index%5B1%5D.html#fragment%5Bxyz%5D", "authority replaced");

 # $u->authority("::1:18000"); #-- theoretically, we could guess an [::1]:18000 ... but for now it will just be ill formatted.
 # is( $u->canonical(), "https://::1:18000/subdir/index%5B1%5D.html#fragment%5Bxyz%5D", "authority replaced");

 $u->authority("user[abc]\@::1");
 is( $u->canonical(), "https://user%5Babc%5D@[::1]/subdir/index%5B1%5D.html#fragment%5Bxyz%5D", "authority replaced");

 $u->authority("user[xyz]\@example.com\@[::1]:22022");
 is( $u->canonical(), "https://user%5Bxyz%5D%40example.com@[::1]:22022/subdir/index%5B1%5D.html#fragment%5Bxyz%5D", "authority replaced");

}

done_testing;