1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
##
## wml::sup::path - Filesystem Path Manipulation
## Copyright (c) 1997-2001 Ralf S. Engelschall, All Rights Reserved.
##
<protect pass=2>
<:
sub relpath {
my ($from, $to) = @_;
my (@F, @T, $i, $j, $path);
# canonicalize input
$from .= '/' if ($from !~ m|/$|);
$to .= '/' if ($to !~ m|/$|);
$from = '' if ($from eq './');
$to = '' if ($to eq './');
$path = '';
# split into directory parts
@F = split('/', $from);
@T = split('/', $to);
# skip common prefix dirs
for ($i = 0; $i <= $#F; $i++) {
last if ($F[$i] ne $T[$i]);
}
# go back for remaining "from" dirs
for ($j = $i; $j <= $#F; $j++) {
$path .= '../';
}
# go foreward for remaining "to" dirs
for ($j = $i; $j <= $#T; $j++) {
$path .= "$T[$j]/";
}
return $path;
}
sub canonpath {
my ($path) = @_;
my $pathL = '';
while ($path ne $pathL) {
$pathL = $path;
$path =~ s|/+|/|g;
$path =~ s|/\./|/|g;
$path =~ s|/\.$|/|;
$path =~ s|^\./(.)|$1|g;
$path =~ s{(^|/)([^/]+)(/\.\./)}{if ($2 ne '..') { $1 } else { $1.$2.$3 }}eg;
}
$path =~ s{(^|/)([^/]+)(/\.\.)$}{if ($2 ne '..') { $1 } else { $1.$2.$3.'/' }}eg;
$path = './' if $path eq '';
return $path;
}
sub canonurl {
my ($url) = @_;
if ($url =~ m|^(.+?://)(.+)|) {
$url = $1.&canonpath($2);
}
else {
$url = &canonpath($url);
}
return $url;
}
:>
</protect>
##EOF##
__END__
=head1 NAME
wml::sup::path - Filesystem Path Manipulation
=head1 SYNOPSIS
#use wml::sup::path
<: $relpath = &relpath($from, $to); :>
<: $path = &canonpath($path); :>
<: $url = &canonurl($url); :>
=head1 DESCRIPTION
This include file provides the Perl functions C<relpath>, C<canonpath> and
C<canonurl> which calculate relative and canonical paths/urls. For example,
the relative path from F</foo/path/bar/quux> to F</foo/path/foobar> is
calculated to F<../../foobar> and the canonical path of
F<./foo/./bar/../quux//> is F<foo/quux/>.
=head1 AUTHOR
Ralf S. Engelschall
rse@engelschall.com
www.engelschall.com
=head1 REQUIRES
Internal: P1, P3
External: --
=head1 SEE ALSO
perl(1)
=cut
|
