lib/File/Spec/Cygwin.pm

   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_01';
   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
  44     # Handle network path names beginning with double slash
  45     my $node = '';
  46     if ( $path =~ s@^(//[^/]+)(?:/|\z)@/@s ) {
  47         $node = $1;
  48     }
  49     return $node . $self->SUPER::canonpath($path);
  50 }
  51
  52 sub catdir {
  53     my $self = shift;
  54
  55     # Don't create something that looks like a //network/path
  56     if ($_[0] eq '/' or $_[0] eq '\\') {
  57         shift;
  58         return $self->SUPER::catdir('', @_);
  59     }
  60
  61     $self->SUPER::catdir(@_);
  62 }
  63
  64 =pod
  65
  66 =item file_name_is_absolute
  67
  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.
  70
  71 =cut
  72
  73
  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);
  78 }
  79
  80 =item tmpdir (override)
  81
  82 Returns a string representation of the first existing directory
  83 from the following list:
  84
  85     $ENV{TMPDIR}
  86     /tmp
  87     C:/temp
  88
  89 Since Perl 5.8.0, if running under taint mode, and if the environment
  90 variables are tainted, they are not used.
  91
  92 =cut
  93
  94 my $tmpdir;
  95 sub tmpdir {
  96     return $tmpdir if defined $tmpdir;
  97     $tmpdir = $_[0]->_tmpdir( $ENV{TMPDIR}, "/tmp", 'C:/temp' );
  98 }
  99
 100 =item case_tolerant
 101
 102 Override Unix. Cygwin is always case-tolerant, indicating that it is not
 103 significant when comparing file specifications.
 104
 105 =cut
 106
 107 sub case_tolerant () { 1 }
 108
 109 =back
 110
 111 =head1 COPYRIGHT
 112
 113 Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
 114
 115 This program is free software; you can redistribute it and/or modify
 116 it under the same terms as Perl itself.
 117
 118 =cut
 119
 120 1;