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
|
From: Niko Tyni <ntyni@debian.org>
Date: Tue, 16 Oct 2012 23:07:56 +0300
Subject: Fix CPAN::FirstTime defaults with nonexisting site dirs if a parent
is writable
The site directories do not exist on a typical Debian system. The build
systems will create them when necessary, so there's no need for a prompt
suggesting local::lib if the first existing parent directory is writable.
Also, writability of the core directories is not interesting as we
explicitly tell CPAN not to touch those with INSTALLDIRS=site.
Bug-Debian: http://bugs.debian.org/688842
---
cpan/CPAN/lib/CPAN/FirstTime.pm | 31 +++++++++++++++++++++++++++----
1 file changed, 27 insertions(+), 4 deletions(-)
diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm
index 54d5131..6f185cc 100644
--- a/cpan/CPAN/lib/CPAN/FirstTime.pm
+++ b/cpan/CPAN/lib/CPAN/FirstTime.pm
@@ -2166,11 +2166,34 @@ sub _print_urllist {
};
}
+# Debian modification: return true if this directory
+# or the first existing one upwards is writable
+sub _can_write_to_this_or_parent {
+ my ($dir) = @_;
+ my @parts = File::Spec->splitdir($dir);
+ while (@parts) {
+ my $cur = File::Spec->catdir(@parts);
+ return 1 if -w $cur;
+ return 0 if -e _;
+ pop @parts;
+ }
+ return 0;
+}
+
+# Debian specific modification: the site directories don't necessarily
+# exist on the system, but the build systems create them when necessary,
+# so return true if the first existing directory upwards is writable
+#
+# Furthermore, on Debian, only test the site directories
+# (installsite*, expanded to /usr/local/{share,lib}/perl),
+# not the core ones
+# (install*lib, expanded to /usr/{share,lib}/perl).
+# We pass INSTALLDIRS=site by default to keep CPAN from touching
+# the core directories.
+
sub _can_write_to_libdirs {
- return -w $Config{installprivlib}
- && -w $Config{installarchlib}
- && -w $Config{installsitelib}
- && -w $Config{installsitearch}
+ return _can_write_to_this_or_parent($Config{installsitelib})
+ && _can_write_to_this_or_parent($Config{installsitearch})
}
sub _using_installbase {
|
