Commit | Line | Data |
270d1e39 |
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 | |
99804bbb |
69 | sub devnull { |
70 | return "nul"; |
71 | } |
72 | |
270d1e39 |
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 | |