File Coverage

blib/lib/File/Path/Collapse.pm
Criterion Covered Total %
statement 25 37 67.5
branch 0 10 0.0
condition 0 9 0.0
subroutine 9 10 90.0
pod 1 1 100.0
total 35 67 52.2


line stmt bran cond sub pod time code
1              
2             package File::Path::Collapse ;
3              
4 2     2   85721 use strict;
  2         5  
  2         81  
5 2     2   14 use warnings ;
  2         4  
  2         59  
6 2     2   12 use Carp ;
  2         9  
  2         219  
7              
8             BEGIN
9             {
10 2         23 use Sub::Exporter -setup =>
11             {
12             exports => [ qw(CollapsePath) ],
13             groups =>
14             {
15             all => [ qw(CollapsePath) ],
16             }
17 2     2   2460 };
  2         29317  
18            
19 2     2   820 use vars qw ($VERSION);
  2         4  
  2         93  
20 2     2   41 $VERSION = '0.03';
21             }
22              
23             #-------------------------------------------------------------------------------
24              
25 2     2   2118 use English qw( -no_match_vars ) ;
  2         11698  
  2         13  
26              
27 2     2   3580 use Readonly ;
  2         7048  
  2         219  
28             Readonly my $EMPTY_STRING => q{} ;
29             Readonly my $UNIX_SEPARATOR => q{/} ;
30             Readonly my $DOT => q{.} ;
31             Readonly my $DOT_DOT => q{..} ;
32             Readonly my $ARRAY_LAST_ENTRY => -1 ;
33              
34 2     2   14 use Carp qw(carp croak confess) ;
  2         4  
  2         562  
35              
36             #-------------------------------------------------------------------------------
37              
38             =head1 NAME
39              
40             File::Path::Collapse - Collapses a path as much as possible
41              
42             =head1 SYNOPSIS
43              
44              
45             =head1 DESCRIPTION
46              
47             This module implements ...
48              
49             =head1 DOCUMENTATION
50              
51             =head1 SUBROUTINES/METHODS
52              
53             =cut
54              
55             #-------------------------------------------------------------------------------
56              
57             sub CollapsePath
58             {
59              
60             =head2 CollapsePath($path_to_collapse )
61              
62             Collapses the path by removing '.' and '..' from it. Trailing '/' is also removed.
63              
64             I
65              
66             =over 2
67              
68             =item * $path_to_collapse -
69              
70             =back
71              
72             I - the collapsed path or undef if undef was passed as argument.
73              
74             =cut
75              
76 0     0 1   my ($path_to_collapse, $path_separator) = @_ ;
77              
78 0 0         return unless defined $path_to_collapse ;
79              
80 0 0         $path_separator = $UNIX_SEPARATOR unless defined $path_separator ;
81              
82 0 0         my $from_root = substr($path_to_collapse, 0, 1) eq $path_separator ? $path_separator : $EMPTY_STRING ;
83              
84 0           my @uncollapsed_components = split(/\Q$path_separator/sxm, $path_to_collapse) ;
85 0           my @collapsed_components ;
86              
87 0           for my $component(@uncollapsed_components)
88             {
89 0 0 0       if
    0 0        
      0        
90             (
91             $component eq $DOT_DOT
92             && @collapsed_components
93             && $collapsed_components[$ARRAY_LAST_ENTRY] ne $DOT_DOT
94             )
95             {
96 0           pop @collapsed_components ;
97             }
98             elsif($component eq $DOT || $component eq $EMPTY_STRING )
99             {
100             }
101             else
102             {
103 0           push @collapsed_components, $component ;
104             }
105             }
106              
107 0           my $collapsed_path = $from_root . join($path_separator, @collapsed_components) ;
108              
109 0           return($collapsed_path, \@uncollapsed_components, \@collapsed_components) ;
110             }
111              
112             #-------------------------------------------------------------------------------
113              
114             1 ;
115              
116             =head1 BUGS AND LIMITATIONS
117              
118             None so far.
119              
120             =head1 AUTHOR
121              
122             Nadim ibn hamouda el Khemir
123             CPAN ID: NH
124             mailto: nadim@cpan.org
125              
126             =head1 LICENSE AND COPYRIGHT
127              
128             This program is free software; you can redistribute
129             it and/or modify it under the same terms as Perl itself.
130              
131             =head1 SUPPORT
132              
133             You can find documentation for this module with the perldoc command.
134              
135             perldoc File::Path::Collapse
136              
137             You can also look for information at:
138              
139             =over 4
140              
141             =item * AnnoCPAN: Annotated CPAN documentation
142              
143             L
144              
145             =item * RT: CPAN's request tracker
146              
147             Please report any bugs or feature requests to L .
148              
149             We will be notified, and then you'll automatically be notified of progress on
150             your bug as we make changes.
151              
152             =item * Search CPAN
153              
154             L
155              
156             =back
157              
158             =head1 SEE ALSO
159              
160              
161             =cut