package Perl::Dist::Strawberry;

=pod

=head1 NAME

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

=head1 DESCRIPTION

Strawberry Perl is a binary distribution of Perl for the Windows operating
system.  It includes a bundled compiler and pre-installed modules that offer
the ability to install XS CPAN modules directly from CPAN.

The purpose of the Strawberry Perl series is to provide a practical Win32 Perl
environment for experienced Perl developers to experiment with and test the
installation of various CPAN modules under Win32 conditions, and to provide a
useful platform for doing real work.

Strawberry Perl includes:

=over

=item *

Perl 5.10.0 or 5.10.1

=item *

MingW GCC C/C++ compiler

=item *

Dmake "make" tool

=item *

Every bundled and dual-life module upgraded to the latest version.

=item *

L<Bundle::CPAN>, L<Bundle::LWP> and L<CPAN::SQLite> to enhance the
functionality of the CPAN client.

=item *

Additional Perl modules that enhance the stability of core Perl for
the Win32 platform

=item *

Modules that enhance the ability to install non-CPAN packages such as
L<PAR::Dist>, L<PPM> and L<pip>.

=item *

Prebuilt and known-good C libraries for math, crypto and XML support.

=item *

Additions that provide L<Portable> support.

=back

The B<Perl::Dist::Strawberry> module available on CPAN contains the modules
and L<perldist_strawberry> script that are used to generate the
Strawberry Perl installers.

Please note that B<Perl::Dist::Strawberry> B<does not> include the
resulting Strawberry Perl installer. See the Strawberry Perl website at
L<http://strawberryperl.com/> to download the Strawberry Perl installer.

See L<Perl::Dist::WiX> for details on how the underlying distribution
construction toolkit works.

=head1 CHANGES FROM CORE PERL

Strawberry Perl is and will continue to be based on the latest "stable"
releases of Perl, currently 5.10.1, and 5.12.3.

Some additional modifications are included that improve general
compatibility with the Win32 platform or improve "turnkey" operation on
Win32.

Whenever possible, these modifications will be made only by preinstalling
additional or updated CPAN modules within Strawberry Perl, particularly
modules that have been newly included as core Perl modules in the
"development" branch of perl to address Win32 compatibility issues.

Additionally, a stub CPAN Config.pm file is added.  This provides a
complete zero-conf preconfiguration for CPAN, using a stable
L<http://cpan.strawberryperl.com/> redirector to bounce to a
known-reliable mirror.

A more-thorough network-aware zero-conf capability is currently being
developed and will be included at a later time.

Strawberry has B<never> patched the Perl source code or modified the
perl.exe binary.

=head1 CONFIGURATION

At present, Strawberry Perl 5.10.1 must be installed in C:\strawberry.
5.12.3 is relocatable, and can be installed anywhere.

The executable installer adds the following environment variable changes:

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

Users installing Strawberry Perl without the installer will need to
add the environment entries manually, or using the provided script.

=head1 METHODS

In addition to extending various underlying L<Perl::Dist::WiX> methods,
Strawberry Perl adds some additional methods that provide installation
support for miscellaneous tools that have not yet been promoted to the
core.

=cut

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

=pod

=head2 default_machine

  Perl::Dist::Strawberry->default_machine(...)->run();
  
The C<default_machine> class method is used to setup the most common
'machine' for building Strawberry Perl.

The machine provided creates a standard 5.8.9 distribution (.zip and .msi),
a standard 5.10.1 distribution (.zip and .msi) and a Portable-enabled 5.10.1 
distribution (.zip only).

Returns a L<Perl::Dist::WiX::Util::Machine|Perl::Dist::WiX::Util::Machine> object.

=cut

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;

=pod

=head1 SUPPORT

Bugs should be reported via the CPAN bug tracker at

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Perl-Dist-Strawberry>

Please note that B<only> bugs in the distribution itself or the CPAN
configuration should be reported to RT. Bugs in individual modules
should be reported to their respective distributions.

For more support information and places for discussion, see the
Strawberry Perl Support page L<http://strawberryperl.com/support.html>.

=head1 AUTHOR

Adam Kennedy E<lt>adamk@cpan.orgE<gt>

Curtis Jewell E<lt>csjewell@cpan.orgE<gt>

=head1 COPYRIGHT

Copyright 2007 - 2009 Adam Kennedy.  

Copyright 2009 - 2011 Curtis Jewell.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut