Perl-Dist-WiX

view lib/Perl/Dist/WiX/Asset/Distribution.pm @ 1034:646672d7d125

Forgot a 'use English'.
author Curtis Jewell <perl@curtisjewell.name>
date Sun Jun 05 05:25:43 2011 -0600 (2011-06-05)
parents af7b8d5d5959
children 5a202646b345
line source
1 package Perl::Dist::WiX::Asset::Distribution;
3 =pod
5 =head1 NAME
7 Perl::Dist::WiX::Asset::Distribution - "Perl Distribution" asset for a Win32 Perl
9 =head1 VERSION
11 This document describes Perl::Dist::WiX::Asset::Distribution version 1.500002.
13 =head1 SYNOPSIS
15 my $distribution = Perl::Dist::WiX::Asset::Distribution->new(
16 parent => $dist,
17 name => 'MSERGEANT/DBD-SQLite-1.14.tar.gz',
18 mod_name => 'DBD::SQLite',
19 force => 1,
20 );
22 =head1 DESCRIPTION
24 L<Perl::Dist::WiX|Perl::Dist::WiX> supports two methods for adding Perl modules to the
25 installation. The main method is to install it via the CPAN shell.
27 The second is to download, make, test and install the Perl distribution
28 package independently, avoiding the use of the CPAN client. Unlike the
29 CPAN installation method, installing the distribution directly does
30 C<not> allow the installation of dependencies, or the ability to discover
31 and install the most recent release of the module.
33 This secondary method is primarily used to deal with cases where the CPAN
34 shell either fails or does not yet exist. Installation of the Perl
35 toolchain to get a working CPAN client is done exclusively using the
36 direct method, as well as the installation of a few special case modules
37 such as ones where the newest release is broken, but an older
38 or a development release is known to be good.
40 B<Perl::Dist::WiX::Asset::Distribution> is a data class that provides
41 encapsulation and error checking for a "Perl Distribution" to be
42 installed in a C<Perl::Dist::WiX>-created installer using this
43 secondary method.
45 It is normally created on the fly by the Perl::Dist::WiX
46 C<install_distribution> method (and other things that call it).
48 =cut
50 #<<<
51 use 5.010;
52 use Moose;
53 use MooseX::Types::Moose qw( Str Bool ArrayRef Maybe );
54 use English qw( -no_match_vars );
55 use File::Spec::Functions qw( catdir catfile );
56 use Params::Util qw( _INSTANCE );
57 use URI qw();
58 #>>>
60 our $VERSION = '1.500002';
62 with 'Perl::Dist::WiX::Role::Asset';
63 extends 'Perl::Dist::WiX::Asset::DistBase';
65 =head1 METHODS
67 This class is a L<Perl::Dist::WiX::Role::Asset|Perl::Dist::WiX::Role::Asset>
68 and shares its API.
70 =head2 new
72 The C<new> constructor takes a series of parameters, validates then
73 and returns a new B<Perl::Dist::WiX::Asset::Distribution> object.
75 It inherits all the parameters described in the
76 L<< Perl::Dist::WiX::Role::Asset->new|Perl::Dist::WiX::Role::Asset/new >>
77 method documentation, and adds the additional parameters described below.
79 =head3 name
81 The required C<name> param is the CPAN path to the distribution
82 such as shown in the synopsis.
84 The url to fetch from will be derived from the name.
86 =cut
90 has name => (
91 is => 'bare',
92 isa => Str,
93 reader => 'get_name',
94 required => 1,
95 );
99 =head3 mod_name
101 The required C<mod_name> param is the name of the main module being
102 installed. This is used to create the fragment name.
104 =cut
108 has module_name => (
109 is => 'bare',
110 isa => Maybe [Str],
111 reader => 'get_module_name',
112 init_arg => 'mod_name',
113 lazy => 1,
114 default => sub { return $_[0]->_name_to_module(); },
115 );
119 =head3 force
121 The optional boolean C<force> param allows you to specify that the tests
122 should be skipped and the distribution installed without validating it.
124 It defaults to the force() attribute of the parent.
126 =cut
130 has force => (
131 is => 'ro',
132 isa => Bool,
133 reader => '_get_force',
134 lazy => 1,
135 default => sub { !!$_[0]->_get_parent()->force() },
136 );
140 =head3 automated_testing
142 Many modules contain additional long-running tests, tests that require
143 additional dependencies, or have differing behaviour when installing
144 in a non-user automated environment.
146 The optional C<automated_testing> param lets you specify that the
147 module should be installed with the B<AUTOMATED_TESTING> environment
148 variable set to true, to make the distribution behave properly in an
149 automated environment (in cases where it doesn't otherwise).
151 Defaults to false.
153 =cut
157 has automated_testing => (
158 is => 'ro',
159 isa => Bool,
160 reader => '_get_automated_testing',
161 default => 0,
162 );
166 =head3 release_testing
168 Some modules contain release-time only tests, that require even heavier
169 additional dependencies compared to even the C<automated_testing> tests.
171 The optional C<release_testing> param lets you specify that the module
172 tests should be run with the additional C<RELEASE_TESTING> environment
173 flag set.
175 By default, C<release_testing> is set to false to squelch any accidental
176 execution of release tests when L<Perl::Dist::WiX|Perl::Dist::WiX> itself
177 is being tested under C<RELEASE_TESTING>.
179 =cut
183 has release_testing => (
184 is => 'ro',
185 isa => Bool,
186 reader => '_get_release_testing',
187 default => 0,
188 );
192 =head3 makefilepl_param
194 Some distributions illegally require you to pass additional non-standard
195 parameters when you invoke "perl Makefile.PL".
197 The optional C<makefilepl_param> param should be a reference to an ARRAY
198 where each element contains the argument to pass to the Makefile.PL.
200 =cut
204 has makefilepl_param => (
205 is => 'ro',
206 isa => ArrayRef,
207 reader => '_get_makefilepl_param',
208 default => sub { return [] },
209 );
213 =head3 buildpl_param
215 Some distributions require you to pass additional non-standard
216 parameters when you invoke "perl Build.PL".
218 The optional C<buildpl_param> param should be a reference to an ARRAY
219 where each element contains the argument to pass to the Build.PL.
221 =cut
225 has buildpl_param => (
226 is => 'ro',
227 isa => ArrayRef,
228 reader => '_get_buildpl_param',
229 default => sub { return [] },
230 );
234 =head3 packlist
236 The optional C<packlist> param lets you specify whether this distribution
237 creates a packlist (which is a quick way to verify which files are installed
238 by the distribution).
240 This parameter defaults to true.
242 =cut
246 has packlist => (
247 is => 'ro',
248 isa => Bool,
249 reader => '_get_packlist',
250 default => 1,
251 );
255 =head3 overwritable
257 Some distributions (ExtUtils::MakeMaker, for example) install files that
258 are overwritten by distributions installed after it.
260 The optional C<overwritable> param lets you spedify that this is the case,
261 and defaults to false.
263 =cut
267 has overwritable => (
268 is => 'ro',
269 isa => Bool,
270 reader => '_get_overwritable',
271 default => 0,
272 );
276 sub BUILDARGS {
277 my $class = shift;
278 my %args;
280 if ( @_ == 1 && 'HASH' eq ref $_[0] ) {
281 %args = %{ $_[0] };
282 } elsif ( 0 == @_ % 2 ) {
283 %args = (@_);
284 } else {
285 PDWiX->throw( 'Parameters incorrect (not a hashref or hash) '
286 . 'for Perl::Dist::WiX::Asset::Distribution' );
287 }
289 if ( not defined _INSTANCE( $args{parent}, 'Perl::Dist::WiX' ) ) {
290 PDWiX::Parameter->throw(
291 parameter =>
292 'parent: missing or not a Perl::Dist::WiX instance',
293 where => '::Asset::Distribution->new',
294 );
295 }
297 if ( exists $args{url} ) {
298 PDWiX::Parameter->throw(
299 parameter =>
300 'url: Passed in (please remove - it will be calculated from name)',
301 where => '::Asset::Distribution->new',
302 );
303 }
305 if ( exists $args{file} ) {
306 PDWiX::Parameter->throw(
307 parameter =>
308 'file: Passed in (please remove - it will be calculated from name)',
309 where => '::Asset::Distribution->new',
310 );
311 }
313 # Map CPAN dist path to url
314 my $dist = $args{name};
315 if ( !defined $dist ) {
316 PDWiX::Parameter->throw(
317 parameter => 'name: Not defined',
318 where => '::Asset::Distribution->new',
319 );
320 }
322 $args{parent}->trace_line( 2, "Using distribution path $dist\n" );
323 my $one = substr $dist, 0, 1;
324 my $two = substr $dist, 1, 1;
325 my $path =
326 File::Spec::Unix->catfile( 'authors', 'id', $one, "$one$two", $dist,
327 );
328 $args{url} = URI->new_abs( $path, $args{parent}->cpan() )->as_string();
329 $args{file} = $args{url};
330 $args{file} =~ s{.+/}{}ms;
332 return {%args};
333 } ## end sub BUILDARGS
335 sub BUILD {
336 my $self = shift;
338 if ( $self->get_name() eq $self->_get_url()
339 and not _DIST( $self->get_name() ) )
340 {
341 PDWiX::Parameter->throw("Missing or invalid name param\n");
342 }
344 return;
345 }
348 # get_name is defined earlier, in the "has name =>" line.
349 # Here works for documenting it.
351 =head2 get_name
353 This method returns the name of the module being installed, in order to use
354 it in filenames.
356 =head2 install
358 The install method installs the distribution described by the
359 B<Perl::Dist::WiX::Asset::Distribution> object and returns a list of files
360 that were installed as a L<File::List::Object|File::List::Object> object.
362 =cut
366 sub install {
367 my $self = shift;
369 my $name = $self->get_name();
370 my $build_dir = $self->_get_build_dir();
372 # If we don't have a packlist file, get an initial filelist to subtract from.
373 my $module = $self->get_module_name();
374 my $filelist_sub;
376 if ( not $self->_get_packlist() ) {
377 $filelist_sub =
378 File::List::Object->new->readdir( $self->_dir('perl') );
379 $self->_trace_line( 5,
380 "***** Module being installed $module"
381 . " requires packlist => 0 *****\n" );
382 }
384 # Download the file
385 my $url = $self->_abs_uri( $self->_get_cpan() );
386 my $tgz = eval {
387 $self->_mirror_url( $url, $self->_get_modules_dir(), )
388 } || PDWiX::Caught->throw(
389 message => $@,
390 info => 'Error trying to download distribution'
391 );
393 # Does it exist? If not, throw an error here.
394 if ( not -f $tgz ) {
395 PDWiX->throw('The file from an attempted download does not exist');
396 }
398 # Where will it get extracted to
399 my $dist_path = $name;
400 $self->_add_to_distributions_installed($dist_path);
401 $dist_path =~ s{[.] tar [.] gz}{}msx; # Take off extensions.
402 $dist_path =~ s{[.] zip}{}msx;
403 $dist_path =~ s{.+\/}{}msx; # Take off directories.
404 $dist_path =~ s{-withoutworldwriteables$}{}msx;
405 my $unpack_to = catdir( $build_dir, $dist_path );
407 # Extract the tarball
408 if ( -d $unpack_to ) {
409 $self->_trace_line( 2, "Removing previous $unpack_to\n" );
410 $self->remove_path( \1, $unpack_to );
411 }
412 $self->_extract( $tgz => $build_dir );
413 if ( not -d $unpack_to ) {
414 PDWiX->throw("Failed to extract $unpack_to\n");
415 }
417 my $buildpl = ( -r catfile( $unpack_to, 'Build.PL' ) ) ? 1 : 0;
418 my $makefilepl = ( -r catfile( $unpack_to, 'Makefile.PL' ) ) ? 1 : 0;
420 if ( not $buildpl and not $makefilepl ) {
421 PDWiX->throw(
422 "Could not find Makefile.PL or Build.PL in $unpack_to\n");
423 }
425 # Build using Build.PL if we have one
426 # unless Module::Build is not installed.
427 if ( not $self->_module_build_installed() ) {
428 $buildpl = 0;
429 if ( not $makefilepl ) {
430 PDWiX->throw( "Could not find Makefile.PL in $unpack_to"
431 . " (too early for Build.PL)\n" );
432 }
433 }
435 # Can't build version.pm using Build.PL until Module::Build
436 # has been upgraded.
437 if ( $module eq 'version' ) {
438 $self->_trace_line( 3, "Bypassing version.pm's Build.PL\n" );
439 $buildpl = 0;
440 }
442 # Build the module
443 SCOPE: {
444 my $wd = $self->_pushd($unpack_to);
446 # Enable automated_testing mode if needed
447 # Blame Term::ReadLine::Perl for needing this ugly hack.
448 if ( $self->_get_automated_testing() ) {
449 $self->_trace_line( 2,
450 "Installing with AUTOMATED_TESTING enabled...\n" );
451 }
452 if ( $self->_get_release_testing() ) {
453 $self->_trace_line( 2,
454 "Installing with RELEASE_TESTING enabled...\n" );
455 }
456 local $ENV{AUTOMATED_TESTING} =
457 $self->_get_automated_testing() ? 1 : undef;
458 local $ENV{RELEASE_TESTING} =
459 $self->_get_release_testing() ? 1 : undef;
460 local $ENV{PERL_MM_USE_DEFAULT} = 1;
461 local $ENV{PERL_MM_NONINTERACTIVE} = 1;
463 $self->_configure($buildpl);
465 $self->_install_distribution($buildpl);
467 } ## end SCOPE:
469 # Making final filelist.
470 my $filelist;
471 if ( $self->_get_packlist() ) {
472 $filelist = $self->_search_packlist($module);
473 } else {
474 $filelist =
475 File::List::Object->new()->readdir( $self->_dir('perl') );
476 $filelist->subtract($filelist_sub)->filter( $self->_filters() );
477 }
479 my $module_name = $self->get_module_name();
480 $module_name =~ s{::}{_}msg;
481 $module_name =~ s{-}{_}msg;
483 # Insert fragment.
484 $self->_insert_fragment( $module_name, $filelist,
485 $self->_get_overwritable() );
487 return 1;
488 } ## end sub install
490 no Moose;
491 __PACKAGE__->meta->make_immutable;
493 1;
495 __END__
497 =head1 SUPPORT
499 Bugs should be reported via the CPAN bug tracker at
501 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Perl-Dist-WiX>
503 For other issues, contact the author.
505 =head1 AUTHOR
507 Curtis Jewell E<lt>csjewell@cpan.orgE<gt>
509 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
511 =head1 SEE ALSO
513 L<Perl::Dist::WiX|Perl::Dist::WiX>,
514 L<Perl::Dist::WiX::Role::Asset|Perl::Dist::WiX::Role::Asset>
516 =head1 COPYRIGHT
518 Copyright 2009 - 2011 Curtis Jewell.
520 Copyright 2007 - 2009 Adam Kennedy.
522 This program is free software; you can redistribute
523 it and/or modify it under the same terms as Perl itself.
525 The full text of the license can be found in the
526 LICENSE file included with this module.
528 =cut