[27174] | 1 | package URI::file;
|
---|
| 2 |
|
---|
| 3 | use strict;
|
---|
| 4 | use vars qw(@ISA $VERSION $DEFAULT_AUTHORITY %OS_CLASS);
|
---|
| 5 |
|
---|
| 6 | require URI::_generic;
|
---|
| 7 | @ISA = qw(URI::_generic);
|
---|
| 8 | $VERSION = "4.21";
|
---|
| 9 |
|
---|
| 10 | use URI::Escape qw(uri_unescape);
|
---|
| 11 |
|
---|
| 12 | $DEFAULT_AUTHORITY = "";
|
---|
| 13 |
|
---|
| 14 | # Map from $^O values to implementation classes. The Unix
|
---|
| 15 | # class is the default.
|
---|
| 16 | %OS_CLASS = (
|
---|
| 17 | os2 => "OS2",
|
---|
| 18 | mac => "Mac",
|
---|
| 19 | MacOS => "Mac",
|
---|
| 20 | MSWin32 => "Win32",
|
---|
| 21 | win32 => "Win32",
|
---|
| 22 | msdos => "FAT",
|
---|
| 23 | dos => "FAT",
|
---|
| 24 | qnx => "QNX",
|
---|
| 25 | );
|
---|
| 26 |
|
---|
| 27 | sub os_class
|
---|
| 28 | {
|
---|
| 29 | my($OS) = shift || $^O;
|
---|
| 30 |
|
---|
| 31 | my $class = "URI::file::" . ($OS_CLASS{$OS} || "Unix");
|
---|
| 32 | no strict 'refs';
|
---|
| 33 | unless (%{"$class\::"}) {
|
---|
| 34 | eval "require $class";
|
---|
| 35 | die $@ if $@;
|
---|
| 36 | }
|
---|
| 37 | $class;
|
---|
| 38 | }
|
---|
| 39 |
|
---|
| 40 | sub host { uri_unescape(shift->authority(@_)) }
|
---|
| 41 |
|
---|
| 42 | sub new
|
---|
| 43 | {
|
---|
| 44 | my($class, $path, $os) = @_;
|
---|
| 45 | os_class($os)->new($path);
|
---|
| 46 | }
|
---|
| 47 |
|
---|
| 48 | sub new_abs
|
---|
| 49 | {
|
---|
| 50 | my $class = shift;
|
---|
| 51 | my $file = $class->new(@_);
|
---|
| 52 | return $file->abs($class->cwd) unless $$file =~ /^file:/;
|
---|
| 53 | $file;
|
---|
| 54 | }
|
---|
| 55 |
|
---|
| 56 | sub cwd
|
---|
| 57 | {
|
---|
| 58 | my $class = shift;
|
---|
| 59 | require Cwd;
|
---|
| 60 | my $cwd = Cwd::cwd();
|
---|
| 61 | $cwd = VMS::Filespec::unixpath($cwd) if $^O eq 'VMS';
|
---|
| 62 | $cwd = $class->new($cwd);
|
---|
| 63 | $cwd .= "/" unless substr($cwd, -1, 1) eq "/";
|
---|
| 64 | $cwd;
|
---|
| 65 | }
|
---|
| 66 |
|
---|
| 67 | sub canonical {
|
---|
| 68 | my $self = shift;
|
---|
| 69 | my $other = $self->SUPER::canonical;
|
---|
| 70 |
|
---|
| 71 | my $scheme = $other->scheme;
|
---|
| 72 | my $auth = $other->authority;
|
---|
| 73 | return $other if !defined($scheme) && !defined($auth); # relative
|
---|
| 74 |
|
---|
| 75 | if (!defined($auth) ||
|
---|
| 76 | $auth eq "" ||
|
---|
| 77 | lc($auth) eq "localhost" ||
|
---|
| 78 | (defined($DEFAULT_AUTHORITY) && lc($auth) eq lc($DEFAULT_AUTHORITY))
|
---|
| 79 | )
|
---|
| 80 | {
|
---|
| 81 | # avoid cloning if $auth already match
|
---|
| 82 | if ((defined($auth) || defined($DEFAULT_AUTHORITY)) &&
|
---|
| 83 | (!defined($auth) || !defined($DEFAULT_AUTHORITY) || $auth ne $DEFAULT_AUTHORITY)
|
---|
| 84 | )
|
---|
| 85 | {
|
---|
| 86 | $other = $other->clone if $self == $other;
|
---|
| 87 | $other->authority($DEFAULT_AUTHORITY);
|
---|
| 88 | }
|
---|
| 89 | }
|
---|
| 90 |
|
---|
| 91 | $other;
|
---|
| 92 | }
|
---|
| 93 |
|
---|
| 94 | sub file
|
---|
| 95 | {
|
---|
| 96 | my($self, $os) = @_;
|
---|
| 97 | os_class($os)->file($self);
|
---|
| 98 | }
|
---|
| 99 |
|
---|
| 100 | sub dir
|
---|
| 101 | {
|
---|
| 102 | my($self, $os) = @_;
|
---|
| 103 | os_class($os)->dir($self);
|
---|
| 104 | }
|
---|
| 105 |
|
---|
| 106 | 1;
|
---|
| 107 |
|
---|
| 108 | __END__
|
---|
| 109 |
|
---|
| 110 | =head1 NAME
|
---|
| 111 |
|
---|
| 112 | URI::file - URI that maps to local file names
|
---|
| 113 |
|
---|
| 114 | =head1 SYNOPSIS
|
---|
| 115 |
|
---|
| 116 | use URI::file;
|
---|
| 117 |
|
---|
| 118 | $u1 = URI->new("file:/foo/bar");
|
---|
| 119 | $u2 = URI->new("foo/bar", "file");
|
---|
| 120 |
|
---|
| 121 | $u3 = URI::file->new($path);
|
---|
| 122 | $u4 = URI::file->new("c:\\windows\\", "win32");
|
---|
| 123 |
|
---|
| 124 | $u1->file;
|
---|
| 125 | $u1->file("mac");
|
---|
| 126 |
|
---|
| 127 | =head1 DESCRIPTION
|
---|
| 128 |
|
---|
| 129 | The C<URI::file> class supports C<URI> objects belonging to the I<file>
|
---|
| 130 | URI scheme. This scheme allows us to map the conventional file names
|
---|
| 131 | found on various computer systems to the URI name space. An old
|
---|
| 132 | specification of the I<file> URI scheme is found in RFC 1738. Some
|
---|
| 133 | older background information is also in RFC 1630. There are no newer
|
---|
| 134 | specifications as far as I know.
|
---|
| 135 |
|
---|
| 136 | If you simply want to construct I<file> URI objects from URI strings,
|
---|
| 137 | use the normal C<URI> constructor. If you want to construct I<file>
|
---|
| 138 | URI objects from the actual file names used by various systems, then
|
---|
| 139 | use one of the following C<URI::file> constructors:
|
---|
| 140 |
|
---|
| 141 | =over 4
|
---|
| 142 |
|
---|
| 143 | =item $u = URI::file->new( $filename, [$os] )
|
---|
| 144 |
|
---|
| 145 | Maps a file name to the I<file:> URI name space, creates a URI object
|
---|
| 146 | and returns it. The $filename is interpreted as belonging to the
|
---|
| 147 | indicated operating system ($os), which defaults to the value of the
|
---|
| 148 | $^O variable. The $filename can be either absolute or relative, and
|
---|
| 149 | the corresponding type of URI object for $os is returned.
|
---|
| 150 |
|
---|
| 151 | =item $u = URI::file->new_abs( $filename, [$os] )
|
---|
| 152 |
|
---|
| 153 | Same as URI::file->new, but makes sure that the URI returned
|
---|
| 154 | represents an absolute file name. If the $filename argument is
|
---|
| 155 | relative, then the name is resolved relative to the current directory,
|
---|
| 156 | i.e. this constructor is really the same as:
|
---|
| 157 |
|
---|
| 158 | URI::file->new($filename)->abs(URI::file->cwd);
|
---|
| 159 |
|
---|
| 160 | =item $u = URI::file->cwd
|
---|
| 161 |
|
---|
| 162 | Returns a I<file> URI that represents the current working directory.
|
---|
| 163 | See L<Cwd>.
|
---|
| 164 |
|
---|
| 165 | =back
|
---|
| 166 |
|
---|
| 167 | The following methods are supported for I<file> URI (in addition to
|
---|
| 168 | the common and generic methods described in L<URI>):
|
---|
| 169 |
|
---|
| 170 | =over 4
|
---|
| 171 |
|
---|
| 172 | =item $u->file( [$os] )
|
---|
| 173 |
|
---|
| 174 | Returns a file name. It maps from the URI name space
|
---|
| 175 | to the file name space of the indicated operating system.
|
---|
| 176 |
|
---|
| 177 | It might return C<undef> if the name can not be represented in the
|
---|
| 178 | indicated file system.
|
---|
| 179 |
|
---|
| 180 | =item $u->dir( [$os] )
|
---|
| 181 |
|
---|
| 182 | Some systems use a different form for names of directories than for plain
|
---|
| 183 | files. Use this method if you know you want to use the name for
|
---|
| 184 | a directory.
|
---|
| 185 |
|
---|
| 186 | =back
|
---|
| 187 |
|
---|
| 188 | The C<URI::file> module can be used to map generic file names to names
|
---|
| 189 | suitable for the current system. As such, it can work as a nice
|
---|
| 190 | replacement for the C<File::Spec> module. For instance, the following
|
---|
| 191 | code translates the UNIX-style file name F<Foo/Bar.pm> to a name
|
---|
| 192 | suitable for the local system:
|
---|
| 193 |
|
---|
| 194 | $file = URI::file->new("Foo/Bar.pm", "unix")->file;
|
---|
| 195 | die "Can't map filename Foo/Bar.pm for $^O" unless defined $file;
|
---|
| 196 | open(FILE, $file) || die "Can't open '$file': $!";
|
---|
| 197 | # do something with FILE
|
---|
| 198 |
|
---|
| 199 | =head1 MAPPING NOTES
|
---|
| 200 |
|
---|
| 201 | Most computer systems today have hierarchically organized file systems.
|
---|
| 202 | Mapping the names used in these systems to the generic URI syntax
|
---|
| 203 | allows us to work with relative file URIs that behave as they should
|
---|
| 204 | when resolved using the generic algorithm for URIs (specified in RFC
|
---|
| 205 | 2396). Mapping a file name to the generic URI syntax involves mapping
|
---|
| 206 | the path separator character to "/" and encoding any reserved
|
---|
| 207 | characters that appear in the path segments of the file name. If
|
---|
| 208 | path segments consisting of the strings "." or ".." have a
|
---|
| 209 | different meaning than what is specified for generic URIs, then these
|
---|
| 210 | must be encoded as well.
|
---|
| 211 |
|
---|
| 212 | If the file system has device, volume or drive specifications as
|
---|
| 213 | the root of the name space, then it makes sense to map them to the
|
---|
| 214 | authority field of the generic URI syntax. This makes sure that
|
---|
| 215 | relative URIs can not be resolved "above" them, i.e. generally how
|
---|
| 216 | relative file names work in those systems.
|
---|
| 217 |
|
---|
| 218 | Another common use of the authority field is to encode the host on which
|
---|
| 219 | this file name is valid. The host name "localhost" is special and
|
---|
| 220 | generally has the same meaning as a missing or empty authority
|
---|
| 221 | field. This use is in conflict with using it as a device
|
---|
| 222 | specification, but can often be resolved for device specifications
|
---|
| 223 | having characters not legal in plain host names.
|
---|
| 224 |
|
---|
| 225 | File name to URI mapping in normally not one-to-one. There are
|
---|
| 226 | usually many URIs that map to any given file name. For instance, an
|
---|
| 227 | authority of "localhost" maps the same as a URI with a missing or empty
|
---|
| 228 | authority.
|
---|
| 229 |
|
---|
| 230 | Example 1: The Mac classic (Mac OS 9 and earlier) used ":" as path separator,
|
---|
| 231 | but not in the same way as a generic URI. ":foo" was a relative name. "foo:bar"
|
---|
| 232 | was an absolute name. Also, path segments could contain the "/" character as well
|
---|
| 233 | as the literal "." or "..". So the mapping looks like this:
|
---|
| 234 |
|
---|
| 235 | Mac classic URI
|
---|
| 236 | ---------- -------------------
|
---|
| 237 | :foo:bar <==> foo/bar
|
---|
| 238 | : <==> ./
|
---|
| 239 | ::foo:bar <==> ../foo/bar
|
---|
| 240 | ::: <==> ../../
|
---|
| 241 | foo:bar <==> file:/foo/bar
|
---|
| 242 | foo:bar: <==> file:/foo/bar/
|
---|
| 243 | .. <==> %2E%2E
|
---|
| 244 | <undef> <== /
|
---|
| 245 | foo/ <== file:/foo%2F
|
---|
| 246 | ./foo.txt <== file:/.%2Ffoo.txt
|
---|
| 247 |
|
---|
| 248 | Note that if you want a relative URL, you *must* begin the path with a :. Any
|
---|
| 249 | path that begins with [^:] is treated as absolute.
|
---|
| 250 |
|
---|
| 251 | Example 2: The UNIX file system is easy to map, as it uses the same path
|
---|
| 252 | separator as URIs, has a single root, and segments of "." and ".."
|
---|
| 253 | have the same meaning. URIs that have the character "\0" or "/" as
|
---|
| 254 | part of any path segment can not be turned into valid UNIX file names.
|
---|
| 255 |
|
---|
| 256 | UNIX URI
|
---|
| 257 | ---------- ------------------
|
---|
| 258 | foo/bar <==> foo/bar
|
---|
| 259 | /foo/bar <==> file:/foo/bar
|
---|
| 260 | /foo/bar <== file://localhost/foo/bar
|
---|
| 261 | file: ==> ./file:
|
---|
| 262 | <undef> <== file:/fo%00/bar
|
---|
| 263 | / <==> file:/
|
---|
| 264 |
|
---|
| 265 | =cut
|
---|
| 266 |
|
---|
| 267 |
|
---|
| 268 | RFC 1630
|
---|
| 269 |
|
---|
| 270 | [...]
|
---|
| 271 |
|
---|
| 272 | There is clearly a danger of confusion that a link made to a local
|
---|
| 273 | file should be followed by someone on a different system, with
|
---|
| 274 | unexpected and possibly harmful results. Therefore, the convention
|
---|
| 275 | is that even a "file" URL is provided with a host part. This allows
|
---|
| 276 | a client on another system to know that it cannot access the file
|
---|
| 277 | system, or perhaps to use some other local mechanism to access the
|
---|
| 278 | file.
|
---|
| 279 |
|
---|
| 280 | The special value "localhost" is used in the host field to indicate
|
---|
| 281 | that the filename should really be used on whatever host one is.
|
---|
| 282 | This for example allows links to be made to files which are
|
---|
| 283 | distributed on many machines, or to "your unix local password file"
|
---|
| 284 | subject of course to consistency across the users of the data.
|
---|
| 285 |
|
---|
| 286 | A void host field is equivalent to "localhost".
|
---|
| 287 |
|
---|
| 288 | =head1 CONFIGURATION VARIABLES
|
---|
| 289 |
|
---|
| 290 | The following configuration variables influence how the class and its
|
---|
| 291 | methods behave:
|
---|
| 292 |
|
---|
| 293 | =over
|
---|
| 294 |
|
---|
| 295 | =item %URI::file::OS_CLASS
|
---|
| 296 |
|
---|
| 297 | This hash maps OS identifiers to implementation classes. You might
|
---|
| 298 | want to add or modify this if you want to plug in your own file
|
---|
| 299 | handler class. Normally the keys should match the $^O values in use.
|
---|
| 300 |
|
---|
| 301 | If there is no mapping then the "Unix" implementation is used.
|
---|
| 302 |
|
---|
| 303 | =item $URI::file::DEFAULT_AUTHORITY
|
---|
| 304 |
|
---|
| 305 | This determine what "authority" string to include in absolute file
|
---|
| 306 | URIs. It defaults to "". If you prefer verbose URIs you might set it
|
---|
| 307 | to be "localhost".
|
---|
| 308 |
|
---|
| 309 | Setting this value to C<undef> force behaviour compatible to URI v1.31
|
---|
| 310 | and earlier. In this mode host names in UNC paths and drive letters
|
---|
| 311 | are mapped to the authority component on Windows, while we produce
|
---|
| 312 | authority-less URIs on Unix.
|
---|
| 313 |
|
---|
| 314 | =back
|
---|
| 315 |
|
---|
| 316 |
|
---|
| 317 | =head1 SEE ALSO
|
---|
| 318 |
|
---|
| 319 | L<URI>, L<File::Spec>, L<perlport>
|
---|
| 320 |
|
---|
| 321 | =head1 COPYRIGHT
|
---|
| 322 |
|
---|
| 323 | Copyright 1995-1998,2004 Gisle Aas.
|
---|
| 324 |
|
---|
| 325 | This library is free software; you can redistribute it and/or
|
---|
| 326 | modify it under the same terms as Perl itself.
|
---|
| 327 |
|
---|
| 328 | =cut
|
---|