[Module-build-checkins] [svn:Module-Build] r5855 - in Module-Build/trunk: . lib/Module/Build t
Status: Beta
Brought to you by:
kwilliams
Menu
▾
▴
[Module-build-checkins] [svn:Module-Build] r5855 - in Module-Build/trunk: . lib/Module/Build t
|
From: <ra...@cv...> - 2006-04-06 09:38:34
|
Author: randys Date: Thu Apr 6 02:38:13 2006 New Revision: 5855 Modified: Module-Build/trunk/Changes Module-Build/trunk/lib/Module/Build/Authoring.pod Module-Build/trunk/lib/Module/Build/Base.pm Module-Build/trunk/t/destinations.t Log: Document install_base_relpaths() and prefix_relpaths() as public API. Modified: Module-Build/trunk/Changes ============================================================================== --- Module-Build/trunk/Changes (original) +++ Module-Build/trunk/Changes Thu Apr 6 02:38:13 2006 @@ -1,5 +1,11 @@ Revision history for Perl extension Module::Build. +0.27_11 + + - Add documentation for the install_base_relpaths() and + prefix_relpaths() methods. Improved their usage for a public API, + and added tests. + 0.27_10 Tue Mar 28 22:50:50 CST 2006 - Added the create_packlist property, default true, which controls Modified: Module-Build/trunk/lib/Module/Build/Authoring.pod ============================================================================== --- Module-Build/trunk/lib/Module/Build/Authoring.pod (original) +++ Module-Build/trunk/lib/Module/Build/Authoring.pod Thu Apr 6 02:38:13 2006 @@ -1183,6 +1183,32 @@ We currently determine this by attempting to compile a simple C source file and reporting whether the attempt was successful. +=item install_base_relpaths() + +=item install_base_relpaths($type) + +=item install_base_relpaths($type => $path) + +[version 0.28] + +Set or retrieve the relative paths that are appended to +C<install_base> for any installable element. This is useful if you +want to set the relative install path for custom build elements. + +With no argument, it returns a reference to a hash containing all +elements and their respective values. This hash should not be modified +directly; use the multi-argument below form to change values. + +The single argument form returns the value associated with the +element C<$type>. + +The multi-argument form allows you to set the paths for element types. +C<$value> must be a relative path using unix-like paths. (A series of +directories seperated by slashes. Eg 'foo/bar'.) The return value is a +localized path based on C<$value>. + +Assigning the value C<undef> to an element causes it to be removed. + =item install_destination($type) [version 0.28] @@ -1214,8 +1240,11 @@ The single argument form returns the value associated with the element C<$type>. -The multi-argument form allows you to set the paths for one or more -element types. The return value is undefined. +The multi-argument form allows you to set the paths for element types. +The supplied C<$path> should be an absolute path to install elements +of C<$type>. The return value is C<$path>. + +Assigning the value C<undef> to an element causes it to be removed. =item install_types() @@ -1287,6 +1316,41 @@ will return C<undef> - there shouldn't be many unknown platforms though. +=item prefix_relpaths() + +=item prefix_relpaths($installdirs) + +=item prefix_relpaths($installdirs, $type) + +=item prefix_relpaths($installdirs, $type => $path) + +[version 0.28] + +Set or retrieve the relative paths that are appended to C<prefix> for +any installable element. This is useful if you want to set the +relative install path for custom build elements. + +With no argument, it returns a reference to a hash containing all +elements and their respective values as defined by the current +C<installdirs> setting. + +With a single argument, it returns a reference to a hash containing +all elements and their respective values as defined by +C<$installdirs>. + +The hash returned by the above calls should not be modified directly; +use the three-argument below form to change values. + +The two argument form returns the value associated with the +element C<$type>. + +The multi-argument form allows you to set the paths for element types. +C<$value> must be a relative path using unix-like paths. (A series of +directories seperated by slashes. Eg 'foo/bar'.) The return value is a +localized path based on C<$value>. + +Assigning the value C<undef> to an element causes it to be removed. + =item prepare_metadata() [version 0.28] @@ -1721,8 +1785,9 @@ Bug reports are also welcome at http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build . -The latest development version is available from the Subversion -repository at <https://svn.perl.org/modules/Module-Build/trunk/> +An anonymous CVS repository containing the latest development version +is available; see http://sourceforge.net/cvs/?group_id=45731 for the +details of how to access it. =head1 SEE ALSO Modified: Module-Build/trunk/lib/Module/Build/Base.pm ============================================================================== --- Module-Build/trunk/lib/Module/Build/Base.pm (original) +++ Module-Build/trunk/lib/Module/Build/Base.pm Thu Apr 6 02:38:13 2006 @@ -2,6 +2,8 @@ use strict; BEGIN { require 5.00503 } + +use Carp; use Config; use File::Copy (); use File::Find (); @@ -3397,15 +3399,39 @@ } } +sub install_path { + my $self = shift; + my( $type, $value ) = ( @_, '<empty>' ); + + Carp::croak( 'Type argument missing' ) + unless defined( $type ); + + my $map = $self->{properties}{install_path}; + return $map unless @_; + + # delete existing value if $value is literal undef() + unless ( defined( $value ) ) { + delete( $map->{$type} ); + return undef; + } + + # return existing value if no new $value is given + if ( $value eq '<empty>' ) { + return undef unless exists $map->{$type}; + return $map->{$type}; + } + + # set value if $value is a valid relative path + return $map->{$type} = $value; +} + sub install_base_relpaths { - # Usage: install_base_relpaths('lib') or install_base_relpaths(); + # Usage: install_base_relpaths(), install_base_relpaths('lib'), + # or install_base_relpaths('lib' => $value); 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}}); + return $self->_relpaths($map, @_); } @@ -3422,18 +3448,48 @@ ); } +sub _relpaths { + my $self = shift; + my( $map, $type, $value ) = ( @_, '<empty>' ); + + Carp::croak( 'Type argument missing' ) + unless defined( $type ); + + my @value = (); + + # delete existing value if $value is literal undef() + unless ( defined( $value ) ) { + delete( $map->{$type} ); + return undef; + } + + # return existing value if no new $value is given + elsif ( $value eq '<empty>' ) { + return undef unless exists $map->{$type}; + @value = @{ $map->{$type} }; + } + + # set value if $value is a valid relative path + else { + Carp::croak( "Value must be a relative path" ) + if File::Spec::Unix->file_name_is_absolute($value); + + @value = split( /\//, $value ); + $map->{$type} = \@value; + } + + return File::Spec->catdir( @value ); +} # Defaults to use in case the config install paths cannot be prefixified. sub prefix_relpaths { - # Usage: prefix_relpaths('site', 'lib') or prefix_relpaths('site'); + # Usage: prefix_relpaths('site'), prefix_relpaths('site', 'lib'), + # or prefix_relpaths('site', 'lib' => $value); my $self = shift; 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}}); + return $self->_relpaths($map, @_); } Modified: Module-Build/trunk/t/destinations.t ============================================================================== --- Module-Build/trunk/t/destinations.t (original) +++ Module-Build/trunk/t/destinations.t Thu Apr 6 02:38:13 2006 @@ -2,7 +2,7 @@ use strict; use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib'; -use MBTest tests => 92; +use MBTest tests => 113; use Cwd (); my $cwd = Cwd::cwd; @@ -58,6 +58,85 @@ $mb->prefix(undef); +# Check install_path() accessor +{ + my( $map, $path ); + + $map = $mb->install_path(); + is_deeply( $map, {}, 'install_path() accessor' ); + + $path = $mb->install_path('elem' => '/foo/bar'); + is( $path, '/foo/bar', ' returns assigned path' ); + + $path = $mb->install_path('elem'); + is( $path, '/foo/bar', ' can read stored path' ); + + $map = $mb->install_path(); + is_deeply( $map, { 'elem' => '/foo/bar' }, ' can access map' ); + + $path = $mb->install_path('elem' => undef); + is( $path, undef, ' can delete a path element' ); + + $map = $mb->install_path(); + is_deeply( $map, {}, ' deletes path from map' ); +} + +# Check install_base_relpaths() accessor +{ + my( $map, $path ); + + $map = $mb->install_base_relpaths(); + is( ref($map), 'HASH', 'install_base_relpaths() accessor' ); + + eval{ $path = $mb->install_base_relpaths('elem' => '/foo/bar') }; + like( $@, qr/Value must be a relative path/, ' emits error if path not relative' ); + + $path = $mb->install_base_relpaths('elem' => 'foo/bar'); + is( $path, 'foo/bar', ' returns assigned path' ); + + $path = $mb->install_base_relpaths('elem'); + is( $path, 'foo/bar', ' can read stored path' ); + + $map = $mb->install_base_relpaths(); + is_deeply( $map->{elem}, [qw(foo bar)], ' can access map' ); + + $path = $mb->install_base_relpaths('elem' => undef); + is( $path, undef, ' can delete a path element' ); + + $map = $mb->install_base_relpaths(); + is( $map->{elem}, undef, ' deletes path from map' ); +} + +# Check prefix_relpaths() accessor +{ + my( $map, $path ); + + $map = $mb->prefix_relpaths(); + is( ref($map), 'HASH', 'prefix_relpaths() accessor' ); + + is_deeply( $mb->prefix_relpaths(), $mb->prefix_relpaths('site'), + ' defaults to \'site\'' ); + + eval{ $path = $mb->prefix_relpaths('site', 'elem' => '/foo/bar') }; + like( $@, qr/Value must be a relative path/, ' emits error if path not relative' ); + + $path = $mb->prefix_relpaths('site', 'elem' => 'foo/bar'); + is( $path, 'foo/bar', ' returns assigned path' ); + + $path = $mb->prefix_relpaths('site', 'elem'); + is( $path, 'foo/bar', ' can read stored path' ); + + $map = $mb->prefix_relpaths(); + is_deeply( $map->{elem}, [qw(foo bar)], ' can access map' ); + + $path = $mb->prefix_relpaths('site', 'elem' => undef); + is( $path, undef, ' can delete a path element' ); + + $map = $mb->prefix_relpaths(); + is( $map->{elem}, undef, ' deletes path from map' ); +} + + # Check that we install into the proper default locations. { is( $mb->installdirs, 'site' ); |
