1package URI::file::Base; 2 3use strict; 4use URI::Escape qw(); 5 6sub 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::escapes{$1},g; 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::escapes{$1},g 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 40sub _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 47sub _file_extract_path 48{ 49 return undef; 50} 51 52sub _file_is_absolute 53{ 54 return 0; 55} 56 57sub _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 69sub file 70{ 71 undef; 72} 73 74sub dir 75{ 76 my $self = shift; 77 $self->file(@_); 78} 79 801; 81