lib/File/Spec/Win32.pm

   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