lib/File/Spec/Epoc.pm

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