home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / lib / zip / File / Spec / Win32.pm < prev   
Encoding:
Perl POD Document  |  1998-07-30  |  2.1 KB  |  105 lines
  1. package File::Spec::Win32;
  2.  
  3. =head1 NAME
  4.  
  5. File::Spec::Win32 - methods for Win32 file specs
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.  use File::Spec::Win32; # Done internally by File::Spec if needed
  10.  
  11. =head1 DESCRIPTION
  12.  
  13. See File::Spec::Unix for a documentation of the methods provided
  14. there. This package overrides the implementation of these methods, not
  15. the semantics.
  16.  
  17. =over
  18.  
  19. =cut 
  20.  
  21. #use Config;
  22. #use Cwd;
  23. use File::Basename;
  24. require Exporter;
  25. use strict;
  26.  
  27. use vars qw(@ISA);
  28.  
  29. use File::Spec;
  30. Exporter::import('File::Spec', qw( $Verbose));
  31.  
  32. @ISA = qw(File::Spec::Unix);
  33.  
  34. $ENV{EMXSHELL} = 'sh'; # to run `commands`
  35.  
  36. sub file_name_is_absolute {
  37.     my($self,$file) = @_;
  38.     $file =~ m{^([a-z]:)?[\\/]}i ;
  39. }
  40.  
  41. sub catdir {
  42.     my $self = shift;
  43.     my @args = @_;
  44.     for (@args) {
  45.     # append a slash to each argument unless it has one there
  46.     $_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\";
  47.     }
  48.     my $result = $self->canonpath(join('', @args));
  49.     $result;
  50. }
  51.  
  52. =item catfile
  53.  
  54. Concatenate one or more directory names and a filename to form a
  55. complete path ending with a filename
  56.  
  57. =cut
  58.  
  59. sub catfile {
  60.     my $self = shift @_;
  61.     my $file = pop @_;
  62.     return $file unless @_;
  63.     my $dir = $self->catdir(@_);
  64.     $dir =~ s/(\\\.)$//;
  65.     $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\";
  66.     return $dir.$file;
  67. }
  68.  
  69. sub path {
  70.     local $^W = 1;
  71.     my($self) = @_;
  72.     my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
  73.     my @path = split(';',$path);
  74.     foreach(@path) { $_ = '.' if $_ eq '' }
  75.     @path;
  76. }
  77.  
  78. =item canonpath
  79.  
  80. No physical check on the filesystem, but a logical cleanup of a
  81. path. On UNIX eliminated successive slashes and successive "/.".
  82.  
  83. =cut
  84.  
  85. sub canonpath {
  86.     my($self,$path) = @_;
  87.     $path =~ s/^([a-z]:)/\u$1/;
  88.     $path =~ s|/|\\|g;
  89.     $path =~ s|\\+|\\|g ;                          # xx////xx  -> xx/xx
  90.     $path =~ s|(\\\.)+\\|\\|g ;                    # xx/././xx -> xx/xx
  91.     $path =~ s|^(\.\\)+|| unless $path eq ".\\";   # ./xx      -> xx
  92.     $path =~ s|\\$|| 
  93.              unless $path =~ m#^([a-z]:)?\\#;      # xx/       -> xx
  94.     $path .= '.' if $path =~ m#\\$#;
  95.     $path;
  96. }
  97.  
  98. 1;
  99. __END__
  100.  
  101. =back
  102.  
  103. =cut 
  104.  
  105.