1 package File::Spec::Cygwin;
4 use vars qw(@ISA $VERSION);
5 require File::Spec::Unix;
9 @ISA = qw(File::Spec::Unix);
13 File::Spec::Cygwin - methods for Cygwin file specs
17 require File::Spec::Cygwin; # Done internally by File::Spec if needed
21 See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
22 implementation of these methods, not the semantics.
24 This module is still in beta. Cygwin-knowledgeable folks are invited
25 to offer patches and suggestions.
35 Any C<\> (backslashes) are converted to C</> (forward slashes),
36 and then File::Spec::Unix canonpath() is called on the result.
44 # Handle network path names beginning with double slash
46 if ( $path =~ s@^(//[^/]+)(?:/|\z)@/@s ) {
49 return $node . $self->SUPER::canonpath($path);
55 # Don't create something that looks like a //network/path
56 if ($_[0] and ($_[0] eq '/' or $_[0] eq '\\')) {
58 return $self->SUPER::catdir('', @_);
61 $self->SUPER::catdir(@_);
66 =item file_name_is_absolute
68 True is returned if the file name begins with C<drive_letter:>,
69 and if not, File::Spec::Unix file_name_is_absolute() is called.
74 sub file_name_is_absolute {
75 my ($self,$file) = @_;
76 return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test
77 return $self->SUPER::file_name_is_absolute($file);
80 =item tmpdir (override)
82 Returns a string representation of the first existing directory
83 from the following list:
91 Since Perl 5.8.0, if running under taint mode, and if the environment
92 variables are tainted, they are not used.
98 return $tmpdir if defined $tmpdir;
99 $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", $ENV{'TMP'}, $ENV{'TEMP'}, 'C:/temp' );
104 Override Unix. Cygwin case-tolerance depends on managed mount settings and
105 as with MsWin32 on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
106 indicating the case significance when comparing file specifications.
111 sub case_tolerant () {
112 if ($^O ne 'cygwin') {
117 my @flags = split(/,/, Cygwin::mount_flags('/cygwin'));
118 my $prefix = pop(@flags);
119 if (! $prefix || $prefix eq 'cygdrive') {
120 $drive = '/cygdrive/c';
121 } elsif ($prefix eq '/') {
124 $drive = "$prefix/c";
127 my $mntopts = Cygwin::mount_flags($drive);
128 if ($mntopts and ($mntopts =~ /,managed/)) {
131 eval { require Win32API::File; } or return 1;
132 my $osFsType = "\0"x256;
133 my $osVolName = "\0"x256;
135 Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
136 if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
144 Copyright (c) 2004,2007 by the Perl 5 Porters. All rights reserved.
146 This program is free software; you can redistribute it and/or modify
147 it under the same terms as Perl itself.