File Coverage

blib/lib/URI/Split.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	16	16	100.0
condition	3	3	100.0
subroutine	6	6	100.0
pod	2	2	100.0
total	61	61	100.0

package URI::Split;

use strict;
use warnings;

our $VERSION = '5.20';

use Exporter 5.57 'import';
our @EXPORT_OK = qw(uri_split uri_join);

use URI::Escape ();

sub uri_split {
     return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
}

sub uri_join {
    my($scheme, $auth, $path, $query, $frag) = @_;
    my $uri = defined($scheme) ? "$scheme:" : "";
    $path = "" unless defined $path;
    if (defined $auth) {
	$auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;
	$uri .= "//$auth";
	$path = "/$path" if length($path) && $path !~ m,^/,;
    }
    elsif ($path =~ m,^//,) {
	$uri .= "//";  # XXX force empty auth
    }
    unless (length $uri) {
	$path =~ s,(:), URI::Escape::escape_char($1),e while $path =~ m,^[^:/?\#]+:,;
    }
    $path =~ s,([?\#]), URI::Escape::escape_char($1),eg;
    $uri .= $path;
    if (defined $query) {
	$query =~ s,(\#), URI::Escape::escape_char($1),eg;
	$uri .= "?$query";
    }
    $uri .= "#$frag" if defined $frag;
    $uri;
}

1;

__END__