From f78d2c2b3f3db6bcdcaca696abd800759740812b Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Tue, 16 Oct 2012 23:07:56 +0300 Subject: [PATCH] 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 Patch-Name: debian/cpan-missing-site-dirs.diff --- 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 3ccaeec..05d8910 100644 --- a/cpan/CPAN/lib/CPAN/FirstTime.pm +++ b/cpan/CPAN/lib/CPAN/FirstTime.pm @@ -2067,11 +2067,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 {