1 package File::Spec::Cygwin;
4 use vars qw(@ISA $VERSION);
5 require File::Spec::Unix;
8 $VERSION = eval $VERSION;
10 @ISA = qw(File::Spec::Unix);
14 File::Spec::Cygwin - methods for Cygwin file specs
18 require File::Spec::Cygwin; # Done internally by File::Spec if needed
22 See L<File::Spec> and L<File::Spec::Unix>. This package overrides the
23 implementation of these methods, not the semantics.
25 This module is still in beta. Cygwin-knowledgeable folks are invited
26 to offer patches and suggestions.
36 Any C<\> (backslashes) are converted to C</> (forward slashes),
37 and then File::Spec::Unix canonpath() is called on the result.
43 return unless defined $path;
47 # Handle network path names beginning with double slash
49 if ( $path =~ s@^(//[^/]+)(?:/|\z)@/@s ) {
52 return $node . $self->SUPER::canonpath($path);
59 # Don't create something that looks like a //network/path
60 if ($_[0] and ($_[0] eq '/' or $_[0] eq '\\')) {
62 return $self->SUPER::catdir('', @_);
65 $self->SUPER::catdir(@_);
70 =item file_name_is_absolute
72 True is returned if the file name begins with C<drive_letter:>,
73 and if not, File::Spec::Unix file_name_is_absolute() is called.
78 sub file_name_is_absolute {
79 my ($self,$file) = @_;
80 return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test
81 return $self->SUPER::file_name_is_absolute($file);
84 =item tmpdir (override)
86 Returns a string representation of the first existing directory
87 from the following list:
95 Since Perl 5.8.0, if running under taint mode, and if the environment
96 variables are tainted, they are not used.
102 return $tmpdir if defined $tmpdir;
103 $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", $ENV{'TMP'}, $ENV{'TEMP'}, 'C:/temp' );
108 Override Unix. Cygwin case-tolerance depends on managed mount settings and
109 as with MsWin32 on GetVolumeInformation() $ouFsFlags == FS_CASE_SENSITIVE,
110 indicating the case significance when comparing file specifications.
116 return 1 unless $^O eq 'cygwin'
117 and defined &Cygwin::mount_flags;
121 my @flags = split(/,/, Cygwin::mount_flags('/cygwin'));
122 my $prefix = pop(@flags);
123 if (! $prefix || $prefix eq 'cygdrive') {
124 $drive = '/cygdrive/c';
125 } elsif ($prefix eq '/') {
128 $drive = "$prefix/c";
131 my $mntopts = Cygwin::mount_flags($drive);
132 if ($mntopts and ($mntopts =~ /,managed/)) {
135 eval { require Win32API::File; } or return 1;
136 my $osFsType = "\0"x256;
137 my $osVolName = "\0"x256;
139 Win32API::File::GetVolumeInformation($drive, $osVolName, 256, [], [], $ouFsFlags, $osFsType, 256 );
140 if ($ouFsFlags & Win32API::File::FS_CASE_SENSITIVE()) { return 0; }
148 Copyright (c) 2004,2007 by the Perl 5 Porters. All rights reserved.
150 This program is free software; you can redistribute it and/or modify
151 it under the same terms as Perl itself.