Perl::Dist::WiX - 4th generation Win32 Perl distribution builder

	# Sets up a distribution with the following options
	my $distribution = Perl::Dist::WiX->new(
		msi               => 1,
		trace             => 1,
		build_number      => 1,
		cpan              => URI->new(('file://C|/minicpan/')),
		image_dir         => 'C:\myperl',
		download_dir      => 'C:\cpandl',
		output_dir        => 'C:\myperl_build',
		temp_dir          => 'C:\temp',
		app_id            => 'myperl',
		app_name          => 'My Perl',
		app_publisher     => 'My Perl Distribution Project',
		app_publisher_url => 'http://test.invalid/',
	);

	# Creates the distribution
	$distribution->run();

	tasklist => [

		# Final initialization
		'final_initialization',

		# Install the core C toolchain
		'install_c_toolchain',

		# Install the Perl binary
		'install_perl',

		# Install the Perl toolchain
		'install_perl_toolchain',

		# Install additional Perl modules
		'install_cpan_upgrades',

		# Check for missing files.
		'verify_msi_file_contents',

		# Apply optional portability support
		'install_portable',

		# Apply optional relocation support
		'install_relocatable',

		# Remove waste and temporary files
		'remove_waste',

		# Regenerate file fragments
		'regenerate_fragments',

		# Find file ID's for relocation.
		'find_relocatable_fields',

		# Write out the merge module
		'write_merge_module',

		# Install the Win32 extras
		'install_win32_extras',

		# Create the distribution list
		'create_distribution_list',

		# Check for missing files.
		'verify_msi_file_contents',

		# Regenerate file fragments again.
		'regenerate_fragments',

		# Write out the distributions
		'write',
	];

	my $dist = Perl::Dist::WiX->new(
		tasklist => [
			'final_initialization',
			... 
		],
		...
	);

	$self->_write_zip();

  $self->_write_msi();

  $self->_write_msm();

	$self->_compile_wxs("Perl.wxs", "Perl.wixobj");

	$id = $dist->bin_candle(); 

	Win32 app_id 5.10.0.1.beta_1 #1 Mon Jun 15 23:11:00 2009 i386

	my $bool = $dist->fragment_exists('FragmentId');

	my $fragment_tag = $dist->get_fragment_object('FragmentId');

	$self->get_merge_module_object('Perl');

	$self->get_merge_module_object('Perl');

    $self->add_merge_module('Perl', $perl_merge_module);

    $self->add_output_files('information.html', 'README.txt');
    $self->add_output_file('distribution.msi');

    $self->add_icon(
	    name     => 'CPAN Client',
		filename => 'C:\strawberry\perl\bin\cpan.bat',
		icon_id  => 'I_cpan_bat_ico',
	);

	$self->add_path('perl', 'bin');

	my $ENV{PATH} = "$ENV{PATH};" . $dist->get_path_string();

	$self->add_env('PATH', $self->image_dir()->subdir(qw(perl bin)), 1);
	$self->add_env('TERM', 'dumb');

	$dist->add_file(
		source => $filename, 
		fragment => $fragment_name
	);

	$self->insert_fragment($id, $files_obj, $overwritable);

	$dist->add_to_fragment($id, $files_obj);

package Perl::Dist::WiX;

#<<<
use 5.010;
use Moose 1.08;
use Moose::Util::TypeConstraints;
use Alien::WiX                              qw(
	:ALL
);
use Archive::Zip                            qw(
	:ERROR_CODES
);
use English                                 qw(
	-no_match_vars
);
use List::MoreUtils                         qw(
	any none uniq
);
use MooseX::Types::Moose                    qw(
	Int Str Maybe Bool Undef ArrayRef Maybe HashRef
);
use MooseX::Types::URI                      qw( 
	Uri
);
use MooseX::Types::Path::Class              qw(
	File Dir
);
use Perl::Dist::WiX::Types                  qw(
	ExistingDirectory ExistingFile TemplateObj
	ExistingSubdirectory ExistingDirectory_Spaceless 
	ExistingDirectory_SaneSlashes
);
use Params::Util                            qw(
	_HASH _STRING _INSTANCE _IDENTIFIER _ARRAY0 _ARRAY
);
use Readonly                                qw(
	Readonly
);
use Storable                                qw(
	retrieve
);
use File::Spec::Functions                   qw(
	catdir catfile catpath tmpdir splitpath rel2abs curdir
);
use CPAN                             1.9600 qw();
use File::HomeDir                           qw();
use File::ShareDir                          qw();
use File::Copy::Recursive                   qw();
use File::PathList                          qw();
use HTTP::Status                            qw();
use IO::File                                qw();
use IO::String                              qw();
use IO::Handle                              qw();
use IPC::Run3                               qw();
use LWP::UserAgent                          qw();
use LWP::Online                             qw();
use Module::CoreList                   2.46 qw();
use PAR::Dist                               qw();
use Path::Class::Dir                        qw();
use Probe::Perl                             qw();
use SelectSaver                             qw();
use Template                                qw();
use URI                                     qw();
use URI::file                               qw();
use Win32                                   qw();
use File::List::Object                      qw();
use Perl::Dist::WiX::Exceptions             qw();
use Perl::Dist::WiX::DirectoryTree          qw();
use Perl::Dist::WiX::FeatureTree            qw();
use Perl::Dist::WiX::DirectoryCache         qw();
use Perl::Dist::WiX::Fragment::CreateFolder qw();
use Perl::Dist::WiX::Fragment::Files        qw();
use Perl::Dist::WiX::Fragment::Environment  qw();
use Perl::Dist::WiX::Fragment::StartMenu    qw();
use Perl::Dist::WiX::IconArray              qw();
use Perl::Dist::WiX::PropertyList           qw();
use Perl::Dist::WiX::Tag::MergeModule       qw();
use Perl::Dist::WiX::Tag::DirectoryRef      qw();
use WiX3::XML::GeneratesGUID::Object        qw();
use WiX3::XML::RegistryKey                  qw();
use WiX3::XML::RegistryValue                qw();
use WiX3::XML::Fragment                     qw();
use WiX3::XML::Component                    qw();
use WiX3::Traceable                         qw();

use namespace::clean  -except => 'meta';
#>>>

our $VERSION = '1.500002';

with
  'MooseX::Object::Pluggable'          => { -version => 0.0011 },
  'Perl::Dist::WiX::Role::MultiPlugin' => { -version => 1.500 },
  ;
extends
  'Perl::Dist::WiX::Mixin::BuildPerl'    => { -version => 1.500002 },
  'Perl::Dist::WiX::Mixin::Checkpoint'   => { -version => 1.500002 },
  'Perl::Dist::WiX::Mixin::Libraries'    => { -version => 1.500002 },
  'Perl::Dist::WiX::Mixin::Installation' => { -version => 1.500 },
  'Perl::Dist::WiX::Mixin::ReleaseNotes' => { -version => 1.500 },
  'Perl::Dist::WiX::Mixin::Patching'     => { -version => 1.500 },
  'Perl::Dist::WiX::Mixin::Support'      => { -version => 1.500002 },
  ;

#####################################################################
# Constructor
#
# (Technically, the definition of the public attributes, and the
# BUILDARGS routine, as Moose provides our new().)
#

has 'msi' => (
	is      => 'ro',
	isa     => Bool,
	writer  => '_set_msi',
	default => sub {
		my $self = shift;
		return $self->portable() ? 0 : 1;
	},
);

has 'msm' => (
	is      => 'ro',
	isa     => Bool,
	default => sub {
		my $self = shift;
		return $self->portable() ? 0 : 1;
	},
);

has 'zip' => (
	is      => 'ro',
	isa     => Bool,
	lazy    => 1,
	default => sub {
		my $self = shift;
		return $self->portable() ? 1 : 0;
	},
);

has 'portable' => (
	is      => 'ro',
	isa     => Bool,
	default => 0,
);

has 'relocatable' => (
	is      => 'ro',
	isa     => Bool,
	default => 0,
);

has 'exe' => (
	is      => 'ro',
	isa     => Bool,
	writer  => '_set_exe',
	default => 0,
);

has 'force' => (
	is      => 'ro',
	isa     => Bool,
	default => 0,
);

has 'forceperl' => (
	is      => 'ro',
	isa     => Bool,
	default => 0,
);

has 'offline' => (
	is      => 'ro',
	isa     => Bool,
	default => sub { return !!LWP::Online::offline() },
);

has 'trace' => (
	is      => 'ro',
	isa     => Int,
	default => 1,
);

has 'tasklist' => (
	is      => 'ro',
	isa     => ArrayRef [Str],
	builder => '_build_tasklist',
);

sub _build_tasklist {
	return [

		# Final initialization
		'final_initialization',

		# Install the core C toolchain
		'install_c_toolchain',

		# Install the Perl binary
		'install_perl',

		# Install the Perl toolchain
		'install_perl_toolchain',

		# Install additional Perl modules
		'install_cpan_upgrades',

		# Check for missing files.
		'verify_msi_file_contents',

		# Apply optional portability support
		'install_portable',

		# Apply optional relocation support
		'install_relocatable',

		# Remove waste and temporary files
		'remove_waste',

		# Regenerate file fragments
		'regenerate_fragments',

		# Find file ID's for relocation.
		'find_relocatable_fields',

		# Write out the merge module
		'write_merge_module',

		# Install the Win32 extras
		'install_win32_extras',

		# Create the distribution list
		'create_distribution_list',

		# Check for missing files.
		'verify_msi_file_contents',

		# Regenerate file fragments again.
		'regenerate_fragments',

		# Write out the distributions
		'write',
	];
} ## end sub _build_tasklist

has 'user_agent' => (
	is  => 'ro',
	isa => class_type(
		'LWP::UserAgent',
		{   message => sub {'Invalid user_agent'}
		}
	),
	lazy    => 1,
	writer  => '_set_user_agent',
	builder => '_build_user_agent',
	clearer => '_clear_user_agent',
);

sub _build_user_agent {
	my $self  = shift;
	my $class = ref $self;

	# Get the real class name after MooseX::Object::Pluggable
	# has messed with it.
	if ( $class =~ /MOP/ms ) {
		$class = $self->_original_class_name();
	}

	my $ua = LWP::UserAgent->new(
		agent => "$class/" . ( $VERSION || '0.00' ),
		timeout       => 30,
		show_progress => 1,
	);

	$ENV{HTTP_PROXY} and $ua->proxy( http => $ENV{HTTP_PROXY} );

	return $ua;
} ## end sub _build_user_agent

has 'app_id' => (
	is  => 'ro',                       # String that passes _IDENTIFIER
	isa => subtype(
		Str => where { _IDENTIFIER($_) },
		message {'app_id must be a legal Perl identifier'}
	),
	required => 1,
);

has 'app_name' => (
	is       => 'ro',
	isa      => Str,
	required => 1,
);

has 'app_publisher' => (
	is       => 'ro',
	isa      => Str,
	required => 1,
);

has 'app_publisher_url' => (
	is       => 'ro',
	isa      => Uri,
	coerce   => 1,
	required => 1,
);

has 'app_ver_name' => (
	is      => 'ro',
	isa     => Str,
	lazy    => 1,
	builder => '_build_app_ver_name',
);

sub _build_app_ver_name {
	my $self = shift;
	return $self->app_name() . q{ } . $self->perl_version_human();
}

has 'beta_number' => (
	is      => 'ro',
	isa     => Int,
	default => 0,
);

has 'bits' => (
	is  => 'ro',                       # Integer 32/64
	isa => subtype(
		'Int' => where {
			if ( not defined $_ ) {
				$_ = 32;
			}

			$_ == 32 or $_ == 64;
		},
		message {
			'Not 32 or 64-bit';
		},
	),
	default => 32,
);

has 'build_number' => (
	is  => 'ro',
	isa => subtype(
		'Int' => where { $_ < 127 and $_ >= 0 },
		message {'Build number must be between 0 and 127'}
	),
	required => 1,
);

has 'default_group_name' => (
	is      => 'ro',
	isa     => Str,
	lazy    => 1,
	default => sub {
		my $self = shift;
		return $self->app_name();
	},
);

has 'gcc_version' => (
	is  => 'ro',
	isa => subtype(
		'Int' => where { $_ == 3 or $_ == 4 },
		message {'Not 3 or 4'}
	),
	default => 3,
);

has 'msi_debug' => (
	is      => 'ro',
	isa     => Bool,
	default => 0,
);

has 'msi_exit_text' => (
	is      => 'ro',
	isa     => Str,
	default => 'Before you start using Perl, please read the README file.',
);

has 'msi_install_warning_text' => (
	is      => 'ro',
	isa     => Str,
	lazy    => 1,
	builder => '_build_msi_install_warning_text',
);

sub _build_msi_install_warning_text {
	my $self = shift;

	my $app_name = $self->app_name();
	my $location = $self->image_dir()->stringify();
	my $url      = $self->app_publisher_url();

	return
"NOTE: This version of $app_name can only be installed to $location. If this is a problem, please download another version from $url.";
}

has 'msi_run_readme_txt' => (
	is      => 'ro',
	isa     => Bool,
	default => 0,
);

has 'output_base_filename' => (
	is      => 'ro',
	isa     => Str,
	lazy    => 1,
	builder => '_build_output_base_filename',
);

# Default the output filename to the id plus the current date
sub _build_output_base_filename {
	my $self = shift;

	my $bits = ( 64 == $self->bits ) ? q{64bit-} : q{};

	return
	    $self->app_id() . q{-}
	  . $self->perl_version_human() . q{-}
	  . $bits
	  . $self->output_date_string();
}

has 'perl_config_cf_email' => (
	is  => 'ro',                       # E-mail address
	isa => subtype(
		Str => where { $_ =~ m/\A.*@.*\z/msx },
		message {
			'perl_config_cf_email must be in the form of an e-mail address';
		}
	),
	default => 'anonymous@unknown.builder.invalid',
);

has 'perl_config_cf_by' => (
	is      => 'ro',
	isa     => Str,
	lazy    => 1,
	builder => '_build_perl_config_cf_by',
);

sub _build_perl_config_cf_by {
	my $self = shift;
	return $self->perl_config_cf_email() =~ m/\A(.*)@.*\z/msx;
}

has 'perl_debug' => (
	is      => 'ro',
	isa     => Bool,
	default => 0,
);

has 'perl_version' => (
	is      => 'ro',
	isa     => Str,
	default => '5101',
);

has 'sitename' => (
	is       => 'ro',                  # Hostname
	isa      => Str,
	required => 1,                     # Default is provided in BUILDARGS.
);

has 'smoketest' => (
	is      => 'ro',
	isa     => Bool,
	default => 0,
);

has 'use_dll_relocation' => (
	is      => 'ro',
	isa     => Bool,
	default => 1,
);

has 'binary_root' => (
	is      => 'ro',
	isa     => Uri,
	coerce  => 1,
	lazy    => 1,
	builder => '_build_binary_root',
);

sub _build_binary_root {
	my $self = shift;

	if ( $self->offline() ) {
		return URI::file->new( $self->download_dir() );
	} else {
		return 'http://strawberryperl.com/package';
	}
}

has 'build_dir' => (
	is      => 'ro',
	isa     => ExistingDirectory_SaneSlashes,
	coerce  => 1,
	lazy    => 1,
	builder => '_build_build_dir',
);

sub _build_build_dir {
	my $self = shift;

	my $dir = catdir( $self->temp_dir(), 'build' );
	$self->remake_path($dir);
	return $dir;
}

has 'cpan' => (
	is      => 'ro',
	isa     => Uri,
	lazy    => 1,
	coerce  => 1,
	builder => '_build_cpan',
);

sub _build_cpan {
	my $self = shift;

	# If we are online and don't have a cpan repository,
	# use cpan.strawberryperl.com as a default.
	if ( $self->offline() ) {
		return URI::file->new('C:\\minicpan\\'),;
	} else {
		return URI->new('http://cpan.strawberryperl.com/');
	}

	return;
} ## end sub _build_cpan

has 'debug_stderr' => (
	is      => 'ro',
	isa     => File,
	lazy    => 1,
	coerce  => 1,
	default => sub {
		my $self = shift;
		return $self->output_dir()->file('debug.err');
	},
);

has 'debug_stdout' => (
	is      => 'ro',
	isa     => File,
	lazy    => 1,
	coerce  => 1,
	default => sub {
		my $self = shift;
		return $self->output_dir()->file('debug.out');
	},
);

has 'download_dir' => (
	is      => 'ro',
	isa     => ExistingDirectory_Spaceless,
	coerce  => 1,
	lazy    => 1,
	builder => '_build_download_dir',
);

sub _build_download_dir {
	my $self = shift;

	my $dir = catdir( $self->temp_dir(), 'download' );
	$self->make_path($dir);
	return $dir;
}

has 'fragment_dir' => (
	is      => 'ro',
	isa     => ExistingDirectory_SaneSlashes,
	lazy    => 1,
	coerce  => 1,
	builder => '_build_fragment_dir',
);

sub _build_fragment_dir {
	my $self = shift;

	my $dir = catdir( $self->temp_dir(), 'fragments' );
	$self->remake_path($dir);
	return Path::Class::Dir->new($dir);
}

has 'git_checkout' => (
	is      => 'ro',
	isa     => Undef | ExistingDirectory_Spaceless,
	builder => '_build_git_checkout',
	coerce  => 1,
);

sub _build_git_checkout {
	my $dir = q{C:\\perl-git};

	if ( -d $dir ) {
		return Path::Class::Dir->new($dir);
	} else {
		## no critic (ProhibitExplicitReturnUndef)
		return undef;
	}
}

has 'git_location' => (
	is      => 'ro',
	isa     => Undef | ExistingFile,
	builder => '_build_git_location',
	coerce  => 1,
);

sub _build_git_location {
	my $file = 'C:\\Program Files\\Git\\bin\\git.exe';

	if ( -f $file ) {
		return $file;
	} else {
		## no critic (ProhibitExplicitReturnUndef)
		return undef;
	}
}

has 'image_dir' => (
	is       => 'ro',
	isa      => ExistingSubdirectory,
	coerce   => 1,
	required => 1,
);

has 'license_dir' => (
	is      => 'ro',
	isa     => ExistingDirectory_Spaceless,
	lazy    => 1,
	coerce  => 1,
	builder => '_build_license_dir',
);

sub _build_license_dir {
	my $self = shift;

	my $dir = $self->image_dir()->subdir('licenses');
	if ( not -d "$dir" ) {
		$self->remake_path("$dir");
	}
	return $dir;
}

has 'modules_dir' => (
	is      => 'ro',
	isa     => ExistingDirectory_Spaceless,
	lazy    => 1,
	builder => '_build_modules_dir',
);

sub _build_modules_dir {
	my $self = shift;

	my $dir = $self->download_dir()->subdir('modules');
	$self->remake_path("$dir");
	return $dir;
}

has 'msi_banner_side' => (
	is      => 'ro',
	isa     => Undef | ExistingFile,
	coerce  => 1,
	default => undef,
);

has 'msi_banner_top' => (
	is      => 'ro',
	isa     => Undef | ExistingFile,
	coerce  => 1,
	default => undef,
);

has 'msi_help_url' => (
	is      => 'ro',
	isa     => Uri | Undef,            # Maybe[ Uri ] will not work.
	                                   # Unions inherit coercions,
	                                   # parameterized types don't.
	coerce  => 1,
	default => undef,
);

has 'msi_license_file' => (
	is      => 'ro',
	isa     => ExistingFile,
	lazy    => 1,
	coerce  => 1,
	default => sub {
		my $self = shift;
		return catfile( $self->wix_dist_dir(), 'License.rtf' );
	},
);

has 'msi_product_icon' => (
	is      => 'ro',
	isa     => Undef | ExistingFile,
	coerce  => 1,
	default => undef,
);

has 'msi_readme_file' => (
	is      => 'ro',
	isa     => Undef | ExistingFile,
	coerce  => 1,
	default => undef,
);

has 'output_dir' => (
	is      => 'ro',
	isa     => ExistingDirectory_SaneSlashes,
	lazy    => 1,
	coerce  => 1,
	builder => '_build_output_dir',
);

sub _build_output_dir {
	my $self = shift;

	my $dir = $self->temp_dir()->subdir('output');
	$self->make_path("$dir");
	return $dir;
}

has 'temp_dir' => (
	is     => 'ro',
	isa    => ExistingDirectory_SaneSlashes,
	coerce => 1,
	default =>
	  sub { return Path::Class::Dir->new( catdir( tmpdir(), 'perldist' ) ) }
	,
);

has 'tempenv_dir' => (
	is      => 'ro',
	isa     => ExistingDirectory_SaneSlashes,
	lazy    => 1,
	coerce  => 1,
	builder => '_build_tempenv_dir',
);

sub _build_tempenv_dir {
	my $self = shift;

	my $dir = $self->temp_dir()->subdir('tempenv');
	$self->remake_path("$dir");
	return $dir;
}

has 'fileid_perl' => (
	is      => 'ro',
	isa     => Str,
	writer  => '_set_fileid_perl',
	default => q{},
);

sub fileid_perl_h {
	my $self    = shift;
	my $perl_id = $self->fileid_perl();
	return q{[#} . $perl_id . q{]};
}

has 'fileid_relocation_pl' => (
	is      => 'ro',
	isa     => Str,
	writer  => '_set_fileid_relocation_pl',
	default => q{},
);

sub fileid_relocation_pl_h {
	my $self      = shift;
	my $script_id = $self->fileid_relocation_pl();
	return q{[#} . $script_id . q{]};
}

has 'msm_code' => (
	is      => 'ro',
	isa     => Maybe [Str],
	writer  => '_set_msm_code',
	default => undef,
);

has 'msm_to_use' => (
	is      => 'ro',
	isa     => Uri | Undef,
	default => undef,
	coerce  => 1,
);

has 'msm_zip' => (
	is      => 'ro',
	isa     => Uri | Undef,
	default => undef,
	coerce  => 1,
);

has 'checkpoint_after' => (
	is      => 'ro',
	isa     => ArrayRef [Int],
	writer  => '_set_checkpoint_after',
	default => sub { return [0] },
);

has 'checkpoint_before' => (
	is      => 'ro',
	isa     => Int,
	writer  => '_set_checkpoint_before',
	default => 0,
);

has 'checkpoint_dir' => (
	is      => 'ro',
	isa     => ExistingDirectory,
	lazy    => 1,
	builder => '_build_checkpoint_dir',
);

sub _build_checkpoint_dir {
	my $self = shift;
	my $dir  = $self->temp_dir()->subdir('checkpoint');
	if ( not -d "$dir" ) {
		$self->remake_path("$dir");
	}
	return $dir;
}

has 'checkpoint_stop' => (
	is      => 'ro',
	isa     => Int,
	writer  => '_set_checkpoint_stop',
	default => 0,
);



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

	if ( @_ == 1 && 'HASH' eq ref $_[0] ) {
		%params = %{ $_[0] };
	} elsif ( 0 == @_ % 2 ) {
		%params = (@_);
	} else {
		PDWiX::ParametersNotHash->throw( where => '->new()' );
	}

	## no critic(ProtectPrivateSubs RequireCarping RequireUseOfExceptions)
	eval {
		$params{_trace_object} ||=
		  WiX3::Traceable->new( tracelevel => $params{trace} );
		1;
	} || eval {
		WiX3::Trace::Object->_clear_instance();
		WiX3::Traceable->_clear_instance();
		$params{_trace_object} ||=
		  WiX3::Traceable->new( tracelevel => $params{trace} );
	} || die 'Could not create trace object';

	# Announce that we're starting.
	{
		my $time = scalar localtime;
		$params{_trace_object}
		  ->trace_line( 0, "Starting build at $time.\n" );
	}

	# Get the parameters required for the GUID generator set up.
	if (    not _STRING( $params{app_publisher_url} )
		and not _INSTANCE( $params{app_publisher_url}, 'URI' ) )
	{
		PDWiX::Parameter->throw(
			parameter => 'app_publisher_url',
			where     => '->new'
		);
	}

	# Convert a string to a URI object.
	if ( _STRING( $params{app_publisher_url} ) ) {
		$params{app_publisher_url} = URI->new( $params{app_publisher_url} );
	}

	# Default the sitename unless it is given.
	if ( not _STRING( $params{sitename} ) ) {
		$params{sitename} = $params{app_publisher_url}->host();
	}

	# Create the GUID generator.
	$params{_guidgen} ||=
	  WiX3::XML::GeneratesGUID::Object->new(
		_sitename => $params{sitename} );

	if ( defined $params{image_dir} ) {
		my $perl_location = lc Probe::Perl->find_perl_interpreter();
		$params{_trace_object}
		  ->trace_line( 3, "Currently executing perl: $perl_location\n" );
		my $our_perl_location =
		  lc catfile( $params{image_dir}, qw(perl bin perl.exe) );
		$params{_trace_object}->trace_line( 3,
			"Our perl to create:       $our_perl_location\n" );

		if ( $our_perl_location eq $perl_location ) {
			PDWiX::Parameter->throw(
				parameter => 'image_dir : attempting to commit suicide',
				where     => '->new'
			);
		}

		# We don't want to delete a previous one yet.
		$class->make_path( $params{image_dir} );
	} else {
		PDWiX::Parameter->throw(
			parameter => 'image_dir: is not defined',
			where     => '->new'
		);
	}

	if ( $params{app_name} =~ m{[\\/:*"<>|]}msx ) {
		PDWiX::Parameter->throw(
			parameter => 'app_name: Contains characters invalid '
			  . 'for Windows file/directory names',
			where => '->new'
		);
	}

	return \%params;
} ## end sub BUILDARGS



# This is called by Moose's DESTROY, and handles moving the CPAN source
# files back.
sub DEMOLISH {
	my $self = shift;

	if ( $self->_has_moved_cpan() ) {
		my $x = eval {
			$self->remove_path( $self->_cpan_sources_from() );
			File::Copy::Recursive::move( $self->_cpan_sources_to(),
				$self->_cpan_sources_from() );
		};
	}

	return;
} ## end sub DEMOLISH



################################################################
#
# Private attributes. (Ones that have no public accessors or
# are not valid parameters for new().)
#

# Reserved for a future parameter to new()
has 'msi_feature_tree' => (
	is       => 'ro',
	isa      => Maybe [ArrayRef],
	default  => undef,
	init_arg => undef,
);



has '_toolchain' => (
	is       => 'bare',
	isa      => 'Maybe[Perl::Dist::WiX::Toolchain]',
	reader   => '_get_toolchain',
	writer   => '_set_toolchain',
	init_arg => undef,
);



has '_build_start_time' => (
	is       => 'ro',
	isa      => Int,
	default  => time,
	init_arg => undef,                 # Cannot set this parameter in new().
);



has '_distributions' => (
	traits   => ['Array'],
	is       => 'bare',
	isa      => ArrayRef [Str],
	default  => sub { return [] },
	init_arg => undef,
	handles  => {
		'_add_distribution'  => 'push',
		'_get_distributions' => 'elements',
	},
);



has '_env_path' => (
	traits   => ['Array'],
	is       => 'bare',
	isa      => ArrayRef [ ArrayRef [Str] ],
	default  => sub { return [] },
	init_arg => undef,
	handles  => {
		'add_path'                => 'push',
		'_get_env_path_unchecked' => 'elements',
	},
);



has '_filters' => (
	is       => 'ro',
	isa      => ArrayRef [Str],
	lazy     => 1,
	builder  => '_build_filters',
	init_arg => undef,
);

sub _build_filters {
	my $self = shift;

	# Initialize filters.
#<<<
	return [   $self->temp_dir() . q{\\},
	  $self->dir(  qw{ perl man         } ) . q{\\},
	  $self->dir(  qw{ perl html        } ) . q{\\},
	  $self->dir(  qw{ c    man         } ) . q{\\},
	  $self->dir(  qw{ c    doc         } ) . q{\\},
	  $self->dir(  qw{ c    info        } ) . q{\\},
	  $self->dir(  qw{ c    contrib     } ) . q{\\},
	  $self->dir(  qw{ c    html        } ) . q{\\},
	  $self->dir(  qw{ c    examples    } ) . q{\\},
	  $self->dir(  qw{ c    manifest    } ) . q{\\},
	  $self->dir(  qw{ cpan sources     } ) . q{\\},
	  $self->dir(  qw{ cpan build       } ) . q{\\},
	  $self->dir(  qw{ c    bin         startup mac   } ) . q{\\},
	  $self->dir(  qw{ c    bin         startup msdos } ) . q{\\},
	  $self->dir(  qw{ c    bin         startup os2   } ) . q{\\},
	  $self->dir(  qw{ c    bin         startup qssl  } ) . q{\\},
	  $self->dir(  qw{ c    bin         startup tos   } ) . q{\\},
	  $self->dir(  qw{ c    libexec     gcc     mingw32 3.4.5 install-tools}) . q{\\},
	  $self->file( qw{ c    COPYING     } ),
	  $self->file( qw{ c    COPYING.LIB } ),
	  $self->file( qw{ c    bin         gccbug  } ),
	  $self->file( qw{ c    bin         mingw32-gcc-3.4.5  } ),
	  $self->file( qw{ cpan FTPstats.yml  } ),
	  ];
#>>>
} ## end sub _build_filters



has '_in_merge_module' => (
	is       => 'ro',
	isa      => Bool,
	default  => 1,
	init_arg => undef,
	writer   => '_set_in_merge_module',
);



has '_perl_version_corelist' => (
	is       => 'ro',
	isa      => Maybe [HashRef],
	lazy     => 1,
	builder  => '_build_perl_version_corelist',
	init_arg => undef,
);



sub _build_perl_version_corelist {
	my $self = shift;

	# Find the core list
	my $corelist_version = $self->perl_version_literal() + 0;
	my $hash             = $Module::CoreList::version{$corelist_version};
	if ( not _HASH($hash) ) {
		PDWiX->throw( 'Failed to resolve Module::CoreList hash for '
			  . $self->perl_version_human() );
	}
	return $hash;
} ## end sub _build_perl_version_corelist



has 'pdw_version' => (
	is      => 'ro',
	isa     => Str,
	default => $Perl::Dist::WiX::VERSION,
	init_arg => undef,                 # Cannot set this parameter in new().
);



has '_guidgen' => (
	is  => 'ro',
	isa => 'WiX3::XML::GeneratesGUID::Object',
	required => 1,                     # Default is provided in BUILDARGS.
	writer   => '_set_guidgen',
	clearer  => '_clear_guidgen',
);



has '_trace_object' => (
	is       => 'ro',
	isa      => 'WiX3::Traceable',
	required => 1,
	writer   => '_set_trace_object',
	clearer  => '_clear_trace_object',
	handles  => {
		'trace_line'      => 'trace_line',
		'_set_tracelevel' => 'set_tracelevel',
	},
);



has _user_agent_directory => (
	is       => 'ro',
	isa      => ExistingDirectory,
	lazy     => 1,
	builder  => '_build_user_agent_directory',
	init_arg => undef,
);

sub _build_user_agent_directory {
	my $self = shift;

# Create a legal path out of the object's class name under
# {Application Data}/Perl.
	my $path = ref $self;
	$path =~ s{::}{-}gmsx;             # Changes all :: to -.
	my $dir =
	  File::Spec->catdir( File::HomeDir->my_data(), 'Perl', $path, );

	# Make the directory or die vividly.
	if ( not -d $dir ) {
		if ( not File::Path::mkpath( $dir, { verbose => 0 } ) ) {
			PDWiX::Directory->throw(
				dir     => $dir,
				message => 'Failed to create'
			);
		}
	}
	if ( not -w $dir ) {
		PDWiX::Directory->throw(
			dir     => $dir,
			message => 'No write permissions for LWP::UserAgent cache'
		);
	}
	return $dir;
} ## end sub _build_user_agent_directory



has '_cpan_moved' => (
	traits   => ['Bool'],
	is       => 'bare',
	isa      => Bool,
	reader   => '_has_moved_cpan',
	default  => 0,
	init_arg => undef,                 # Cannot set this parameter in new().
	handles => { '_move_cpan' => 'set', },
);



has '_cpan_sources_to' => (
	is       => 'ro',
	isa      => Maybe [Str],
	writer   => '_set_cpan_sources_to',
	default  => undef,
	init_arg => undef,                 # Cannot set this parameter in new().
);



has '_cpan_sources_from' => (
	is      => 'ro',
	isa     => Maybe [Str],
	writer  => '_set_cpan_sources_from',
	default => undef,
	init_arg => undef,                 # Cannot set this parameter in new().
);



has '_portable_dist' => (
	is      => 'ro',                   # String
	isa     => 'Maybe[Portable::Dist]',
	writer  => '_set_portable_dist',
	default => undef,
	init_arg => undef,                 # Cannot set this parameter in new().
);



has '_use_sqlite' => (
	is       => 'ro',
	isa      => Bool,
	init_arg => undef,
	lazy     => 1,
	default  => sub {
		my $self = shift;
		return ( defined $self->msm_to_use() ) ? 1 : 0;
	},
);


has '_all_files_object' => (
	is       => 'ro',
	isa      => 'File::List::Object',
	init_arg => undef,
	lazy     => 1,
	default  => sub { File::List::Object->new() },
);

# This comes from MooseX::Object::Pluggable, and sets up the
# fact that Perl::Dist::WiX::BuildPerl::* is where plugins happen to be.
has '+_plugin_ns' => ( default => 'BuildPerl', );



#####################################################################
# Top Level Process Methods

sub prepare { return 1 }

sub run {
	my $self  = shift;
	my $start = time;

	if ( not( $self->msi() or $self->zip() ) ) {
		$self->trace_line('No msi or zip target, nothing to do');
		return 1;
	}

	# Don't buffer
	STDOUT->autoflush(1);
	STDERR->autoflush(1);

	# List plugins that we can load if we want to.
	my @plugins = $self->_plugin_locator()->plugins();
	$self->trace_line( 3,
		join( qq{\n  }, 'Plugins to build Perl with available:', @plugins )
		  . qq{\n} );

	my $version_plugin = $self->perl_version();
	if ( none {m{:: $version_plugin \z}msx} @plugins ) {
		PDWiX::Parameter->throw(
			parameter => 'perl_version: No plugin installed'
			  . " for the requested version of perl ($version_plugin)",
			where => '->run',
		);
	}

	# Load our perl-building plugin now, because
	# if we do it later, we end up losing data
	# in trait-attached hashrefs and arrayrefs.
	$self->load_plugins($version_plugin);

	my @task_list   = @{ $self->tasklist() };
	my $task_number = 1;
	my $task;
	my $answer = 1;

	while ( $answer and ( $task = shift @task_list ) ) {
		$answer = $self->checkpoint_task( $task => $task_number );
		$task_number++;
	}

	my $time_string = scalar localtime;

	# Finished
	$self->trace_line( 0,
		    'Distribution generation completed in '
		  . ( time - $start )
		  . " seconds (${time_string})\n" );
	foreach my $file ( $self->get_output_files ) {
		$self->trace_line( 0, "Created distribution $file\n" );
	}

	return 1;
} ## end sub run



#####################################################################
#
# Perl::Dist::WiX Main Methods
# (Those referred to in the tasklist.)
#

sub final_initialization {
	my $self = shift;

	# Check for architectures that we can't build 64-bit on.
	if ( 64 == $self->bits() ) {
		$self->_check_64_bit();
	}

	if (    $self->use_dll_relocation()
		and $self->relocatable()
		and not $self->can('msm_relocation_idlist') )
	{
		PDWiX::Parameter->throw(
			parameter => 'use_dll_relocation: Cannot use DLL relocation'
			  . ' without a relocation file id being available '
			  . '(set this parameter to 0)',
			where => '->final_initialization',
		);
	}

	# Redirect $ENV{TEMP} to within our build directory.
	$self->trace_line( 1,
		"Emptying the directory to redirect \$ENV{TEMP} to...\n" );
	$self->remake_path( $self->tempenv_dir() );
	## no critic (RequireLocalizedPunctuationVars)
	$ENV{TEMP} = $self->tempenv_dir();
	$self->trace_line( 5, 'Emptied: ' . $self->tempenv_dir() . "\n" );

	### *** TODO: Move AppData/.cpan/CPAN/MyConfig.pm out of the way. ***

	# If we have a file:// url for the CPAN, move the
	# sources directory out of the way.
	if ( $self->cpan()->as_string() =~ m{\Afile://}mxsi ) {
		if ( not $CPAN::Config_loaded++ ) {
			CPAN::HandleConfig->load();
		}

		my $cpan_path_from = $CPAN::Config->{'keep_source_where'};
		my $cpan_path_to =
		  rel2abs( catdir( $cpan_path_from, q{..}, 'old_sources' ) );

		$self->trace_line( 0, "Moving CPAN sources files:\n" );
		$self->trace_line( 2, <<"EOF");
  From: $cpan_path_from
  To:   $cpan_path_to
EOF

		File::Copy::Recursive::move( $cpan_path_from, $cpan_path_to );

		$self->_set_cpan_sources_from($cpan_path_from);
		$self->_set_cpan_sources_to($cpan_path_to);
		$self->_move_cpan();
	} ## end if ( $self->cpan()->as_string...)

	# Do some sanity checks.
	if ( $self->cpan()->as_string() !~ m{\/\z}ms ) {
		PDWiX::Parameter->throw(
			parameter => 'cpan: Missing trailing slash',
			where     => '->final_initialization'
		);
	}
	if ( $self->build_dir() =~ /\s/ms ) {
		PDWiX::Parameter->throw(
			parameter => 'build_dir: Spaces are not allowed',
			where     => '->final_initialization'
		);
	}

	# Handle portable special cases
	if ( $self->portable() ) {
		$self->_set_exe(0);
		$self->_set_msi(0);
		if ( not $self->zip() ) {
			PDWiX->throw('Cannot be portable and not build a .zip');
		}
	}

	# Making sure that this is set.
	$self->_set_in_merge_module(1);

	## no critic(ProtectPrivateSubs)
	# Set up element collections, starting with the directory tree.
	$self->trace_line( 2, "Creating in-memory directory tree...\n" );
	Perl::Dist::WiX::DirectoryTree->_clear_instance();
	$self->_set_directories(
		Perl::Dist::WiX::DirectoryTree->new(
			app_dir  => $self->image_dir(),
			app_name => $self->app_name(),
		  )->initialize_tree(
			$self->perl_version(), $self->bits(), $self->gcc_version() ) );

	# Create an environment fragment.
	$self->_add_fragment( 'Environment',
		Perl::Dist::WiX::Fragment::Environment->new() );

	# Add directories that need created.
	$self->_add_fragment(
		'CreateCpan',
		Perl::Dist::WiX::Fragment::CreateFolder->new(
			directory_id => 'Cpan',
			id           => 'CPANFolder',
		) );
	$self->_add_fragment(
		'CreateCpanSources',
		Perl::Dist::WiX::Fragment::CreateFolder->new(
			directory_id => 'CpanSources',
			id           => 'CPANSourcesFolder',
		) );
	$self->_add_fragment(
		'CreatePerl',
		Perl::Dist::WiX::Fragment::CreateFolder->new(
			directory_id => 'Perl',
			id           => 'PerlFolder',
		) );
	$self->_add_fragment(
		'CreatePerlSite',
		Perl::Dist::WiX::Fragment::CreateFolder->new(
			directory_id => 'PerlSite',
			id           => 'PerlSiteFolder',
		) );
	$self->_add_fragment(
		'CreatePerlSiteBin',
		Perl::Dist::WiX::Fragment::CreateFolder->new(
			directory_id => 'PerlSiteBin',
			id           => 'PerlSiteBinFolder',
		) );
	$self->_add_fragment(
		'CreatePerlSiteLib',
		Perl::Dist::WiX::Fragment::CreateFolder->new(
			directory_id => 'PerlSiteLib',
			id           => 'PerlSiteLibFolder',
		) );
	$self->_add_fragment(
		'CreateCpanplus',
		Perl::Dist::WiX::Fragment::CreateFolder->new(
			directory_id => 'Cpanplus',
			id           => 'CPANPLUSFolder',
		) );

	# Empty directories that need emptied.
	$self->trace_line( 1,
		    'Wait a second while we empty the image, '
		  . "output, and fragment directories...\n" );
	$self->remake_path( $self->image_dir() );
	$self->remake_path( $self->output_dir() );
	$self->remake_path( $self->fragment_dir() );

	# Make some directories.
	my @directories_to_make =
	  ( $self->dir('cpan'), $self->dir('cpanplus') );
	for my $d (@directories_to_make) {
		next if -d $d;
		File::Path::mkpath($d);
	}

	# Add environment variables.
	# We use YAML as the backend because we have it.
	$self->add_env( 'TERM',              'dumb' );
	$self->add_env( 'FTP_PASSIVE',       '1' );
	$self->add_env( 'PERL_YAML_BACKEND', 'YAML' );

	# Blow away the directory cache for a new build.
	Perl::Dist::WiX::DirectoryCache->instance()->clear_cache();

	return 1;
} ## end sub final_initialization



sub _check_64_bit {
	my $self = shift;

	# Make the environment variable checks shorter.
	my $arch      = lc( $ENV{'PROCESSOR_ARCHITECTURE'} or 'x86' );
	my $archw6432 = lc( $ENV{'PROCESSOR_ARCHITEW6432'} or 'x86' );

	# Check for Itanium architecture.
	if (   ( 'ix86' eq $arch )
		or ( 'ix86' eq $archw6432 ) )
	{
		PDWiX->throw( 'We do not support building 64-bit Perl'
			  . ' on Itanium architectures.' );
	}

	# Check for x86 architecture.
	if (    ( 'x86' eq $arch )
		and ( 'x86' eq $archw6432 ) )
	{
		PDWiX->throw( 'We do not support building 64-bit Perl'
			  . ' on 32-bit machines.' );
	}

	return;
} ## end sub _check_64_bit

sub initialize_nomsm {
	my $self = shift;

	# Making sure that this is unset.
	$self->_set_in_merge_module(0);

	# Add fragments that otherwise would be after the merge module is done.
	$self->_add_fragment( 'StartMenuIcons',
		Perl::Dist::WiX::Fragment::StartMenu->new() );
	$self->_add_fragment(
		'Win32Extras',
		Perl::Dist::WiX::Fragment::Files->new(
			id    => 'Win32Extras',
			files => File::List::Object->new(),
		) );

	$self->_set_icons(
		$self->get_fragment_object('StartMenuIcons')->get_icons() );
	if ( defined $self->msi_product_icon() ) {
		$self->_icons()->add_icon( $self->msi_product_icon() );
	}

	return 1;
} ## end sub initialize_nomsm

sub initialize_using_msm {
	my $self = shift;

	# Making sure that this is unset.
	$self->_set_in_merge_module(0);

	# Download and extract the image.
	my $tgz = $self->mirror_url( $self->msm_zip(), $self->download_dir() );
	$self->extract_archive( $tgz, $self->image_dir() );

	# Start adding the fragments that are only for an .msi.
	$self->_add_fragment( 'StartMenuIcons',
		Perl::Dist::WiX::Fragment::StartMenu->new() );
	$self->_add_fragment(
		'Win32Extras',
		Perl::Dist::WiX::Fragment::Files->new(
			id    => 'Win32Extras',
			files => File::List::Object->new(),
		) );

	$self->_set_icons(
		$self->get_fragment_object('StartMenuIcons')->get_icons() );
	if ( defined $self->msi_product_icon() ) {
		$self->_icons()->add_icon( $self->msi_product_icon() );
	}

	# Download the merge module.
	my $msm =
	  $self->mirror_url( $self->msm_to_use(), $self->download_dir() );

	# Connect the Merge Module tag.
	my $mm = Perl::Dist::WiX::Tag::MergeModule->new(
		id                => 'Perl',
		disk_id           => 1,
		language          => 1033,
		source_file       => $msm,
		primary_reference => 1,
	);
	$self->_add_merge_module( 'Perl', $mm );
	$self->get_directory_tree()
	  ->add_merge_module( $self->image_dir()->stringify(), $mm );

   # Set the file paths that the first portion of the build otherwise would.
	$self->_set_bin_perl( $self->file(qw(perl bin perl.exe)) );
	$self->_set_bin_make( $self->file(qw(c bin dmake.exe)) );
	$self->_set_bin_pexports( $self->file(qw(c bin pexports.exe)) );
	$self->_set_bin_dlltool( $self->file(qw(c bin dlltool.exe)) );

	# Do the same for the environment variables
	$self->add_path( 'c',    'bin' );
	$self->add_path( 'perl', 'site', 'bin' );
	$self->add_path( 'perl', 'bin' );

	# Remove the .url files and README.txt files.
	my $answer;
	$answer = unlink glob $self->file(qw(win32 *.url));
	$answer = unlink $self->file('README.txt');

	# Initialize CPAN::SQLite if we need to.
	if ( $self->_use_sqlite() && $self->offline() ) {
		my $cpan_dir = $self->cpan()->dir();
		$cpan_dir =~ s{\\\z}{}ms;
		$self->execute_perl( $self->file(qw(perl bin cpandb)),
			'--setup', '--db_dir', $self->dir(qw(cpan)), '--CPAN',
			$cpan_dir, );
	}

	return 1;
} ## end sub initialize_using_msm

# Install the required toolchain elements.
# We use separate methods for each tool to make
# it easier for individual distributions to customize
# the versions of tools they incorporate.
sub install_c_toolchain {
	my $self = shift;

	# The primary make
	$self->install_dmake;

	# Core compiler and support libraries.
	$self->install_gcc_toolchain;

	# C Utilities
	$self->install_mingw_make;
	$self->install_pexports;

	# Set up the environment variables for the binaries
	$self->add_path( 'c', 'bin' );

	return 1;
} ## end sub install_c_toolchain

# Portability support must be added after modules
sub install_portable {
	my $self = shift;

	return 1 if not $self->portable();

	# Install the regular parts of Portability
	if ( not $self->isa('Perl::Dist::Strawberry') ) {
		$self->install_modules( qw(
			  Sub::Uplevel
			  Test::Exception
			  Test::Tester
			  Test::NoWarnings
			  LWP::Online
			  Class::Inspector
		) );
	}
	if ( not $self->isa('Perl::Dist::Bootstrap') ) {
		$self->install_modules( qw(
			  CPAN::Mini
			  Portable
		) );
	}

	# Create the portability object
	$self->trace_line( 1, "Creating Portable::Dist\n" );
	require Portable::Dist;
	$self->_set_portable_dist(
		Portable::Dist->new( perl_root => $self->dir('perl') ) );
	$self->trace_line( 1, "Running Portable::Dist\n" );
	$self->_portable_dist()->run();
	$self->trace_line( 1, "Completed Portable::Dist\n" );

	# Install the file that turns on Portability last
	$self->install_file(
		share      => 'Perl-Dist-WiX portable\portable.perl',
		install_to => 'portable.perl',
	);

	# Install files to help use Strawberry Portable.
	$self->install_file(
		share      => 'Perl-Dist-WiX portable\README.portable.txt',
		install_to => 'README.portable.txt',
	);
	$self->install_file(
		share      => 'Perl-Dist-WiX portable\portableshell.bat',
		install_to => 'portableshell.bat',
	);

	$self->get_directory_tree()->get_directory_object('INSTALLDIR')
	  ->add_directories_id( 'Data', 'data' );
	$self->_add_fragment(
		'DataFolder',
		Perl::Dist::WiX::Fragment::CreateFolder->new(
			directory_id => 'Data',
			id           => 'DataFolder'
		) );

	$self->make_path( $self->dir('data') );

	return 1;
} ## end sub install_portable

# Relocatability support must be added before writing the merge module
sub install_relocatable {
	my $self = shift;

	return 1 if not $self->relocatable();

	# Copy the relocation information in.
	$self->copy_file( catfile( $self->wix_dist_dir(), 'relocation.pl.bat' ),
		$self->image_dir() );

	# Make sure it gets installed.
	$self->insert_fragment(
		'relocation_script',
		File::List::Object->new()
		  ->add_file( $self->file('relocation.pl.bat') ),
	);

	return 1;
} ## end sub install_relocatable

# Relocatability support must be added before writing the merge module
sub find_relocatable_fields {
	my $self = shift;

	return 1 if $self->portable();

	# Set the fileid attributes.
	my $perl_id =
	  $self->get_fragment_object('perl')
	  ->find_file_id( $self->file(qw(perl bin perl.exe)) );
	if ( not $perl_id ) {
		PDWiX->throw("Could not find perl.exe's ID.\n");
	}
	$self->_set_fileid_perl($perl_id);
	$self->trace_line( 2, "File ID for perl.exe: $perl_id\n" );

	return 1 if not $self->relocatable();

	my $script_id =
	  $self->get_fragment_object('relocation_script')
	  ->find_file_id( $self->file('relocation.pl.bat') );
	if ( not $script_id ) {
		PDWiX->throw("Could not find relocation.pl.bat's ID.\n");
	}
	$self->_set_fileid_relocation_pl($script_id);
	$self->trace_line( 2, "File ID for relocation.pl.bat: $script_id\n" );

	return 1;
} ## end sub find_relocatable_fields

# Install links and launchers and so on
sub install_win32_extras {
	my $self = shift;

	File::Path::mkpath( $self->dir('win32') );

	# Copy the environment update script in.
	if ( not $self->portable() ) {
		$self->copy_file(
			catfile( $self->wix_dist_dir(), 'update_env.pl.bat' ),
			$self->image_dir()->file('update_env.pl.bat')->stringify() );
	}

	if ( $self->msi() ) {
		$self->install_launcher(
			name => 'CPAN Client',
			bin  => 'cpan',
		);
		$self->install_website(
			name      => 'CPAN Module Search',
			url       => 'http://search.cpan.org/',
			icon_file => catfile( $self->wix_dist_dir(), 'cpan.ico' ) );

		if ( $self->perl_version_human eq '5.10.0' ) {
			$self->install_website(
				name      => 'Perl 5.10.0 Documentation',
				url       => 'http://perldoc.perl.org/5.10.0/',
				icon_file => catfile( $self->wix_dist_dir(), 'perldoc.ico' )
			);
		}
		if ( $self->perl_version_human eq '5.10.1' ) {
			$self->install_website(
				name      => 'Perl 5.10.1 Documentation',
				url       => 'http://perldoc.perl.org/5.10.1/',
				icon_file => catfile( $self->wix_dist_dir(), 'perldoc.ico' )
			);
		}
		if ( $self->perl_version_human eq '5.12.0' ) {
			$self->install_website(
				name      => 'Perl 5.12.0 Documentation',
				url       => 'http://perldoc.perl.org/5.12.0/',
				icon_file => catfile( $self->wix_dist_dir(), 'perldoc.ico' )
			);
		}
		if ( $self->perl_version_human eq '5.12.1' ) {
			$self->install_website(
				name      => 'Perl 5.12.1 Documentation',
				url       => 'http://perldoc.perl.org/5.12.1/',
				icon_file => catfile( $self->wix_dist_dir(), 'perldoc.ico' )
			);
		}
		if ( $self->perl_version_human eq '5.12.2' ) {
			$self->install_website(
				name      => 'Perl 5.12.2 Documentation',
				url       => 'http://perldoc.perl.org/5.12.2/',
				icon_file => catfile( $self->wix_dist_dir(), 'perldoc.ico' )
			);
		}
		if ( $self->perl_version_human eq '5.12.3' ) {
			$self->install_website(
				name =>
				  'Perl 5.12.2 Documentation (5.12.3 not available yet)',
				url       => 'http://perldoc.perl.org/5.12.2/',
				icon_file => catfile( $self->wix_dist_dir(), 'perldoc.ico' )
			);
		}
		if ( $self->perl_version_human eq '5.14.0' ) {
			$self->install_website(
				name =>
				  'Perl 5.12.2 Documentation (5.14.0 not available yet)',
				url       => 'http://perldoc.perl.org/5.12.2/',
				icon_file => catfile( $self->wix_dist_dir(), 'perldoc.ico' )
			);
		}
		$self->install_website(
			name      => 'Win32 Perl Wiki',
			url       => 'http://win32.perl.org/',
			icon_file => catfile( $self->wix_dist_dir(), 'win32.ico' ) );

		$self->get_fragment_object('StartMenuIcons')->add_shortcut(
			name => 'Perl (command line)',
			description =>
			  'Quick way to get to the command line in order to use Perl.',
			target       => '[SystemFolder]cmd.exe',
			id           => 'PerlCmdLine',
			working_dir  => 'PersonalFolder',
			directory_id => 'D_App_Menu',
		);

		$self->add_to_fragment(
			'Win32Extras',
			[   $self->file(qw(win32 win32.ico)),
				$self->file(qw(win32 cpan.ico)),
			] );

		# Make sure the environment script gets installed.
		$self->insert_fragment(
			'update_env_script',
			File::List::Object->new()
			  ->add_file( $self->file('update_env.pl.bat') ),
		);

	} ## end if ( $self->msi() )

	return $self;
} ## end sub install_win32_extras

# Delete various stuff we won't be needing
sub remove_waste {
	my $self = shift;

	$self->trace_line( 1, "Removing waste\n" );
	$self->trace_line( 2,
		"  Removing doc, man, info and html documentation\n" );
	$self->_remove_dir(qw{ perl man       });
	$self->_remove_dir(qw{ perl html      });
	$self->_remove_dir(qw{ c    man       });
	$self->_remove_dir(qw{ c    doc       });
	$self->_remove_dir(qw{ c    info      });
	$self->_remove_dir(qw{ c    contrib   });
	$self->_remove_dir(qw{ c    html      });

	$self->trace_line( 2, "  Removing C examples, manifests\n" );
	$self->_remove_dir(qw{ c examples  });
	$self->_remove_dir(qw{ c manifest  });

	$self->trace_line( 2, "  Removing extra dmake/gcc files\n" );
	$self->_remove_dir(qw{ c bin startup mac   });
	$self->_remove_dir(qw{ c bin startup msdos });
	$self->_remove_dir(qw{ c bin startup os2   });
	$self->_remove_dir(qw{ c bin startup qssl  });
	$self->_remove_dir(qw{ c bin startup tos   });
	$self->_remove_dir(qw{ c libexec gcc mingw32 3.4.5 install-tools});

	$self->trace_line( 2, "  Removing redundant files\n" );
	$self->_remove_file(qw{ c COPYING     });
	$self->_remove_file(qw{ c COPYING.LIB });
	$self->_remove_file(qw{ c bin gccbug  });
	$self->_remove_file(qw{ c bin mingw32-gcc-3.4.5 });

	$self->trace_line( 2,
		"  Removing CPAN build directories and download caches\n" );
	$self->_remove_dir(qw{ cpan sources  });
	$self->_remove_dir(qw{ cpan build    });
	$self->_remove_file(qw{ cpan cpandb.sql });
	$self->_remove_file(qw{ cpan FTPstats.yml });
	$self->_remove_file(qw{ cpan cpan_sqlite_log.* });
	$self->_remove_file(qw{ cpan Metadata });

	# Readding the cpan directory.
	$self->remake_path( catdir( $self->build_dir, 'cpan' ) );

	return 1;
} ## end sub remove_waste

sub _remove_dir {
	my $self = shift;
	my $dir  = $self->dir(@_);
	if ( -e $dir ) {
		$self->remove_path($dir);
	}
	return 1;
}

sub _remove_file {
	my $self = shift;
	my $file = $self->file(@_);
	if ( -e $file ) {
		## TODO: Deal with the 'no critic'
		unlink $file; ## no critic(RequireCheckedSyscalls)
	}
	return 1;
}

sub regenerate_fragments {
	my $self = shift;

	return 1 if not $self->msi();

	# Add the perllocal.pod here, because apparently it's disappearing.
	if ( $self->fragment_exists('perl') ) {
		$self->add_to_fragment( 'perl',
			[ $self->file(qw(perl lib perllocal.pod)) ] );
	}

	my @fragment_names_regenerate;
	my @fragment_names = $self->_fragment_keys();
	while ( 0 != scalar @fragment_names ) {
		foreach my $name (@fragment_names) {
			my $fragment = $self->get_fragment_object($name);
			if ( defined $fragment ) {
				push @fragment_names_regenerate, $fragment->_regenerate();
			} else {
				$self->trace_line( 0,
					    "Couldn't regenerate fragment $name "
					  . "because fragment object did not exist.\n" );
			}
		}

		$#fragment_names = -1;         # clears the array.
		@fragment_names             = uniq @fragment_names_regenerate;
		$#fragment_names_regenerate = -1;
	} ## end while ( 0 != scalar @fragment_names)

	return 1;
} ## end sub regenerate_fragments