Perl::Dist::Strawberry - Strawberry Perl for Win32

  * Adds directories to PATH
    - C:\strawberry\perl\bin  
    - C:\strawberry\perl\site\bin  
    - C:\strawberry\c\bin  

  Perl::Dist::Strawberry->default_machine(...)->run();

package Perl::Dist::Strawberry;

use 5.010;
use Moose;
use strict;
use File::Spec::Functions            qw( catfile catdir  );
use URI::file                        qw();
use File::ShareDir                   qw();
use File::ShareDir::PathClass        qw();
use Perl::Dist::WiX::Util::Machine   qw();
use File::List::Object               qw();
use Path::Class::Dir                 qw();

our $VERSION = '2.5001';
$VERSION =~ s/_//ms;

extends 'Perl::Dist::WiX'                   => { -version => '1.500001', },
        'Perl::Dist::Strawberry::Libraries' => { -version => '2.5001', };

#####################################################################
# Build Machine Generator

sub default_machine {
	my $class = shift;

	# Create the machine
	my $machine = Perl::Dist::WiX::Util::Machine->new(
		class => $class,
		@_,
	);

	# Set the different versions
	$machine->add_dimension('version');
	$machine->add_option('version',
		perl_version => '5101',
		build_number => 5,
	);
	$machine->add_option('version',
		perl_version => '5101',
		build_number => 5,
		image_dir    => 'D:\strawberry',
		msi          => 1,
		zip          => 0,
	);
	$machine->add_option('version',
		perl_version => '5123',
		build_number => 0,
		portable     => 1,
		gcc_version  => 4,
		download_dir => 'C:\tmp\dl-gcc4',
	);
	$machine->add_option('version',
		perl_version       => '5123',
		build_number       => 0,
		relocatable        => 1,
		use_dll_relocation => 1,
		gcc_version        => 4,
		download_dir       => 'C:\tmp\dl-gcc4',
	);

	return $machine;
}

around BUILDARGS => sub {
	my $orig = shift;
	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::Strawberry' );
	}

	$args{app_id}            //= 'strawberryperl';
	$args{app_name}          //= 'Strawberry Perl';
	$args{app_publisher}     //= 'Vanilla Perl Project';
	$args{app_publisher_url} //= URI->new('http://www.strawberryperl.com/');
	$args{image_dir}         //= Path::Class::Dir->new('C:\strawberry');

# Strawberry Perl version.
	$args{perl_version} //= '5123';
	$args{build_number} //= 0;
	$args{beta_number}  //= 0;

# New options for msi building...
	$args{msi_product_icon}   //= File::ShareDir::PathClass->dist_dir('Perl-Dist-WiX')->file('win32.ico');
	$args{msi_license_file}   //= dist_dir()->file('License-short.rtf');
	$args{msi_banner_top}     //= dist_dir()->file('StrawberryBanner.bmp');
	$args{msi_banner_side}    //= dist_dir()->file('StrawberryDialog.bmp');
	$args{msi_run_readme_txt} //= 1;
	$args{msi_help_url}       //= 'http://www.strawberryperl.com/support.html';
	$args{msi_exit_text}      //= <<'EOT';
Before you start using Strawberry Perl, read the Release Notes and the README file.  These are both available from the start menu under "Strawberry Perl".
EOT

# Set e-mail to something Strawberry-specific.
	$args{perl_config_cf_email} //= 'win32-vanilla@perl.org';

# Build both msi and zip versions
	$args{msi} //= 1;
	$args{zip} //= 1;

	return $class->$orig(\%args);
}; ## end sub BUILDARGS


sub _build_tasklist { return [
	'final_initialization',
	'install_c_toolchain',
	'install_strawberry_c_toolchain',
	'install_strawberry_c_libraries',
	'install_perl',
	'install_perl_toolchain',
	'install_cpan_upgrades',
	'verify_msi_file_contents',
	'install_strawberry_modules_1',
	'install_strawberry_modules_2',
	'install_strawberry_modules_3',
	'install_strawberry_modules_4',
	'install_strawberry_modules_5',
	'install_strawberry_files',
	'install_relocatable',
	'regenerate_fragments',
	'find_relocatable_fields',
	'verify_msi_file_contents',
	'write_merge_module',
	'install_win32_extras',
	'install_strawberry_extras',
	'install_relocation_information',
	'install_portable',
	'remove_waste',
	'create_distribution_list',
	'regenerate_fragments',
	'verify_msi_file_contents',
	'write',
	'create_release_notes',
	];
}

#####################################################################
# Configuration

sub dist_dir {
	return File::ShareDir::PathClass::dist_dir('Perl-Dist-Strawberry');
}

# Lazily default the full name.
# Supports building multiple versions of Perl.
sub _build_app_ver_name {
	my $self = shift;
	return $self->app_name()
		. ($self->portable() ? ' Portable' : '')
		. ' ' . $self->perl_version_human()
		. '.' . $self->build_number()
		. ($self->beta_number() ? ' Beta ' . $self->beta_number() : '');
}

sub add_forgotten_files {
	my $self = shift;

	return 1;
}

# Lazily default the file name.
# Supports building multiple versions of Perl.
sub _build_output_base_filename {
	my $self = shift;
	return 'strawberry-perl'
		. '-' . $self->perl_version_human() . q{.}
		. ($self->smoketest() ? 'smoketest-' . $self->output_date_string() : $self->build_number())
		. ($self->image_dir() =~ /^d:/i ? '-ddrive' : q{})
		. ($self->portable() ? '-portable' : q{})
		. (( 64 == $self->bits() ) ? q{-64bit} : q{})
		. ($self->beta_number() ? '-beta-' . $self->beta_number() : q{})
}




#####################################################################
# Customisations for C assets

sub install_strawberry_c_toolchain {
	my $self = shift;

	# Extra Binary Tools
	$self->install_patch();

	return 1;
}

sub install_strawberry_c_libraries {
	my $self = shift;

	# XML Libraries
	$self->install_librarypacks(qw{
		zlib
		libiconv
		libxml2
		libexpat
		libxslt
	});

	# Math Libraries
	$self->install_librarypacks(qw{
		gmp
		mpc
		mpfr
	});

	# Graphics libraries
	$self->install_librarypacks(qw{
		libjpeg
		libgif
		libtiff
		libpng
		libgd
		libfreetype
		libxpm
		freeglut
	});	
	
	# Database Libraries
	$self->install_librarypacks(qw{
		libdb
		libgdbm
		libpostgresql
	});
	$self->install_libmysql();

	# Extra compression libraries
	$self->install_librarypack('libxz');

	# Crypto libraries
	$self->install_librarypacks(qw{
		libopenssl
		libssh2
	});

	return 1;
}






#####################################################################
# Customisations for Perl assets

sub patch_include_path {
	my $self  = shift;

	# Find the share path for this distribution
	my $share = File::ShareDir::dist_dir('Perl-Dist-Strawberry');
	
	# Verify the subdirectories we need exist.
	my $path  = File::Spec->catdir( $share, 'strawberry' );
	my $portable  = File::Spec->catdir( $share, 'portable' );
	unless ( -d $path ) {
		die("Directory $path does not exist");
	}

	if ( $self->portable() ) {
		unless ( -d $portable ) {
			die("Directory $portable does not exist");
		}
		# Prepend to the default include path
		return [ $portable, $path,
			@{ $self->SUPER::patch_include_path() },
		];
	} else {
		# Prepend to the default include path
		return [ $path,
			@{ $self->SUPER::patch_include_path() },
		];
	}
}

sub install_strawberry_modules_1 {
	my $self = shift;

	# Install LWP::Online so our custom minicpan code works
	if ($self->portable() && (12 < $self->perl_major_version()) ) {
		$self->install_distribution(
			name     => 'ADAMK/LWP-Online-1.07.tar.gz',
			mod_name => 'LWP::Online',
			makefilepl_param => ['INSTALLDIRS=site'],
		);
	} else {
		$self->install_distribution(
			name     => 'ADAMK/LWP-Online-1.07.tar.gz',
			mod_name => 'LWP::Online',
			makefilepl_param => ['INSTALLDIRS=vendor'],
		);
	}

	# Win32 Modules
	$self->install_modules( qw{
		Win32::File
		File::Remove
		Win32::File::Object
		Parse::Binary
	} );
	$self->install_module(
		name => 'Win32::EventLog',
		force => 1, # Tests fail on only one computer, will be reported later
	);
	$self->install_modules('Win32::API') if not 64 == $self->bits();

	# Install additional math modules
	$self->install_pari() if not 64 == $self->bits();
	$self->install_modules( qw{
		Math::BigInt::GMP
	} );
	
	# XML Modules
	if ($self->portable() && (12 < $self->perl_major_version()) ) {
		$self->install_distribution(
			name             => 'CHORNY/XML-Parser-2.40.tar.gz',
			mod_name         => 'XML::Parser',
			makefilepl_param => [
				'INSTALLDIRS=site',
				'EXPATLIBPATH=' . $self->dir(qw{ c lib     }),
				'EXPATINCPATH=' . $self->dir(qw{ c include }),
			],
		);
	} else {
		$self->install_distribution(
			name             => 'CHORNY/XML-Parser-2.40.tar.gz',
			mod_name         => 'XML::Parser',
			makefilepl_param => [
				'INSTALLDIRS=vendor',
				'EXPATLIBPATH=' . $self->dir(qw{ c lib     }),
				'EXPATINCPATH=' . $self->dir(qw{ c include }),
			],
		);
	}

	$self->install_modules( qw{
		XML::NamespaceSupport
		XML::SAX
		XML::LibXML
		XML::LibXSLT
	} );
	
	unless ($self->portable() && (12 < $self->perl_major_version()) ) {
		# Insert ParserDetails.ini
		my $ini_file = catfile($self->image_dir(), qw(perl vendor lib XML SAX ParserDetails.ini));
		$self->add_to_fragment('XML_SAX', [ $ini_file ]);
	}
	
	# Apparently Win32::Exe now requires XML::Simple and XML::Parser
	$self->install_modules( qw{
		XML::Simple
		Win32::Exe
	} );

	return 1;
}

sub install_strawberry_modules_2 {
	my $self = shift;
	
	# Networking Enhancements
	# All the Bundle::LWP modules are
	# included in the toolchain or in the upgrades.
	
	# Binary Package Support
	$self->install_modules( qw{
		PAR::Dist
		PAR::Dist::FromPPD
		PAR::Dist::InstallPPD
		Tree::DAG_Node
		Sub::Uplevel
		Test::Warn
		Test::Tester
		Test::NoWarnings
		Test::Deep
		IO::Stringy
		Test::Exception
	} );
	$self->install_module(
		name => 'DBM::Deep',
		force => 1, # RT#56512. (missing t\lib directory) Other tests pass.
	);
	$self->install_modules( qw{
		YAML::Tiny
		PAR
		PAR::Repository::Query
		PAR::Repository::Client
	} );
	if (32 == $self->bits()) {
		$self->install_ppm();
	}
	
	my $cpan_sources = catdir($self->image_dir, 'cpan', 'sources');
	unless (-d $cpan_sources) {
		require File::Path;
		File::Path::mkpath($cpan_sources);
	}
	
	# Console Utilities
	$self->install_modules( qw{
		Number::Compare
		File::Find::Rule
		Data::Compare
		File::chmod
		Params::Util
		CPAN::Checksums
		CPAN::Inject
		File::pushd
		pler
	} );
	$self->install_module( 
		name => 'pip', 
		force => $self->offline() || 0,
	);
	
	return 1;
}

sub install_strawberry_modules_3 {
	my $self = shift;

	# CPAN::SQLite Modules
	$self->install_modules( qw{
		DBI
		DBD::SQLite
		CPAN::DistnameInfo
		CPAN::SQLite
	} );
	
	# CPANPLUS::Internals::Source::SQLite 
	# needs this module, so adding it.
	$self->install_modules( qw{
		DBIx::Simple
	} ) if ($self->perl_version() >= 5100);
	
	# Support for other databases.
	# DB_File had a "Permission denied" on 64-bit Win7 machine on the last test. 
	# Could be artifact of build environment... 
	$self->install_module(
		name  => 'DB_File',
		force => 1,
	); 

	#problems on Russian Windows, RT#67609 and #67611
	$self->install_module(
		name  => 'Win32::OLE',
		force => 1,
	); 
	$self->install_modules( qw{
		BerkeleyDB
		DBD::ODBC
		DBD::ADO
	} );

	if ($self->portable() && (12 < $self->perl_major_version()) ) {
		$self->install_distribution(
			name     => 'CAPTTOFU/DBD-mysql-4.018.tar.gz',
			mod_name => 'DBD::mysql',
			force    => 1,
			makefilepl_param => ['INSTALLDIRS=site', '--mysql_config=mysql_config'],
		);
	} else {
		$self->install_distribution(
			name     => 'CAPTTOFU/DBD-mysql-4.018.tar.gz',
			mod_name => 'DBD::mysql',
			force    => 1,
			makefilepl_param => ['INSTALLDIRS=vendor', '--mysql_config=mysql_config'],
		);
	}
			
	$self->install_module(
		name  => 'DBD::Pg',
		force => 1,
	);
	
	# JSON and local library installation
	$self->install_modules( qw{
		common::sense
		JSON::XS
		JSON
		local::lib
	} );	

	# Now that we have JSON::XS, use it as Parse::CPAN::Meta's JSON backend.
	$self->add_env('PERL_JSON_BACKEND', 'JSON::XS');
	
	# Graphics module installation.
	$self->install_module( name => 'Imager' );
	$self->install_module( name => 'GD' );
	
	return 1;
}

sub install_strawberry_modules_4 {
	my $self = shift;
	
#	if ($self->portable() && (12 < $self->perl_major_version()) ) {
#		$self->install_distribution( 
#			mod_name => 'Crypt::OpenSSL::Random',
#			name     => 'IROBERTS/Crypt-OpenSSL-Random-0.04.tar.gz',
#			makefilepl_param => [
#				'LIBS="-lssl32 -leay32"' ,
#			],
#		);
#	} else {
#		$self->install_distribution( 
#			mod_name => 'Crypt::OpenSSL::Random',
#			name     => 'IROBERTS/Crypt-OpenSSL-Random-0.04.tar.gz',
#			makefilepl_param => [
#				'INSTALLDIRS=vendor', 'LIBS="-lssl32 -leay32"' ,
#			],
#		);
#	}

	# Required for Net::SSLeay.
	local $ENV{'OPENSSL_PREFIX'} = catdir($self->image_dir(), 'c');
	# This is required for IO::Socket::SSL.
	local $ENV{'SKIP_RNG_TEST'} = 1;

	# Crypt::SSLeay has been distropref'd to use the same environment
	# variable that Net::SSLeay uses in order to make building easier.
	$self->install_modules( qw{
		Crypt::SSLeay
		Digest::HMAC
	});

	# Net::SSLeay crashes at present on 64-bit during testing.
	$self->install_modules( qw{	
		Net::SSLeay
		IO::Socket::SSL
		Net::SMTP::TLS
	}) if 32 == $self->bits();
	
	# The rest of the Net::SSH::Perl toolchain.
	$self->install_module(
		name  => 'Data::Random',
		force => 1, # Timing-dependent test.
	);
	$self->install_modules( qw{
		Math::GMP
		Data::Buffer
	});
	# Check why this one isn't working.
	$self->install_modules( qw{
		Crypt::DSA
	}) if 32 == $self->bits();
	$self->install_modules( qw{
		Class::ErrorHandler
		Convert::ASN1
		Crypt::CBC
		Crypt::DES
		Crypt::DES_EDE3
	});
	# Has what appears to be a timing-dependent test.
	$self->install_module(
		name => 'Convert::PEM',
		force => 1,
	);
	$self->install_modules( qw{
		Crypt::DH
		Crypt::Blowfish
		Tie::EncryptedHash
		Class::Loader
	});
	# Requires Math::Pari.
	$self->install_modules( qw{
		Crypt::Random
	}) if 32 == $self->bits();
	$self->install_modules( qw{
		Convert::ASCII::Armour
		Digest::MD2
		Sort::Versions
	});
	# These two require Crypt::Random. See above.
	$self->install_modules( qw{
		Crypt::Primes
		Crypt::RSA
	}) if 32 == $self->bits();
	$self->install_modules( qw{
		Digest::BubbleBabble
	});
	# Does not build 64-bit yet.
	$self->install_modules( qw{
		Crypt::IDEA
	}) if 32 == $self->bits();
	$self->install_modules( qw{
		String::CRC32
		Net::SSH2
	});

	# Since	Net::SSH::Perl does not work under Win32 yet, it
	# is not being installed.  When it does, add it to the end
	# of the previous install_modules call.

	# Module::Signature toolchain.
	$self->install_modules( qw{
		Test::Manifest
		Crypt::Rijndael
		Crypt::CAST5_PP
		Crypt::RIPEMD160
		Crypt::Twofish
	});
	# Requires Crypt::DSA, Crypt::IDEA, 
	# Crypt::RSA, and Math::Pari.
	$self->install_modules( qw{
		Crypt::OpenPGP
	}) if 32 == $self->bits();
	$self->install_modules( qw{
		Algorithm::Diff
		Text::Diff
	});

	# Requires Crypt::OpenPGP - see above.
	$self->install_distribution(
		name     => 'FLORA/Module-Signature-0.66.tar.gz',
		mod_name => 'Module::Signature',
		makefilepl_param => [ 'INSTALLDIRS=vendor', ],
	) if 32 == $self->bits();
	# version 0.67 of Module::Signature can have serious problems on Windows
	# See https://rt.cpan.org/Ticket/Display.html?id=46339
	# IPC::Run is a prereq only for 0.67
	
	return 1;
}

sub install_strawberry_modules_5 {
	my $self = shift;

	# These are common requests.
	$self->install_modules( qw{
		File::Slurp
		Task::Weaken
		Class::Inspector
		SOAP::Lite
		File::ShareDir
	});
	
	# Install this one only on 5.10 and up. 
	# Too many modules to install otherwise.
	$self->install_modules( qw{
		Alien::Tidyp
	}) if $self->perl_version !~ m{\A58}ms;

	# For the local-lib script.
	$self->install_modules( qw{
		IO::Interactive
		App::local::lib::Win32Helper
	});

	# Additional compression modules
	$self->install_module( name => 'Compress::Raw::Lzma' );
	$self->install_module( name => 'IO::Compress::Lzma', force => 1 );
	
	# Additional math modules.
	$self->install_modules( qw{
		Math::MPFR
		Math::MPC
	});
	
	# Clear things out.
	$self->remake_path($self->dir(qw(cpan build))); 

	return 1;
}

sub install_strawberry_files {
	my $self = shift;
	
	## Now let's copy individual files in.
	
	# Copy the module-version script in, and use the runperl.bat trick on it.
	$self->copy_file(
		catfile($self->dist_dir(), 'module-version'), 
		$self->file(qw(perl bin module-version))
	);
	$self->copy_file(
		$self->file(qw(perl bin runperl.bat)), 
		$self->file(qw(perl bin module-version.bat))
	);
	
	# Make sure it gets installed.
	$self->insert_fragment('module_version',
		File::List::Object->new()->add_files(
			$self->file(qw(perl bin module-version)),
			$self->file(qw(perl bin module-version.bat)),				
		),
	);

	if ($self->relocatable()) {
		# Copy the relocation information in.
		$self->make_relocation_file('strawberry-merge-module.reloc.txt');
		
		# Make sure it gets installed.
		$self->insert_fragment('relocation_info',
			File::List::Object->new()->add_file(
				$self->file('strawberry-merge-module.reloc.txt'),				
			),
		);
	}

	return 1;
}



#####################################################################
# Customisations to Windows assets

sub _dist_file {
	return File::ShareDir::dist_file('Perl-Dist-Strawberry', @_);
}

sub install_strawberry_extras {
	my $self = shift;

	my $dist_dir = File::ShareDir::dist_dir('Perl-Dist-Strawberry');

	my $license_file_from = catfile($dist_dir, 'License.rtf');
	my $license_file_to = catfile($self->license_dir(), 'License.rtf');

	$self->copy_file($license_file_from, $license_file_to);
	
	if (not $self->portable()) {
		$self->add_to_fragment( 'Win32Extras', [ $license_file_to, ] );
	}
	
	# Don't include the rest of this for non-Strawberry sub-classes if we 
	# can avoid it.
	my $class = $self->_original_class_name();
	if ('Perl::Dist::Strawberry' ne $class) {
		$self->trace_line(2, 
		  "Did not install the Strawberry extras in a $class");
		return 1;
	}
	
	$self->patch_file( 'README.txt' => $self->image_dir(), { dist => $self } );

	if (not $self->portable()) {
		$self->install_launcher(
			name => 'Check installed versions of modules',
			bin  => 'module-version',
		);
		$self->install_launcher(
			name => 'Create local library areas',
			bin  => 'llw32helper',
		);

		$self->install_website(
			name       => 'Strawberry Perl Website',
			url        => $self->strawberry_url(),
			icon_file  => _dist_file('strawberry.ico')
		);
		$self->install_website(
			name         => 'Strawberry Perl Release Notes',
			url          => $self->strawberry_release_notes_url(),
			icon_file    => _dist_file('strawberry.ico'),
			directory_id => 'D_App_Menu',
		);
		$self->install_website(
			name         => 'learn.perl.org (tutorials, links)',
			url          => 'http://learn.perl.org/',
			icon_file    => _dist_file('perlhelp.ico'),
		);
		$self->install_website(
			name         => 'Beginning Perl (online book)',
			url          => 'http://learn.perl.org/books/beginning-perl/',
			icon_file    => _dist_file('perlhelp.ico'),
		);
		$self->install_website(
			name         => q{Ovid's CGI Course},
			url          => 'http://jdporter.perlmonk.org/cgi_course/',
			icon_file    => _dist_file('perlhelp.ico'),
		);
		
		# Link to IRC.
		$self->install_website(
			name       => 'Live Support',
			url        => 'http://widget.mibbit.com/?server=irc.perl.org&channel=%23win32',
			icon_file  => _dist_file('onion.ico')
		);
		$self->add_icon(
			name         => 'Strawberry Perl README',
			directory_id => 'D_App_Menu',
			filename     => $self->image_dir()->file('README.txt')->stringify(),
		);
	}

	my $readme_file = $self->file('README.txt');

	my $onion_ico_file = $self->file(qw(win32 onion.ico));
	my $strawberry_ico_file = $self->file(qw(win32 strawberry.ico));
	
	$self->copy_file($license_file_from, $license_file_to);
	
	if (not $self->portable()) {
		$self->add_to_fragment( 'Win32Extras',
			[ $readme_file, $onion_ico_file, $strawberry_ico_file ] );
	}

	return 1;
}
 
sub install_relocation_information {
	my $self = shift;

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

	# Copy the relocation information in.
	$self->make_relocation_file('strawberry-ui.reloc.txt', 'strawberry-merge-module.reloc.txt');
	
	# Make sure it gets installed.
	$self->insert_fragment('relocation_ui_info',
		File::List::Object->new()->add_file(
			$self->file('strawberry-ui.reloc.txt'),				
		),
	);

	return 1;
}

sub strawberry_url {
	my $self = shift;
	my $path = $self->output_base_filename();

	# Strip off anything post-version
	unless ( $path =~ s/^(strawberry-perl-\d+(?:\.\d+)+).*$/$1/ ) {
		PDWiX->throw("Failed to generate the strawberry subpath");
	}

	return "http://strawberryperl.com/$path";
}

sub strawberry_release_notes_url {
	my $self = shift;
	my $path = $self->perl_version_human()
		. q{.} . $self->build_number()
		. ($self->beta_number() ? '.beta-' . $self->beta_number() : '');

	return "http://strawberryperl.com/release-notes/$path.html";
}

sub msi_relocation_commandline_files {
	my $self = shift;
	
	return('relocation_ui_info', $self->file('strawberry-ui.reloc.txt'));
}

sub msm_relocation_commandline_files {
	my $self = shift;
	
	return('relocation_info', $self->file('strawberry-merge-module.reloc.txt'));
}

sub msi_relocation_idlist {
	my $self = shift;

	my $answer;
	my %files = $self->msi_relocation_commandline_files();

	my ( $fragment, $file, $id );
	while ( ( $fragment, $file ) = each %files ) {
		$id = $self->get_fragment_object($fragment)->find_file_id($file);
		PDWiX->throw("Could not find file $file in fragment $fragment\n")
		  if not defined $id;
		$answer .= "[#$id]";
	}

	return $answer;
} ## end sub msi_relocation_commandline

sub msm_relocation_idlist {
	my $self = shift;

	my $answer;
	my %files = $self->msm_relocation_commandline_files();

	my ( $fragment, $file, $id );
	while ( ( $fragment, $file ) = each %files ) {
		$id = $self->get_fragment_object($fragment)->find_file_id($file);
		PDWiX->throw("Could not find file $file in fragment $fragment\n")
		  if not defined $id;
		$answer .= "[#$id]";
	}

	return $answer;
} ## end sub msi_relocation_commandline


1;