File Coverage

blib/lib/Module/Install/TemplateInstallPath.pm

Criterion	Covered	Total	%
statement	15	38	39.4
branch	0	12	0.0
condition	0	3	0.0
subroutine	5	7	71.4
pod	1	1	100.0
total	21	61	34.4

# --8<--8<--8<--8<--
#
# Copyright (C) 2011 Smithsonian Astrophysical Observatory
#
# This file is part of Module::Install::TemplateInstallPath
#
# Module::Install::TemplateInstallPath is free software: you can
# redistribute it and/or modify it under the terms of the GNU General
# Public License as published by the Free Software Foundation, either
# version 3 of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see .
#
# -->8-->8-->8-->8--

package Module::Install::TemplateInstallPath;

use strict;
use warnings;
use Carp;

our $VERSION = '0.03';

use base 'Module::Install::Base';

use File::Spec::Functions qw[ catdir ];

my %Tokens = (

	      '%n' => sub { $_[0]->name },
	      '%v' => sub { $_[0]->version  },
);


sub _fill_template {

    my $self = shift;
    my ( $tpl, $tokens ) = @_;

    my ( $token, $value );

    while ( ( $token, $value ) = each %$tokens )
    {
	next unless defined $value;
	my $value = 'CODE' eq ref $value ? $value->($self) : $value;

	$tpl =~ s/$token/$value/g;
    }
    return $tpl;
}

sub template_install_path {

    my $self = shift;
    my %arg = ( template => undef,
		catdir => 1,
		tokens => {},
		@_ );

    my %tokens = ( %Tokens, %{$arg{tokens}} );

    for my $argv ( @ARGV )
    {
	next unless $argv =~ /^(INSTALL_BASE|PREFIX|LIB)=(.*)/i;

	die ( "$1: no value specified\n" )
	  unless defined $2;
	my $var  = $1;
	my $base = $2;

	my $nbase = $self->_fill_template( $base, \%tokens );

	if ( $nbase eq $base && defined $arg{template} )
	{
	    $nbase = $self->_fill_template( $arg{template}, \%tokens );
	    $nbase = catdir( $base, $nbase )
	      if $arg{catdir};
	}

	$argv = "\U$var\E=$nbase";
    }

    return;
}
1;

__END__