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 devnull {
  70     return "nul";
  71 }
  72
  73 sub path {
  74     local $^W = 1;
  75     my($self) = @_;
  76     my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
  77     my @path = split(';',$path);
  78     foreach(@path) { $_ = '.' if $_ eq '' }
  79     @path;
  80 }
  81
  82 =item canonpath
  83
  84 No physical check on the filesystem, but a logical cleanup of a
  85 path. On UNIX eliminated successive slashes and successive "/.".
  86
  87 =cut
  88
  89 sub canonpath {
  90     my($self,$path) = @_;
  91     $path =~ s/^([a-z]:)/\u$1/;
  92     $path =~ s|/|\\|g;
  93     $path =~ s|\\+|\\|g ;                          # xx////xx  -> xx/xx
  94     $path =~ s|(\\\.)+\\|\\|g ;                    # xx/././xx -> xx/xx
  95     $path =~ s|^(\.\\)+|| unless $path eq ".\\";   # ./xx      -> xx
  96     $path =~ s|\\$||
  97              unless $path =~ m#^([a-z]:)?\\#;      # xx/       -> xx
  98     $path .= '.' if $path =~ m#\\$#;
  99     $path;
 100 }
 101
 102 1;
 103 __END__
 104
 105 =back
 106
 107 =cut
 108