Commit | Line | Data |
3fea05b9 |
1 | package URI::file::Base; |
2 | |
3 | use strict; |
4 | use URI::Escape qw(); |
5 | |
6 | sub new |
7 | { |
8 | my $class = shift; |
9 | my $path = shift; |
10 | $path = "" unless defined $path; |
11 | |
12 | my($auth, $escaped_auth, $escaped_path); |
13 | |
14 | ($auth, $escaped_auth) = $class->_file_extract_authority($path); |
15 | ($path, $escaped_path) = $class->_file_extract_path($path); |
16 | |
17 | if (defined $auth) { |
18 | $auth =~ s,%,%25,g unless $escaped_auth; |
19 | $auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg; |
20 | $auth = "//$auth"; |
21 | if (defined $path) { |
22 | $path = "/$path" unless substr($path, 0, 1) eq "/"; |
23 | } else { |
24 | $path = ""; |
25 | } |
26 | } else { |
27 | return undef unless defined $path; |
28 | $auth = ""; |
29 | } |
30 | |
31 | $path =~ s,([%;?]), URI::Escape::escape_char($1),eg unless $escaped_path; |
32 | $path =~ s/\#/%23/g; |
33 | |
34 | my $uri = $auth . $path; |
35 | $uri = "file:$uri" if substr($uri, 0, 1) eq "/"; |
36 | |
37 | URI->new($uri, "file"); |
38 | } |
39 | |
40 | sub _file_extract_authority |
41 | { |
42 | my($class, $path) = @_; |
43 | return undef unless $class->_file_is_absolute($path); |
44 | return $URI::file::DEFAULT_AUTHORITY; |
45 | } |
46 | |
47 | sub _file_extract_path |
48 | { |
49 | return undef; |
50 | } |
51 | |
52 | sub _file_is_absolute |
53 | { |
54 | return 0; |
55 | } |
56 | |
57 | sub _file_is_localhost |
58 | { |
59 | shift; # class |
60 | my $host = lc(shift); |
61 | return 1 if $host eq "localhost"; |
62 | eval { |
63 | require Net::Domain; |
64 | lc(Net::Domain::hostfqdn()) eq $host || |
65 | lc(Net::Domain::hostname()) eq $host; |
66 | }; |
67 | } |
68 | |
69 | sub file |
70 | { |
71 | undef; |
72 | } |
73 | |
74 | sub dir |
75 | { |
76 | my $self = shift; |
77 | $self->file(@_); |
78 | } |
79 | |
80 | 1; |