Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | package File::Spec::Cygwin; |
2 | ||
3 | use strict; | |
4 | use vars qw(@ISA $VERSION); | |
5 | require File::Spec::Unix; | |
6 | ||
7 | $VERSION = '1.1'; | |
8 | ||
9 | @ISA = qw(File::Spec::Unix); | |
10 | ||
11 | =head1 NAME | |
12 | ||
13 | File::Spec::Cygwin - methods for Cygwin file specs | |
14 | ||
15 | =head1 SYNOPSIS | |
16 | ||
17 | require File::Spec::Cygwin; # Done internally by File::Spec if needed | |
18 | ||
19 | =head1 DESCRIPTION | |
20 | ||
21 | See L<File::Spec> and L<File::Spec::Unix>. This package overrides the | |
22 | implementation of these methods, not the semantics. | |
23 | ||
24 | This module is still in beta. Cygwin-knowledgeable folks are invited | |
25 | to offer patches and suggestions. | |
26 | ||
27 | =cut | |
28 | ||
29 | =pod | |
30 | ||
31 | =over 4 | |
32 | ||
33 | =item canonpath | |
34 | ||
35 | Any C<\> (backslashes) are converted to C</> (forward slashes), | |
36 | and then File::Spec::Unix canonpath() is called on the result. | |
37 | ||
38 | =cut | |
39 | ||
40 | sub canonpath { | |
41 | my($self,$path) = @_; | |
42 | $path =~ s|\\|/|g; | |
43 | return $self->SUPER::canonpath($path); | |
44 | } | |
45 | ||
46 | =pod | |
47 | ||
48 | =item file_name_is_absolute | |
49 | ||
50 | True is returned if the file name begins with C<drive_letter:>, | |
51 | and if not, File::Spec::Unix file_name_is_absolute() is called. | |
52 | ||
53 | =cut | |
54 | ||
55 | ||
56 | sub file_name_is_absolute { | |
57 | my ($self,$file) = @_; | |
58 | return 1 if $file =~ m{^([a-z]:)?[\\/]}is; # C:/test | |
59 | return $self->SUPER::file_name_is_absolute($file); | |
60 | } | |
61 | ||
62 | =item tmpdir (override) | |
63 | ||
64 | Returns a string representation of the first existing directory | |
65 | from the following list: | |
66 | ||
67 | $ENV{TMPDIR} | |
68 | /tmp | |
69 | C:/temp | |
70 | ||
71 | Since Perl 5.8.0, if running under taint mode, and if the environment | |
72 | variables are tainted, they are not used. | |
73 | ||
74 | =cut | |
75 | ||
76 | my $tmpdir; | |
77 | sub tmpdir { | |
78 | return $tmpdir if defined $tmpdir; | |
79 | $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", 'C:/temp' ); | |
80 | } | |
81 | ||
82 | =back | |
83 | ||
84 | =head1 COPYRIGHT | |
85 | ||
86 | Copyright (c) 2004 by the Perl 5 Porters. All rights reserved. | |
87 | ||
88 | This program is free software; you can redistribute it and/or modify | |
89 | it under the same terms as Perl itself. | |
90 | ||
91 | =cut | |
92 | ||
93 | 1; |