File Coverage

blib/lib/File/Spec/Epoc.pm
Criterion Covered Total %
statement 15 15 100.0
branch 5 6 83.3
condition n/a
subroutine 4 4 100.0
pod 2 2 100.0
total 26 27 96.3


line stmt bran cond sub pod time code
1             package File::Spec::Epoc;
2              
3 2     2   2378 use strict;
  2         5  
  2         68  
4 2     2   9 use vars qw($VERSION @ISA);
  2         4  
  2         556  
5              
6             $VERSION = '3.62';
7             $VERSION =~ tr/_//d;
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 a work in progress. ;-)
27              
28             =cut
29              
30             sub case_tolerant {
31 1     1 1 661 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 72     72 1 3205 my ($self,$path) = @_;
49 72 100       194 return unless defined $path;
50              
51 70         263 $path =~ s|/+|/|g; # xx////xx -> xx/xx
52 70         125 $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx
53 70 50       167 $path =~ s|^(\./)+||s unless $path eq "./"; # ./xx -> xx
54 70         95 $path =~ s|^/(\.\./)+|/|s; # /../../xx -> xx
55 70 100       212 $path =~ s|/\Z(?!\n)|| unless $path eq "/"; # xx/ -> xx
56 70         682 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 and L. This package overrides the
75             implementation of these methods, not the semantics.
76              
77             =cut
78              
79             1;