view release on metacpan or  search on metacpan

lib/IO/Socket/SSL/PublicSuffix.pm  view on Meta::CPAN

	next_choice:
	if ( @$choices ) {
	    $p = shift(@$choices);
	    push @stack, [ $choices, $i ] if @$choices;
	    next; # go deeper
	}

	# backtrack
	@stack or last;
	($choices,$i) = @{ pop(@stack) };
	goto next_choice;
    }

    #warn Dumper([\%wild,\%host,\%xcept]); use Data::Dumper;


    # remove all exceptions from wildcards
    delete @wild{ keys %xcept } if %xcept;
    # get longest match
    my ($len) = sort { $b <=> $a } (
	keys(%wild), keys(%host), map { $_-1 } keys(%xcept));
    # if we have no matches use a minimum of min_suffix
    $len = $self->{min_suffix} if ! defined $len;
    $len += $add if $add;
    my $suffix;
    if ( $len < @$name ) {
	$suffix = [ splice( @$name, -$len, $len ) ];
    } elsif ( $len > 0 ) {
	$suffix = $name;
	$name = []
    } else {
	$suffix = []
    }

    if ( $want ne 'a' ) {
	$suffix = join('.',@$suffix);
	$name = join('.',@$name);
	if ( $want eq 'u' ) {
	    $suffix = idn_to_unicode($suffix);
	    $name   = idn_to_unicode($name);
	}
    }

    $suffix .= "." if $add_dot && !ref $suffix;
    return wantarray ? ($name,$suffix):$suffix;
}


{
    my $data;
    sub _default_data {
	if ( ! defined $data ) {
	    $data = _builtin_data();
	    $data =~s{^// ===END ICANN DOMAINS.*}{}ms
		or die "cannot find END ICANN DOMAINS";
	}
	return $data;
    }
}

sub update_self_from_url {
    my $url = shift || URL();
    my $dst = __FILE__;
    -w $dst or die "cannot write $dst";
    open( my $fh,'<',$dst ) or die "open $dst: $!";
    my $code = '';
    local $/ = "\n";
    while (<$fh>) {
	$code .= $_;
	m{<<\'END_BUILTIN_DATA\'} and last;
    }
    my $tail;
    while (<$fh>) {
	m{\AEND_BUILTIN_DATA\r?\n} or next;
	$tail = $_;
	last;
    }
    $tail .= do { local $/; <$fh> };
    close($fh);

    require LWP::UserAgent;
    my $resp = LWP::UserAgent->new->get($url)
	or die "no response from $url";
    die "no success url=$url code=".$resp->code." ".$resp->message 
	if ! $resp->is_success;
    my $content = $resp->decoded_content;
    while ( $content =~m{(.*\n)}g ) {
	my $line = $1;
	if ( $line =~m{\S} && $line !~m{\A\s*//} ) {
	    $line =~s{//.*}{};
	    $line =~s{\s+$}{};
	    $line eq '' and next;
	    if ( $line !~m{\A[\x00-\x7f]+\Z} ) {
		$line = idn_to_ascii($line);
	    }
	    $code .= "$line\n";
	} else {
	    $code .= "$line";
	}
    }

    open( $fh,'>:utf8',$dst ) or die "open $dst: $!";
    print $fh $code.$tail;
}

sub _builtin_data { return <<'END_BUILTIN_DATA' }
// This Source Code Form is subject to the terms of the Mozilla Public
// License, v. 2.0. If a copy of the MPL was not distributed with this
// file, You can obtain one at https://mozilla.org/MPL/2.0/.

// Please pull this list from, and only from https://publicsuffix.org/list/public_suffix_list.dat,
// rather than any other VCS sites. Pulling from any other URL is not guaranteed to be supported.

// VERSION: 2025-06-02_07-53-42_UTC
// COMMIT: c792070bab60deb20e497677bf33e4e198433033

// Instructions on pulling and using this list can be found at https://publicsuffix.org/list/.

// ===BEGIN ICANN DOMAINS===

// ac : http://nic.ac/rules.htm