package Perl::Dist::Inno; =pod =head1 NAME Perl::Dist::Inno - 3rd Generation Distribution Builder using Inno Setup =head1 SYNOPSIS Creating a custom distribution package My::Perl::Dist; use strict; use base 'Perl::Dist::Strawberry'; 1; Building that distribution... > perldist --cpan "file://c|/minicpan/" Strawberry =head1 DESCRIPTION B is a Win32 Perl distribution builder that targets the Inno Setup 5 installer creation program. It provides a rich set of functionality that allows a distribution developer to specify either Perl 5.8.8 or Perl 5.10.0, specify additional C libraries and CPAN modules to be installed, and then set start menu entries to websites and programs as needed. A distribution directory and a matching .iss script is generated, which is then handed off to Inno Setup 5 to create the final distribution .exe installer. Alternatively, B can generate a .zip file for the distribution without the installer. Because the API for B is extremely rich and fairly complex (and a moving target) the documentation is unfortunately a bit less complete than it should be. As parts of the API solidify I hope to document them better. =head2 API Structure The L API is separated into 2 layers, and a series of objects. L provides the direct mapping to the Inno Setup 5 .iss script, and has no logical understand of Perl Distribution. It stores the values that will ultimately be written into the .iss files as attributes, and contains a series of collections of L, L and L>Perl::Dist::Inno::Icon> objects, which map directly to entries in the .iss script's [Files], [Icons] and [Registry] sections. To the extent that it does interact with actual distributions, it is only to the extent of validating some directories exist, and triggering the actual execution of the Inno Setup 5 compiler. B (this class) is a sub-class of L and represents the layer at which the understanding of the Perl distribution itself is implemented. L and its various subclasses provides the internal representation of the logical elements of a Perl distribution. These assets are mostly transient and are destroyed once the asset has been added to the distribution (this may change). In the process of adding the asset to the distribution, various files may be created and objects added to the script object that will result in .iss keys being created where the installer builder needs to know about that asset explicitly. L itself provides both many levels of abstraction with sensible default implementations of high level concept methods, as well as multiple levels of submethods. Strong separation of concerns in this manner allows people creating distribution sub-classes to add hooks to the build process in many places, for maximum customisability. The main Perl::Dist::Inno B method implements the basic flow for the creation of a Perl distribution. The order is rougly as follows: =over 4 =item 1. Install a C toolchain =item 2. Install additional C libraries =item 3. Install Perl itself =item 4. Install/Upgrade the CPAN toolchain =item 5. Install additional CPAN modules =item 6. Optionally install Portability support =item 7. Install Win32-specific things such as start menu entries =item 8. Remove any files we don't need in the final distribution =item 9. Generate the zip, exe or msi files. =back =head2 Creating Your Own Distribution Rather than building directly on top of Perl::Dist::Inno, it is probably better to build on top of a particular distribution, probably Strawberry. For more information, see the L documentation which details how to sub-class the distribution. =head1 METHODS =cut use 5.006; use strict; use warnings; use Carp (); use Archive::Tar 1.42 (); use Archive::Zip 1.26 (); use File::Temp 0.21 (); use File::Spec 3.29 (); use File::Spec::Unix (); use File::Spec::Win32 (); use File::Copy (); use File::Copy::Recursive 0.38 (); use File::Path 2.07 (); use File::PathList 1.04 (); use File::pushd 1.00 (); use File::Remove 1.42 (); use File::HomeDir 0.82 (); use File::Basename (); use File::ShareDir 1.00 (); use File::Find::Rule 0.30 (); use IPC::Run3 0.042 (); use YAML::Tiny 1.36 (); use IO::Capture 0.05 (); use Params::Util 0.35 (); use HTTP::Status 5.817 (); use LWP::UserAgent 5.823 (); use LWP::UserAgent::WithCache 0.06 (); use LWP::Online 1.07 (); use Module::CoreList 2.17 (); use Template 2.20 (); use PAR::Dist 0.42 (); use Portable::Dist 0.02 (); use Storable 2.17 (); use URI::file 1.37 (); use Probe::Perl 0.01 (); use Process 0.25 (); use Process::Storable 0.25 (); use Process::Delegatable 0.25 (); use Perl::Dist::Asset (); use Perl::Dist::Asset::Binary (); use Perl::Dist::Asset::Library (); use Perl::Dist::Asset::Perl (); use Perl::Dist::Asset::Distribution (); use Perl::Dist::Asset::Module (); use Perl::Dist::Asset::PAR (); use Perl::Dist::Asset::File (); use Perl::Dist::Asset::Website (); use Perl::Dist::Asset::Launcher (); use Perl::Dist::Inno::Script (); use Perl::Dist::Util::Toolchain (); use vars qw{$VERSION @ISA}; BEGIN { $VERSION = '1.16'; @ISA = 'Perl::Dist::Inno::Script'; } use Object::Tiny 1.06 qw{ perl_version portable archlib exe zip binary_root offline temp_dir download_dir image_dir modules_dir license_dir build_dir checkpoint_dir iss_file bin_perl bin_make bin_pexports bin_dlltool env_path debug_stdout debug_stderr output_file perl_version_corelist cpan force checkpoint_before checkpoint_after }; ##################################################################### # Upstream Binary Packages (Mirrored) my %PACKAGES = ( 'dmake' => 'dmake-4.8-20070327-SHAY.zip', 'gcc-core' => 'gcc-core-3.4.5-20060117-3.tar.gz', 'gcc-g++' => 'gcc-g++-3.4.5-20060117-3.tar.gz', 'mingw-make' => 'mingw32-make-3.81-2.tar.gz', 'binutils' => 'binutils-2.17.50-20060824-1.tar.gz', 'mingw-runtime' => 'mingw-runtime-3.13.tar.gz', 'w32api' => 'w32api-3.10.tar.gz', 'libiconv-dep' => 'libiconv-1.9.2-1-dep.zip', 'libiconv-lib' => 'libiconv-1.9.2-1-lib.zip', 'libiconv-bin' => 'libiconv-1.9.2-1-bin.zip', 'expat' => 'expat-2.0.1-vanilla.zip', 'gmp' => 'gmp-4.2.1-vanilla.zip', ); sub binary_file { unless ( $PACKAGES{$_[1]} ) { Carp::croak("Unknown package '$_[1]'"); } return $PACKAGES{$_[1]}; } sub binary_url { my $self = shift; my $file = shift; unless ( $file =~ /\.(zip|gz|tgz)$/i ) { # Shorthand, map to full file name $file = $self->binary_file($file, @_); } return $self->binary_root . '/' . $file; } ##################################################################### # Constructor =pod =head2 new The B method creates a new Perl Distribution build as an object. Each object is used to create a single distribution, and then should be discarded. Although there are about 30 potential constructor arguments that can be provided, most of them are automatically resolved and exist for overloading puposes only, or they revert to sensible default and generally never need to be modified. The following is an example of the most likely attributes that will be specified. my $build = Perl::Dist::Inno->new( image_dir => 'C:\vanilla', temp_dir => 'C:\tmp\vp', cpan => 'file://C|/minicpan/', ); =over 4 =item image_dir Perl::Dist::Inno distributions can only be installed to fixed paths. To facilitate a correctly working CPAN setup, the files that will ultimately end up in the installer must also be assembled under the same path on the author's machine. The C 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 devestating results. =item temp_dir B needs a series of temporary directories while it is running the build, including places to cache downloaded files, somewhere to expand tarballs to build things, and somewhere to put debugging output and the final installer zip and exe files. The C param specifies the root path for where these temporary directories should be created. For convenience it is best to make these short paths with simple names, near the root. =item cpan The C param provides a path to a CPAN or minicpan mirror that the installer can use to fetch any needed files during the build process. The param should be a L object to the root of the CPAN repository, including trailing newline. If you are online and no C param is provided, the value will default to the L repository as a convenience. =item portable The optional boolean C param is used to indicate that the distribution is intended for installation on a portable storable device. =item exe The optional boolean C param is used to indicate that a zip distribution package should be created. =item zip The optional boolean C param is used to indicate that an InnoSetup executable installer should be created. =back The C constructor returns a B object, which you should then call C on to generate the distribution. =cut sub new { my $class = shift; my %params = @_; # Apply some defaults unless ( defined $params{binary_root} ) { $params{binary_root} = 'http://strawberryperl.com/package'; } if ( defined $params{image_dir} and ! defined $params{default_dir_name} ) { $params{default_dir_name} = $params{image_dir}; } unless ( defined $params{temp_dir} ) { $params{temp_dir} = File::Spec->catdir( File::Spec->tmpdir, 'perldist', ); } unless ( defined $params{download_dir} ) { $params{download_dir} = File::Spec->catdir( $params{temp_dir}, 'download', ); File::Path::mkpath($params{download_dir}); } unless ( defined $params{build_dir} ) { $params{build_dir} = File::Spec->catdir( $params{temp_dir}, 'build', ); $class->remake_path( $params{build_dir} ); } unless ( defined $params{output_dir} ) { $params{output_dir} = File::Spec->catdir( $params{temp_dir}, 'output', ); $class->remake_path( $params{output_dir} ); } if ( defined $params{image_dir} ) { $class->remake_path( $params{image_dir} ); } unless ( defined $params{perl_version} ) { $params{perl_version} = '5100'; } # Hand off to the parent class my $self = $class->SUPER::new(%params); # Check the version of Perl to build unless ( $self->perl_version_literal ) { Carp::croak "Failed to resolve perl_version_literal"; } unless ( $self->perl_version_human ) { Carp::croak "Failed to resolve perl_version_human"; } unless ( $self->can('install_perl_' . $self->perl_version) ) { Carp::croak("$class does not support Perl " . $self->perl_version); } # Find the core list my $corelist_version = $self->perl_version_literal+0; $self->{perl_version_corelist} = $Module::CoreList::version{$corelist_version}; unless ( Params::Util::_HASH($self->{perl_version_corelist}) ) { Carp::croak("Failed to resolve Module::CoreList hash for " . $self->perl_version_human); } # Apply more defaults unless ( defined $self->{force} ) { $self->{force} = 0; } unless ( defined $self->{trace} ) { $self->{trace} = 1; } unless ( defined $self->debug_stdout ) { $self->{debug_stdout} = File::Spec->catfile( $self->output_dir, 'debug.out', ); } unless ( defined $self->debug_stderr ) { $self->{debug_stderr} = File::Spec->catfile( $self->output_dir, 'debug.err', ); } # Auto-detect online-ness if needed unless ( defined $self->offline ) { $self->{offline} = LWP::Online::offline(); } unless ( defined $self->exe ) { $self->{exe} = 1; } unless ( defined $self->zip ) { $self->{zip} = $self->portable ? 1 : 0; } unless ( defined $self->checkpoint_before ) { $self->{checkpoint_before} = 0; } unless ( defined $self->checkpoint_after ) { $self->{checkpoint_after} = 0; } # Normalize some params $self->{offline} = !! $self->offline; $self->{trace} = !! $self->{trace}; $self->{force} = !! $self->force; $self->{portable} = !! $self->portable; $self->{exe} = !! $self->exe; $self->{zip} = !! $self->zip; $self->{archlib} = !! $self->archlib; # Handle portable special cases if ( $self->portable ) { $self->{exe} = 0; } # If we are online and don't have a cpan repository, # use cpan.strawberryperl.com as a default. if ( ! $self->offline and ! $self->cpan ) { $self->{cpan} = URI->new('http://cpan.strawberryperl.com/'); } # Check params unless ( Params::Util::_STRING($self->download_dir) ) { Carp::croak("Missing or invalid download_dir param"); } unless ( defined $self->modules_dir ) { $self->{modules_dir} = File::Spec->catdir( $self->download_dir, 'modules' ); } unless ( Params::Util::_STRING($self->modules_dir) ) { Carp::croak("Invalid modules_dir param"); } unless ( Params::Util::_STRING($self->image_dir) ) { Carp::croak("Missing or invalid image_dir param"); } if ( $self->image_dir =~ /\s/ ) { Carp::croak("Spaces are not allowed in image_dir"); } unless ( defined $self->license_dir ) { $self->{license_dir} = File::Spec->catdir( $self->image_dir, 'licenses' ); } unless ( Params::Util::_STRING($self->license_dir) ) { Carp::croak("Invalid license_dir param"); } unless ( Params::Util::_STRING($self->build_dir) ) { Carp::croak("Missing or invalid build_dir param"); } if ( $self->build_dir =~ /\s/ ) { Carp::croak("Spaces are not allowed in build_dir"); } unless ( Params::Util::_INSTANCE($self->user_agent, 'LWP::UserAgent') ) { Carp::croak("Missing or invalid user_agent param"); } unless ( Params::Util::_INSTANCE($self->cpan, 'URI') ) { Carp::croak("Missing or invalid cpan param"); } unless ( $self->cpan->as_string =~ /\/$/ ) { Carp::croak("Missing trailing slash in cpan param"); } unless ( defined $self->iss_file ) { $self->{iss_file} = File::Spec->catfile( $self->output_dir, $self->app_id . '.iss' ); } # Clear the previous build if ( -d $self->image_dir ) { $self->trace("Removing previous " . $self->image_dir . "\n"); File::Remove::remove( \1, $self->image_dir ); } else { $self->trace("No previous " . $self->image_dir . " found\n"); } # Initialize the build for my $d ( $self->download_dir, $self->image_dir, $self->modules_dir, $self->license_dir, ) { next if -d $d; File::Path::mkpath($d); } # More details on the tracing if ( $self->{trace} ) { $self->{stdout} = undef; $self->{stderr} = undef; } else { $self->{stdout} = \undef; $self->{stderr} = \undef; } # Inno-Setup Initialization $self->{env_path} = []; $self->add_dir('c'); $self->add_dir('perl'); $self->add_dir('licenses'); $self->add_uninstall; # Set some common environment variables $self->add_env( TERM => 'dumb' ); $self->add_env( FTP_PASSIVE => 1 ); # Initialize the output valuse $self->{output_file} = []; return $self; } =pod =head2 offline The B module has limited ability to build offline, if all packages have already been downloaded and cached. The connectedness of the Perl::Dist object is checked automatically be default using L. It can be overidden by providing an offline param to the constructor. The C accessor returns true if no connection to "the internet" is available and the object will run in offline mode, or false otherwise. =head2 download_dir The C accessor returns the path to the directory that packages of various types will be downloaded and cached to. An explicit value can be provided via a C param to the constructor. Otherwise the value is derived from C. =head2 image_dir The C accessor returns the path to the built distribution image. That is, the directory in which the build C/Perl code and modules will be installed on the build server. At the present time, this is also the path to which Perl will be installed on the user's machine via the C accessor, which is an alias to the L method C. (although theoretically they can be different, this is likely to break the user's Perl install) =cut ##################################################################### # Checkpoint Support sub checkpoint_task { my $self = shift; my $task = shift; my $step = shift; # Are we loading at this step? if ( $self->checkpoint_before == $step ) { $self->checkpoint_load; } # Skip if we are loading later on unless ( $self->checkpoint_before > $step ) { my $t = time; $self->$task(); $self->trace("Completed $task in " . (time - $t) . " seconds\n"); } # Are we saving at this step if ( $self->checkpoint_after == $step ) { $self->checkpoint_save; } return $self; } sub checkpoint_file { File::Spec->catfile( $_[0]->checkpoint_dir, 'self.dat' ); } sub checkpoint_self { die "CODE INCOMPLETE"; } sub checkpoint_save { my $self = shift; unless ( $self->temp_dir ) { die "Checkpoints require a temp_dir to be set"; } # Clear out any existing checkpoint $self->trace("Removing old checkpoint\n"); $self->{checkpoint_dir} = File::Spec->catfile( $self->temp_dir, 'checkpoint', ); $self->remake_path( $self->checkpoint_dir ); # Copy the paths into the checkpoint directory $self->trace("Copying checkpoint directories...\n"); foreach my $dir ( qw{ build_dir download_dir image_dir output_dir } ) { my $from = $self->$dir(); my $to = File::Spec->catdir( $self->checkpoint_dir, $dir ); $self->_copy( $from => $to ); } # Store the main object. # Blank the checkpoint values to prevent load/save loops, and remove # things we can recreate later. my $copy = { %$self, checkpoint_before => 0, checkpoint_after => 0, user_agent => undef, }; Storable::nstore( $copy, $self->checkpoint_file ); return 1; } sub checkpoint_load { my $self = shift; unless ( $self->temp_dir ) { die "Checkpoints require a temp_dir to be set"; } # Does the checkpoint exist $self->trace("Removing old checkpoint\n"); $self->{checkpoint_dir} = File::Spec->catfile( $self->temp_dir, 'checkpoint', ); unless ( -d $self->checkpoint_dir ) { die "Failed to find checkpoint directory"; } # Load the stored hash over our object my $stored = Storable::retrieve( $self->checkpoint_file ); %$self = %$stored; # Pull all the directories out of the storage $self->trace("Restoring checkpoint directories...\n"); foreach my $dir ( qw{ build_dir download_dir image_dir output_dir } ) { my $from = File::Spec->catdir( $self->checkpoint_dir, $dir ); my $to = $self->$dir(); File::Remove::remove( $to ); $self->_copy( $from => $to ); } return 1; } ##################################################################### # Perl::Dist::Inno::Script Methods sub source_dir { $_[0]->image_dir; } # Default the versioned name to an unversioned name sub app_ver_name { my $self = shift; if ( $self->{app_ver_name} ) { return $self->{app_ver_name}; } return $self->app_name . ' ' . $self->perl_version_human; } # Default the output filename to the id plus the current date sub output_base_filename { my $self = shift; if ( $self->{output_base_filename} ) { return $self->{output_base_filename}; } return $self->app_id . '-' . $self->perl_version_human . '-' . $self->output_date_string; } ##################################################################### # Perl::Dist::Inno Main Methods =pod =head2 perl_version The C accessor returns the shorthand perl version as a string (consisting of the three-part version with dots removed). Thus Perl 5.8.8 will be "588" and Perl 5.10.0 will return "5100". =head2 perl_version_literal The C method returns the literal numeric Perl version for the distribution. For Perl 5.8.8 this will be '5.008008', Perl 5.8.9 will be '5.008009', and for Perl 5.10.0 this will be '5.010000'. =cut sub perl_version_literal { return { 588 => '5.008008', 589 => '5.008009', 5100 => '5.010000', }->{$_[0]->perl_version} || 0; } =pod =head2 perl_version_human The C method returns the "marketing" form of the Perl version. This will be either '5.8.8', '5.8.9' or '5.10.0'. =cut sub perl_version_human { return { 588 => '5.8.8', 589 => '5.8.9', 5100 => '5.10.0', }->{$_[0]->perl_version} || 0; } ##################################################################### # Top Level Process Methods sub prepare { 1 } =pod =head1 run The C method is the main method for the class. It does a complete build of a product, spitting out an installer. Returns true, or throws an exception on error. This method may take an hour or more to run. =cut sub run { my $self = shift; my $start = time; unless ( $self->exe or $self->zip ) { $self->trace("No exe or zip target, nothing to do"); return 1; } # Don't buffer $| = 1; # Install the core C toolchain $self->checkpoint_task( install_c_toolchain => 1 ); # Install any additional C libraries $self->checkpoint_task( install_c_libraries => 2 ); # Install the Perl binary $self->checkpoint_task( install_perl => 3 ); # Install additional Perl modules $self->checkpoint_task( install_perl_modules => 4 ); # Install the Win32 extras $self->checkpoint_task( install_win32_extras => 5 ); # Apply optional portability support $self->checkpoint_task( install_portable => 6 ) if $self->portable; # Remove waste and temporary files $self->checkpoint_task( remove_waste => 7 ); # Install any extra custom non-Perl software on top of Perl. # This is primarily added for the benefit of Parrot. $self->checkpoint_task( install_custom => 8 ); # Write out the distributions $self->checkpoint_task( write => 9 ); # Finished $self->trace( "Distribution generation completed in " . (time - $start) . " seconds\n" ); foreach my $file ( @{$self->output_file} ) { $self->trace("Created distribution $file\n"); } return 1; } =pod =head2 install_custom The C method is an empty install stub provided to allow sub-classed distributions to add B different additional packages on top of Strawberry Perl. For example, this class is used by the Parrot distribution builder (which needs to sit on a full Strawberry install). Notably, the C method AFTER C, so that the file deletion logic in C won't accidntally delete files that may result in a vastly more damaging effect on the custom software. Returns true, or throws an error on exception. =cut sub install_custom { return 1; } =pod =head2 install_c_toolchain The C method is used by C to install various binary packages to provide a working C development environment. By default, the C toolchain consists of dmake, gcc (C/C++), binutils, pexports, the mingw runtime environment, and the win32api C package. Although dmake is the "standard" make for Perl::Dist distributions, it will also install... TO BE CONTINUED =cut # Install the required toolchain elements. # We use separate methods for each tool to make # it easier for individual distributions to customize # the versions of tools they incorporate. sub install_c_toolchain { my $self = shift; # The primary make $self->install_dmake; # Core compiler $self->install_gcc; # C Utilities $self->install_mingw_make; $self->install_binutils; $self->install_pexports; # Install support libraries $self->install_mingw_runtime; $self->install_win32api; # Set up the environment variables for the binaries $self->add_env_path( 'c', 'bin' ); return 1; } # No additional modules by default sub install_c_libraries { my $class = shift; if ( $class eq __PACKAGE__ ) { $class->trace("install_c_libraries: Nothing to do\n"); } return 1; } # Install Perl 5.10.0 by default. # Just hand off to the larger set of Perl install methods. sub install_perl { my $self = shift; my $install_perl_method = "install_perl_" . $self->perl_version; unless ( $self->can($install_perl_method) ) { Carp::croak("Cannot generate perl, missing $install_perl_method method in " . ref($self)); } $self->$install_perl_method(@_); } sub install_perl_toolchain { my $self = shift; my $toolchain = @_ ? Params::Util::_INSTANCE($_[0], 'Perl::Dist::Util::Toolchain') : Perl::Dist::Util::Toolchain->new( perl_version => $self->perl_version_literal, ); unless ( $toolchain ) { die("Did not provide a toolchain resolver"); } # Get the regular Perl to generate the list. # Run it in a separate process so we don't hold # any permanent CPAN.pm locks. $toolchain->delegate; if ( $toolchain->{errstr} ) { die("Failed to generate toolchain distributions"); } # Install the toolchain dists foreach my $dist ( @{$toolchain->{dists}} ) { my $automated_testing = 0; my $release_testing = 0; my $force = $self->force; if ( $dist =~ /Scalar-List-Util/ ) { # Does something weird with tainting $force = 1; } if ( $dist =~ /URI-/ ) { # Can't rely on t/heuristic.t not finding a www.perl.bv # because some ISP's use DNS redirectors for unfindable # sites. $force = 1; } if ( $dist =~ /Term-ReadLine-Perl/ ) { # Does evil things when testing, and # so testing cannot be automated. $automated_testing = 1; } $self->install_distribution( name => $dist, force => $force, automated_testing => $automated_testing, release_testing => $release_testing, ); } return 1; } sub install_cpan_upgrades { my $self = shift; unless ( $self->bin_perl ) { Carp::croak("Cannot install CPAN modules yet, perl is not installed"); } # Generate the CPAN installation script my $cpan_string = <<"END_PERL"; print "Loading CPAN...\\n"; use CPAN; CPAN::HandleConfig->load unless \$CPAN::Config_loaded++; print "Upgrading all out of date CPAN modules...\\n"; print "\\\$ENV{PATH} = '\$ENV{PATH}'\\n"; CPAN::Shell->upgrade; print "Completed upgrade of all modules\\n"; exit(0); END_PERL # Dump the CPAN script to a temp file and execute $self->trace("Running upgrade of all modules\n"); my $cpan_file = File::Spec->catfile( $self->build_dir, 'cpan_string.pl', ); SCOPE: { open( CPAN_FILE, '>', $cpan_file ) or die "open: $!"; print CPAN_FILE $cpan_string or die "print: $!"; close( CPAN_FILE ) or die "close: $!"; } local $ENV{PERL_MM_USE_DEFAULT} = 1; local $ENV{AUTOMATED_TESTING} = ''; local $ENV{RELEASE_TESTING} = ''; $self->_run3( $self->bin_perl, $cpan_file ) or die "perl failed"; die "Failure detected during cpan upgrade, stopping" if $?; return 1; } # No additional modules by default sub install_perl_modules { my $self = shift; # Upgrade anything out of date, # but don't install anything extra. $self->install_cpan_upgrades; return 1; } # Portability support must be added after modules sub install_portable { my $self = shift; # Install the regular parts of Portability $self->install_module( name => 'Portable', ); # Create the portability object $self->trace("Creating Portable::Dist\n"); $self->{portable_dist} = Portable::Dist->new( perl_root => File::Spec->catdir( $self->image_dir => 'perl', ), ); $self->trace("Running Portable::Dist\n"); $self->{portable_dist}->run; $self->trace("Completed Portable::Dist\n"); # Install the file that turns on Portability last $self->install_file( share => 'Perl-Dist portable.perl', install_to => 'portable.perl', ); return 1; } # Install links and launchers and so on sub install_win32_extras { my $self = shift; $self->install_launcher( name => 'CPAN Client', bin => 'cpan', ); $self->install_website( name => 'CPAN Search', url => 'http://search.cpan.org/', ); if ( $self->perl_version_human eq '5.8.8' ) { $self->install_website( name => 'Perl 5.8.8 Documentation', url => 'http://perldoc.perl.org/5.8.8/', ); } if ( $self->perl_version_human eq '5.8.9' ) { $self->install_website( name => 'Perl 5.8.9 Documentation', url => 'http://perldoc.perl.org/5.8.9/', ); } if ( $self->perl_version_human eq '5.10.0' ) { $self->install_website( name => 'Perl 5.10.0 Documentation', url => 'http://perldoc.perl.org/', ); } $self->install_website( name => 'Win32 Perl Wiki', url => 'http://win32.perl.org/', ); return 1; } # Delete various stuff we won't be needing sub remove_waste { my $self = shift; $self->trace("Removing doc, man, info and html documentation...\n"); $self->remove_dir(qw{ perl man }); $self->remove_dir(qw{ perl html }); $self->remove_dir(qw{ c man }); $self->remove_dir(qw{ c doc }); $self->remove_dir(qw{ c info }); $self->remove_dir(qw{ c contrib }); $self->remove_dir(qw{ c html }); $self->trace("Removing C examples, manifests...\n"); $self->remove_dir(qw{ c examples }); $self->remove_dir(qw{ c manifest }); $self->trace("Removing redundant license files...\n"); $self->remove_file(qw{ c COPYING }); $self->remove_file(qw{ c COPYING.LIB }); $self->trace("Removing CPAN build directories and download caches...\n"); $self->remove_dir(qw{ cpan sources }); $self->remove_dir(qw{ cpan build }); return 1; } sub remove_dir { my $self = shift; my $dir = $self->dir( @_ ); File::Remove::remove( \1, $dir ) if -e $dir; return 1; } sub remove_file { my $self = shift; my $file = $self->file( @_ ); File::Remove::remove( \1, $file ) if -e $file; return 1; } ##################################################################### # Perl 5.8.8 Support sub install_perl_588 { my $self = shift; # Prefetch and predelegate the toolchain so that it # fails early if there's a problem $self->trace("Pregenerating toolchain...\n"); my $toolchain = Perl::Dist::Util::Toolchain->new( perl_version => $self->perl_version_literal, ) or die("Failed to resolve toolchain modules"); $toolchain->delegate; if ( $toolchain->{errstr} ) { die("Failed to generate toolchain distributions"); } # Install the main perl distributions $self->install_perl_588_bin( name => 'perl', url => 'http://strawberryperl.com/package/perl-5.8.8.tar.gz', unpack_to => 'perl', install_to => 'perl', patch => [ qw{ lib/ExtUtils/Install.pm lib/ExtUtils/Installed.pm lib/ExtUtils/Packlist.pm lib/ExtUtils/t/Install.t lib/ExtUtils/t/Installed.t lib/ExtUtils/t/Installapi2.t lib/ExtUtils/t/Packlist.t lib/ExtUtils/t/basic.t lib/ExtUtils/t/can_write_dir.t lib/CPAN/Config.pm } ], license => { 'perl-5.8.8/Readme' => 'perl/Readme', 'perl-5.8.8/Artistic' => 'perl/Artistic', 'perl-5.8.8/Copying' => 'perl/Copying', }, ); # Upgrade the toolchain modules $self->install_perl_toolchain( $toolchain ); return 1; } sub install_perl_588_bin { my $self = shift; my $perl = Perl::Dist::Asset::Perl->new( parent => $self, force => $self->force, @_, ); unless ( $self->bin_make ) { Carp::croak("Cannot build Perl yet, no bin_make defined"); } # Download the file my $tgz = $self->_mirror( $perl->url, $self->download_dir, ); # Unpack to the build directory my $unpack_to = File::Spec->catdir( $self->build_dir, $perl->unpack_to ); if ( -d $unpack_to ) { $self->trace("Removing previous $unpack_to\n"); File::Remove::remove( \1, $unpack_to ); } $self->_extract( $tgz => $unpack_to ); # Get the versioned name of the directory (my $perlsrc = $tgz) =~ s{\.tar\.gz\z|\.tgz\z}{}; $perlsrc = File::Basename::basename($perlsrc); # Pre-copy updated files over the top of the source my $patch = $perl->patch; if ( $patch ) { # Overwrite the appropriate files foreach my $file ( @$patch ) { $self->patch_file( "perl-5.8.8/$file" => $unpack_to ); } } # Copy in licenses if ( ref $perl->license eq 'HASH' ) { my $license_dir = File::Spec->catdir( $self->image_dir, 'licenses' ); $self->_extract_filemap( $tgz, $perl->license, $license_dir, 1 ); } # Build win32 perl SCOPE: { my $wd = $self->_pushd($unpack_to, $perlsrc , "win32" ); # Prepare to patch my $image_dir = $self->image_dir; my $INST_TOP = File::Spec->catdir( $self->image_dir, $perl->install_to ); my ($INST_DRV) = File::Spec->splitpath( $INST_TOP, 1 ); $self->trace("Patching makefile.mk\n"); $self->patch_file( 'perl-5.8.8/win32/makefile.mk' => $unpack_to, { dist => $self, INST_DRV => $INST_DRV, INST_TOP => $INST_TOP, } ); $self->trace("Building perl...\n"); $self->_make; unless ( $perl->force ) { local $ENV{PERL_SKIP_TTY_TEST} = 1; $self->trace("Testing perl...\n"); $self->_make('test'); } $self->trace("Installing perl...\n"); $self->_make( qw/install UNINST=1/ ); } # Should now have a perl to use $self->{bin_perl} = File::Spec->catfile( $self->image_dir, qw/perl bin perl.exe/ ); unless ( -x $self->bin_perl ) { Carp::croak("Can't execute " . $self->bin_perl); } # Add to the environment variables $self->add_env_path( 'perl', 'bin' ); return 1; } ##################################################################### # Perl 5.8.9 Support sub install_perl_589 { my $self = shift; # Prefetch and predelegate the toolchain so that it # fails early if there's a problem $self->trace("Pregenerating toolchain...\n"); my $toolchain = Perl::Dist::Util::Toolchain->new( perl_version => $self->perl_version_literal, ) or die("Failed to resolve toolchain modules"); $toolchain->delegate; if ( $toolchain->{errstr} ) { die("Failed to generate toolchain distributions"); } # Install the main perl distributions $self->install_perl_589_bin( name => 'perl', url => 'http://strawberryperl.com/package/perl-5.8.9.tar.gz', unpack_to => 'perl', install_to => 'perl', patch => [ qw{ lib/CPAN/Config.pm } ], license => { 'perl-5.8.9/Readme' => 'perl/Readme', 'perl-5.8.9/Artistic' => 'perl/Artistic', 'perl-5.8.9/Copying' => 'perl/Copying', }, ); # Upgrade the toolchain modules $self->install_perl_toolchain( $toolchain ); return 1; } sub install_perl_589_bin { my $self = shift; my $perl = Perl::Dist::Asset::Perl->new( parent => $self, force => $self->force, @_, ); unless ( $self->bin_make ) { Carp::croak("Cannot build Perl yet, no bin_make defined"); } # Download the file my $tgz = $self->_mirror( $perl->url, $self->download_dir, ); # Unpack to the build directory my $unpack_to = File::Spec->catdir( $self->build_dir, $perl->unpack_to ); if ( -d $unpack_to ) { $self->trace("Removing previous $unpack_to\n"); File::Remove::remove( \1, $unpack_to ); } $self->_extract( $tgz => $unpack_to ); # Get the versioned name of the directory (my $perlsrc = $tgz) =~ s{\.tar\.gz\z|\.tgz\z}{}; $perlsrc = File::Basename::basename($perlsrc); # Pre-copy updated files over the top of the source my $patch = $perl->patch; if ( $patch ) { # Overwrite the appropriate files foreach my $file ( @$patch ) { $self->patch_file( "perl-5.8.9/$file" => $unpack_to ); } } # Copy in licenses if ( ref $perl->license eq 'HASH' ) { my $license_dir = File::Spec->catdir( $self->image_dir, 'licenses' ); $self->_extract_filemap( $tgz, $perl->license, $license_dir, 1 ); } # Build win32 perl SCOPE: { my $wd = $self->_pushd($unpack_to, $perlsrc , "win32" ); # Prepare to patch my $image_dir = $self->image_dir; my $INST_TOP = File::Spec->catdir( $self->image_dir, $perl->install_to ); my ($INST_DRV) = File::Spec->splitpath( $INST_TOP, 1 ); $self->trace("Patching makefile.mk\n"); $self->patch_file( 'perl-5.8.9/win32/makefile.mk' => $unpack_to, { dist => $self, INST_DRV => $INST_DRV, INST_TOP => $INST_TOP, } ); $self->trace("Building perl...\n"); $self->_make; unless ( $perl->force ) { local $ENV{PERL_SKIP_TTY_TEST} = 1; $self->trace("Testing perl...\n"); $self->_make('test'); } $self->trace("Installing perl...\n"); $self->_make( qw/install UNINST=1/ ); } # Should now have a perl to use $self->{bin_perl} = File::Spec->catfile( $self->image_dir, qw/perl bin perl.exe/ ); unless ( -x $self->bin_perl ) { Carp::croak("Can't execute " . $self->bin_perl); } # Add to the environment variables $self->add_env_path( 'perl', 'bin' ); return 1; } ##################################################################### # Perl 5.10.0 Support =pod =head2 install_perl_5100 The C method provides a simplified way to install Perl 5.10.0 into the distribution. It takes care of calling C with the standard params, and then calls C to set up the Perl 5.10.0 CPAN toolchain. Returns true, or throws an exception on error. =cut sub install_perl_5100 { my $self = shift; # Prefetch and predelegate the toolchain so that it # fails early if there's a problem $self->trace("Pregenerating toolchain...\n"); my $toolchain = Perl::Dist::Util::Toolchain->new( perl_version => $self->perl_version_literal, ) or die("Failed to resolve toolchain modules"); $toolchain->delegate; if ( $toolchain->{errstr} ) { print "Error: $toolchain->{errstr}\n"; die("Failed to generate toolchain distributions"); } # Install the main binary $self->install_perl_5100_bin( name => 'perl', url => 'http://strawberryperl.com/package/perl-5.10.0.tar.gz', unpack_to => 'perl', install_to => 'perl', patch => [ qw{ lib/ExtUtils/Command.pm lib/CPAN/Config.pm } ], license => { 'perl-5.10.0/Readme' => 'perl/Readme', 'perl-5.10.0/Artistic' => 'perl/Artistic', 'perl-5.10.0/Copying' => 'perl/Copying', }, ); # Install the toolchain $self->install_perl_toolchain( $toolchain ); return 1; } =pod =head2 install_perl_5100_bin $self->install_perl_5100_bin( name => 'perl', dist => 'RGARCIA/perl-5.10.0.tar.gz', unpack_to => 'perl', license => { 'perl-5.10.0/Readme' => 'perl/Readme', 'perl-5.10.0/Artistic' => 'perl/Artistic', 'perl-5.10.0/Copying' => 'perl/Copying', }, install_to => 'perl', ); The C method takes care of the detailed process of building the Perl 5.10.0 binary and installing it into the distribution. A short summary of the process would be that it downloads or otherwise fetches the named package, unpacks it, copies out any license files from the source code, then tweaks the Win32 makefile to point to the specific build directory, and then runs make/make test/make install. It also registers some environment variables for addition to the Inno Setup script. It is normally called directly by C rather than directly from the API, but is documented for completeness. It takes a number of parameters that are sufficiently detailed above. Returns true (after 20 minutes or so) or throws an exception on error. =cut sub install_perl_5100_bin { my $self = shift; my $perl = Perl::Dist::Asset::Perl->new( parent => $self, force => $self->force, @_, ); unless ( $self->bin_make ) { die("Cannot build Perl yet, no bin_make defined"); } $self->trace("Preparing " . $perl->name . "\n"); # Download the file my $tgz = $self->_mirror( $perl->url, $self->download_dir, ); # Unpack to the build directory my $unpack_to = File::Spec->catdir( $self->build_dir, $perl->unpack_to ); if ( -d $unpack_to ) { $self->trace("Removing previous $unpack_to\n"); File::Remove::remove( \1, $unpack_to ); } $self->_extract( $tgz => $unpack_to ); # Get the versioned name of the directory (my $perlsrc = $tgz) =~ s{\.tar\.gz\z|\.tgz\z}{}; $perlsrc = File::Basename::basename($perlsrc); # Pre-copy updated files over the top of the source my $patch = $perl->patch; if ( $patch ) { # Overwrite the appropriate files foreach my $file ( @$patch ) { $self->patch_file( "perl-5.10.0/$file" => $unpack_to ); } } # Copy in licenses if ( ref $perl->license eq 'HASH' ) { my $license_dir = File::Spec->catdir( $self->image_dir, 'licenses' ); $self->_extract_filemap( $tgz, $perl->license, $license_dir, 1 ); } # Build win32 perl SCOPE: { my $wd = $self->_pushd($unpack_to, $perlsrc , "win32" ); # Prepare to patch my $image_dir = $self->image_dir; my $INST_TOP = File::Spec->catdir( $self->image_dir, $perl->install_to ); my ($INST_DRV) = File::Spec->splitpath( $INST_TOP, 1 ); $self->trace("Patching makefile.mk\n"); $self->patch_file( 'perl-5.10.0/win32/makefile.mk' => $unpack_to, { dist => $self, INST_DRV => $INST_DRV, INST_TOP => $INST_TOP, } ); $self->trace("Building perl...\n"); $self->_make; unless ( $perl->force ) { local $ENV{PERL_SKIP_TTY_TEST} = 1; $self->trace("Testing perl...\n"); $self->_make('test'); } $self->trace("Installing perl...\n"); $self->_make( 'install' ); } # Should now have a perl to use $self->{bin_perl} = File::Spec->catfile( $self->image_dir, qw/perl bin perl.exe/ ); unless ( -x $self->bin_perl ) { die "Can't execute " . $self->bin_perl; } # Add to the environment variables $self->add_env_path( 'perl', 'bin' ); return 1; } ##################################################################### # Installing C Toolchain and Library Packages =pod =head2 install_dmake $dist->install_dmake The C method installs the B make tool into the distribution, and is typically installed during "C toolchain" build phase. It provides the approproate arguments to C and then validates that the binary was installed correctly. Returns true or throws an exception on error. =cut sub install_dmake { my $self = shift; # Install dmake $self->install_binary( name => 'dmake', license => { 'dmake/COPYING' => 'dmake/COPYING', 'dmake/readme/license.txt' => 'dmake/license.txt', }, install_to => { 'dmake/dmake.exe' => 'c/bin/dmake.exe', 'dmake/startup' => 'c/bin/startup', }, ); # Initialize the make location $self->{bin_make} = File::Spec->catfile( $self->image_dir, 'c', 'bin', 'dmake.exe', ); unless ( -x $self->bin_make ) { Carp::croak("Can't execute make"); } return 1; } =pod =head2 install_gcc $dist->install_gcc The C method installs the B into the distribution, and is typically installed during "C toolchain" build phase. It provides the appropriate arguments to several C calls. The default C method installs two binary packages, the core compiler 'gcc-core' and the C++ compiler 'gcc-c++'. Returns true or throws an exception on error. =cut sub install_gcc { my $self = shift; # Install the compilers (gcc) $self->install_binary( name => 'gcc-core', license => { 'COPYING' => 'gcc/COPYING', 'COPYING.lib' => 'gcc/COPYING.lib', }, ); $self->install_binary( name => 'gcc-g++', ); return 1; } =pod =head2 install_binutils $dist->install_binutils The C method installs the C package into the distribution. The most important of these is C, which is used to extract static library files from .dll files. This is needed by some libraries to let the Perl interfaces build against them correctly. Returns true or throws an exception on error. =cut sub install_binutils { my $self = shift; $self->install_binary( name => 'binutils', license => { 'Copying' => 'binutils/Copying', 'Copying.lib' => 'binutils/Copying.lib', }, ); $self->{bin_dlltool} = File::Spec->catfile( $self->image_dir, 'c', 'bin', 'dlltool.exe', ); unless ( -x $self->bin_dlltool ) { die "Can't execute dlltool"; } return 1; } =pod =head2 install_pexports $dist->install_pexports The C method installs the C package into the distribution. This is needed by some libraries to let the Perl interfaces build against them correctly. Returns true or throws an exception on error. =cut sub install_pexports { my $self = shift; $self->install_binary( name => 'pexports', url => $self->binary_url('pexports-0.43-1.zip'), license => { 'pexports-0.43/COPYING' => 'pexports/COPYING', }, install_to => { 'pexports-0.43/bin' => 'c/bin', }, ); $self->{bin_pexports} = File::Spec->catfile( $self->image_dir, 'c', 'bin', 'pexports.exe', ); unless ( -x $self->bin_pexports ) { die "Can't execute pexports"; } return 1; } =pod =head2 install_mingw_runtime $dist->install_mingw_runtime The C method installs the MinGW runtime package into the distribution, which is basically the MinGW version of libc and some other very low level libs. Returns true or throws an exception on error. =cut sub install_mingw_runtime { my $self = shift; $self->install_binary( name => 'mingw-runtime', license => { 'doc/mingw-runtime/Contributors' => 'mingw/Contributors', 'doc/mingw-runtime/Disclaimer' => 'mingw/Disclaimer', }, ); return 1; } =pod =head2 install_zlib $dist->install_zlib The C method installs the B compression library into the distribution, and is typically installed during "C toolchain" build phase. It provides the appropriate arguments to a C call that will extract the standard zlib win32 package, and generate the additional files that Perl needs. Returns true or throws an exception on error. =cut sub install_zlib { my $self = shift; # Zlib is a pexport-based lib-install $self->install_library( name => 'zlib', url => $self->binary_url('zlib-1.2.3.win32.zip'), unpack_to => 'zlib', build_a => { 'dll' => 'zlib-1.2.3.win32/bin/zlib1.dll', 'def' => 'zlib-1.2.3.win32/bin/zlib1.def', 'a' => 'zlib-1.2.3.win32/lib/zlib1.a', }, install_to => { 'zlib-1.2.3.win32/bin' => 'c/bin', 'zlib-1.2.3.win32/lib' => 'c/lib', 'zlib-1.2.3.win32/include' => 'c/include', }, ); return 1; } =pod =head2 install_win32api $dist->install_win32api The C method installs C layer, to allow C code to compile against native Win32 APIs. Returns true or throws an exception on error. =cut sub install_win32api { my $self = shift; $self->install_binary( name => 'w32api', ); return 1; } =pod =head2 install_mingw_make $dist->install_mingw_make The C method installs the MinGW build of the B build tool. While GNU make is not used by Perl itself, some C libraries can't be built using the normal C tool and explicitly need GNU make. So we install it as mingw-make and certain Alien:: modules will use it by that name. Returns true or throws an exception on error. =cut sub install_mingw_make { my $self = shift; $self->install_binary( name => 'mingw-make', ); return 1; } =pod =head2 install_libiconv $dist->install_libiconv The C method installs the C library, which is used for various character encoding tasks, and is needed for other libraries such as C. Returns true or throws an exception on error. =cut sub install_libiconv { my $self = shift; # libiconv for win32 comes in 3 parts, install them. $self->install_binary( name => 'libiconv-dep', ); $self->install_binary( name => 'libiconv-lib', ); $self->install_binary( name => 'libiconv-bin', ); # The dll is installed with an unexpected name, # so we correct it post-install. $self->_move( File::Spec->catfile( $self->image_dir, 'c', 'bin', 'libiconv2.dll' ), File::Spec->catfile( $self->image_dir, 'c', 'bin', 'iconv.dll' ), ); return 1; } =pod =head2 install_libxml $dist->install_libxml The C method installs the C library, which is a fast, reliable, XML parsing library, and the new standard library for XML parsing. Returns true or throws an exception on error. =cut sub install_libxml { my $self = shift; # libxml is a straight forward pexport-based install $self->install_library( name => 'libxml2', url => $self->binary_url('libxml2-2.6.30.win32.zip'), unpack_to => 'libxml2', build_a => { 'dll' => 'libxml2-2.6.30.win32/bin/libxml2.dll', 'def' => 'libxml2-2.6.30.win32/bin/libxml2.def', 'a' => 'libxml2-2.6.30.win32/lib/libxml2.a', }, install_to => { 'libxml2-2.6.30.win32/bin' => 'c/bin', 'libxml2-2.6.30.win32/lib' => 'c/lib', 'libxml2-2.6.30.win32/include' => 'c/include', }, ); return 1; } =pod =head2 install_expat $dist->install_expat The C method installs the C XML library, which was the first popular C XML parser. Many Perl XML libraries are based on Expat. Returns true or throws an exception on error. =cut sub install_expat { my $self = shift; # Install the PAR version of libexpat $self->install_par( name => 'libexpat', share => 'Perl-Dist vanilla/libexpat-vanilla.par', install_perl => 1, install_c => 0, ); return 1; } =pod =head2 install_gmp $dist->install_gmp The C method installs the C, which is used for fast and robust bignum support. Returns true or throws an exception on error. =cut sub install_gmp { my $self = shift; # Comes as a single prepackaged vanilla-specific zip file $self->install_binary( name => 'gmp', ); return 1; } =pod =head2 install_pari $dist->install_pari The C method install (via a PAR package) libpari and the L module into the distribution. This method should only be called at during the install_modules phase. =cut sub install_pari { $_[0]->install_par( name => 'pari', url => 'http://strawberryperl.com/package/Math-Pari-2.010800.par', ); } ##################################################################### # General Installation Methods =pod =head2 install_binary $self->install_binary( name => 'gmp', ); The C method is used by library-specific methods to install pre-compiled and un-modified tar.gz or zip archives into the distribution. Returns true or throws an exception on error. =cut sub install_binary { my $self = shift; my $binary = Perl::Dist::Asset::Binary->new( parent => $self, install_to => 'c', # Default to the C dir @_, ); my $name = $binary->name; $self->trace("Preparing $name\n"); # Download the file my $tgz = $self->_mirror( $binary->url, $self->download_dir, ); # Unpack the archive my $install_to = $binary->install_to; if ( ref $binary->install_to eq 'HASH' ) { $self->_extract_filemap( $tgz, $binary->install_to, $self->image_dir ); } elsif ( ! ref $binary->install_to ) { # unpack as a whole my $tgt = File::Spec->catdir( $self->image_dir, $binary->install_to ); $self->_extract( $tgz => $tgt ); } else { die "didn't expect install_to to be a " . ref $binary->install_to; } # Find the licenses if ( ref $binary->license eq 'HASH' ) { $self->_extract_filemap( $tgz, $binary->license, $self->license_dir, 1 ); } return 1; } sub install_library { my $self = shift; my $library = Perl::Dist::Asset::Library->new( parent => $self, @_, ); my $name = $library->name; $self->trace("Preparing $name\n"); # Download the file my $tgz = $self->_mirror( $library->url, $self->download_dir, ); # Unpack to the build directory my $unpack_to = File::Spec->catdir( $self->build_dir, $library->unpack_to ); if ( -d $unpack_to ) { $self->trace("Removing previous $unpack_to\n"); File::Remove::remove( \1, $unpack_to ); } $self->_extract( $tgz => $unpack_to ); # Build the .a file if needed if ( Params::Util::_HASH($library->build_a) ) { # Hand off for the .a generation $self->_dll_to_a( $library->build_a->{source} ? ( source => File::Spec->catfile( $unpack_to, $library->build_a->{source}, ), ) : (), dll => File::Spec->catfile( $unpack_to, $library->build_a->{dll}, ), def => File::Spec->catfile( $unpack_to, $library->build_a->{def}, ), a => File::Spec->catfile( $unpack_to, $library->build_a->{a}, ), ); } # Copy in the files my $install_to = $library->install_to; if ( Params::Util::_HASH($install_to) ) { foreach my $k ( sort keys %$install_to ) { my $from = File::Spec->catdir( $unpack_to, $k, ); my $to = File::Spec->catdir( $self->image_dir, $install_to->{$k}, ); $self->_copy( $from => $to ); } } # Copy in licenses if ( Params::Util::_HASH($library->license) ) { my $license_dir = File::Spec->catdir( $self->image_dir, 'licenses' ); $self->_extract_filemap( $tgz, $library->license, $license_dir, 1 ); } return 1; } =pod =head2 install_distribution $self->install_distribution( name => 'ADAMK/File-HomeDir-0.69.tar.gz, force => 1, automated_testing => 1, makefilepl_param => [ 'LIBDIR=' . File::Spec->catdir( $self->image_dir, 'c', 'lib', ), ], ); The C method is used to install a single CPAN or non-CPAN distribution directly, without installing any of the dependencies for that distribution. It is used primarily during CPAN bootstrapping, to allow the installation of the toolchain modules, with the distribution install order precomputed or hard-coded. It takes a compulsory 'name' param, which should be the AUTHOR/file path within the CPAN mirror. The optional 'force' param allows the installation of distributions with spuriously failing test suites. The optional 'automated_testing' param allows for installation with the C environment flag enabled, which is used to either run more-intensive testing, or to convince certain Makefile.PL that insists on prompting that there is no human around and they REALLY need to just go with the default options. The optional 'makefilepl_param' param should be a reference to an array of additional params that should be passwd to the C. This can help with distributions that insist on taking additional options via Makefile.PL. Returns true of throws an exception on error. =cut sub install_distribution { my $self = shift; my $dist = Perl::Dist::Asset::Distribution->new( parent => $self, force => $self->force, @_, ); my $name = $dist->name; # Download the file my $tgz = $self->_mirror( $dist->abs_uri( $self->cpan ), $self->download_dir, ); # Where will it get extracted to my $dist_path = $name; $dist_path =~ s/\.tar\.gz//; $dist_path =~ s/\.zip//; $dist_path =~ s/.+\///; my $unpack_to = File::Spec->catdir( $self->build_dir, $dist_path ); # Extract the tarball if ( -d $unpack_to ) { $self->trace("Removing previous $unpack_to\n"); File::Remove::remove( \1, $unpack_to ); } $self->_extract( $tgz => $self->build_dir ); unless ( -d $unpack_to ) { Carp::croak("Failed to extract $unpack_to"); } # Build the module SCOPE: { my $wd = $self->_pushd($unpack_to); # Enable automated_testing mode if needed # Blame Term::ReadLine::Perl for needing this ugly hack. if ( $dist->automated_testing ) { $self->trace("Installing with AUTOMATED_TESTING enabled...\n"); } if ( $dist->release_testing ) { $self->trace("Installing with RELEASE_TESTING enabled...\n"); } local $ENV{AUTOMATED_TESTING} = $dist->automated_testing; local $ENV{RELEASE_TESTING} = $dist->release_testing; $self->trace("Configuring $name...\n"); $self->_perl( 'Makefile.PL', @{$dist->makefilepl_param} ); $self->trace("Building $name...\n"); $self->_make; unless ( $dist->force ) { $self->trace("Testing $name...\n"); $self->_make('test'); } $self->trace("Installing $name...\n"); $self->_make( qw/install UNINST=1/ ); } return 1; } =pod =head2 install_module $self->install_module( name => 'DBI', ); The C method is a high level installation method that can be used during the C phase, once the CPAN toolchain has been been initialized. It makes the installation call using the CPAN client directly, allowing the CPAN client to both do the installation and fulfill all of the dependencies for the module, identically to if it was installed from the CPAN shell via an "install Module::Name" command. The compulsory 'name' param should be the class name of the module to be installed. The optional 'force' param can be used to force the install of module. This does not, however, force the installation of the dependencies of the module. Returns true or throws an exception on error. =cut sub install_module { my $self = shift; my $module = Perl::Dist::Asset::Module->new( force => $self->force, parent => $self, @_, ); my $name = $module->name; my $force = $module->force; unless ( $self->bin_perl ) { Carp::croak("Cannot install CPAN modules yet, perl is not installed"); } # Generate the CPAN installation script my $cpan_string = <<"END_PERL"; print "Loading CPAN...\\n"; use CPAN; CPAN::HandleConfig->load unless \$CPAN::Config_loaded++; print "Installing $name from CPAN...\\n"; my \$module = CPAN::Shell->expandany( "$name" ) or die "CPAN.pm couldn't locate $name"; if ( \$module->uptodate ) { print "$name is up to date\\n"; exit(0); } print "\\\$ENV{PATH} = '\$ENV{PATH}'\\n"; if ( $force ) { CPAN::Shell->notest('install', '$name'); } else { CPAN::Shell->install('$name'); } print "Completed install of $name\\n"; unless ( \$module->uptodate ) { die "Installation of $name appears to have failed"; } exit(0); END_PERL # Dump the CPAN script to a temp file and execute $self->trace("Running install of $name\n"); my $cpan_file = File::Spec->catfile( $self->build_dir, 'cpan_string.pl', ); SCOPE: { open( CPAN_FILE, '>', $cpan_file ) or die "open: $!"; print CPAN_FILE $cpan_string or die "print: $!"; close( CPAN_FILE ) or die "close: $!"; } local $ENV{PERL_MM_USE_DEFAULT} = 1; local $ENV{AUTOMATED_TESTING} = ''; local $ENV{RELEASE_TESTING} = ''; $self->_run3( $self->bin_perl, $cpan_file ) or die "perl failed"; die "Failure detected installing $name, stopping" if $?; return 1; } =pod =head2 install_modules $self->install_modules( qw{ Foo::Bar This::That One::Two } ); The C method is a convenience shorthand that makes it trivial to install a series of modules via C. As a convenience, it does not support any additional params to the underlying C call other than the name. =cut sub install_modules { my $self = shift; foreach my $name ( @_ ) { $self->install_module( name => $name, ); } return 1; } =pod =head2 install_par The C method extends the available installation options to allow for the install of pre-compiled modules and pre-compiled C libraries via "PAR" packages. The compulsory 'name' param should be a simple identifying name, and does not have any functional use. The compulsory 'uri' param should be a URL string to the PAR package. Returns true on success or throws an exception on error. =cut sub install_par { my $self = shift; my $par = Perl::Dist::Asset::PAR->new( parent => $self, # not supported at the moment: #install_to => 'c', # Default to the C dir @_, ); # Download the file. # Do it here for consistency instead of letting PAR::Dist do it $self->trace("Preparing " . $par->name . "\n"); my $file = $self->_mirror( $par->url, $self->download_dir, ); # Set the appropriate installation paths my $no_colon = $par->name; $no_colon =~ s/::/-/g; my $perldir = File::Spec->catdir($self->image_dir, 'perl'); my $libdir = File::Spec->catdir($perldir, 'site', 'lib'); my $bindir = File::Spec->catdir($perldir, 'bin'); my $packlist = File::Spec->catfile($libdir, $no_colon, '.packlist'); my $cdir = File::Spec->catdir($self->image_dir, 'c'); # Suppress warnings for resources that don't exist local $^W = 0; # Install PAR::Dist::install_par( dist => $file, packlist_read => $packlist, packlist_write => $packlist, inst_lib => $libdir, inst_archlib => $libdir, inst_bin => $bindir, inst_script => $bindir, inst_man1dir => undef, # no man pages inst_man3dir => undef, # no man pages custom_targets => { 'blib/c/lib' => File::Spec->catdir($cdir, 'lib'), 'blib/c/bin' => File::Spec->catdir($cdir, 'bin'), 'blib/c/include' => File::Spec->catdir($cdir, 'include'), 'blib/c/share' => File::Spec->catdir($cdir, 'share'), }, ); return 1; } =pod =head2 install_file # Overwrite the CPAN::Config $self->install_file( share => 'Perl-Dist CPAN_Config.pm', install_to => 'perl/lib/CPAN/Config.pm', ); # Install a custom icon file $self->install_file( name => 'Strawberry Perl Website Icon', url => 'http://strawberryperl.com/favicon.ico', install_to => 'Strawberry Perl Website.ico', ); The C method is used to install a single specific file from various sources into the distribution. It is generally used to overwrite modules with distribution-specific customisations, or to install licenses, README files, or other miscellaneous data files which don't need to be compiled or modified. It takes a variety of different params. The optional 'name' param provides an optional plain name for the file. It does not have any functional purpose or meaning for this method. One of several alternative source methods must be provided. The 'url' method is used to provide a fully-resolved path to the source file and should be a fully-resolved URL. The 'file' method is used to provide a local path to the source file on the local system, and should be a fully-resolved filesystem path. The 'share' method is used to provide a path to a file installed as part of a CPAN distribution, and accessed via L. It should be a string containing two space-seperated value, the first of which is the distribution name, and the second is the path within the share dir of that distribution. The final compulsory method is the 'install_to' method, which provides either a destination file path, or alternatively a path to an existing directory that the file be installed below, using its source file name. Returns true or throws an exception on error. =cut sub install_file { my $self = shift; my $dist = Perl::Dist::Asset::File->new( parent => $self, @_, ); # Get the file my $tgz = $self->_mirror( $dist->url, $self->download_dir ); # Copy the file to the target location my $from = File::Spec->catfile( $self->download_dir, $dist->file ); my $to = File::Spec->catfile( $self->image_dir, $dist->install_to ); $self->_copy( $from => $to ); # Clear the download file File::Remove::remove( \1, $tgz ); return 1; } =pod =head2 install_launcher $self->install_launcher( name => 'CPAN Client', bin => 'cpan', ); The C method is used to describe a binary program launcher that will be added to the Windows "Start" menu when the distribution is installed. It takes two compulsory param. The compulsory 'name' param is the name of the launcher, and the text that label will be displayed in the start menu (Currently this only supports ASCII, and is not language-aware in any way). The compulsory 'bin' param should be the name of a .bat script launcher in the Perl bin directory. The program itself MUST be installed before trying to add the launcher. Returns true or throws an exception on error. =cut sub install_launcher { my $self = shift; my $launcher = Perl::Dist::Asset::Launcher->new( parent => $self, @_, ); # Check the script exists my $to = File::Spec->catfile( $self->image_dir, 'perl', 'bin', $launcher->bin . '.bat' ); unless ( -f $to ) { die "The script '" . $launcher->bin . '" does not exist'; } # Add the icon $self->add_icon( name => $launcher->name, filename => '{app}\\perl\bin\\' . $launcher->bin . '.bat', ); return 1; } =pod =head2 install_website $self->install_website( name => 'Strawberry Perl Website', url => 'http://strawberryperl.com/', icon_file => 'Strawberry Perl Website.ico', icon_index => 1, ); The C param is used to install a "Start" menu entry that will load a website using the default system browser. The compulsory 'name' param should be the name of the website, and will be the labelled displayed in the "Start" menu. The compulsory 'url' param is the fully resolved URL for the website. The optional 'icon_file' param should be the path to a file that contains the icon for the website. The optional 'icon_index' param should be the icon index within the icon file. This param is optional even if the 'icon_file' param has been provided, by default the first icon in the file will be used. Returns true on success, or throws an exception on error. =cut sub install_website { my $self = shift; my $website = Perl::Dist::Asset::Website->new( parent => $self, @_, ); # Write the file directly to the image $website->write( File::Spec->catfile($self->image_dir, $website->file) ); # Add the file to the files section of the inno script $self->add_file( source => $website->file, dest_dir => '{app}\\win32', ); # Add the file to the icons section of the inno script $self->add_icon( name => $website->name, filename => '{app}\\win32\\' . $website->file, ); return 1; } ##################################################################### # Package Generation sub write { my $self = shift; $self->{output_file} ||= []; if ( $self->zip ) { push @{ $self->{output_file} }, $self->write_zip; } if ( $self->exe ) { push @{ $self->{output_file} }, $self->write_exe; } return 1; } =pod =head2 write_exe $self->write_exe; The C method is used to generate the compiled installer executable. It creates the entire installation file tree, and then executes InnoSetup to create the final executable. This method should only be called after all installation phases have been completed and all of the files for the distribution are in place. The executable 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_exe { my $self = shift; # Convert the environment to registry entries if ( @{$self->{env_path}} ) { my $value = "{olddata}"; foreach my $array ( @{$self->{env_path}} ) { $value .= File::Spec::Win32->catdir( ';{app}', @$array, ); } $self->add_env( PATH => $value ); } $self->SUPER::write_exe(@_); } =pod =head2 write_zip The C method is used to generate a standalone .zip file containing the entire distribution, for situations in which a full installer executable is not wanted (such as for "Portable Perl" type installations). The executable 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_zip { my $self = shift; my $file = File::Spec->catfile( $self->output_dir, $self->output_base_filename . '.zip' ); $self->trace("Generating zip at $file\n"); # Create the archive my $zip = Archive::Zip->new; # Add the image directory to the root $zip->addTree( $self->image_dir, '' ); # Set max compression for all members foreach my $member ( $zip->members ) { next if $member->isDirectory; $member->desiredCompressionLevel( 9 ); } # Write out the file name $zip->writeToFileNamed( $file ); return $file; } ##################################################################### # Adding Inno-Setup Information sub add_icon { my $self = shift; my %params = @_; $params{name} = "{group}\\$params{name}"; unless ( $params{filename} =~ /^\{/ ) { $params{filename} = "{app}\\$params{filename}"; } $self->SUPER::add_icon(%params); } sub add_system { my $self = shift; my %params = @_; unless ( $params{filename} =~ /^\{/ ) { $params{filename} = "{app}\\$params{filename}"; } $self->SUPER::add_system(%params); } sub add_run { my $self = shift; my %params = @_; unless ( $params{filename} =~ /^\{/ ) { $params{filename} = "{app}\\$params{filename}"; } $self->SUPER::add_run(%params); } sub add_uninstallrun { my $self = shift; my %params = @_; unless ( $params{filename} =~ /^\{/ ) { $params{filename} = "{app}\\$params{filename}"; } $self->SUPER::add_uninstallrun(%params); } sub add_env_path { my $self = shift; my @path = @_; my $dir = File::Spec->catdir( $self->image_dir, @path, ); unless ( -d $dir ) { Carp::croak("PATH directory $dir does not exist"); } push @{$self->{env_path}}, [ @path ]; return 1; } sub get_env_path { my $self = shift; return join ';', map { File::Spec->catdir( $self->image_dir, @$_ ) } @{$self->env_path}; } sub get_inno_path { my $self = shift; return join ';', '{olddata}', map { File::Spec->catdir( '{app}', @$_ ) } @{$self->env_path}; } sub add_env_lib { my $self = shift; my @path = @_; my $dir = File::Spec->catdir( $self->image_dir, @path, ); unless ( -d $dir ) { Carp::croak("INC directory $dir does not exist"); } push @{$self->{env_lib}}, [ @path ]; return 1; } sub get_env_lib { my $self = shift; return join ';', map { File::Spec->catdir( $self->image_dir, @$_ ) } @{$self->env_lib}; } sub get_inno_lib { my $self = shift; return join ';', '{olddata}', map { File::Spec->catdir( '{app}', @$_ ) } @{$self->env_lib}; } sub add_env_include { my $self = shift; my @path = @_; my $dir = File::Spec->catdir( $self->image_dir, @path, ); unless ( -d $dir ) { Carp::croak("PATH directory $dir does not exist"); } push @{$self->{env_include}}, [ @path ]; return 1; } sub get_env_include { my $self = shift; return join ';', map { File::Spec->catdir( $self->image_dir, @$_ ) } @{$self->env_include}; } sub get_inno_include { my $self = shift; return join ';', '{olddata}', map { File::Spec->catdir( '{app}', @$_ ) } @{$self->env_include}; } ##################################################################### # Patch Support # By default only use the default (as a default...) sub patch_include_path { my $self = shift; my $share = File::ShareDir::dist_dir('Perl-Dist'); my $path = File::Spec->catdir( $share, 'default', ); unless ( -d $path ) { die("Directory $path does not exist"); } return [ $path ]; } sub patch_pathlist { my $self = shift; return File::PathList->new( paths => $self->patch_include_path, ); } # Cache this sub patch_template { $_[0]->{template_toolkit} or $_[0]->{template_toolkit} = Template->new( INCLUDE_PATH => $_[0]->patch_include_path, ABSOLUTE => 1, ); } sub patch_file { my $self = shift; my $file = shift; my $file_tt = $file . '.tt'; my $dir = shift; my $to = File::Spec->catfile( $dir, $file ); my $pathlist = $self->patch_pathlist; # Locate the source file my $from = $pathlist->find_file( $file ); my $from_tt = $pathlist->find_file( $file_tt );; unless ( defined $from and defined $from_tt ) { die "Missing or invalid file $file or $file_tt in pathlist search"; } if ( $from_tt ne '' ) { # Generate the file my $hash = Params::Util::_HASH(shift) || {}; my ($fh, $output) = File::Temp::tempfile(); $self->trace("Generating $from_tt into temp file $output\n"); $self->patch_template->process( $from_tt, { %$hash, self => $self }, $fh, ) or die "Template processing failed for $from_tt"; # Copy the file to the final location $fh->close; $self->_copy( $output => $to ); } elsif ( $from ne '' ) { # Simple copy of the regular file to the target location $self->_copy( $from => $to ); } else { die "Failed to find file $file"; } return 1; } sub image_dir_url { my $self = shift; URI::file->new( $self->image_dir )->as_string; } # This is a temporary hack sub image_dir_quotemeta { my $self = shift; my $string = $self->image_dir; $string =~ s/\\/\\\\/g; return $string; } ##################################################################### # Support Methods sub trace { my $self = shift; if ( $self->{trace} ) { print $_[0]; } return 1; } sub dir { File::Spec->catdir( shift->image_dir, @_ ); } sub file { File::Spec->catfile( shift->image_dir, @_ ); } sub user_agent { my $self = shift; unless ( $self->{user_agent} ) { if ( $self->{user_agent_cache} ) { SCOPE: { # Temporarily set $ENV{HOME} to the File::HomeDir # version while loading the module. local $ENV{HOME} ||= File::HomeDir->my_home; require LWP::UserAgent::WithCache; } $self->{user_agent} = LWP::UserAgent::WithCache->new( { namespace => 'perl-dist', cache_root => $self->user_agent_directory, cache_depth => 0, default_expires_in => 86400 * 30, show_progress => 1, } ); } else { $self->{user_agent} = LWP::UserAgent->new( agent => ref($self) . '/' . ($VERSION || '0.00'), timeout => 30, show_progress => 1, ); } } return $self->{user_agent}; } sub user_agent_cache { $_[0]->{user_agent_cache}; } sub user_agent_directory { my $self = shift; my $path = ref($self); $path =~ s/::/-/g; my $dir = File::Spec->catdir( File::HomeDir->my_data, 'Perl', $path, ); unless ( -d $dir ) { unless ( File::Path::mkpath( $dir, { verbose => 0 } ) ) { die("Failed to create $dir"); } } unless ( -w $dir ) { die("No write permissions for LWP::UserAgent cache '$dir'"); } return $dir; } sub _mirror { my ($self, $url, $dir) = @_; my $file = $url; $file =~ s|.+\/||; my $target = File::Spec->catfile( $dir, $file ); if ( $self->offline and -f $target ) { return $target; } if ( $self->offline and ! $url =~ m|^file://| ) { $self->trace("Error: Currently offline, cannot download.\n"); exit(0); } File::Path::mkpath($dir); $| = 1; $self->trace("Downloading file $url...\n"); if ( $url =~ m|^file://| ) { # Don't use WithCache for files (it generates warnings) my $ua = LWP::UserAgent->new; my $r = $ua->mirror( $url, $target ); if ( $r->is_error ) { $self->trace(" Error getting $url:\n" . $r->as_string . "\n"); } elsif ( $r->code == HTTP::Status::RC_NOT_MODIFIED ) { $self->trace("(already up to date)\n"); } } else { # my $ua = $self->user_agent; my $ua = LWP::UserAgent->new; my $r = $ua->mirror( $url, $target ); if ( $r->is_error ) { $self->trace(" Error getting $url:\n" . $r->as_string . "\n"); } elsif ( $r->code == HTTP::Status::RC_NOT_MODIFIED ) { $self->trace("(already up to date)\n"); } } return $target; } sub _copy { my ($self, $from, $to) = @_; my $basedir = File::Basename::dirname( $to ); File::Path::mkpath($basedir) unless -e $basedir; $self->trace("Copying $from to $to\n"); if ( -f $to and ! -w $to ) { require Win32::File::Object; # Make sure it isn't readonly my $file = Win32::File::Object->new( $to, 1 ); my $readonly = $file->readonly; $file->readonly(0); # Do the actual copy File::Copy::Recursive::rcopy( $from, $to ) or die $!; # Set it back to what it was $file->readonly($readonly); } else { File::Copy::Recursive::rcopy( $from, $to ) or die $!; } return 1; } sub _move { my ($self, $from, $to) = @_; my $basedir = File::Basename::dirname( $to ); File::Path::mkpath($basedir) unless -e $basedir; $self->trace("Moving $from to $to\n"); File::Copy::Recursive::rmove( $from, $to ) or die $!; } sub _pushd { my $self = shift; my $dir = File::Spec->catdir(@_); $self->trace("Lexically changing directory to $dir...\n"); return File::pushd::pushd( $dir ); } sub _make { my $self = shift; my @params = @_; $self->trace(join(' ', '>', $self->bin_make, @params) . "\n"); $self->_run3( $self->bin_make, @params ) or die "make failed"; die "make failed (OS error)" if ( $? >> 8 ); return 1; } sub _perl { my $self = shift; my @params = @_; $self->trace(join(' ', '>', $self->bin_perl, @params) . "\n"); $self->_run3( $self->bin_perl, @params ) or die "perl failed"; die "perl failed (OS error)" if ( $? >> 8 ); return 1; } sub _run3 { my $self = shift; # Remove any Perl installs from PATH to prevent # "which" discovering stuff it shouldn't. my @path = split /;/, $ENV{PATH}; my @keep = (); foreach my $p ( @path ) { # Strip any path that doesn't exist next unless -d $p; # Strip any path that contains either dmake or perl.exe. # This should remove both the ...\c\bin and ...\perl\bin # parts of the paths that Vanilla/Strawberry added. next if -f File::Spec->catfile( $p, 'dmake.exe' ); next if -f File::Spec->catfile( $p, 'perl.exe' ); # Strip any path that contains either unzip or gzip.exe. # These two programs cause perl to fail its own tests. next if -f File::Spec->catfile( $p, 'unzip.exe' ); next if -f File::Spec->catfile( $p, 'gzip.exe' ); push @keep, $p; } # Reset the environment local $ENV{LIB} = ''; local $ENV{INCLUDE} = ''; local $ENV{PERL5LIB} = ''; local $ENV{PATH} = $self->get_env_path . ';' . join( ';', @keep ); # Execute the child process return IPC::Run3::run3( [ @_ ], \undef, $self->debug_stdout, $self->debug_stderr, ); } sub _extract { my ( $self, $from, $to ) = @_; File::Path::mkpath($to); my $wd = $self->_pushd($to); $self->trace("Extracting $from...\n"); if ( $from =~ m{\.zip\z} ) { my $zip = Archive::Zip->new( $from ); $zip->extractTree(); } elsif ( $from =~ m{\.tar\.gz|\.tgz} ) { local $Archive::Tar::CHMOD = 0; Archive::Tar->extract_archive($from, 1); } else { die "Didn't recognize archive type for $from"; } return 1; } sub _extract_filemap { my ( $self, $archive, $filemap, $basedir, $file_only ) = @_; if ( $archive =~ m{\.zip\z} ) { my $zip = Archive::Zip->new( $archive ); my $wd = $self->_pushd($basedir); while ( my ($f, $t) = each %$filemap ) { $self->trace("Extracting $f to $t\n"); my $dest = File::Spec->catfile( $basedir, $t ); $zip->extractTree( $f, $dest ); } } elsif ( $archive =~ m{\.tar\.gz|\.tgz} ) { local $Archive::Tar::CHMOD = 0; my $tar = Archive::Tar->new( $archive ); for my $file ( $tar->get_files ) { my $f = $file->full_path; my $canon_f = File::Spec::Unix->canonpath( $f ); for my $tgt ( keys %$filemap ) { my $canon_tgt = File::Spec::Unix->canonpath( $tgt ); my $t; # say "matching $canon_f vs $canon_tgt"; if ( $file_only ) { next unless $canon_f =~ m{\A([^/]+[/])?\Q$canon_tgt\E\z}i; ($t = $canon_f) =~ s{\A([^/]+[/])?\Q$canon_tgt\E\z} {$filemap->{$tgt}}i; } else { next unless $canon_f =~ m{\A([^/]+[/])?\Q$canon_tgt\E}i; ($t = $canon_f) =~ s{\A([^/]+[/])?\Q$canon_tgt\E} {$filemap->{$tgt}}i; } my $full_t = File::Spec->catfile( $basedir, $t ); $self->trace("Extracting $f to $full_t\n"); $tar->extract_file( $f, $full_t ); } } } else { die "Didn't recognize archive type for $archive"; } return 1; } # Convert a .dll to an .a file sub _dll_to_a { my $self = shift; my %params = @_; unless ( $self->bin_dlltool ) { Carp::croak("Required method bin_dlltool is not defined"); } # Source file my $source = $params{source}; if ( $source and ! $source =~ /\.dll$/ ) { Carp::croak("Missing or invalid source param"); } # Target .dll file my $dll = $params{dll}; unless ( $dll and $dll =~ /\.dll/ ) { Carp::croak("Missing or invalid .dll file"); } # Target .def file my $def = $params{def}; unless ( $def and $def =~ /\.def$/ ) { Carp::croak("Missing or invalid .def file"); } # Target .a file my $_a = $params{a}; unless ( $_a and $_a =~ /\.a$/ ) { Carp::croak("Missing or invalid .a file"); } # Step 1 - Copy the source .dll to the target if needed unless ( ($source and -f $source) or -f $dll ) { Carp::croak("Need either a source or dll param"); } if ( $source ) { $self->_move( $source => $dll ); } # Step 2 - Generate the .def from the .dll SCOPE: { my $bin = $self->bin_pexports; unless ( $bin ) { Carp::croak("Required method bin_pexports is not defined"); } my $ok = ! system("$bin $dll > $def"); unless ( $ok and -f $def ) { Carp::croak("Failed to generate .def file"); } } # Step 3 - Generate the .a from the .def SCOPE: { my $bin = $self->bin_dlltool; unless ( $bin ) { Carp::croak("Required method bin_dlltool is not defined"); } my $ok = ! system("$bin -dllname $dll --def $def --output-lib $_a"); unless ( $ok and -f $_a ) { Carp::croak("Failed to generate .a file"); } } return 1; } sub make_path { my $class = shift; my $dir = File::Spec->rel2abs( File::Spec->catdir( File::Spec->curdir, @_, ), ); File::Path::mkpath( $dir ) unless -d $dir; unless ( -d $dir ) { Carp::croak("Failed to make_path for $dir"); } return $dir; } sub remake_path { my $class = shift; my $dir = File::Spec->rel2abs( File::Spec->catdir( File::Spec->curdir, @_, ), ); File::Remove::remove( \1, $dir ) if -d $dir; File::Path::mkpath( $dir ); unless ( -d $dir ) { Carp::croak("Failed to make_path for $dir"); } return $dir; } 1; =pod =head1 SUPPORT Bugs should be reported via the CPAN bug tracker L For other issues, or commercial enhancement or support, contact the author. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 SEE ALSO L, L, L =head1 COPYRIGHT Copyright 2009 Adam Kennedy. 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