source: main/trunk/greenstone2/perllib/cpan/URI/file.pm@ 27174

Last change on this file since 27174 was 27174, checked in by davidb, 11 years ago

Perl modules from CPAN that are used in supporting activate.pl, but not part of the Perl core. Only PMs included.

File size: 9.6 KB
Line 
1package URI::file;
2
3use strict;
4use vars qw(@ISA $VERSION $DEFAULT_AUTHORITY %OS_CLASS);
5
6require URI::_generic;
7@ISA = qw(URI::_generic);
8$VERSION = "4.21";
9
10use 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
27sub 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
40sub host { uri_unescape(shift->authority(@_)) }
41
42sub new
43{
44 my($class, $path, $os) = @_;
45 os_class($os)->new($path);
46}
47
48sub 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
56sub 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
67sub 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
94sub file
95{
96 my($self, $os) = @_;
97 os_class($os)->file($self);
98}
99
100sub dir
101{
102 my($self, $os) = @_;
103 os_class($os)->dir($self);
104}
105
1061;
107
108__END__
109
110=head1 NAME
111
112URI::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
129The C<URI::file> class supports C<URI> objects belonging to the I<file>
130URI scheme. This scheme allows us to map the conventional file names
131found on various computer systems to the URI name space. An old
132specification of the I<file> URI scheme is found in RFC 1738. Some
133older background information is also in RFC 1630. There are no newer
134specifications as far as I know.
135
136If you simply want to construct I<file> URI objects from URI strings,
137use the normal C<URI> constructor. If you want to construct I<file>
138URI objects from the actual file names used by various systems, then
139use one of the following C<URI::file> constructors:
140
141=over 4
142
143=item $u = URI::file->new( $filename, [$os] )
144
145Maps a file name to the I<file:> URI name space, creates a URI object
146and returns it. The $filename is interpreted as belonging to the
147indicated operating system ($os), which defaults to the value of the
148$^O variable. The $filename can be either absolute or relative, and
149the corresponding type of URI object for $os is returned.
150
151=item $u = URI::file->new_abs( $filename, [$os] )
152
153Same as URI::file->new, but makes sure that the URI returned
154represents an absolute file name. If the $filename argument is
155relative, then the name is resolved relative to the current directory,
156i.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
162Returns a I<file> URI that represents the current working directory.
163See L<Cwd>.
164
165=back
166
167The following methods are supported for I<file> URI (in addition to
168the common and generic methods described in L<URI>):
169
170=over 4
171
172=item $u->file( [$os] )
173
174Returns a file name. It maps from the URI name space
175to the file name space of the indicated operating system.
176
177It might return C<undef> if the name can not be represented in the
178indicated file system.
179
180=item $u->dir( [$os] )
181
182Some systems use a different form for names of directories than for plain
183files. Use this method if you know you want to use the name for
184a directory.
185
186=back
187
188The C<URI::file> module can be used to map generic file names to names
189suitable for the current system. As such, it can work as a nice
190replacement for the C<File::Spec> module. For instance, the following
191code translates the UNIX-style file name F<Foo/Bar.pm> to a name
192suitable 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
201Most computer systems today have hierarchically organized file systems.
202Mapping the names used in these systems to the generic URI syntax
203allows us to work with relative file URIs that behave as they should
204when resolved using the generic algorithm for URIs (specified in RFC
2052396). Mapping a file name to the generic URI syntax involves mapping
206the path separator character to "/" and encoding any reserved
207characters that appear in the path segments of the file name. If
208path segments consisting of the strings "." or ".." have a
209different meaning than what is specified for generic URIs, then these
210must be encoded as well.
211
212If the file system has device, volume or drive specifications as
213the root of the name space, then it makes sense to map them to the
214authority field of the generic URI syntax. This makes sure that
215relative URIs can not be resolved "above" them, i.e. generally how
216relative file names work in those systems.
217
218Another common use of the authority field is to encode the host on which
219this file name is valid. The host name "localhost" is special and
220generally has the same meaning as a missing or empty authority
221field. This use is in conflict with using it as a device
222specification, but can often be resolved for device specifications
223having characters not legal in plain host names.
224
225File name to URI mapping in normally not one-to-one. There are
226usually many URIs that map to any given file name. For instance, an
227authority of "localhost" maps the same as a URI with a missing or empty
228authority.
229
230Example 1: The Mac classic (Mac OS 9 and earlier) used ":" as path separator,
231but not in the same way as a generic URI. ":foo" was a relative name. "foo:bar"
232was an absolute name. Also, path segments could contain the "/" character as well
233as 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
248Note that if you want a relative URL, you *must* begin the path with a :. Any
249path that begins with [^:] is treated as absolute.
250
251Example 2: The UNIX file system is easy to map, as it uses the same path
252separator as URIs, has a single root, and segments of "." and ".."
253have the same meaning. URIs that have the character "\0" or "/" as
254part 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
268RFC 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
290The following configuration variables influence how the class and its
291methods behave:
292
293=over
294
295=item %URI::file::OS_CLASS
296
297This hash maps OS identifiers to implementation classes. You might
298want to add or modify this if you want to plug in your own file
299handler class. Normally the keys should match the $^O values in use.
300
301If there is no mapping then the "Unix" implementation is used.
302
303=item $URI::file::DEFAULT_AUTHORITY
304
305This determine what "authority" string to include in absolute file
306URIs. It defaults to "". If you prefer verbose URIs you might set it
307to be "localhost".
308
309Setting this value to C<undef> force behaviour compatible to URI v1.31
310and earlier. In this mode host names in UNC paths and drive letters
311are mapped to the authority component on Windows, while we produce
312authority-less URIs on Unix.
313
314=back
315
316
317=head1 SEE ALSO
318
319L<URI>, L<File::Spec>, L<perlport>
320
321=head1 COPYRIGHT
322
323Copyright 1995-1998,2004 Gisle Aas.
324
325This library is free software; you can redistribute it and/or
326modify it under the same terms as Perl itself.
327
328=cut
Note: See TracBrowser for help on using the repository browser.