1 | package URI::Split;
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 |
|
---|
5 | use vars qw(@ISA @EXPORT_OK);
|
---|
6 | require Exporter;
|
---|
7 | @ISA = qw(Exporter);
|
---|
8 | @EXPORT_OK = qw(uri_split uri_join);
|
---|
9 |
|
---|
10 | use URI::Escape ();
|
---|
11 |
|
---|
12 | sub uri_split {
|
---|
13 | return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
|
---|
14 | }
|
---|
15 |
|
---|
16 | sub uri_join {
|
---|
17 | my($scheme, $auth, $path, $query, $frag) = @_;
|
---|
18 | my $uri = defined($scheme) ? "$scheme:" : "";
|
---|
19 | $path = "" unless defined $path;
|
---|
20 | if (defined $auth) {
|
---|
21 | $auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;
|
---|
22 | $uri .= "//$auth";
|
---|
23 | $path = "/$path" if length($path) && $path !~ m,^/,;
|
---|
24 | }
|
---|
25 | elsif ($path =~ m,^//,) {
|
---|
26 | $uri .= "//"; # XXX force empty auth
|
---|
27 | }
|
---|
28 | unless (length $uri) {
|
---|
29 | $path =~ s,(:), URI::Escape::escape_char($1),e while $path =~ m,^[^:/?\#]+:,;
|
---|
30 | }
|
---|
31 | $path =~ s,([?\#]), URI::Escape::escape_char($1),eg;
|
---|
32 | $uri .= $path;
|
---|
33 | if (defined $query) {
|
---|
34 | $query =~ s,(\#), URI::Escape::escape_char($1),eg;
|
---|
35 | $uri .= "?$query";
|
---|
36 | }
|
---|
37 | $uri .= "#$frag" if defined $frag;
|
---|
38 | $uri;
|
---|
39 | }
|
---|
40 |
|
---|
41 | 1;
|
---|
42 |
|
---|
43 | __END__
|
---|
44 |
|
---|
45 | =head1 NAME
|
---|
46 |
|
---|
47 | URI::Split - Parse and compose URI strings
|
---|
48 |
|
---|
49 | =head1 SYNOPSIS
|
---|
50 |
|
---|
51 | use URI::Split qw(uri_split uri_join);
|
---|
52 | ($scheme, $auth, $path, $query, $frag) = uri_split($uri);
|
---|
53 | $uri = uri_join($scheme, $auth, $path, $query, $frag);
|
---|
54 |
|
---|
55 | =head1 DESCRIPTION
|
---|
56 |
|
---|
57 | Provides functions to parse and compose URI
|
---|
58 | strings. The following functions are provided:
|
---|
59 |
|
---|
60 | =over
|
---|
61 |
|
---|
62 | =item ($scheme, $auth, $path, $query, $frag) = uri_split($uri)
|
---|
63 |
|
---|
64 | Breaks up a URI string into its component
|
---|
65 | parts. An C<undef> value is returned for those parts that are not
|
---|
66 | present. The $path part is always present (but can be the empty
|
---|
67 | string) and is thus never returned as C<undef>.
|
---|
68 |
|
---|
69 | No sensible value is returned if this function is called in a scalar
|
---|
70 | context.
|
---|
71 |
|
---|
72 | =item $uri = uri_join($scheme, $auth, $path, $query, $frag)
|
---|
73 |
|
---|
74 | Puts together a URI string from its parts.
|
---|
75 | Missing parts are signaled by passing C<undef> for the corresponding
|
---|
76 | argument.
|
---|
77 |
|
---|
78 | Minimal escaping is applied to parts that contain reserved chars
|
---|
79 | that would confuse a parser. For instance, any occurrence of '?' or '#'
|
---|
80 | in $path is always escaped, as it would otherwise be parsed back
|
---|
81 | as a query or fragment.
|
---|
82 |
|
---|
83 | =back
|
---|
84 |
|
---|
85 | =head1 SEE ALSO
|
---|
86 |
|
---|
87 | L<URI>, L<URI::Escape>
|
---|
88 |
|
---|
89 | =head1 COPYRIGHT
|
---|
90 |
|
---|
91 | Copyright 2003, Gisle Aas
|
---|
92 |
|
---|
93 | This library is free software; you can redistribute it and/or
|
---|
94 | modify it under the same terms as Perl itself.
|
---|
95 |
|
---|
96 | =cut
|
---|