File Coverage

blib/lib/File/Spec/Epoc.pm
Criterion Covered Total %
statement 12 12 100.0
branch 5 6 83.3
condition n/a
subroutine 3 3 100.0
pod 2 2 100.0
total 22 23 95.6


line stmt bran cond sub pod time code
1             package File::Spec::Epoc;
2              
3 2     2   2083 use strict;
  2         4  
  2         526  
4              
5             our $VERSION = '3.75';
6             $VERSION =~ tr/_//d;
7              
8             require File::Spec::Unix;
9             our @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 a work in progress. ;-)
26              
27             =cut
28              
29             sub case_tolerant {
30 1     1 1 625 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 72     72 1 3394 my ($self,$path) = @_;
48 72 100       139 return unless defined $path;
49              
50 70         251 $path =~ s|/+|/|g; # xx////xx -> xx/xx
51 70         175 $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
52 70 50       137 $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
53 70         90 $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx
54 70 100       147 $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx
55 70         523 return $path;
56             }
57              
58             =pod
59              
60             =head1 AUTHOR
61              
62             o.flebbe@gmx.de
63              
64             =head1 COPYRIGHT
65              
66             Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
67              
68             This program is free software; you can redistribute it and/or modify
69             it under the same terms as Perl itself.
70              
71             =head1 SEE ALSO
72              
73             See L and L. This package overrides the
74             implementation of these methods, not the semantics.
75              
76             =cut
77              
78             1;