Viewing File: /usr/local/cpanel/3rdparty/perl/536/cpanel-lib/auto/Data/Validate/URI/_test_uri.al

# NOTE: Derived from blib/lib/Data/Validate/URI.pm.
# Changes made here will be lost when autosplit is run again.
# See AutoSplit.pm.
package Data::Validate::URI;

#line 209 "blib/lib/Data/Validate/URI.pm (autosplit into blib/lib/auto/Data/Validate/URI/_test_uri.al)"
# -------------------------------------------------------------------------------

sub _test_uri {
	# 1 = HTTP only
	# 2 = HTTPS only
	# 3 = both HTTP and HTTPS are allowed
	my $allowed_scheme = shift;
	my $value = shift;
	my $options = shift // {};
	
	return unless is_uri($value);
	
	my($scheme, $authority, $path, $query, $fragment) = _split_uri($value);
	
	return unless $scheme;
	
	if($allowed_scheme == 1) {
		return unless lc($scheme) eq 'http';
	} elsif ($allowed_scheme == 2) {
		return unless lc($scheme) eq 'https'
	} elsif ($allowed_scheme == 3) {
		return unless lc($scheme) =~ m/^https?$/;
	} else {
		return;
	}
	
	# fully-qualified URIs must have an authority section that is
	# a valid host
	return unless($authority);
	
	# allow a port component
	my($port) = $authority =~ /:(\d+)$/;
	$authority =~ s/:\d+$//;
	
	# modifying this to allow the (discouraged, but still legal) use of IP addresses
	unless(Data::Validate::Domain::is_domain($authority, $options) || Data::Validate::IP::is_ipv4($authority)){
		return;
	}
	
	# re-assemble the URL per section 5.3 in RFC 3986
	my $out = $scheme . ':';
	$out .= '//' . $authority;
	
	$out .= ':' . $port if $port;
	
	$out .= $path;
	
	if(defined $query && length($query)){
		$out .= '?' . $query;
	}
	if(defined $fragment && length($fragment)){
		$out .= '#' . $fragment;
	}
	
	return $out;
}

# end of Data::Validate::URI::_test_uri
1;