lib/File/Spec/Win32.pm

   1 package File::Spec::Win32;
   2
   3 use strict;
   4 use vars qw(@ISA);
   5 require File::Spec::Unix;
   6 @ISA = qw(File::Spec::Unix);
   7
   8 =head1 NAME
   9
  10 File::Spec::Win32 - methods for Win32 file specs
  11
  12 =head1 SYNOPSIS
  13
  14  require File::Spec::Win32; # Done internally by File::Spec if needed
  15
  16 =head1 DESCRIPTION
  17
  18 See File::Spec::Unix for a documentation of the methods provided
  19 there. This package overrides the implementation of these methods, not
  20 the semantics.
  21
  22 =over
  23
  24 =item devnull
  25
  26 Returns a string representation of the null device.
  27
  28 =cut
  29
  30 sub devnull {
  31     return "nul";
  32 }
  33
  34 =item tmpdir
  35
  36 Returns a string representation of the first existing directory
  37 from the following list:
  38
  39     $ENV{TMPDIR}
  40     $ENV{TEMP}
  41     $ENV{TMP}
  42     /tmp
  43     /
  44
  45 =cut
  46
  47 my $tmpdir;
  48 sub tmpdir {
  49     return $tmpdir if defined $tmpdir;
  50     my $self = shift;
  51     foreach (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)) {
  52         next unless defined && -d;
  53         $tmpdir = $_;
  54         last;
  55     }
  56     $tmpdir = '' unless defined $tmpdir;
  57     $tmpdir = $self->canonpath($tmpdir);
  58     return $tmpdir;
  59 }
  60
  61 sub file_name_is_absolute {
  62     my ($self,$file) = @_;
  63     return scalar($file =~ m{^([a-z]:)?[\\/]}i);
  64 }
  65
  66 =item catfile
  67
  68 Concatenate one or more directory names and a filename to form a
  69 complete path ending with a filename
  70
  71 =cut
  72
  73 sub catfile {
  74     my $self = shift;
  75     my $file = pop @_;
  76     return $file unless @_;
  77     my $dir = $self->catdir(@_);
  78     $dir .= "\\" unless substr($dir,-1) eq "\\";
  79     return $dir.$file;
  80 }
  81
  82 sub path {
  83     local $^W = 1;
  84     my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
  85     my @path = split(';',$path);
  86     foreach (@path) { $_ = '.' if $_ eq '' }
  87     return @path;
  88 }
  89
  90 =item canonpath
  91
  92 No physical check on the filesystem, but a logical cleanup of a
  93 path. On UNIX eliminated successive slashes and successive "/.".
  94
  95 =cut
  96
  97 sub canonpath {
  98     my ($self,$path) = @_;
  99     $path =~ s/^([a-z]:)/\u$1/;
 100     $path =~ s|/|\\|g;
 101     $path =~ s|([^\\])\\+|\1\\|g;                  # xx////xx  -> xx/xx
 102     $path =~ s|(\\\.)+\\|\\|g;                     # xx/././xx -> xx/xx
 103     $path =~ s|^(\.\\)+|| unless $path eq ".\\";   # ./xx      -> xx
 104     $path =~ s|\\$||
 105              unless $path =~ m#^([A-Z]:)?\\#;      # xx/       -> xx
 106     return $path;
 107 }
 108
 109 =back
 110
 111 =head1 SEE ALSO
 112
 113 L<File::Spec>
 114
 115 =cut
 116
 117 1;