[Module-build-checkins] Module-Build/lib/Module/Build Base.pm,1.434,1.435
Status: Beta
Brought to you by:
kwilliams
Menu
▾
▴
[Module-build-checkins] Module-Build/lib/Module/Build Base.pm,1.434,1.435
|
From: Ken W. <kwi...@us...> - 2005-06-23 00:27:56
|
Update of /cvsroot/module-build/Module-Build/lib/Module/Build In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22611/lib/Module/Build Modified Files: Base.pm Log Message: Moved the setting of various default installation paths from being scattered throughout several methods into the _set_install_paths() method, which is called at new() time. Besides cleaning up the code, this will pave the way for users to be able to change those defaults. More checkins that rearrange things a little are coming. Index: Base.pm =================================================================== RCS file: /cvsroot/module-build/Module-Build/lib/Module/Build/Base.pm,v retrieving revision 1.434 retrieving revision 1.435 diff -u -d -r1.434 -r1.435 --- Base.pm 22 Jun 2005 02:45:37 -0000 1.434 +++ Base.pm 23 Jun 2005 00:27:43 -0000 1.435 @@ -171,10 +171,14 @@ sub _set_install_paths { my $self = shift; my $c = $self->{config}; + my $p = $self->{properties}; - my @html = $c->{installhtmldir} ? (html => $c->{installhtmldir}) : (); + my @libstyle = $c->{installstyle} ? File::Spec->splitdir($c->{installstyle}) : qw(lib perl5); + my $arch = $c->{archname}; + my $version = $c->{version}; + my @html = $c->{installhtmldir} ? (html => $c->{installhtmldir}) : (); - $self->{properties}{install_sets} = + $p->{install_sets} = { core => { lib => $c->{installprivlib}, @@ -204,6 +208,53 @@ @html, }, }; + + $p->{prefix_sets} = + { + core => $c->{installprefixexp} || $c->{installprefix} || + $c->{prefixexp} || $c->{prefix} || '', + site => $c->{siteprefixexp}, + vendor => $c->{usevendorprefix} ? $c->{vendorprefixexp} : '', + }; + $p->{prefix_sets}{site} ||= $p->{prefix_sets}{core}; + + $p->{install_base_relpaths} = + { + lib => ['lib', 'perl5'], + arch => ['lib', 'perl5', $arch], + bin => ['bin'], + script => ['bin'], + bindoc => ['man', 'man1'], + libdoc => ['man', 'man3'], + }; + + $p->{prefix_relpaths} = + { + core => { + lib => [@libstyle], + arch => [@libstyle, $version, $arch], + bin => ['bin'], + script => ['bin'], + libdoc => ['man', 'man3'], + bindoc => ['man', 'man1'], + }, + vendor => { + lib => [@libstyle], + arch => [@libstyle, $version, $arch], + bin => ['bin'], + script => ['bin'], + libdoc => ['man', 'man3'], + bindoc => ['man', 'man1'], + }, + site => { + lib => [@libstyle, 'site_perl'], + arch => [@libstyle, 'site_perl', $version, $arch], + bin => ['bin'], + script => ['bin'], + libdoc => ['man', 'man3'], + bindoc => ['man', 'man1'], + }, + }; } sub _find_nested_builds { @@ -496,6 +547,9 @@ perl has_config_data install_sets + install_base_relpaths + prefix_sets + prefix_relpaths install_base destdir debugger @@ -2553,90 +2607,47 @@ } } -sub install_base_relative { - my ($self, $type) = @_; - # XXX - this won't handle additional build elements correctly - my %map = ( - lib => ['lib', 'perl5'], - arch => ['lib', 'perl5', $self->{config}{archname}], - bin => ['bin'], - script => ['bin'], - bindoc => ['man', 'man1'], - libdoc => ['man', 'man3'], - ); - return unless exists $map{$type}; - return File::Spec->catdir(@{$map{$type}}); +sub install_base_relpaths { + # Usage: install_base_relpaths('lib') or install_base_relpaths(); + my $self = shift; + my $map = $self->{properties}{install_base_relpaths}; + return $map unless @_; + + my $type = shift; + return unless exists $map->{$type}; + return File::Spec->catdir(@{$map->{$type}}); } # Translated from ExtUtils::MM_Any::init_INSTALL_from_PREFIX sub prefix_relative { my ($self, $type, $prefix) = @_; - my $c = $self->{config}; - - my $map = $self->install_sets; - my $defaults = $self->_prefix_defaults; - my $installdirs = $self->installdirs; - return unless exists $map->{$installdirs}{$type}; - my %prefixes = - ( - core => $c->{installprefixexp} || $c->{installprefix} || - $c->{prefixexp} || $c->{prefix} || '', - site => $c->{siteprefixexp}, - vendor => $c->{usevendorprefix} ? $c->{vendorprefixexp} : '', - ); - $prefixes{site} ||= $prefixes{core}; - - return $self->_prefixify($map->{$installdirs}{$type}, - $prefixes{$installdirs}, + my $map = $self->install_sets->{$installdirs}; + my $prefix_rel = $self->prefix_relpaths($installdirs, $type); + return unless exists $map->{$type}; + + return $self->_prefixify($map->{$type}, + $self->prefix_sets->{$installdirs}, $prefix, - $defaults->{$installdirs}{$type} + $prefix_rel ); } # Defaults to use in case the config install paths cannot be prefixified. -sub _prefix_defaults { +sub prefix_relpaths { + # Usage: prefix_relpaths('site', 'lib') or prefix_relpaths('site'); my $self = shift; - my $c = $self->{config}; - - my $libstyle = $c->{installstyle} || 'lib/perl5'; - my $arch = $c->{archname}; - my $version = $c->{version}; - - my %defaults = - ( - core => { - lib => $libstyle, - arch => File::Spec->catdir($libstyle, $version, $arch), - bin => 'bin', - script => 'bin', - libdoc => File::Spec->catdir('man', 'man3'), - bindoc => File::Spec->catdir('man', 'man1'), - }, - vendor => { - lib => $libstyle, - arch => File::Spec->catdir($libstyle, $version, $arch), - bin => 'bin', - script => 'bin', - libdoc => File::Spec->catdir('man', 'man3'), - bindoc => File::Spec->catdir('man', 'man1'), - }, - site => { - lib => File::Spec->catdir($libstyle, 'site_perl'), - arch => File::Spec->catdir($libstyle, 'site_perl', - $version, $arch), - bin => 'bin', - script => 'bin', - libdoc => File::Spec->catdir('man', 'man3'), - bindoc => File::Spec->catdir('man', 'man1'), - }, - ); - - return \%defaults; + my $installdirs = shift || $self->installdirs; + my $map = $self->{properties}{prefix_relpaths}{$installdirs}; + return $map unless @_; + + my $type = shift; + return unless exists $map->{$type}; + return File::Spec->catdir(@{$map->{$type}}); } @@ -2709,7 +2720,7 @@ my $p = $self->{properties}; return $p->{install_path}{$type} if exists $p->{install_path}{$type}; - return File::Spec->catdir($p->{install_base}, $self->install_base_relative($type)) if $p->{install_base}; + return File::Spec->catdir($p->{install_base}, $self->install_base_relpaths($type)) if $p->{install_base}; return $self->prefix_relative($type, $p->{prefix}) if $p->{prefix}; return $p->{install_sets}{ $p->{installdirs} }{$type}; } |
