This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add File-Spec-0.6 from CPAN
[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
69sub 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
80No physical check on the filesystem, but a logical cleanup of a
81path. On UNIX eliminated successive slashes and successive "/.".
82
83=cut
84
85sub 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
981;
99__END__
100
101=back
102
103=cut
104