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