home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _074e117e35aefa1677f5d4cc89877cbc < prev    next >
Text File  |  2000-03-15  |  1KB  |  74 lines
  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->extract_authority($path);
  15.     ($path, $escaped_path) = $class->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 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.  
  40. sub extract_authority
  41. {
  42.     undef;
  43. }
  44.  
  45. sub extract_path
  46. {
  47.     undef;
  48. }
  49.  
  50. sub is_this_host
  51. {
  52.     shift; # class
  53.     my $host = lc(shift);
  54.     return 1 if $host eq "localhost";
  55.     eval {
  56.     require Net::Domain;
  57.     lc(Net::Domain::hostfqdn()) eq $host ||
  58.     lc(Net::Domain::hostname()) eq $host;
  59.     };
  60. }
  61.  
  62. sub file
  63. {
  64.     undef;
  65. }
  66.  
  67. sub dir
  68. {
  69.     my $self = shift;
  70.     $self->file(@_);
  71. }
  72.  
  73. 1;
  74.