Perl-Dist-WiX
view release on metacpan or search on metacpan
lib/Perl/Dist/WiX.pm view on Meta::CPAN
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().)
#
=pod
=head2 new
The B<new> method creates a Perl::Dist::WiX object that describes a
distribution of perl.
Each object is used to create a single distribution by calling L<run()|/run>,
and then should be discarded.
Although there are over 60 potential constructor arguments that can be
provided, most of them are automatically resolved and exist for overloading
puposes only, or they revert to sensible defaults and generally never need
to be modified.
This routine may take a few minutes to run.
An example of the most likely attributes that will be specified is in the
SYNOPSIS.
Attributes that are required to be set are marked as I<required>
below. They may often be set by subclasses.
All attributes below can also be called as accessors on the object created.
There are six types of parameters that can be passed to new().
=head3 Types of distributions to build
This specifies the "highest" level of change in how the perl distribution is
made - whether a .zip is requested, a .msi, a "thumb-drive portable" .zip, or
a relocatable .msi or .zip.
=head4 msi
The optional boolean C<msi> param is used to indicate that a Windows
Installer distribution package (otherwise known as an msi file) should
be created.
It defaults to true, unless L<portable()|/portable> is true.
=cut
has 'msi' => (
is => 'ro',
isa => Bool,
writer => '_set_msi',
default => sub {
my $self = shift;
return $self->portable() ? 0 : 1;
},
);
=head4 msm
The optional boolean C<msm> param is used to indicate that a Windows
Installer merge module (otherwise known as an msm file) should
be created.
This defaults to true, unless L<portable()|/portable> is true.
=cut
has 'msm' => (
is => 'ro',
isa => Bool,
default => sub {
my $self = shift;
return $self->portable() ? 0 : 1;
},
);
=head4 zip
The optional boolean C<zip> param is used to indicate that a zip
distribution package should be created.
This defaults to the value of C<portable()>.
=cut
has 'zip' => (
is => 'ro',
isa => Bool,
lazy => 1,
default => sub {
my $self = shift;
return $self->portable() ? 1 : 0;
},
);
=head4 portable
The optional C<portable> parameter is used to determine whether a portable
'Perl-on-a-stick' distribution - one that is intended for distribution on
a portable storage device - is built with this object.
If set to a true value, L<zip()|/zip> must also be set to a true value, and
L<msi()|/msi> will be set to a false value.
This defaults to a false value.
=cut
has 'portable' => (
is => 'ro',
isa => Bool,
default => 0,
);
=head4 relocatable
The optional C<relocatable> parameter is used to determine whether the
distribution is meant to be relocatable.
This defaults to a false value.
=cut
has 'relocatable' => (
is => 'ro',
isa => Bool,
default => 0,
);
=head4 exe
The optional boolean C<exe> param is unused at the moment.
=cut
has 'exe' => (
is => 'ro',
isa => Bool,
writer => '_set_exe',
default => 0,
);
=head3 Parameters that affect the build process.
These parameters affect the build process - whether modules are tested
or not, how much information is given, what routines to run, etcetera.
=head4 force
The optional C<force> parameter determines if perl and perl modules are
tested upon installation. If this parameter is true, then no testing
is done.
This defaults to false.
=cut
has 'force' => (
is => 'ro',
isa => Bool,
default => 0,
);
=head4 forceperl
The optional C<forceperl> parameter determines if perl and perl modules
are tested upon installation. If this parameter is true, then testing
is done only upon installed modules, not upon perl itself.
This defaults to false.
=cut
has 'forceperl' => (
is => 'ro',
isa => Bool,
default => 0,
);
lib/Perl/Dist/WiX.pm view on Meta::CPAN
=head4 trace
The optional C<trace> parameter sets the level of tracing that is output.
Setting this parameter to 0 prints out only MAJOR stuff and errors.
Setting this parameter to a number between 2 and 5 will progressively
print out more information about the build.
Numbers above 2 are only needed for debugging purposes.
Default is 1 if not set.
=cut
has 'trace' => (
is => 'ro',
isa => Int,
default => 1,
);
=head4 tasklist
The optional C<tasklist> parameter specifies the list of routines that the
object can do. The routines are object methods of Perl::Dist::WiX (or its
subclasses) that will be executed in order, without parameters, and their
task numbers (as used in Perl::Dist::WiX) will begin with 1 and increment in sequence.
Task routines should either return 1, or throw an exception.
The default task list for Perl::Dist::WiX is as shown below. Subclasses
should provide their own list and insert their tasks in this list, rather
than overriding routines shown above.
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',
];
=cut
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
=head4 user_agent
The optional C<user_agent> parameter stores the L<LWP::UserAgent|LWP::UserAgent>
object (or an object of a subclass of LWP::UserAgent) that Perl::Dist::WiX
uses to download files.
The default creates an L<user_agent_cache|/user_agent_cache>
parameter.
=cut
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,
lib/Perl/Dist/WiX.pm view on Meta::CPAN
The optional C<gcc_version> parameter specifies whether perl is being built
using gcc 3.4.5 from the mingw32 project (by specifying a value of '3'), or
using gcc 4.4.3 from the mingw64 project (by specifying a value of '4').
'3' (gcc 3.4.5) is the default, and is incompatible with C<< L<bits|/bits>
=> 64 >>. '4' is compatible with both 32 and 64-bit, but is incompatible with
C<< L<perl_version|/perl_version> => 5100 5101 >>.
=cut
has 'gcc_version' => (
is => 'ro',
isa => subtype(
'Int' => where { $_ == 3 or $_ == 4 },
message {'Not 3 or 4'}
),
default => 3,
);
=head4 msi_debug
The optional boolean C<msi_debug> parameter is used to indicate that
a debugging MSI (one that creates a log in $ENV{TEMP} upon execution
in Windows Installer 4.0 or above) will be created if C<msi> is also
true.
This defaults to false.
=cut
has 'msi_debug' => (
is => 'ro',
isa => Bool,
default => 0,
);
=head4 msi_exit_text
The optional C<msi_exit_text> parameter is used to customize the text
that the MSI shows on its last screen.
The default says: "Before you start using Perl, please read the README
file."
=cut
has 'msi_exit_text' => (
is => 'ro',
isa => Str,
default => 'Before you start using Perl, please read the README file.',
);
=head4 msi_install_warning_text
Returns the text that the MSI needs to use when not able to relocate.
=cut
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.";
}
=head4 msi_run_readme_txt
Specifies whether to give the option to run a README.txt file when the
installation is completed.
=cut
has 'msi_run_readme_txt' => (
is => 'ro',
isa => Bool,
default => 0,
);
=head4 output_base_filename
The optional C<output_base_filename> parameter specifies the filename
(without extensions) that is used for the installer(s) being generated.
The default is based on C<app_id()>, C<perl_version()>, C<bits()>, and the
current date.
=cut
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{};
lib/Perl/Dist/WiX.pm view on Meta::CPAN
has 'perl_debug' => (
is => 'ro',
isa => Bool,
default => 0,
);
=head4 perl_version
The C<perl_version> parameter specifies what version of perl is downloaded
and built. Legal values for this parameter are 'git', '5100', '5101',
'5120', and '5121' (for a version from perl5.git.perl.org, 5.10.0,
5.10.1, and 5.12.1, respectively.)
This parameter defaults to '5101' if not specified.
=cut
has 'perl_version' => (
is => 'ro',
isa => Str,
default => '5101',
);
=head4 sitename
The optional C<sitename> parameter is used to generate the GUID's necessary
during the process of building the distribution.
This defaults to the host part of C<app_publisher_url>.
=cut
has 'sitename' => (
is => 'ro', # Hostname
isa => Str,
required => 1, # Default is provided in BUILDARGS.
);
=head4 smoketest
The optional boolean C<smoketest> parameter is used to indicate that
a 'smoketest' marked perl interpreter will be created.
=cut
has 'smoketest' => (
is => 'ro',
isa => Bool,
default => 0,
);
=head4 use_dll_relocation
The optional C<use_dll_relocation> parameter specifies whether to use the
C++ relocation dll that's being tested for relocating perl, or to call a
Perl relocation script from the .msi's.
This parameter has no effect is the C<msi> parameter is false, or if the
C<relocatable> parameter is false.
If this variable is false, the Perl relocation script is used instead.
(The default is true.)
=cut
has 'use_dll_relocation' => (
is => 'ro',
isa => Bool,
default => 1,
);
=head3 Directories, files, and URLs used in building.
These parameters specify which directories and files are used when building
a distribution.
At a minimum, L<image_dir|/image_dir> is required, which specifies where Perl
will be installed (by default, in the case where L<relocatable|/relocatable>
is true.) All other options have defaults, most of the time.
=head4 binary_root
The optional C<binary_root> accessor is the URL (as a string, not including
the filename) where the distribution will find its libraries to download.
Defaults to 'http://strawberryperl.com/package' unless C<offline> is set,
in which case it defaults to C<download_dir()>.
=cut
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';
}
}
=head4 build_dir
The optional directory where the source files for the distribution will
be extracted and built from.
Defaults to C<temp_dir> . '\build', and must exist if given.
=cut
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;
}
=head4 cpan
lib/Perl/Dist/WiX.pm view on Meta::CPAN
} else {
## no critic (ProhibitExplicitReturnUndef)
return undef;
}
}
=head4 git_location
The optional C<git_location> parameter is not used unless you specify
that C<perl_version> is 'git'. In that event, this parameter should
contain a string pointing to the location of the git.exe binary, as because
a perl.exe file is in the same directory, it gets removed from the PATH
during the execution of programs from Perl::Dist::WiX.
The default is 'C:\Program Files\Git\bin\git.exe', if it exists. Otherwise,
the default is undef.
People on x64 systems should set this to
C<'C:\Program Files (x86)\Git\bin\git.exe'> unless MSysGit is installed
in a different location (or a 64-bit version becomes available).
This will be converted to a short name before execution, so this must
NOT be on a partition that does not have them, unless the location does
not have spaces.
=cut
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;
}
}
=head4 image_dir
The I<required> C<image_dir> method specifies the location of the Perl install,
both on the author's and end-user's host.
Please note that this directory will be automatically deleted if it
already exists at object creation time. Trying to build a Perl
distribution on the SAME distribution can thus have devastating
results, and an attempt is made to prevent this from happening.
Perl::Dist::WiX distributions can only be installed to fixed paths
as of yet, unless C<relocatable()|/relocatable> is true.
To facilitate a correctly working CPAN setup, the files that will
ultimately end up in the installer must also be assembled under the
same (default, in the C<relocatable> case) path on the author's machine.
=cut
has 'image_dir' => (
is => 'ro',
isa => ExistingSubdirectory,
coerce => 1,
required => 1,
);
=head4 license_dir
The optional subdirectory of L<image_dir|/image_dir> where the licenses for
the different portions of the distribution will be copied to.
Defaults to C<image_dir . '\licenses'>, and needs to exist if given.
=cut
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;
}
=head4 modules_dir
The optional C<modules_dir> parameter sets the location of the directory
that perl modules will be downloaded and cached to.
Defaults to C<download_dir . '\modules'>, and must exist if given.
=cut
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");
lib/Perl/Dist/WiX.pm view on Meta::CPAN
=cut
has 'temp_dir' => (
is => 'ro',
isa => ExistingDirectory_SaneSlashes,
coerce => 1,
default =>
sub { return Path::Class::Dir->new( catdir( tmpdir(), 'perldist' ) ) }
,
);
=head4 tempenv_dir
The processes that B<Perl::Dist::WiX> executes sometimes need
a place to put their temporary files, usually in $ENV{TEMP}.
The optional C<tempenv_dir> parameter specifies the location to
put those files.
This parameter defaults to a subdirectory of temp_dir() if not specified.
=cut
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;
}
=head3 Using a merge module
Subclasses can start building a perl distribution from a merge module,
instead of having to build perl from scratch.
This means that the distribution can:
1) update the version of Perl installed using the merge module.
2) be installed on top of another distribution using that merge module (or
an earlier version of it).
The next 5 options specify the information required to use a merge module.
=head4 fileid_perl
The optional C<fileid_perl> parameter helps the relocation find the perl
executable.
If the merge module is being built, this is set by the
L<install_relocatable|/install_relocatable> method.
If the merge module is being used, it needs to be passed in to new().
=head4 fileid_perl_h
TODO
=cut
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{]};
}
=head4 fileid_relocation_pl
The optional C<fileid_relocation_pl> parameter helps the relocation find
the relocation script.
If the merge module is being built, this is set by the
L<install_relocatable|/install_relocatable> method.
If the merge module is being used, it needs to be passed in to new().
=head4 fileid_relocation_pl_h
TODO
=cut
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{]};
}
=head4 msm_code
The optional C<msm_code> parameter is used to specify the product code
for the merge module referred to in C<msm_to_use>.
C<msm_to_use>, C<msm_zip>, and this parameter must either be all unset,
or all set. They must be all set if C<initialize_using_msm> is in the
tasklist.
=cut
has 'msm_code' => (
is => 'ro',
isa => Maybe [Str],
writer => '_set_msm_code',
default => undef,
);
=head4 msm_to_use
The optional C<msm_to_use> parameter is the location of a merge module
to use when linking the .msi.
It can be specified as a string, a L<Path::Class::File|Path::Class::File>
object, or a L<URI|URI> object.
=cut
has 'msm_to_use' => (
is => 'ro',
isa => Uri | Undef,
default => undef,
coerce => 1,
);
=head4 msm_zip
The optional C<msm_zip> refers to where the .zip version of Strawberry Perl
that matches the merge module specified in C<msm_to_use>
It can be a file:// URL if it's already downloaded.
It can be specified as a string, a L<Path::Class::File|Path::Class::File>
object, or a L<URI|URI> object.
=cut
has 'msm_zip' => (
is => 'ro',
isa => Uri | Undef,
default => undef,
coerce => 1,
lib/Perl/Dist/WiX.pm view on Meta::CPAN
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.)
#
=head2 Methods used by C<run> in the tasklist.
my $dist = Perl::Dist::WiX->new(
tasklist => [
'final_initialization',
...
],
...
);
These methods are used in the tasklist, along with other methods that
are defined by C<Perl::Dist::WiX> or its subclasses.
=head3 final_initialization
The C<final_initialization> routine does the initialization that is
required after the object representing a distribution has been created, but
before files can be installed.
=cut
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');
}
lib/Perl/Dist/WiX.pm view on Meta::CPAN
# 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
=head3 install_relocatable
The C<install_relocatable> method is used by C<run> to install the perl
script to make Perl relocatable when installed.
This routine must be run before L</regenerate_fragments>, so that the
fragment created in this method is regenerated and the file ID can
be found by L</find_relocatable_fields> later.
=cut
# 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
=head3 find_relocatable_fields
The C<find_relocatable_fields> method is used by C<run> to find the
property ID's required to make Perl relocatable when installed.
This routine must be run after L<regenerate_fragments()|/regenerate_fragments>.
=cut
# 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
=head3 install_win32_extras
The C<install_win32_extras> method is used by L<run()|/run> to install
the links and launchers into the Start menu.
=cut
# 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' )
);
lib/Perl/Dist/WiX.pm view on Meta::CPAN
my $dir = $self->fragment_dir;
my ( $fragment, $fragment_name, $fragment_string );
my ( $filename_in, $filename_out );
my $fh;
my @files;
$self->trace_line( 1, "Generating msi\n" );
$self->_create_rightclick_fragment();
FRAGMENT:
# Write out .wxs files for all the fragments and compile them.
foreach my $key ( $self->_fragment_keys() ) {
$fragment = $self->get_fragment_object($key);
$fragment_string = $fragment->as_string();
next
if ( ( not defined $fragment_string )
or ( $fragment_string eq q{} ) );
$fragment_name = $fragment->get_id;
$filename_in = catfile( $dir, $fragment_name . q{.wxs} );
$filename_out = catfile( $dir, $fragment_name . q{.wixout} );
$fh = IO::File->new( $filename_in, 'w' );
if ( not defined $fh ) {
PDWiX::File->throw(
file => $filename_in,
message => 'Could not open file for writing '
. "[$OS_ERROR] [$EXTENDED_OS_ERROR]"
);
}
$fh->print($fragment_string);
$fh->close;
$self->trace_line( 2, "Compiling $filename_in\n" );
$self->_compile_wxs( $filename_in, $filename_out )
or PDWiX->throw("WiX could not compile $filename_in");
if ( not -f $filename_out ) {
PDWiX->throw( "Failed to find $filename_out (probably "
. "compilation error in $filename_in)" );
}
push @files, $filename_out;
} ## end foreach my $key ( $self->_fragment_keys...)
# Generate feature tree.
$self->_set_feature_tree_object(
Perl::Dist::WiX::FeatureTree->new( parent => $self, ) );
my $mm;
# Add merge modules.
foreach my $mm_key ( $self->_merge_module_keys() ) {
$mm = $self->get_merge_module_object($mm_key);
$self->feature_tree_object()->add_merge_module($mm);
}
# Write out the .wxs file
my $content = $self->process_template(
'Main.wxs.tt',
fileid_relocation_pl_h => $self->fileid_relocation_pl_h(),
fileid_perl_h => $self->fileid_perl_h(),
propertylist => $self->_get_msi_property_list(),
);
$content =~ s{\r\n}{\n}msg; # CRLF -> LF
$filename_in =
catfile( $self->fragment_dir(), $self->app_name() . q{.wxs} );
if ( -f $filename_in ) {
# Had a collision. Yell and scream.
PDWiX->throw(
"Could not write out $filename_in: File already exists.");
}
$filename_out =
catfile( $self->fragment_dir, $self->app_name . q{.wixobj} );
$fh = IO::File->new( $filename_in, 'w' );
if ( not defined $fh ) {
PDWiX::File->throw(
file => $filename_in,
message => 'Could not open file for writing '
. "[$OS_ERROR] [$EXTENDED_OS_ERROR]"
);
}
$fh->print($content);
$fh->close;
# Compile the main .wxs
$self->trace_line( 2, "Compiling $filename_in\n" );
$self->_compile_wxs( $filename_in, $filename_out )
or PDWiX->throw("WiX could not compile $filename_in");
if ( not -f $filename_out ) {
PDWiX->throw( "Failed to find $filename_out (probably "
. "compilation error in $filename_in)" );
}
# Start linking the msi.
# Get the parameters for the msi linking.
my $output_msi =
catfile( $self->output_dir, $self->output_base_filename . '.msi', );
my $input_wixouts = catfile( $self->fragment_dir, '*.wixout' );
my $input_wixobj =
catfile( $self->fragment_dir, $self->app_name . '.wixobj' );
# Link the .wixobj files
$self->trace_line( 1, "Linking $output_msi\n" );
my $out;
my $cmd = [
wix_bin_light(),
'-sice:ICE38', # Gets rid of ICE38 warning.
'-sice:ICE43', # Gets rid of ICE43 warning.
'-sice:ICE47', # Gets rid of ICE47 warning.
# (Too many components in one
# feature for Win9X)
'-sice:ICE48', # Gets rid of ICE48 warning.
# (Hard-coded installation location)
# '-v', # Verbose for the moment.
'-out', $output_msi,
'-ext', wix_lib_wixui(),
'-ext', wix_library('WixUtil'),
$input_wixobj,
$input_wixouts,
];
my $rv = IPC::Run3::run3( $cmd, \undef, \$out, \undef );
$self->trace_line( 1, $out );
# Did everything get done correctly?
if ( ( not -f $output_msi ) and ( $out =~ /error|warning/msx ) ) {
$self->trace_line( 0, $out );
PDWiX->throw(
"Failed to find $output_msi (probably compilation error)");
}
return $output_msi;
} ## end sub _write_msi
sub _get_msi_property_list {
my $self = shift;
my $list = Perl::Dist::WiX::PropertyList->new();
$list->add_simple_property( 'PerlModuleID',
$self->msm_package_id_property() );
$list->add_simple_property( 'MSIFASTINSTALL', 1 );
$list->add_simple_property( 'ARPNOREPAIR', 1 );
if ( defined $self->msi_feature_tree() ) {
$list->add_simple_property( 'ARPNOMODIFY', 1 );
}
$list->add_simple_property( 'ARPCOMMENTS',
$self->app_name() . q{ } . $self->perl_version_human() );
$list->add_simple_property( 'ARPCONTACT', $self->app_publisher() );
$list->add_simple_property( 'ARPURLINFOABOUT',
$self->app_publisher_url() );
if ( defined $self->msi_help_url() ) {
$list->add_simple_property( 'ARPHELPLINK', $self->msi_help_url() );
}
if ( defined $self->msi_readme_file() ) {
$list->add_simple_property( 'ARPREADME', $self->msi_readme_file() );
}
if ( defined $self->msi_product_icon() ) {
$list->add_simple_property( 'ARPPRODUCTICON',
$self->msi_product_icon_id() );
}
$list->add_simple_property( 'WIXUI_EXITDIALOGOPTIONALTEXT',
$self->msi_exit_text() );
if ( $self->msi_run_readme_txt() ) {
$list->add_simple_property( 'WIXUI_EXITDIALOGOPTIONALCHECKBOXTEXT',
'Read README file.' );
$list->add_simple_property( 'WIXUI_EXITDIALOGOPTIONALCHECKBOX', 1 );
$list->add_simple_property( 'WixShellExecTarget',
$self->msi_fileid_readme_txt() );
}
if ( $self->relocatable() ) {
$list->add_simple_property( 'WIXUI_INSTALLDIR', 'INSTALLDIR' );
}
if ( defined $self->msi_banner_top() ) {
$list->add_wixvariable( 'WixUIBannerBmp', $self->msi_banner_top() );
}
if ( defined $self->msi_banner_side() ) {
$list->add_wixvariable( 'WixUIDialogBmp',
$self->msi_banner_side() );
}
$list->add_wixvariable( 'WixUILicenseRtf', $self->msi_license_file() );
return $list;
} ## end sub _get_msi_property_list
=head3 _write_msm
$self->_write_msm();
The C<_write_msm> method is used to generate the compiled merge module
used in the installer. It creates the entire installation file tree, and then
executes WiX to create the merge module.
This method is called by L<write_merge_module()|/write_merge_module>, and
should only be called after all installation phases that install perl
modules that should be in the .msm have been completed and all of the files
for the merge module are in place.
The merge module file is written to the output directory, and the location
of the file is printed to STDOUT.
Returns true or throws an exception or error.
=cut
sub _write_msm {
my $self = shift;
my $dir = $self->fragment_dir;
my ( $fragment, $fragment_name, $fragment_string );
my ( $filename_in, $filename_out );
my $fh;
my @files;
$self->trace_line( 1, "Generating msm\n" );
# Add the path in.
foreach my $value ( map { '[INSTALLDIR]' . catdir( @{$_} ) }
$self->_get_env_path_unchecked() )
{
$self->add_env( 'PATH', $value, 1 );
}
FRAGMENT:
# Write out .wxs files for all the fragments and compile them.
foreach my $key ( $self->_fragment_keys() ) {
$fragment = $self->get_fragment_object($key);
$fragment_string = $fragment->as_string();
next
if ( ( not defined $fragment_string )
or ( $fragment_string eq q{} ) );
$fragment_name = $fragment->get_id();
$filename_in = catfile( $dir, $fragment_name . q{.wxs} );
$filename_out = catfile( $dir, $fragment_name . q{.wixout} );
$fh = IO::File->new( $filename_in, 'w' );
if ( not defined $fh ) {
PDWiX::File->throw(
file => $filename_in,
message => 'Could not open file for writing '
. "[$OS_ERROR] [$EXTENDED_OS_ERROR]"
);
}
$fh->print($fragment_string);
$fh->close;
$self->trace_line( 2, "Compiling $filename_in\n" );
$self->_compile_wxs( $filename_in, $filename_out )
or PDWiX->throw("WiX could not compile $filename_in");
if ( not -f $filename_out ) {
PDWiX->throw( "Failed to find $filename_out (probably "
. "compilation error in $filename_in)" );
}
push @files, $filename_out;
} ## end foreach my $key ( $self->_fragment_keys...)
# Generate feature tree.
$self->_set_feature_tree_object(
Perl::Dist::WiX::FeatureTree->new( parent => $self, ) );
my $commandline = q{};
if ( $self->relocatable() ) {
$commandline = $self->msm_relocation_commandline();
}
# Write out the .wxs file
my $content = $self->process_template(
'Merge-Module.wxs.tt',
fileid_relocation_pl_h => $self->fileid_relocation_pl_h(),
fileid_perl_h => $self->fileid_perl_h(),
msm_relocation_commandline => $commandline,
);
$content =~ s{\r\n}{\n}msg; # CRLF -> LF
$filename_in =
catfile( $self->fragment_dir, $self->app_name . q{.wxs} );
if ( -f $filename_in ) {
# Had a collision. Yell and scream.
PDWiX->throw(
"Could not write out $filename_in: File already exists.");
}
$filename_out =
catfile( $self->fragment_dir, $self->app_name . q{.wixobj} );
$fh = IO::File->new( $filename_in, 'w' );
if ( not defined $fh ) {
PDWiX->throw(
"Could not open file $filename_in for writing [$OS_ERROR] [$EXTENDED_OS_ERROR]"
);
}
$fh->print($content);
$fh->close;
# Compile the main .wxs
$self->trace_line( 2, "Compiling $filename_in\n" );
$self->_compile_wxs( $filename_in, $filename_out )
or PDWiX->throw("WiX could not compile $filename_in");
if ( not -f $filename_out ) {
PDWiX->throw( "Failed to find $filename_out (probably "
. "compilation error in $filename_in)" );
}
# Start linking the merge module.
# Get the parameters for the msi linking.
my $output_msm =
catfile( $self->output_dir, $self->output_base_filename . '.msm', );
my $input_wixouts = catfile( $self->fragment_dir, '*.wixout' );
my $input_wixobj =
catfile( $self->fragment_dir, $self->app_name . '.wixobj' );
# Link the .wixobj files
$self->trace_line( 1, "Linking $output_msm\n" );
my $out;
my $cmd = [
wix_bin_light(), '-out',
$output_msm, '-ext',
wix_lib_wixui(), '-ext',
wix_library('WixUtil'), $input_wixobj,
$input_wixouts,
];
my $rv = IPC::Run3::run3( $cmd, \undef, \$out, \undef );
$self->trace_line( 1, $out );
# Did everything get done correctly?
if ( ( not -f $output_msm ) and ( $out =~ /error|warning/msx ) ) {
$self->trace_line( 0, $out );
PDWiX->throw(
"Failed to find $output_msm (probably compilation error)");
lib/Perl/Dist/WiX.pm view on Meta::CPAN
. $self->build_number()
. ( $self->portable() ? ' Portable' : q{} )
. ( $self->beta_number() ? ' Beta ' . $self->beta_number() : q{} );
} ## end sub distribution_version_human
=head3 distribution_version_file
The C<distribution_version_file> method returns the "marketing" form
of the distribution version, in such a way that it can be used in a file
name.
=cut
sub distribution_version_file {
my $self = shift;
my $version = $self->perl_version_human();
if ( 'git' eq $version ) {
$version = $self->git_describe();
}
return
$version . q{.}
. $self->build_number()
. ( $self->portable() ? '-portable' : q{} )
. ( $self->beta_number() ? '-beta-' . $self->beta_number() : q{} );
} ## end sub distribution_version_file
=head3 output_date_string
Returns a stringified date in YYYYMMDD format for the use of other
routines.
=cut
# Convenience method
sub output_date_string {
my @t = localtime;
return sprintf '%04d%02d%02d', $t[5] + 1900, $t[4] + 1, $t[3];
}
=head3 msi_ui_type
Returns the UI type that the MSI needs to use.
=cut
# For template
sub msi_ui_type {
my $self = shift;
if ( defined $self->msi_feature_tree() ) {
return 'FeatureTree';
} elsif ( $self->relocatable() ) {
return 'MyInstallDir';
} else {
return 'MyInstall';
}
}
=head3 msi_platform_string
Returns the Platform attribute to the MSI's Package tag.
See L<http://wix.sourceforge.net/manual-wix3/wix_xsd_package.htm>
=cut
# For template
sub msi_platform_string {
my $self = shift;
return ( 64 == $self->bits() ) ? 'x64' : 'x86';
}
=head3 msi_product_icon_id
Returns the product icon to use in the main template.
=cut
sub msi_product_icon_id {
my $self = shift;
# Get the icon ID if we can.
if ( defined $self->msi_product_icon() ) {
return 'I_'
. $self->_icons()
->search_icon( $self->msi_product_icon()->stringify() );
} else {
## no critic (ProhibitExplicitReturnUndef)
return undef;
}
} ## end sub msi_product_icon_id
=head3 msi_product_id
Returns the Id for the MSI's <Product> tag.
See L<http://wix.sourceforge.net/manual-wix3/wix_xsd_product.htm>
=cut
# For template
sub msi_product_id {
my $self = shift;
my $generator = WiX3::XML::GeneratesGUID::Object->instance();
lib/Perl/Dist/WiX.pm view on Meta::CPAN
my @ver = @{ $self->_perl_version_arrayref() };
# Merge build number with last part of perl version.
$ver[2] = ( $ver[2] << 8 ) + $self->build_number();
return join q{.}, @ver;
}
=head3 perl_major_version
Gets the major version (the 10, or 12 part of 5.10, or 5.12) of
the perl distribution being built.
=cut
sub perl_major_version {
my $self = shift;
my $ver = $self->_perl_version_arrayref();
return @{$ver}[1];
}
=head3 msi_perl_major_version
Returns the major perl version so that upgrades that jump delete the
site directory.
=cut
# For template.
# MSI versions are 3 part, not 4, with the maximum version being 255.255.65535
sub msi_perl_major_version {
my $self = shift;
# Get perl version arrayref.
my @ver = @{ $self->_perl_bincompat_version_arrayref() };
if ( $self->does('Perl::Dist::WiX::Role::GitPlugin') ) {
# Shift the third portion over to match msi_perl_version.
# Correct to the build number (minus 1 so as not to duplicate) for git.
$ver[2] <<= 8;
$ver[2] += $self->build_number();
$ver[2] -= 1;
} else {
# Shift the third portion over to match msi_perl_version.
$ver[2] <<= 8;
$ver[2] += 255;
}
return join q{.}, @ver;
} ## end sub msi_perl_major_version
=head3 msi_relocation_commandline
Returns a command line to use in Main.wxs.tt for relocation purposes.
=cut
# For template.
sub msi_relocation_commandline {
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);
if ( not defined $id ) {
PDWiX->throw(
"Could not find file $file in fragment $fragment\n");
}
$answer .= " --file [#$id]";
}
return $answer;
} ## end sub msi_relocation_commandline
=head3 msm_relocation_commandline
Returns a command line to use in Merge-Module.wxs.tt for relocation purposes.
=cut
# For template.
sub msm_relocation_commandline {
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);
if ( not defined $id ) {
PDWiX->throw(
"Could not find file $file in fragment $fragment\n");
}
$answer .= " --file [#$id]";
}
return $answer;
} ## end sub msm_relocation_commandline
=head3 msi_relocation_commandline_files
Returns the files to use in Main.wxs.tt for relocation purposes.
This is overridden in subclasses, and creates an exception if not overridden.
=cut
# For template.
sub msi_relocation_commandline_files {
my $self = shift;
PDWiX::Unimplemented->throw();
return;
}
=head3 msm_relocation_commandline_files
Returns the files to use in Merge-Module.wxs.tt for relocation purposes.
This is overridden in subclasses, and creates an exception if not overridden.
=cut
# For template.
sub msm_relocation_commandline_files {
my $self = shift;
PDWiX::Unimplemented->throw();
return;
}
=head3 msi_relocation_ca
Returns which CA to use in Main.wxs.tt and Merge-Module.wxs.tt for relocation
purposes.
=cut
sub msi_relocation_ca {
my $self = shift;
return ( 64 == $self->bits() ) ? 'CAQuietExec64' : 'CAQuietExec';
}
=head3 msi_fileid_readme_txt
Returns the ID of the tag that installs a README.txt file.
=cut
sub msi_fileid_readme_txt {
my $self = shift;
# Set the fileid attributes.
my $readme_id =
$self->get_fragment_object('Win32Extras')
->find_file_id( $self->file(qw(README.txt)) );
if ( not $readme_id ) {
PDWiX->throw("Could not find README.txt's ID.\n");
}
return "[#$readme_id]";
} ## end sub msi_fileid_readme_txt
=head3 perl_config_myuname
Returns the value to be used for perl -V:myuname, which is in this pattern:
Win32 app_id 5.10.0.1.beta_1 #1 Mon Jun 15 23:11:00 2009 i386
(the .beta_X is omitted if the beta_number accessor is not set.)
=cut
# For template.
sub perl_config_myuname {
my $self = shift;
my $version = $self->perl_version_human();
if ( $version =~ m/git/ms ) {
$version = $self->git_describe();
}
if ( $self->smoketest() ) {
$version .= '.smoketest';
} else {
$version .= q{.} . $self->build_number();
if ( $self->beta_number() > 0 ) {
$version .= '.beta_' . $self->beta_number();
}
}
my $bits = ( 64 == $self->bits() ) ? 'x64' : 'i386';
( run in 0.596 second using v1.01-cache-2.11-cpan-71847e10f99 )