cpan/Cwd/lib/File/Spec/Epoc.pm

   1 package File::Spec::Epoc;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA);
   5
   6 $VERSION = '3.30';
   7 $VERSION = eval $VERSION;
   8
   9 require File::Spec::Unix;
  10 @ISA = qw(File::Spec::Unix);
  11
  12 =head1 NAME
  13
  14 File::Spec::Epoc - methods for Epoc file specs
  15
  16 =head1 SYNOPSIS
  17
  18  require File::Spec::Epoc; # Done internally by File::Spec if needed
  19
  20 =head1 DESCRIPTION
  21
  22 See File::Spec::Unix for a documentation of the methods provided
  23 there. This package overrides the implementation of these methods, not
  24 the semantics.
  25
  26 This package is still work in progress ;-)
  27
  28 =cut
  29
  30 sub case_tolerant {
  31     return 1;
  32 }
  33
  34 =pod
  35
  36 =over 4
  37
  38 =item canonpath()
  39
  40 No physical check on the filesystem, but a logical cleanup of a
  41 path. On UNIX eliminated successive slashes and successive "/.".
  42
  43 =back
  44
  45 =cut
  46
  47 sub canonpath {
  48     my ($self,$path) = @_;
  49     return unless defined $path;
  50
  51     $path =~ s|/+|/|g;                             # xx////xx  -> xx/xx
  52     $path =~ s|(/\.)+/|/|g;                        # xx/././xx -> xx/xx
  53     $path =~ s|^(\./)+||s unless $path eq "./";    # ./xx      -> xx
  54     $path =~ s|^/(\.\./)+|/|s;                     # /../../xx -> xx
  55     $path =~  s|/\Z(?!\n)|| unless $path eq "/";          # xx/       -> xx
  56     return $path;
  57 }
  58
  59 =pod
  60
  61 =head1 AUTHOR
  62
  63 o.flebbe@gmx.de
  64
  65 =head1 COPYRIGHT
  66
  67 Copyright (c) 2004 by the Perl 5 Porters.  All rights reserved.
  68
  69 This program is free software; you can redistribute it and/or modify
  70 it under the same terms as Perl itself.
  71
  72 =head1 SEE ALSO
  73
  74 See L<File::Spec> and L<File::Spec::Unix>.  This package overrides the
  75 implementation of these methods, not the semantics.
  76
  77 =cut
  78
  79 1;