home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _8e6fffa7c8d125f7c32c359a99e313cc < prev    next >
Encoding:
Text File  |  2004-06-01  |  930 b   |  49 lines
  1. package URI::file::Unix;
  2.  
  3. require URI::file::Base;
  4. @ISA=qw(URI::file::Base);
  5.  
  6. use strict;
  7. use URI::Escape qw(uri_unescape);
  8.  
  9. sub extract_path
  10. {
  11.     my($class, $path) = @_;
  12.     # tidy path
  13.     $path =~ s,//+,/,g;
  14.     $path =~ s,(/\.)+/,/,g;
  15.     $path = "./$path" if $path =~ m,^[^:/]+:,,; # look like "scheme:"
  16.     $path;
  17. }
  18.  
  19. sub file
  20. {
  21.     my $class = shift;
  22.     my $uri = shift;
  23.  
  24.     my @path;
  25.  
  26.     my $auth = $uri->authority;
  27.     if (defined($auth)) {
  28.     if (lc($auth) ne "localhost" && $auth ne "") {
  29.         $auth = uri_unescape($auth);
  30.         unless ($class->is_this_host($auth)) {
  31.         push(@path, "", "", $auth);
  32.         }
  33.     }
  34.     }
  35.  
  36.     my @ps = $uri->path_segments;
  37.     shift @ps if @path;
  38.     push(@path, @ps);
  39.  
  40.     for (@path) {
  41.     # Unix file/directory names are not allowed to contain '\0' or '/'
  42.     return if /\0/;
  43.     return if /\//;  # should we really?
  44.     }
  45.     join("/", @path);
  46. }
  47.  
  48. 1;
  49.