54ff667c52f4529fe312b5f480793f2a720169eb
[perl.git] / ext / 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;