This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
tweak select() test
[perl5.git] / lib / File / Spec / Win32.pm
CommitLineData
270d1e39
GS
1package File::Spec::Win32;
2
3=head1 NAME
4
5File::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
13See File::Spec::Unix for a documentation of the methods provided
14there. This package overrides the implementation of these methods, not
15the semantics.
16
17=over
18
19=cut
20
21#use Config;
22#use Cwd;
23use File::Basename;
24require Exporter;
25use strict;
26
27use vars qw(@ISA);
28
29use File::Spec;
30Exporter::import('File::Spec', qw( $Verbose));
31
32@ISA = qw(File::Spec::Unix);
33
34$ENV{EMXSHELL} = 'sh'; # to run `commands`
35
36sub file_name_is_absolute {
37 my($self,$file) = @_;
38 $file =~ m{^([a-z]:)?[\\/]}i ;
39}
40
41sub 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
54Concatenate one or more directory names and a filename to form a
55complete path ending with a filename
56
57=cut
58
59sub 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
99804bbb
GS
69sub devnull {
70 return "nul";
71}
72
270d1e39
GS
73sub 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
84No physical check on the filesystem, but a logical cleanup of a
85path. On UNIX eliminated successive slashes and successive "/.".
86
87=cut
88
89sub 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
1021;
103__END__
104
105=back
106
107=cut
108