git.maemo.org Git - pkg-perl/blob - deb-src/liburi-perl/liburi-perl-1.35.dfsg.1/URI/Split.pm

   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::escapes{$1},g;
  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::escapes{$1}, while $path =~ m,^[^:/?\#]+:,;
  30     }
  31     $path =~ s,([?\#]),$URI::Escape::escapes{$1},g;
  32     $uri .= $path;
  33     if (defined $query) {
  34         $query =~ s,(\#),$URI::Escape::escapes{$1},g;
  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