<commit_before>class URI;

use IETF::RFC_Grammar;
use IETF::RFC_Grammar::URI;
use URI::Escape;
need URI::DefaultPort;

has $.grammar;
has $.is_validating is rw = False;
has $!path;
has $!is_absolute;
has $!scheme;
has $!authority;
has $!query;
has $!frag;
has %!query_form;
has $!uri;  # use of this now deprecated

has @.segments;

method parse (Str $str) {

    # clear string before parsing
    my $c_str = $str;
    $c_str .= subst(/^ \s* ['<' | '"'] /, '');
    $c_str .= subst(/ ['>' | '"'] \s* $/, '');

    $!uri = $!path = $!is_absolute = $!scheme = $!authority = $!query =
        $!frag = Mu;
    %!query_form = @!segments = Nil;

    my $note_caught;
    try {
        if ($.is_validating) {
            $!grammar.parse_validating($c_str);
        }
        else {
            $!grammar.parse($c_str);
        }

        CATCH {
            $note_caught++; # exception handling still needs some work ...
        }
    }
    if $note_caught {die "Could not parse URI: $str"  }

    # now deprecated
    $!uri = $!grammar.parse_result;

    my $comp_container = $!grammar.parse_result<URI_reference><URI> ||
        $!grammar.parse_result<URI_reference><relative_ref>;
    $!scheme = $comp_container<scheme>;
    $!query = $comp_container<query>;
    $!frag = $comp_container<fragment>;
    $comp_container = $comp_container<hier_part> || $comp_container<relative_part>;

    $!authority = $comp_container<authority>;
    $!path =    $comp_container<path_abempty>       ||
                $comp_container<path_absolute>      ;
    $!is_absolute = ?($!path || $!scheme);

    $!path ||=  $comp_container<path_noscheme>      ||
                $comp_container<path_rootless>      ;

    @!segments = $!path<segment>.list() || ('');
    if my $first_chunk = $!path<segment_nz_nc> || $!path<segment_nz> {
        unshift @!segments, $first_chunk;
    }
    if @!segments.elems == 0 {
        @!segments = ('');
    }
#    @!segments ||= ('');

    try {
        %!query_form = split_query( ~$!query );
        CATCH {
            default {
                %!query_form = ();
            }
        }
    }
}

our sub split_query(Str $query) {
    my %query_form;

    for map { [split(/<[=]>/, $_) ]}, split(/<[&;]>/, $query) -> $qmap {
        for (0, 1) -> $i { # could go past 1 in theory ...
            $qmap[ $i ] = uri_unescape($qmap[ $i ]);
        }
        if %query_form.exists($qmap[0]) {
            if %query_form{ $qmap[0] } ~~ Array  {
                %query_form{ $qmap[0] }.push($qmap[1])
            }
            else {
                %query_form{ $qmap[0] } = [
                    %query_form{ $qmap[0] }, $qmap[1]
                ]
            }
        }
        else {
            %query_form{ $qmap[0]} = $qmap[1]
        }
    }

    return %query_form;
}

# deprecated old call for parse
method init ($str) {
    warn "init method now deprecated in favor of parse method";
    $.parse($str);
}

# new can pass alternate grammars some day ...
submethod BUILD(:$!is_validating) {
    $!grammar = IETF::RFC_Grammar.new('rfc3896');
}

method new(Str $uri_pos1?, Str :$uri, :$is_validating) {
    my $obj = self.bless(*);

    if $is_validating.defined {
        $obj.is_validating = ?$is_validating;
    }

    if $uri.defined and $uri_pos1.defined {
        die "Please specify the uri by name or position but not both.";
    }
    elsif $uri.defined or $uri_pos1.defined {
        $obj.parse($uri.defined ?? $uri !! $uri_pos1);
    }

    return $obj;
}

method scheme {
    return ~$!scheme.lc;
}

method authority {
    return ~$!authority.lc;
}

method host {
    return ($!authority<host> || '').lc;
}

method default_port {
    URI::DefaultPort::scheme_port($.scheme)
}

method _port {
    # port 0 is off limits and see also RT 96424
    # $!authority<port>.Int doesn't work because of RT 96472
    $!authority<port> ?? ($!authority<port> ~ '').Int !! Int;
}

method port {
    $._port // $.default_port;
}

method path {
    return ~($!path || '');
}

method absolute {
    return $!is_absolute;
}

method relative {
    return ! $.absolute;
}

method query {
    item ~($!query || '');
}

method path_query {
    $.query ?? $.path ~ '?' ~ $.query !! $.path
}


method frag {
    return ~($!frag || '').lc;
}

method fragment { $.frag }

method Str() {
    my $str;
    $str ~= $.scheme if $.scheme;
    $str ~= '://' ~ $.authority if $.authority;
    $str ~= $.path;
    $str ~= '?' ~ $.query if $.query;
    $str ~= '#' ~ $.frag if $.frag;
    return $str;
}

# chunks now strongly deprecated
# it's segments in p5 URI and segment is part of rfc so no more chunks soon!
method chunks {
    warn "chunks attribute now deprecated in favor of segments";
    return @!segments;
}

method uri {
    warn "uri attribute now deprecated in favor of .grammar.parse_result";
    return $!uri;
}

method query_form {
    return %!query_form;
}

=begin pod

=head NAME

URI — Uniform Resource Identifiers (absolute and relative)

=head SYNOPSYS

    use URI;
    my $u = URI.new('http://her.com/foo/bar?tag=woow#bla');

    my $scheme = $u.scheme;
    my $authority = $u.authority;
    my $host = $u.host;
    my $port = $u.port;
    my $path = $u.path;
    my $query = $u.query;
    my $frag = $u.frag; # or $u.fragment;
    my $tag = $u.query_form<tag>; # should be woow

    my $is_absolute = $u.absolute;
    my $is_relative = $u.relative;

    # something p5 URI without grammar could not easily do !
    my $host_in_grammar =
        $u.grammar.parse_result<URI_reference><URI><hier_part><authority><host>;
    if ($host_in_grammar<reg_name>) {
        say 'Host looks like registered domain name - approved!';
    }
    else {
        say 'Sorry we do not take ip address hosts at this time.';
        say 'Please use registered domain name!';
    }

    # require whole string matches URI and throw exception otherwise ..
    my $u_v = URI.new('http://?#?#', :is_validating<1>);# throw exception
=end pod


# vim:ft=perl6
<commit_msg>simplify object construction a bit<commit_after>class URI;

use IETF::RFC_Grammar;
use IETF::RFC_Grammar::URI;
use URI::Escape;
need URI::DefaultPort;

has $.grammar;
has $.is_validating is rw = False;
has $!path;
has $!is_absolute;
has $!scheme;
has $!authority;
has $!query;
has $!frag;
has %!query_form;
has $!uri;  # use of this now deprecated

has @.segments;

method parse (Str $str) {

    # clear string before parsing
    my $c_str = $str;
    $c_str .= subst(/^ \s* ['<' | '"'] /, '');
    $c_str .= subst(/ ['>' | '"'] \s* $/, '');

    $!uri = $!path = $!is_absolute = $!scheme = $!authority = $!query =
        $!frag = Mu;
    %!query_form = @!segments = Nil;

    my $note_caught;
    try {
        if ($.is_validating) {
            $!grammar.parse_validating($c_str);
        }
        else {
            $!grammar.parse($c_str);
        }

        CATCH {
            $note_caught++; # exception handling still needs some work ...
        }
    }
    if $note_caught {die "Could not parse URI: $str"  }

    # now deprecated
    $!uri = $!grammar.parse_result;

    my $comp_container = $!grammar.parse_result<URI_reference><URI> ||
        $!grammar.parse_result<URI_reference><relative_ref>;
    $!scheme = $comp_container<scheme>;
    $!query = $comp_container<query>;
    $!frag = $comp_container<fragment>;
    $comp_container = $comp_container<hier_part> || $comp_container<relative_part>;

    $!authority = $comp_container<authority>;
    $!path =    $comp_container<path_abempty>       ||
                $comp_container<path_absolute>      ;
    $!is_absolute = ?($!path || $!scheme);

    $!path ||=  $comp_container<path_noscheme>      ||
                $comp_container<path_rootless>      ;

    @!segments = $!path<segment>.list() || ('');
    if my $first_chunk = $!path<segment_nz_nc> || $!path<segment_nz> {
        unshift @!segments, $first_chunk;
    }
    if @!segments.elems == 0 {
        @!segments = ('');
    }
#    @!segments ||= ('');

    try {
        %!query_form = split_query( ~$!query );
        CATCH {
            default {
                %!query_form = ();
            }
        }
    }
}

our sub split_query(Str $query) {
    my %query_form;

    for map { [split(/<[=]>/, $_) ]}, split(/<[&;]>/, $query) -> $qmap {
        for (0, 1) -> $i { # could go past 1 in theory ...
            $qmap[ $i ] = uri_unescape($qmap[ $i ]);
        }
        if %query_form.exists($qmap[0]) {
            if %query_form{ $qmap[0] } ~~ Array  {
                %query_form{ $qmap[0] }.push($qmap[1])
            }
            else {
                %query_form{ $qmap[0] } = [
                    %query_form{ $qmap[0] }, $qmap[1]
                ]
            }
        }
        else {
            %query_form{ $qmap[0]} = $qmap[1]
        }
    }

    return %query_form;
}

# deprecated old call for parse
method init ($str) {
    warn "init method now deprecated in favor of parse method";
    $.parse($str);
}

# new can pass alternate grammars some day ...
submethod BUILD(:$!is_validating) {
    $!grammar = IETF::RFC_Grammar.new('rfc3896');
}

method new(Str $uri_pos1?, Str :$uri, :$is_validating) {
    my $obj = self.bless(*);

    if $is_validating.defined {
        $obj.is_validating = ?$is_validating;
    }

    if $uri.defined and $uri_pos1.defined {
        die "Please specify the uri by name or position but not both.";
    }
    elsif $uri.defined or $uri_pos1.defined {
        $obj.parse($uri // $uri_pos1);
    }

    return $obj;
}

method scheme {
    return ~$!scheme.lc;
}

method authority {
    return ~$!authority.lc;
}

method host {
    return ($!authority<host> || '').lc;
}

method default_port {
    URI::DefaultPort::scheme_port($.scheme)
}

method _port {
    # port 0 is off limits and see also RT 96424
    # $!authority<port>.Int doesn't work because of RT 96472
    $!authority<port> ?? ($!authority<port> ~ '').Int !! Int;
}

method port {
    $._port // $.default_port;
}

method path {
    return ~($!path || '');
}

method absolute {
    return $!is_absolute;
}

method relative {
    return ! $.absolute;
}

method query {
    item ~($!query || '');
}

method path_query {
    $.query ?? $.path ~ '?' ~ $.query !! $.path
}


method frag {
    return ~($!frag || '').lc;
}

method fragment { $.frag }

method Str() {
    my $str;
    $str ~= $.scheme if $.scheme;
    $str ~= '://' ~ $.authority if $.authority;
    $str ~= $.path;
    $str ~= '?' ~ $.query if $.query;
    $str ~= '#' ~ $.frag if $.frag;
    return $str;
}

# chunks now strongly deprecated
# it's segments in p5 URI and segment is part of rfc so no more chunks soon!
method chunks {
    warn "chunks attribute now deprecated in favor of segments";
    return @!segments;
}

method uri {
    warn "uri attribute now deprecated in favor of .grammar.parse_result";
    return $!uri;
}

method query_form {
    return %!query_form;
}

=begin pod

=head NAME

URI — Uniform Resource Identifiers (absolute and relative)

=head SYNOPSYS

    use URI;
    my $u = URI.new('http://her.com/foo/bar?tag=woow#bla');

    my $scheme = $u.scheme;
    my $authority = $u.authority;
    my $host = $u.host;
    my $port = $u.port;
    my $path = $u.path;
    my $query = $u.query;
    my $frag = $u.frag; # or $u.fragment;
    my $tag = $u.query_form<tag>; # should be woow

    my $is_absolute = $u.absolute;
    my $is_relative = $u.relative;

    # something p5 URI without grammar could not easily do !
    my $host_in_grammar =
        $u.grammar.parse_result<URI_reference><URI><hier_part><authority><host>;
    if ($host_in_grammar<reg_name>) {
        say 'Host looks like registered domain name - approved!';
    }
    else {
        say 'Sorry we do not take ip address hosts at this time.';
        say 'Please use registered domain name!';
    }

    # require whole string matches URI and throw exception otherwise ..
    my $u_v = URI.new('http://?#?#', :is_validating<1>);# throw exception
=end pod


# vim:ft=perl6

{'fraction_non_alphanumeric': 0.16338829831756926, 'fraction_numerical': 0.006026617560893948, 'mean_word_length': 2.431361286616887, 'pattern_counts': {'":': 0, '<': 67, '<?xml version=': 0, '>': 71, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '163560', 'n_tokens_mistral': 4308, 'n_tokens_neox': 4210, 'n_words': 1037}