Perl::Dist::WiX::Asset::Distribution - "Perl Distribution" asset for a Win32 Perl

  my $distribution = Perl::Dist::WiX::Asset::Distribution->new(
      parent   => $dist,
      name     => 'MSERGEANT/DBD-SQLite-1.14.tar.gz',
	  mod_name => 'DBD::SQLite',
      force    => 1,
  );

package Perl::Dist::WiX::Asset::Distribution;

#<<<
use 5.010;
use Moose;
use MooseX::Types::Moose   qw( Str Bool ArrayRef Maybe );
use English                qw( -no_match_vars );
use File::Spec::Functions  qw( catdir catfile );
use Params::Util           qw( _INSTANCE );
use URI                    qw();
#>>>

our $VERSION = '1.500002';

with 'Perl::Dist::WiX::Role::Asset';
extends 'Perl::Dist::WiX::Asset::DistBase';

has name => (
	is       => 'bare',
	isa      => Str,
	reader   => 'get_name',
	required => 1,
);

has module_name => (
	is       => 'bare',
	isa      => Maybe [Str],
	reader   => 'get_module_name',
	init_arg => 'mod_name',
	lazy     => 1,
	default  => sub { return $_[0]->_name_to_module(); },
);

has force => (
	is      => 'ro',
	isa     => Bool,
	reader  => '_get_force',
	lazy    => 1,
	default => sub { !!$_[0]->_get_parent()->force() },
);

has automated_testing => (
	is      => 'ro',
	isa     => Bool,
	reader  => '_get_automated_testing',
	default => 0,
);

has release_testing => (
	is      => 'ro',
	isa     => Bool,
	reader  => '_get_release_testing',
	default => 0,
);

has makefilepl_param => (
	is      => 'ro',
	isa     => ArrayRef,
	reader  => '_get_makefilepl_param',
	default => sub { return [] },
);

has buildpl_param => (
	is      => 'ro',
	isa     => ArrayRef,
	reader  => '_get_buildpl_param',
	default => sub { return [] },
);

has packlist => (
	is      => 'ro',
	isa     => Bool,
	reader  => '_get_packlist',
	default => 1,
);

has overwritable => (
	is      => 'ro',
	isa     => Bool,
	reader  => '_get_overwritable',
	default => 0,
);



sub BUILDARGS {
	my $class = shift;
	my %args;

	if ( @_ == 1 && 'HASH' eq ref $_[0] ) {
		%args = %{ $_[0] };
	} elsif ( 0 == @_ % 2 ) {
		%args = (@_);
	} else {
		PDWiX->throw( 'Parameters incorrect (not a hashref or hash) '
			  . 'for Perl::Dist::WiX::Asset::Distribution' );
	}

	if ( not defined _INSTANCE( $args{parent}, 'Perl::Dist::WiX' ) ) {
		PDWiX::Parameter->throw(
			parameter =>
			  'parent: missing or not a Perl::Dist::WiX instance',
			where => '::Asset::Distribution->new',
		);
	}

	if ( exists $args{url} ) {
		PDWiX::Parameter->throw(
			parameter =>
'url: Passed in (please remove - it will be calculated from name)',
			where => '::Asset::Distribution->new',
		);
	}

	if ( exists $args{file} ) {
		PDWiX::Parameter->throw(
			parameter =>
'file: Passed in (please remove - it will be calculated from name)',
			where => '::Asset::Distribution->new',
		);
	}

	# Map CPAN dist path to url
	my $dist = $args{name};
	if ( !defined $dist ) {
		PDWiX::Parameter->throw(
			parameter => 'name: Not defined',
			where     => '::Asset::Distribution->new',
		);
	}

	$args{parent}->trace_line( 2, "Using distribution path $dist\n" );
	my $one = substr $dist, 0, 1;
	my $two = substr $dist, 1, 1;
	my $path =
	  File::Spec::Unix->catfile( 'authors', 'id', $one, "$one$two", $dist,
	  );
	$args{url} = URI->new_abs( $path, $args{parent}->cpan() )->as_string();
	$args{file} = $args{url};
	$args{file} =~ s{.+/}{}ms;

	return {%args};
} ## end sub BUILDARGS

sub BUILD {
	my $self = shift;

	if ( $self->get_name() eq $self->_get_url()
		and not _DIST( $self->get_name() ) )
	{
		PDWiX::Parameter->throw("Missing or invalid name param\n");
	}

	return;
}


# get_name is defined earlier, in the "has name =>" line.
# Here works for documenting it.

sub install {
	my $self = shift;

	my $name      = $self->get_name();
	my $build_dir = $self->_get_build_dir();

# If we don't have a packlist file, get an initial filelist to subtract from.
	my $module = $self->get_module_name();
	my $filelist_sub;

	if ( not $self->_get_packlist() ) {
		$filelist_sub =
		  File::List::Object->new->readdir( $self->_dir('perl') );
		$self->_trace_line( 5,
			    "***** Module being installed $module"
			  . " requires packlist => 0 *****\n" );
	}

	# Download the file
	my $url = $self->_abs_uri( $self->_get_cpan() );
	my $tgz =
	  eval { $self->_mirror_url( $url, $self->_get_modules_dir(), ) }
	  || PDWiX::Caught->throw(
		message => $EVAL_ERROR,
		info    => 'Error trying to download distribution'
	  );

	# Does it exist? If not, throw an error here.
	if ( not -f $tgz ) {
		PDWiX->throw('The file from an attempted download does not exist');
	}

	# Where will it get extracted to
	my $dist_path = $name;
	$self->_add_to_distributions_installed($dist_path);
	$dist_path =~ s{[.] tar [.] gz}{}msx;            # Take off extensions.
	$dist_path =~ s{[.] zip}{}msx;
	$dist_path =~ s{.+\/}{}msx;        # Take off directories.
	$dist_path =~ s{-withoutworldwriteables$}{}msx;
	my $unpack_to = catdir( $build_dir, $dist_path );

	# Extract the tarball
	if ( -d $unpack_to ) {
		$self->_trace_line( 2, "Removing previous $unpack_to\n" );
		$self->remove_path( \1, $unpack_to );
	}
	$self->_extract( $tgz => $build_dir );
	if ( not -d $unpack_to ) {
		PDWiX->throw("Failed to extract $unpack_to\n");
	}

	my $buildpl    = ( -r catfile( $unpack_to, 'Build.PL' ) )    ? 1 : 0;
	my $makefilepl = ( -r catfile( $unpack_to, 'Makefile.PL' ) ) ? 1 : 0;

	if ( not $buildpl and not $makefilepl ) {
		PDWiX->throw(
			"Could not find Makefile.PL or Build.PL in $unpack_to\n");
	}

	# Build using Build.PL if we have one
	# unless Module::Build is not installed.
	if ( not $self->_module_build_installed() ) {
		$buildpl = 0;
		if ( not $makefilepl ) {
			PDWiX->throw( "Could not find Makefile.PL in $unpack_to"
				  . " (too early for Build.PL)\n" );
		}
	}

	# Can't build version.pm using Build.PL until Module::Build
	# has been upgraded.
	if ( $module eq 'version' ) {
		$self->_trace_line( 3, "Bypassing version.pm's Build.PL\n" );
		$buildpl = 0;
	}

	# Build the module
  SCOPE: {
		my $wd = $self->_pushd($unpack_to);

		# Enable automated_testing mode if needed
		# Blame Term::ReadLine::Perl for needing this ugly hack.
		if ( $self->_get_automated_testing() ) {
			$self->_trace_line( 2,
				"Installing with AUTOMATED_TESTING enabled...\n" );
		}
		if ( $self->_get_release_testing() ) {
			$self->_trace_line( 2,
				"Installing with RELEASE_TESTING enabled...\n" );
		}
		local $ENV{AUTOMATED_TESTING} =
		  $self->_get_automated_testing() ? 1 : undef;
		local $ENV{RELEASE_TESTING} =
		  $self->_get_release_testing() ? 1 : undef;
		local $ENV{PERL_MM_USE_DEFAULT}    = 1;
		local $ENV{PERL_MM_NONINTERACTIVE} = 1;

		$self->_configure($buildpl);

		$self->_install_distribution($buildpl);

	} ## end SCOPE:

	# Making final filelist.
	my $filelist;
	if ( $self->_get_packlist() ) {
		$filelist = $self->_search_packlist($module);
	} else {
		$filelist =
		  File::List::Object->new()->readdir( $self->_dir('perl') );
		$filelist->subtract($filelist_sub)->filter( $self->_filters() );
	}

	my $module_name = $self->get_module_name();
	$module_name =~ s{::}{_}msg;
	$module_name =~ s{-}{_}msg;

	# Insert fragment.
	$self->_insert_fragment( $module_name, $filelist,
		$self->_get_overwritable() );

	return 1;
} ## end sub install

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__