���ѧۧݧ�ӧ�� �ާ֧ߧ֧էا֧� - ���֧էѧܧ�ڧ��ӧѧ�� - /home/ukubnwwtacc0unt/chapelbellstudios.com/uploads/cover/Build.tar
���ѧ٧ѧ�
PodParser.pm 0000644 00000002431 15204366373 0007012 0 ustar 00 package Module::Build::PodParser; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; sub new { # Perl is so fun. my $package = shift; my $self; $self = bless {have_pod_parser => 0, @_}, $package; unless ($self->{fh}) { die "No 'file' or 'fh' parameter given" unless $self->{file}; open($self->{fh}, '<', $self->{file}) or die "Couldn't open $self->{file}: $!"; } return $self; } sub parse_from_filehandle { my ($self, $fh) = @_; local $_; while (<$fh>) { next unless /^=(?!cut)/ .. /^=cut/; # in POD # Accept Name - abstract or C<Name> - abstract last if ($self->{abstract}) = /^ (?: [a-z_0-9:]+ | [BCIF] < [a-z_0-9:]+ > ) \s+ - \s+ (.*\S) /ix; } my @author; while (<$fh>) { next unless /^=head1\s+AUTHORS?/i ... /^=/; next if /^=/; push @author, $_ if /\@/; } return unless @author; s/^\s+|\s+$//g foreach @author; $self->{author} = \@author; return; } sub get_abstract { my $self = shift; return $self->{abstract} if defined $self->{abstract}; $self->parse_from_filehandle($self->{fh}); return $self->{abstract}; } sub get_author { my $self = shift; return $self->{author} if defined $self->{author}; $self->parse_from_filehandle($self->{fh}); return $self->{author} || []; } Base.pm 0000644 00000502524 15204366373 0005775 0 ustar 00 # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- # vim:ts=8:sw=2:et:sta:sts=2 package Module::Build::Base; use 5.006; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Carp; use Cwd (); use File::Copy (); use File::Find (); use File::Path (); use File::Basename (); use File::Spec 0.82 (); use File::Compare (); use Module::Build::Dumper (); use Text::ParseWords (); use Module::Metadata; use Module::Build::Notes; use Module::Build::Config; use version; #################### Constructors ########################### sub new { my $self = shift()->_construct(@_); $self->{invoked_action} = $self->{action} ||= 'Build_PL'; $self->cull_args(@ARGV); die "Too early to specify a build action '$self->{action}'. Do 'Build $self->{action}' instead.\n" if $self->{action} && $self->{action} ne 'Build_PL'; $self->check_manifest; $self->auto_require; # All checks must run regardless if one fails, so no short circuiting! if( grep { !$_ } $self->check_prereq, $self->check_autofeatures ) { $self->log_warn(<<EOF); ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions of the modules indicated above before proceeding with this installation EOF unless ( $self->dist_name eq 'Module-Build' || $ENV{PERL5_CPANPLUS_IS_RUNNING} || $ENV{PERL5_CPAN_IS_RUNNING} ) { $self->log_warn( "Run 'Build installdeps' to install missing prerequisites.\n\n" ); } } # record for later use in resume; $self->{properties}{_added_to_INC} = [ $self->_added_to_INC ]; $self->set_bundle_inc; $self->dist_name; $self->dist_version; $self->release_status; $self->_guess_module_name unless $self->module_name; $self->_find_nested_builds; return $self; } sub resume { my $package = shift; my $self = $package->_construct(@_); $self->read_config; my @added_earlier = @{ $self->{properties}{_added_to_INC} || [] }; @INC = ($self->_added_to_INC, @added_earlier, $self->_default_INC); # If someone called Module::Build->current() or # Module::Build->new_from_context() and the correct class to use is # actually a *subclass* of Module::Build, we may need to load that # subclass here and re-delegate the resume() method to it. unless ( $package->isa($self->build_class) ) { my $build_class = $self->build_class; my $config_dir = $self->config_dir || '_build'; my $build_lib = File::Spec->catdir( $config_dir, 'lib' ); unshift( @INC, $build_lib ); unless ( $build_class->can('new') ) { eval "require $build_class; 1" or die "Failed to re-load '$build_class': $@"; } return $build_class->resume(@_); } unless ($self->_perl_is_same($self->{properties}{perl})) { my $perl = $self->find_perl_interpreter; die(<<"DIEFATAL"); * FATAL ERROR: Perl interpreter mismatch. Configuration was initially created with '$self->{properties}{perl}' but we are now using '$perl'. You must run 'Build realclean' or 'make realclean' and re-configure. DIEFATAL } $self->cull_args(@ARGV); unless ($self->allow_mb_mismatch) { my $mb_version = $Module::Build::VERSION; if ( $mb_version ne $self->{properties}{mb_version} ) { $self->log_warn(<<"MISMATCH"); * WARNING: Configuration was initially created with Module::Build version '$self->{properties}{mb_version}' but we are now using version '$mb_version'. If errors occur, you must re-run the Build.PL or Makefile.PL script. MISMATCH } } $self->{invoked_action} = $self->{action} ||= 'build'; return $self; } sub new_from_context { my ($package, %args) = @_; $package->run_perl_script('Build.PL',[],[$package->unparse_args(\%args)]); return $package->resume; } sub current { # hmm, wonder what the right thing to do here is local @ARGV; return shift()->resume; } sub _construct { my ($package, %input) = @_; my $args = delete $input{args} || {}; my $config = delete $input{config} || {}; my $self = bless { args => {%$args}, config => Module::Build::Config->new(values => $config), properties => { base_dir => $package->cwd, mb_version => $Module::Build::VERSION, %input, }, phash => {}, stash => {}, # temporary caching, not stored in _build }, $package; $self->_set_defaults; my ($p, $ph) = ($self->{properties}, $self->{phash}); foreach (qw(notes config_data features runtime_params cleanup auto_features)) { my $file = File::Spec->catfile($self->config_dir, $_); $ph->{$_} = Module::Build::Notes->new(file => $file); $ph->{$_}->restore if -e $file; if (exists $p->{$_}) { my $vals = delete $p->{$_}; foreach my $k (sort keys %$vals) { $self->$_($k, $vals->{$k}); } } } # The following warning could be unnecessary if the user is running # an embedded perl, but there aren't too many of those around, and # embedded perls aren't usually used to install modules, and the # installation process sometimes needs to run external scripts # (e.g. to run tests). $p->{perl} = $self->find_perl_interpreter or $self->log_warn("Warning: Can't locate your perl binary"); my $blibdir = sub { File::Spec->catdir($p->{blib}, @_) }; $p->{bindoc_dirs} ||= [ $blibdir->("script") ]; $p->{libdoc_dirs} ||= [ $blibdir->("lib"), $blibdir->("arch") ]; $p->{dist_author} = [ $p->{dist_author} ] if defined $p->{dist_author} and not ref $p->{dist_author}; # Synonyms $p->{requires} = delete $p->{prereq} if defined $p->{prereq}; $p->{script_files} = delete $p->{scripts} if defined $p->{scripts}; # Convert to from shell strings to arrays for ('extra_compiler_flags', 'extra_linker_flags') { $p->{$_} = [ $self->split_like_shell($p->{$_}) ] if exists $p->{$_}; } # Convert to arrays for ('include_dirs') { $p->{$_} = [ $p->{$_} ] if exists $p->{$_} && !ref $p->{$_} } $self->add_to_cleanup( @{delete $p->{add_to_cleanup}} ) if $p->{add_to_cleanup}; return $self; } ################## End constructors ######################### sub log_info { my $self = shift; print @_ if ref($self) && ( $self->verbose || ! $self->quiet ); } sub log_verbose { my $self = shift; print @_ if ref($self) && $self->verbose; } sub log_debug { my $self = shift; print @_ if ref($self) && $self->debug; } sub log_warn { # Try to make our call stack invisible shift; if (@_ and $_[-1] !~ /\n$/) { my (undef, $file, $line) = caller(); warn @_, " at $file line $line.\n"; } else { warn @_; } } # install paths must be generated when requested to be sure all changes # to config (from various sources) are included sub _default_install_paths { my $self = shift; my $c = $self->{config}; my $p = {}; my @libstyle = $c->get('installstyle') ? File::Spec->splitdir($c->get('installstyle')) : qw(lib perl5); my $arch = $c->get('archname'); my $version = $c->get('version'); my $bindoc = $c->get('installman1dir') || undef; my $libdoc = $c->get('installman3dir') || undef; my $binhtml = $c->get('installhtml1dir') || $c->get('installhtmldir') || undef; my $libhtml = $c->get('installhtml3dir') || $c->get('installhtmldir') || undef; $p->{install_sets} = { core => { lib => $c->get('installprivlib'), arch => $c->get('installarchlib'), bin => $c->get('installbin'), script => $c->get('installscript'), bindoc => $bindoc, libdoc => $libdoc, binhtml => $binhtml, libhtml => $libhtml, }, site => { lib => $c->get('installsitelib'), arch => $c->get('installsitearch'), bin => $c->get('installsitebin') || $c->get('installbin'), script => $c->get('installsitescript') || $c->get('installsitebin') || $c->get('installscript'), bindoc => $c->get('installsiteman1dir') || $bindoc, libdoc => $c->get('installsiteman3dir') || $libdoc, binhtml => $c->get('installsitehtml1dir') || $binhtml, libhtml => $c->get('installsitehtml3dir') || $libhtml, }, vendor => { lib => $c->get('installvendorlib'), arch => $c->get('installvendorarch'), bin => $c->get('installvendorbin') || $c->get('installbin'), script => $c->get('installvendorscript') || $c->get('installvendorbin') || $c->get('installscript'), bindoc => $c->get('installvendorman1dir') || $bindoc, libdoc => $c->get('installvendorman3dir') || $libdoc, binhtml => $c->get('installvendorhtml1dir') || $binhtml, libhtml => $c->get('installvendorhtml3dir') || $libhtml, }, }; $p->{original_prefix} = { core => $c->get('installprefixexp') || $c->get('installprefix') || $c->get('prefixexp') || $c->get('prefix') || '', site => $c->get('siteprefixexp'), vendor => $c->get('usevendorprefix') ? $c->get('vendorprefixexp') : '', }; $p->{original_prefix}{site} ||= $p->{original_prefix}{core}; # Note: you might be tempted to use $Config{installstyle} here # instead of hard-coding lib/perl5, but that's been considered and # (at least for now) rejected. `perldoc Config` has some wisdom # about it. $p->{install_base_relpaths} = { lib => ['lib', 'perl5'], arch => ['lib', 'perl5', $arch], bin => ['bin'], script => ['bin'], bindoc => ['man', 'man1'], libdoc => ['man', 'man3'], binhtml => ['html'], libhtml => ['html'], }; $p->{prefix_relpaths} = { core => { lib => [@libstyle], arch => [@libstyle, $version, $arch], bin => ['bin'], script => ['bin'], bindoc => ['man', 'man1'], libdoc => ['man', 'man3'], binhtml => ['html'], libhtml => ['html'], }, vendor => { lib => [@libstyle], arch => [@libstyle, $version, $arch], bin => ['bin'], script => ['bin'], bindoc => ['man', 'man1'], libdoc => ['man', 'man3'], binhtml => ['html'], libhtml => ['html'], }, site => { lib => [@libstyle, 'site_perl'], arch => [@libstyle, 'site_perl', $version, $arch], bin => ['bin'], script => ['bin'], bindoc => ['man', 'man1'], libdoc => ['man', 'man3'], binhtml => ['html'], libhtml => ['html'], }, }; return $p } sub _find_nested_builds { my $self = shift; my $r = $self->recurse_into or return; my ($file, @r); if (!ref($r) && $r eq 'auto') { local *DH; opendir DH, $self->base_dir or die "Can't scan directory " . $self->base_dir . " for nested builds: $!"; while (defined($file = readdir DH)) { my $subdir = File::Spec->catdir( $self->base_dir, $file ); next unless -d $subdir; push @r, $subdir if -e File::Spec->catfile( $subdir, 'Build.PL' ); } } $self->recurse_into(\@r); } sub cwd { return Cwd::cwd(); } sub _quote_args { # Returns a string that can become [part of] a command line with # proper quoting so that the subprocess sees this same list of args. my ($self, @args) = @_; my @quoted; for (@args) { if ( /^[^\s*?!\$<>;\\|'"\[\]\{\}]+$/ ) { # Looks pretty safe push @quoted, $_; } else { # XXX this will obviously have to improve - is there already a # core module lying around that does proper quoting? s/('+)/'"$1"'/g; push @quoted, qq('$_'); } } return join " ", @quoted; } sub _backticks { my ($self, @cmd) = @_; if ($self->have_forkpipe) { local *FH; my $pid = open *FH, "-|"; if ($pid) { return wantarray ? <FH> : join '', <FH>; } else { die "Can't execute @cmd: $!\n" unless defined $pid; exec { $cmd[0] } @cmd; } } else { my $cmd = $self->_quote_args(@cmd); return `$cmd`; } } # Tells us whether the construct open($fh, '-|', @command) is # supported. It would probably be better to dynamically sense this. sub have_forkpipe { 1 } # Determine whether a given binary is the same as the perl # (configuration) that started this process. sub _perl_is_same { my ($self, $perl) = @_; my @cmd = ($perl); # When run from the perl core, @INC will include the directories # where perl is yet to be installed. We need to reference the # absolute path within the source distribution where it can find # it's Config.pm This also prevents us from picking up a Config.pm # from a different configuration that happens to be already # installed in @INC. if ($ENV{PERL_CORE}) { push @cmd, '-I' . File::Spec->catdir(File::Basename::dirname($perl), 'lib'); } push @cmd, qw(-MConfig=myconfig -e print -e myconfig); return $self->_backticks(@cmd) eq Config->myconfig; } # cache _discover_perl_interpreter() results { my $known_perl; sub find_perl_interpreter { my $self = shift; return $known_perl if defined($known_perl); return $known_perl = $self->_discover_perl_interpreter; } } # Returns the absolute path of the perl interpreter used to invoke # this process. The path is derived from $^X or $Config{perlpath}. On # some platforms $^X contains the complete absolute path of the # interpreter, on other it may contain a relative path, or simply # 'perl'. This can also vary depending on whether a path was supplied # when perl was invoked. Additionally, the value in $^X may omit the # executable extension on platforms that use one. It's a fatal error # if the interpreter can't be found because it can result in undefined # behavior by routines that depend on it (generating errors or # invoking the wrong perl.) sub _discover_perl_interpreter { my $proto = shift; my $c = ref($proto) ? $proto->{config} : 'Module::Build::Config'; my $perl = $^X; my $perl_basename = File::Basename::basename($perl); my @potential_perls; # Try 1, Check $^X for absolute path push( @potential_perls, $perl ) if File::Spec->file_name_is_absolute($perl); # Try 2, Check $^X for a valid relative path my $abs_perl = File::Spec->rel2abs($perl); push( @potential_perls, $abs_perl ); # Try 3, Last ditch effort: These two option use hackery to try to locate # a suitable perl. The hack varies depending on whether we are running # from an installed perl or an uninstalled perl in the perl source dist. if ($ENV{PERL_CORE}) { # Try 3.A, If we are in a perl source tree, running an uninstalled # perl, we can keep moving up the directory tree until we find our # binary. We wouldn't do this under any other circumstances. # CBuilder is also in the core, so it should be available here require ExtUtils::CBuilder; my $perl_src = Cwd::realpath( ExtUtils::CBuilder->perl_src ); if ( defined($perl_src) && length($perl_src) ) { my $uninstperl = File::Spec->rel2abs(File::Spec->catfile( $perl_src, $perl_basename )); push( @potential_perls, $uninstperl ); } } else { # Try 3.B, First look in $Config{perlpath}, then search the user's # PATH. We do not want to do either if we are running from an # uninstalled perl in a perl source tree. push( @potential_perls, $c->get('perlpath') ); push( @potential_perls, map File::Spec->catfile($_, $perl_basename), File::Spec->path() ); } # Now that we've enumerated the potential perls, it's time to test # them to see if any of them match our configuration, returning the # absolute path of the first successful match. my $exe = $c->get('exe_ext'); foreach my $thisperl ( @potential_perls ) { if (defined $exe) { $thisperl .= $exe unless $thisperl =~ m/$exe$/i; } if ( -f $thisperl && $proto->_perl_is_same($thisperl) ) { return $thisperl; } } # We've tried all alternatives, and didn't find a perl that matches # our configuration. Throw an exception, and list alternatives we tried. my @paths = map File::Basename::dirname($_), @potential_perls; die "Can't locate the perl binary used to run this script " . "in (@paths)\n"; } # Adapted from IPC::Cmd::can_run() sub find_command { my ($self, $command) = @_; if( File::Spec->file_name_is_absolute($command) ) { return $self->_maybe_command($command); } else { for my $dir ( File::Spec->path ) { my $abs = File::Spec->catfile($dir, $command); return $abs if $abs = $self->_maybe_command($abs); } } } # Copied from ExtUtils::MM_Unix::maybe_command sub _maybe_command { my($self,$file) = @_; return $file if -x $file && ! -d $file; return; } sub _is_interactive { return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe? } # NOTE this is a blocking operation if(-t STDIN) sub _is_unattended { my $self = shift; return $ENV{PERL_MM_USE_DEFAULT} || ( !$self->_is_interactive && eof STDIN ); } sub _readline { my $self = shift; return undef if $self->_is_unattended; my $answer = <STDIN>; chomp $answer if defined $answer; return $answer; } sub prompt { my $self = shift; my $mess = shift or die "prompt() called without a prompt message"; # use a list to distinguish a default of undef() from no default my @def; @def = (shift) if @_; # use dispdef for output my @dispdef = scalar(@def) ? ('[', (defined($def[0]) ? $def[0] . ' ' : ''), ']') : (' ', ''); local $|=1; print "$mess ", @dispdef; if ( $self->_is_unattended && !@def ) { die <<EOF; ERROR: This build seems to be unattended, but there is no default value for this question. Aborting. EOF } my $ans = $self->_readline(); if ( !defined($ans) # Ctrl-D or unattended or !length($ans) ) { # User hit return print "$dispdef[1]\n"; $ans = scalar(@def) ? $def[0] : ''; } return $ans; } sub y_n { my $self = shift; my ($mess, $def) = @_; die "y_n() called without a prompt message" unless $mess; die "Invalid default value: y_n() default must be 'y' or 'n'" if $def && $def !~ /^[yn]/i; my $answer; while (1) { # XXX Infinite or a large number followed by an exception ? $answer = $self->prompt(@_); return 1 if $answer =~ /^y/i; return 0 if $answer =~ /^n/i; local $|=1; print "Please answer 'y' or 'n'.\n"; } } sub current_action { shift->{action} } sub invoked_action { shift->{invoked_action} } sub notes { shift()->{phash}{notes}->access(@_) } sub config_data { shift()->{phash}{config_data}->access(@_) } sub runtime_params { shift->{phash}{runtime_params}->read( @_ ? shift : () ) } # Read-only sub auto_features { shift()->{phash}{auto_features}->access(@_) } sub features { my $self = shift; my $ph = $self->{phash}; if (@_) { my $key = shift; if ($ph->{features}->exists($key)) { return $ph->{features}->access($key, @_); } if (my $info = $ph->{auto_features}->access($key)) { my $disabled; for my $type ( @{$self->prereq_action_types} ) { next if $type eq 'description' || $type eq 'recommends' || ! exists $info->{$type}; my $prereqs = $info->{$type}; for my $modname ( sort keys %$prereqs ) { my $spec = $prereqs->{$modname}; my $status = $self->check_installed_status($modname, $spec); if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; } if ( ! eval "require $modname; 1" ) { return 0; } } } return 1; } return $ph->{features}->access($key, @_); } # No args - get the auto_features & overlay the regular features my %features; my %auto_features = $ph->{auto_features}->access(); while (my ($name, $info) = each %auto_features) { my $failures = $self->prereq_failures($info); my $disabled = grep( /^(?:\w+_)?(?:requires|conflicts)$/, keys %$failures ) ? 1 : 0; $features{$name} = $disabled ? 0 : 1; } %features = (%features, $ph->{features}->access()); return wantarray ? %features : \%features; } BEGIN { *feature = \&features } # Alias sub _mb_feature { my $self = shift; if (($self->module_name || '') eq 'Module::Build') { # We're building Module::Build itself, so ...::ConfigData isn't # valid, but $self->features() should be. return $self->feature(@_); } else { require Module::Build::ConfigData; return Module::Build::ConfigData->feature(@_); } } sub _warn_mb_feature_deps { my $self = shift; my $name = shift; $self->log_warn( "The '$name' feature is not available. Please install missing\n" . "feature dependencies and try again.\n". $self->_feature_deps_msg($name) . "\n" ); } sub add_build_element { my ($self, $elem) = @_; my $elems = $self->build_elements; push @$elems, $elem unless grep { $_ eq $elem } @$elems; } sub ACTION_config_data { my $self = shift; return unless $self->has_config_data; my $module_name = $self->module_name or die "The config_data feature requires that 'module_name' be set"; my $notes_name = $module_name . '::ConfigData'; # TODO: Customize name ??? my $notes_pm = File::Spec->catfile($self->blib, 'lib', split /::/, "$notes_name.pm"); return if $self->up_to_date(['Build.PL', $self->config_file('config_data'), $self->config_file('features') ], $notes_pm); $self->log_verbose("Writing config notes to $notes_pm\n"); File::Path::mkpath(File::Basename::dirname($notes_pm)); Module::Build::Notes->write_config_data ( file => $notes_pm, module => $module_name, config_module => $notes_name, config_data => scalar $self->config_data, feature => scalar $self->{phash}{features}->access(), auto_features => scalar $self->auto_features, ); } ######################################################################## { # enclosing these lexicals -- TODO my %valid_properties = ( __PACKAGE__, {} ); my %additive_properties; sub _mb_classes { my $class = ref($_[0]) || $_[0]; return ($class, $class->mb_parents); } sub valid_property { my ($class, $prop) = @_; return grep exists( $valid_properties{$_}{$prop} ), $class->_mb_classes; } sub valid_properties { return keys %{ shift->valid_properties_defaults() }; } sub valid_properties_defaults { my %out; for my $class (reverse shift->_mb_classes) { @out{ keys %{ $valid_properties{$class} } } = map { $_->() } values %{ $valid_properties{$class} }; } return \%out; } sub array_properties { map { exists $additive_properties{$_}->{ARRAY} ? @{$additive_properties{$_}->{ARRAY}} : () } shift->_mb_classes; } sub hash_properties { map { exists $additive_properties{$_}->{HASH} ? @{$additive_properties{$_}->{HASH}} : () } shift->_mb_classes; } sub add_property { my ($class, $property) = (shift, shift); die "Property '$property' already exists" if $class->valid_property($property); my %p = @_ == 1 ? ( default => shift ) : @_; my $type = ref $p{default}; $valid_properties{$class}{$property} = $type eq 'CODE' ? $p{default} : $type eq 'HASH' ? sub { return { %{ $p{default} } } } : $type eq 'ARRAY'? sub { return [ @{ $p{default} } ] } : sub { return $p{default} } ; push @{$additive_properties{$class}->{$type}}, $property if $type; unless ($class->can($property)) { # TODO probably should put these in a util package my $sub = $type eq 'HASH' ? _make_hash_accessor($property, \%p) : _make_accessor($property, \%p); no strict 'refs'; *{"$class\::$property"} = $sub; } return $class; } sub property_error { my $self = shift; die 'ERROR: ', @_; } sub _set_defaults { my $self = shift; # Set the build class. $self->{properties}{build_class} ||= ref $self; # If there was no orig_dir, set to the same as base_dir $self->{properties}{orig_dir} ||= $self->{properties}{base_dir}; my $defaults = $self->valid_properties_defaults; foreach my $prop (keys %$defaults) { $self->{properties}{$prop} = $defaults->{$prop} unless exists $self->{properties}{$prop}; } # Copy defaults for arrays any arrays. for my $prop ($self->array_properties) { $self->{properties}{$prop} = [@{$defaults->{$prop}}] unless exists $self->{properties}{$prop}; } # Copy defaults for arrays any hashes. for my $prop ($self->hash_properties) { $self->{properties}{$prop} = {%{$defaults->{$prop}}} unless exists $self->{properties}{$prop}; } } } # end enclosure ######################################################################## sub _make_hash_accessor { my ($property, $p) = @_; my $check = $p->{check} || sub { 1 }; return sub { my $self = shift; # This is only here to deprecate the historic accident of calling # properties as class methods - I suspect it only happens in our # test suite. unless(ref($self)) { carp("\n$property not a class method (@_)"); return; } my $x = $self->{properties}; return $x->{$property} unless @_; my $prop = $x->{$property}; if ( defined $_[0] && !ref $_[0] ) { if ( @_ == 1 ) { return exists $prop->{$_[0]} ? $prop->{$_[0]} : undef; } elsif ( @_ % 2 == 0 ) { my %new = (%{ $prop }, @_); local $_ = \%new; $x->{$property} = \%new if $check->($self); return $x->{$property}; } else { die "Unexpected arguments for property '$property'\n"; } } else { die "Unexpected arguments for property '$property'\n" if defined $_[0] && ref $_[0] ne 'HASH'; local $_ = $_[0]; $x->{$property} = shift if $check->($self); } }; } ######################################################################## sub _make_accessor { my ($property, $p) = @_; my $check = $p->{check} || sub { 1 }; return sub { my $self = shift; # This is only here to deprecate the historic accident of calling # properties as class methods - I suspect it only happens in our # test suite. unless(ref($self)) { carp("\n$property not a class method (@_)"); return; } my $x = $self->{properties}; return $x->{$property} unless @_; local $_ = $_[0]; $x->{$property} = shift if $check->($self); return $x->{$property}; }; } ######################################################################## # Add the default properties. __PACKAGE__->add_property(auto_configure_requires => 1); __PACKAGE__->add_property(blib => 'blib'); __PACKAGE__->add_property(build_class => 'Module::Build'); __PACKAGE__->add_property(build_elements => [qw(PL support pm xs share_dir pod script)]); __PACKAGE__->add_property(build_script => 'Build'); __PACKAGE__->add_property(build_bat => 0); __PACKAGE__->add_property(bundle_inc => []); __PACKAGE__->add_property(bundle_inc_preload => []); __PACKAGE__->add_property(config_dir => '_build'); __PACKAGE__->add_property(dynamic_config => 1); __PACKAGE__->add_property(include_dirs => []); __PACKAGE__->add_property(license => 'unknown'); __PACKAGE__->add_property(metafile => 'META.yml'); __PACKAGE__->add_property(mymetafile => 'MYMETA.yml'); __PACKAGE__->add_property(metafile2 => 'META.json'); __PACKAGE__->add_property(mymetafile2 => 'MYMETA.json'); __PACKAGE__->add_property(recurse_into => []); __PACKAGE__->add_property(use_rcfile => 1); __PACKAGE__->add_property(create_packlist => 1); __PACKAGE__->add_property(allow_mb_mismatch => 0); __PACKAGE__->add_property(config => undef); __PACKAGE__->add_property(test_file_exts => ['.t']); __PACKAGE__->add_property(use_tap_harness => 0); __PACKAGE__->add_property(cpan_client => 'cpan'); __PACKAGE__->add_property(tap_harness_args => {}); __PACKAGE__->add_property(pureperl_only => 0); __PACKAGE__->add_property(allow_pureperl => 0); __PACKAGE__->add_property( 'installdirs', default => 'site', check => sub { return 1 if /^(core|site|vendor)$/; return shift->property_error( $_ eq 'perl' ? 'Perhaps you meant installdirs to be "core" rather than "perl"?' : 'installdirs must be one of "core", "site", or "vendor"' ); return shift->property_error("Perhaps you meant 'core'?") if $_ eq 'perl'; return 0; }, ); { __PACKAGE__->add_property(html_css => ''); } { my @prereq_action_types = qw(requires build_requires test_requires conflicts recommends); foreach my $type (@prereq_action_types) { __PACKAGE__->add_property($type => {}); } __PACKAGE__->add_property(prereq_action_types => \@prereq_action_types); } __PACKAGE__->add_property($_ => {}) for qw( get_options install_base_relpaths install_path install_sets meta_add meta_merge original_prefix prefix_relpaths configure_requires ); __PACKAGE__->add_property($_) for qw( PL_files autosplit base_dir bindoc_dirs c_source cover create_license create_makefile_pl create_readme debugger destdir dist_abstract dist_author dist_name dist_suffix dist_version dist_version_from extra_compiler_flags extra_linker_flags has_config_data install_base libdoc_dirs magic_number mb_version module_name needs_compiler orig_dir perl pm_files pod_files pollute prefix program_name quiet recursive_test_files release_status script_files scripts share_dir sign test_files verbose debug xs_files extra_manify_args ); sub config { my $self = shift; my $c = ref($self) ? $self->{config} : 'Module::Build::Config'; return $c->all_config unless @_; my $key = shift; return $c->get($key) unless @_; my $val = shift; return $c->set($key => $val); } sub mb_parents { # Code borrowed from Class::ISA. my @in_stack = (shift); my %seen = ($in_stack[0] => 1); my ($current, @out); while (@in_stack) { next unless defined($current = shift @in_stack) && $current->isa('Module::Build::Base'); push @out, $current; next if $current eq 'Module::Build::Base'; no strict 'refs'; unshift @in_stack, map { my $c = $_; # copy, to avoid being destructive substr($c,0,2) = "main::" if substr($c,0,2) eq '::'; # Canonize the :: -> main::, ::foo -> main::foo thing. # Should I ever canonize the Foo'Bar = Foo::Bar thing? $seen{$c}++ ? () : $c; } @{"$current\::ISA"}; # I.e., if this class has any parents (at least, ones I've never seen # before), push them, in order, onto the stack of classes I need to # explore. } shift @out; return @out; } sub extra_linker_flags { shift->_list_accessor('extra_linker_flags', @_) } sub extra_compiler_flags { shift->_list_accessor('extra_compiler_flags', @_) } sub _list_accessor { (my $self, local $_) = (shift, shift); my $p = $self->{properties}; $p->{$_} = [@_] if @_; $p->{$_} = [] unless exists $p->{$_}; return ref($p->{$_}) ? $p->{$_} : [$p->{$_}]; } # XXX Problem - if Module::Build is loaded from a different directory, # it'll look for (and perhaps destroy/create) a _build directory. sub subclass { my ($pack, %opts) = @_; my $build_dir = '_build'; # XXX The _build directory is ostensibly settable by the user. Shouldn't hard-code here. $pack->delete_filetree($build_dir) if -e $build_dir; die "Must provide 'code' or 'class' option to subclass()\n" unless $opts{code} or $opts{class}; $opts{code} ||= ''; $opts{class} ||= 'MyModuleBuilder'; my $filename = File::Spec->catfile($build_dir, 'lib', split '::', $opts{class}) . '.pm'; my $filedir = File::Basename::dirname($filename); $pack->log_verbose("Creating custom builder $filename in $filedir\n"); File::Path::mkpath($filedir); die "Can't create directory $filedir: $!" unless -d $filedir; open(my $fh, '>', $filename) or die "Can't create $filename: $!"; print $fh <<EOF; package $opts{class}; use $pack; \@ISA = qw($pack); $opts{code} 1; EOF close $fh; unshift @INC, File::Spec->catdir(File::Spec->rel2abs($build_dir), 'lib'); eval "use $opts{class}"; die $@ if $@; return $opts{class}; } sub _guess_module_name { my $self = shift; my $p = $self->{properties}; return if $p->{module_name}; if ( $p->{dist_version_from} && -e $p->{dist_version_from} ) { my $mi = Module::Metadata->new_from_file($self->dist_version_from); $p->{module_name} = $mi->name; } else { my $mod_path = my $mod_name = $p->{dist_name}; $mod_name =~ s{-}{::}g; $mod_path =~ s{-}{/}g; $mod_path .= ".pm"; if ( -e $mod_path || -e "lib/$mod_path" ) { $p->{module_name} = $mod_name; } else { $self->log_warn( << 'END_WARN' ); No 'module_name' was provided and it could not be inferred from other properties. This will prevent a packlist from being written for this file. Please set either 'module_name' or 'dist_version_from' in Build.PL. END_WARN } } } sub dist_name { my $self = shift; my $p = $self->{properties}; my $me = 'dist_name'; return $p->{$me} if defined $p->{$me}; die "Can't determine distribution name, must supply either 'dist_name' or 'module_name' parameter" unless $self->module_name; ($p->{$me} = $self->module_name) =~ s/::/-/g; return $p->{$me}; } sub release_status { my ($self) = @_; my $me = 'release_status'; my $p = $self->{properties}; if ( ! defined $p->{$me} ) { $p->{$me} = $self->_is_dev_version ? 'testing' : 'stable'; } unless ( $p->{$me} =~ qr/\A(?:stable|testing|unstable)\z/ ) { die "Illegal value '$p->{$me}' for $me\n"; } if ( $p->{$me} eq 'stable' && $self->_is_dev_version ) { my $version = $self->dist_version; die "Illegal value '$p->{$me}' with version '$version'\n"; } return $p->{$me}; } sub dist_suffix { my ($self) = @_; my $p = $self->{properties}; my $me = 'dist_suffix'; return $p->{$me} if defined $p->{$me}; if ( $self->release_status eq 'stable' ) { $p->{$me} = ""; } else { # non-stable release but non-dev version number needs '-TRIAL' appended $p->{$me} = $self->_is_dev_version ? "" : "TRIAL" ; } return $p->{$me}; } sub dist_version_from { my ($self) = @_; my $p = $self->{properties}; my $me = 'dist_version_from'; if ($self->module_name) { $p->{$me} ||= join( '/', 'lib', split(/::/, $self->module_name) ) . '.pm'; } return $p->{$me} || undef; } sub dist_version { my ($self) = @_; my $p = $self->{properties}; my $me = 'dist_version'; return $p->{$me} if defined $p->{$me}; if ( my $dist_version_from = $self->dist_version_from ) { my $version_from = File::Spec->catfile( split( qr{/}, $dist_version_from ) ); my $pm_info = Module::Metadata->new_from_file( $version_from ) or die "Can't find file $version_from to determine version"; #$p->{$me} is undef here $p->{$me} = $self->normalize_version( $pm_info->version() ); unless (defined $p->{$me}) { die "Can't determine distribution version from $version_from"; } } die ("Can't determine distribution version, must supply either 'dist_version',\n". "'dist_version_from', or 'module_name' parameter") unless defined $p->{$me}; return $p->{$me}; } sub _is_dev_version { my ($self) = @_; my $dist_version = $self->dist_version; my $version_obj = eval { version->new( $dist_version ) }; # assume it's normal if the version string is fatal -- in this case # the author might be doing something weird so should play along and # assume they'll specify all necessary behavior return $@ ? 0 : $version_obj->is_alpha; } sub dist_author { shift->_pod_parse('author') } sub dist_abstract { shift->_pod_parse('abstract') } sub _pod_parse { my ($self, $part) = @_; my $p = $self->{properties}; my $member = "dist_$part"; return $p->{$member} if defined $p->{$member}; my $docfile = $self->_main_docfile or return; open(my $fh, '<', $docfile) or return; require Module::Build::PodParser; my $parser = Module::Build::PodParser->new(fh => $fh); my $method = "get_$part"; return $p->{$member} = $parser->$method(); } sub version_from_file { # Method provided for backwards compatibility return Module::Metadata->new_from_file($_[1])->version(); } sub find_module_by_name { # Method provided for backwards compatibility return Module::Metadata->find_module_by_name(@_[1,2]); } { # $unlink_list_for_pid{$$} = [ ... ] my %unlink_list_for_pid; sub _unlink_on_exit { my $self = shift; for my $f ( @_ ) { push @{$unlink_list_for_pid{$$}}, $f if -f $f; } return 1; } END { for my $f ( map glob($_), @{ $unlink_list_for_pid{$$} || [] } ) { next unless -e $f; File::Path::rmtree($f, 0, 0); } } } sub add_to_cleanup { my $self = shift; my %files = map {$self->localize_file_path($_), 1} @_; $self->{phash}{cleanup}->write(\%files); } sub cleanup { my $self = shift; my $all = $self->{phash}{cleanup}->read; return wantarray ? sort keys %$all : keys %$all; } sub config_file { my $self = shift; return unless -d $self->config_dir; return File::Spec->catfile($self->config_dir, @_); } sub read_config { my ($self) = @_; my $file = $self->config_file('build_params') or die "Can't find 'build_params' in " . $self->config_dir; open(my $fh, '<', $file) or die "Can't read '$file': $!"; my $ref = eval do {local $/; <$fh>}; die if $@; close $fh; my $c; ($self->{args}, $c, $self->{properties}) = @$ref; $self->{config} = Module::Build::Config->new(values => $c); } sub has_config_data { my $self = shift; return scalar grep $self->{phash}{$_}->has_data(), qw(config_data features auto_features); } sub _write_data { my ($self, $filename, $data) = @_; my $file = $self->config_file($filename); open(my $fh, '>', $file) or die "Can't create '$file': $!"; unless (ref($data)) { # e.g. magicnum print $fh $data; return; } print {$fh} Module::Build::Dumper->_data_dump($data); close $fh; } sub write_config { my ($self) = @_; File::Path::mkpath($self->{properties}{config_dir}); -d $self->{properties}{config_dir} or die "Can't mkdir $self->{properties}{config_dir}: $!"; my @items = @{ $self->prereq_action_types }; $self->_write_data('prereqs', { map { $_, $self->$_() } @items }); $self->_write_data('build_params', [$self->{args}, $self->{config}->values_set, $self->{properties}]); # Set a new magic number and write it to a file $self->_write_data('magicnum', $self->magic_number(int rand 1_000_000)); $self->{phash}{$_}->write() foreach qw(notes cleanup features auto_features config_data runtime_params); } { # packfile map -- keys are guts of regular expressions; If they match, # values are module names corresponding to the packlist my %packlist_map = ( '^File::Spec' => 'Cwd', '^Devel::AssertOS' => 'Devel::CheckOS', ); sub _find_packlist { my ($self, $inst, $mod) = @_; my $lookup = $mod; my $packlist = eval { $inst->packlist($lookup) }; if ( ! $packlist ) { # try from packlist_map while ( my ($re, $new_mod) = each %packlist_map ) { if ( $mod =~ qr/$re/ ) { $lookup = $new_mod; $packlist = eval { $inst->packlist($lookup) }; last; } } } return $packlist ? $lookup : undef; } sub set_bundle_inc { my $self = shift; my $bundle_inc = $self->{properties}{bundle_inc}; my $bundle_inc_preload = $self->{properties}{bundle_inc_preload}; # We're in author mode if inc::latest is loaded, but not from cwd return unless inc::latest->can('loaded_modules'); require ExtUtils::Installed; # ExtUtils::Installed is buggy about finding additions to default @INC my $inst = eval { ExtUtils::Installed->new(extra_libs => [@INC]) }; if ($@) { $self->log_warn( << "EUI_ERROR" ); Bundling in inc/ is disabled because ExtUtils::Installed could not create a list of your installed modules. Here is the error: $@ EUI_ERROR return; } my @bundle_list = map { [ $_, 0 ] } inc::latest->loaded_modules; # XXX TODO: Need to get ordering of prerequisites correct so they are # are loaded in the right order. Use an actual tree?! while( @bundle_list ) { my ($mod, $prereq) = @{ shift @bundle_list }; # XXX TODO: Append prereqs to list # skip if core or already in bundle or preload lists # push @bundle_list, [$_, 1] for prereqs() # Locate packlist for bundling my $lookup = $self->_find_packlist($inst,$mod); if ( ! $lookup ) { # XXX Really needs a more helpful error message here die << "NO_PACKLIST"; Could not find a packlist for '$mod'. If it's a core module, try force installing it from CPAN. NO_PACKLIST } else { push @{ $prereq ? $bundle_inc_preload : $bundle_inc }, $lookup; } } } # sub check_bundling } sub check_autofeatures { my ($self) = @_; my $features = $self->auto_features; return 1 unless %$features; # TODO refactor into ::Util my $longest = sub { my @str = @_ or croak("no strings given"); my @len = map({length($_)} @str); my $max = 0; my $longest; for my $i (0..$#len) { ($max, $longest) = ($len[$i], $str[$i]) if($len[$i] > $max); } return($longest); }; my $max_name_len = length($longest->(keys %$features)); my ($num_disabled, $log_text) = (0, "\nChecking optional features...\n"); for my $name ( sort keys %$features ) { $log_text .= $self->_feature_deps_msg($name, $max_name_len); } $num_disabled = () = $log_text =~ /disabled/g; # warn user if features disabled if ( $num_disabled ) { $self->log_warn( $log_text ); return 0; } else { $self->log_verbose( $log_text ); return 1; } } sub _feature_deps_msg { my ($self, $name, $max_name_len) = @_; $max_name_len ||= length $name; my $features = $self->auto_features; my $info = $features->{$name}; my $feature_text = "$name" . '.' x ($max_name_len - length($name) + 4); my ($log_text, $disabled) = ('',''); if ( my $failures = $self->prereq_failures($info) ) { $disabled = grep( /^(?:\w+_)?(?:requires|conflicts)$/, keys %$failures ) ? 1 : 0; $feature_text .= $disabled ? "disabled\n" : "enabled\n"; for my $type ( @{ $self->prereq_action_types } ) { next unless exists $failures->{$type}; $feature_text .= " $type:\n"; my $prereqs = $failures->{$type}; for my $module ( sort keys %$prereqs ) { my $status = $prereqs->{$module}; my $required = ($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ? 1 : 0; my $prefix = ($required) ? '!' : '*'; $feature_text .= " $prefix $status->{message}\n"; } } } else { $feature_text .= "enabled\n"; } $log_text .= $feature_text if $disabled || $self->verbose; return $log_text; } # Automatically detect configure_requires prereqs sub auto_config_requires { my ($self) = @_; my $p = $self->{properties}; # add current Module::Build to configure_requires if there # isn't one already specified (but not ourself, so we're not circular) if ( $self->dist_name ne 'Module-Build' && $self->auto_configure_requires && ! exists $p->{configure_requires}{'Module::Build'} ) { (my $ver = $VERSION) =~ s/^(\d+\.\d\d).*$/$1/; # last major release only $self->log_warn(<<EOM); Module::Build was not found in configure_requires! Adding it now automatically as: configure_requires => { 'Module::Build' => $ver } EOM $self->_add_prereq('configure_requires', 'Module::Build', $ver); } # if we're in author mode, add inc::latest modules to # configure_requires if not already set. If we're not in author mode # then configure_requires will have been satisfied, or we'll just # live with what we've bundled if ( inc::latest->can('loaded_module') ) { for my $mod ( inc::latest->loaded_modules ) { next if exists $p->{configure_requires}{$mod}; $self->_add_prereq('configure_requires', $mod, $mod->VERSION); } } return; } # Automatically detect and add prerequisites based on configuration sub auto_require { my ($self) = @_; my $p = $self->{properties}; # If needs_compiler is not explicitly set, automatically set it # If set, we need ExtUtils::CBuilder (and a compiler) my $xs_files = $self->find_xs_files; if ( ! defined $p->{needs_compiler} ) { $self->needs_compiler( keys %$xs_files || defined $self->c_source ); } if ($self->needs_compiler) { $self->_add_prereq('build_requires', 'ExtUtils::CBuilder', 0); if ( ! $self->have_c_compiler ) { $self->log_warn(<<'EOM'); Warning: ExtUtils::CBuilder not installed or no compiler detected Proceeding with configuration, but compilation may fail during Build EOM } } # If using share_dir, require File::ShareDir if ( $self->share_dir ) { $self->_add_prereq( 'requires', 'File::ShareDir', '1.00' ); } return; } sub _add_prereq { my ($self, $type, $module, $version) = @_; my $p = $self->{properties}; $version = 0 unless defined $version; if ( exists $p->{$type}{$module} ) { return if $self->compare_versions( $version, '<=', $p->{$type}{$module} ); } $self->log_verbose("Adding to $type\: $module => $version\n"); $p->{$type}{$module} = $version; return 1; } sub prereq_failures { my ($self, $info) = @_; my @types = @{ $self->prereq_action_types }; $info ||= {map {$_, $self->$_()} @types}; my $out; foreach my $type (@types) { my $prereqs = $info->{$type}; for my $modname ( keys %$prereqs ) { my $spec = $prereqs->{$modname}; my $status = $self->check_installed_status($modname, $spec); if ($type =~ /^(?:\w+_)?conflicts$/) { next if !$status->{ok}; $status->{conflicts} = delete $status->{need}; $status->{message} = "$modname ($status->{have}) conflicts with this distribution"; } elsif ($type =~ /^(?:\w+_)?recommends$/) { next if $status->{ok}; $status->{message} = (!ref($status->{have}) && $status->{have} eq '<none>' ? "$modname is not installed" : "$modname ($status->{have}) is installed, but we prefer to have $spec"); } else { next if $status->{ok}; } $out->{$type}{$modname} = $status; } } return $out; } # returns a hash of defined prerequisites; i.e. only prereq types with values sub _enum_prereqs { my $self = shift; my %prereqs; foreach my $type ( @{ $self->prereq_action_types } ) { if ( $self->can( $type ) ) { my $prereq = $self->$type() || {}; $prereqs{$type} = $prereq if %$prereq; } } return \%prereqs; } sub check_prereq { my $self = shift; # Check to see if there are any prereqs to check my $info = $self->_enum_prereqs; return 1 unless $info; my $log_text = "Checking prerequisites...\n"; my $failures = $self->prereq_failures($info); if ( $failures ) { $self->log_warn($log_text); for my $type ( @{ $self->prereq_action_types } ) { my $prereqs = $failures->{$type}; $self->log_warn(" ${type}:\n") if keys %$prereqs; for my $module ( sort keys %$prereqs ) { my $status = $prereqs->{$module}; my $prefix = ($type =~ /^(?:\w+_)?recommends$/) ? "* " : "! "; $self->log_warn(" $prefix $status->{message}\n"); } } return 0; } else { $self->log_verbose($log_text . "Looks good\n\n"); return 1; } } sub perl_version { my ($self) = @_; # Check the current perl interpreter # It's much more convenient to use $] here than $^V, but 'man # perlvar' says I'm not supposed to. Bloody tyrant. return $^V ? $self->perl_version_to_float(sprintf "%vd", $^V) : $]; } sub perl_version_to_float { my ($self, $version) = @_; return $version if grep( /\./, $version ) < 2; $version =~ s/\./../; $version =~ s/\.(\d+)/sprintf '%03d', $1/eg; return $version; } sub _parse_conditions { my ($self, $spec) = @_; return ">= 0" if not defined $spec; if ($spec =~ /^\s*([\w.]+)\s*$/) { # A plain number, maybe with dots, letters, and underscores return (">= $spec"); } else { return split /\s*,\s*/, $spec; } } sub try_require { my ($self, $modname, $spec) = @_; my $status = $self->check_installed_status($modname, defined($spec) ? $spec : 0); return unless $status->{ok}; my $path = $modname; $path =~ s{::}{/}g; $path .= ".pm"; if ( defined $INC{$path} ) { return 1; } elsif ( exists $INC{$path} ) { # failed before, don't try again return; } else { return eval "require $modname"; } } sub check_installed_status { my ($self, $modname, $spec) = @_; my %status = (need => $spec); if ($modname eq 'perl') { $status{have} = $self->perl_version; } elsif (eval { no strict; $status{have} = ${"${modname}::VERSION"} }) { # Don't try to load if it's already loaded } else { my $pm_info = Module::Metadata->new_from_module( $modname ); unless (defined( $pm_info )) { @status{ qw(have message) } = ('<none>', "$modname is not installed"); return \%status; } $status{have} = eval { $pm_info->version() }; if ($spec and !defined($status{have})) { @status{ qw(have message) } = (undef, "Couldn't find a \$VERSION in prerequisite $modname"); return \%status; } } my @conditions = $self->_parse_conditions($spec); foreach (@conditions) { my ($op, $version) = /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x or die "Invalid prerequisite condition '$_' for $modname"; $version = $self->perl_version_to_float($version) if $modname eq 'perl'; next if $op eq '>=' and !$version; # Module doesn't have to actually define a $VERSION unless ($self->compare_versions( $status{have}, $op, $version )) { $status{message} = "$modname ($status{have}) is installed, but we need version $op $version"; return \%status; } } $status{ok} = 1; return \%status; } sub compare_versions { my $self = shift; my ($v1, $op, $v2) = @_; $v1 = version->new($v1) unless eval { $v1->isa('version') }; my $eval_str = "\$v1 $op \$v2"; my $result = eval $eval_str; $self->log_warn("error comparing versions: '$eval_str' $@") if $@; return $result; } # I wish I could set $! to a string, but I can't, so I use $@ sub check_installed_version { my ($self, $modname, $spec) = @_; my $status = $self->check_installed_status($modname, $spec); if ($status->{ok}) { return $status->{have} if $status->{have} and "$status->{have}" ne '<none>'; return '0 but true'; } $@ = $status->{message}; return 0; } sub make_executable { # Perl's chmod() is mapped to useful things on various non-Unix # platforms, so we use it in the base class even though it looks # Unixish. my $self = shift; foreach (@_) { my $current_mode = (stat $_)[2]; chmod $current_mode | oct(111), $_; } } sub is_executable { # We assume this does the right thing on generic platforms, though # we do some other more specific stuff on Unixish platforms. my ($self, $file) = @_; return -x $file; } sub _startperl { shift()->config('startperl') } # Return any directories in @INC which are not in the default @INC for # this perl. For example, stuff passed in with -I or loaded with "use lib". sub _added_to_INC { my $self = shift; my %seen; $seen{$_}++ foreach $self->_default_INC; return grep !$seen{$_}++, @INC; } # Determine the default @INC for this Perl { my @default_inc; # Memoize sub _default_INC { my $self = shift; return @default_inc if @default_inc; local $ENV{PERL5LIB}; # this is not considered part of the default. my $perl = ref($self) ? $self->perl : $self->find_perl_interpreter; my @inc = $self->_backticks($perl, '-le', 'print for @INC'); chomp @inc; return @default_inc = @inc; } } sub print_build_script { my ($self, $fh) = @_; my $build_package = $self->build_class; my $closedata=""; my $config_requires; if ( -f $self->metafile ) { my $meta = eval { $self->read_metafile( $self->metafile ) }; $config_requires = $meta && $meta->{prereqs}{configure}{requires}{'Module::Build'}; } $config_requires ||= 0; my %q = map {$_, $self->$_()} qw(config_dir base_dir); $q{base_dir} = Win32::GetShortPathName($q{base_dir}) if $self->is_windowsish; $q{magic_numfile} = $self->config_file('magicnum'); my @myINC = $self->_added_to_INC; for (@myINC, values %q) { $_ = File::Spec->canonpath( $_ ) unless $self->is_vmsish; s/([\\\'])/\\$1/g; } my $quoted_INC = join ",\n", map " '$_'", @myINC; my $shebang = $self->_startperl; my $magic_number = $self->magic_number; my $dot_in_inc_code = $INC[-1] eq '.' ? <<'END' : ''; if ($INC[-1] ne '.') { push @INC, '.'; } END print $fh <<EOF; $shebang use strict; use Cwd; use File::Basename; use File::Spec; sub magic_number_matches { return 0 unless -e '$q{magic_numfile}'; my \$FH; open \$FH, '<','$q{magic_numfile}' or return 0; my \$filenum = <\$FH>; close \$FH; return \$filenum == $magic_number; } my \$progname; my \$orig_dir; BEGIN { \$^W = 1; # Use warnings \$progname = basename(\$0); \$orig_dir = Cwd::cwd(); my \$base_dir = '$q{base_dir}'; if (!magic_number_matches()) { unless (chdir(\$base_dir)) { die ("Couldn't chdir(\$base_dir), aborting\\n"); } unless (magic_number_matches()) { die ("Configuration seems to be out of date, please re-run 'perl Build.PL' again.\\n"); } } unshift \@INC, ( $quoted_INC ); $dot_in_inc_code } close(*DATA) unless eof(*DATA); # ensure no open handles to this script use $build_package; Module::Build->VERSION(q{$config_requires}); # Some platforms have problems setting \$^X in shebang contexts, fix it up here \$^X = Module::Build->find_perl_interpreter; if (-e 'Build.PL' and not $build_package->up_to_date('Build.PL', \$progname)) { warn "Warning: Build.PL has been altered. You may need to run 'perl Build.PL' again.\\n"; } # This should have just enough arguments to be able to bootstrap the rest. my \$build = $build_package->resume ( properties => { config_dir => '$q{config_dir}', orig_dir => \$orig_dir, }, ); \$build->dispatch; EOF } sub create_mymeta { my ($self) = @_; my ($meta_obj, $mymeta); my @metafiles = ( $self->metafile2, $self->metafile, ); my @mymetafiles = ( $self->mymetafile2, $self->mymetafile, ); # cleanup old MYMETA for my $f ( @mymetafiles ) { if ( $self->delete_filetree($f) ) { $self->log_verbose("Removed previous '$f'\n"); } } # Try loading META.json or META.yml if ( $self->try_require("CPAN::Meta", "2.142060") ) { for my $file ( @metafiles ) { next unless -f $file; $meta_obj = eval { CPAN::Meta->load_file($file, { lazy_validation => 0 }) }; last if $meta_obj; } } # maybe get a copy in spec v2 format (regardless of original source) my $mymeta_obj; if ($meta_obj) { # if we have metadata, just update it my %updated = ( %{ $meta_obj->as_struct({ version => 2.0 }) }, prereqs => $self->_normalize_prereqs, dynamic_config => 0, generated_by => "Module::Build version $Module::Build::VERSION", ); $mymeta_obj = CPAN::Meta->new( \%updated, { lazy_validation => 0 } ); } else { $mymeta_obj = $self->_get_meta_object(quiet => 0, dynamic => 0, fatal => 1, auto => 0); } my @created = $self->_write_meta_files( $mymeta_obj, 'MYMETA' ); $self->log_warn("Could not create MYMETA files\n") unless @created; return 1; } sub create_build_script { my ($self) = @_; $self->write_config; $self->create_mymeta; # Create Build my ($build_script, $dist_name, $dist_version) = map $self->$_(), qw(build_script dist_name dist_version); if ( $self->delete_filetree($build_script) ) { $self->log_verbose("Removed previous script '$build_script'\n"); } $self->log_info("Creating new '$build_script' script for ", "'$dist_name' version '$dist_version'\n"); open(my $fh, '>', $build_script) or die "Can't create '$build_script': $!"; $self->print_build_script($fh); close $fh; $self->make_executable($build_script); return 1; } sub check_manifest { my $self = shift; return unless -e 'MANIFEST'; # Stolen nearly verbatim from MakeMaker. But ExtUtils::Manifest # could easily be re-written into a modern Perl dialect. require ExtUtils::Manifest; # ExtUtils::Manifest is not warnings clean. local ($^W, $ExtUtils::Manifest::Quiet) = (0,1); $self->log_verbose("Checking whether your kit is complete...\n"); if (my @missed = ExtUtils::Manifest::manicheck()) { $self->log_warn("WARNING: the following files are missing in your kit:\n", "\t", join("\n\t", @missed), "\n", "Please inform the author.\n\n"); } else { $self->log_verbose("Looks good\n\n"); } } sub dispatch { my $self = shift; local $self->{_completed_actions} = {}; if (@_) { my ($action, %p) = @_; my $args = $p{args} ? delete($p{args}) : {}; local $self->{invoked_action} = $action; local $self->{args} = {%{$self->{args}}, %$args}; local $self->{properties} = {%{$self->{properties}}, %p}; return $self->_call_action($action); } die "No build action specified" unless $self->{action}; local $self->{invoked_action} = $self->{action}; $self->_call_action($self->{action}); } sub _call_action { my ($self, $action) = @_; return if $self->{_completed_actions}{$action}++; local $self->{action} = $action; my $method = $self->can_action( $action ); die "No action '$action' defined, try running the 'help' action.\n" unless $method; $self->log_debug("Starting ACTION_$action\n"); my $rc = $self->$method(); $self->log_debug("Finished ACTION_$action\n"); return $rc; } sub can_action { my ($self, $action) = @_; return $self->can( "ACTION_$action" ); } # cuts the user-specified options out of the command-line args sub cull_options { my $self = shift; my (@argv) = @_; # XXX is it even valid to call this as a class method? return({}, @argv) unless(ref($self)); # no object my $specs = $self->get_options; return({}, @argv) unless($specs and %$specs); # no user options require Getopt::Long; # XXX Should we let Getopt::Long handle M::B's options? That would # be easy-ish to add to @specs right here, but wouldn't handle options # passed without "--" as M::B currently allows. We might be able to # get around this by setting the "prefix_pattern" Configure option. my @specs; my $args = {}; # Construct the specifications for GetOptions. foreach my $k (sort keys %$specs) { my $v = $specs->{$k}; # Throw an error if specs conflict with our own. die "Option specification '$k' conflicts with a " . ref $self . " option of the same name" if $self->valid_property($k); push @specs, $k . (defined $v->{type} ? $v->{type} : ''); push @specs, $v->{store} if exists $v->{store}; $args->{$k} = $v->{default} if exists $v->{default}; } local @ARGV = @argv; # No other way to dupe Getopt::Long # Get the options values and return them. # XXX Add option to allow users to set options? if ( @specs ) { Getopt::Long::Configure('pass_through'); Getopt::Long::GetOptions($args, @specs); } return $args, @ARGV; } sub unparse_args { my ($self, $args) = @_; my @out; foreach my $k (sort keys %$args) { my $v = $args->{$k}; push @out, (ref $v eq 'HASH' ? map {+"--$k", "$_=$v->{$_}"} sort keys %$v : ref $v eq 'ARRAY' ? map {+"--$k", $_} @$v : ("--$k", $v)); } return @out; } sub args { my $self = shift; return wantarray ? %{ $self->{args} } : $self->{args} unless @_; my $key = shift; $self->{args}{$key} = shift if @_; return $self->{args}{$key}; } # allows select parameters (with underscores) to be spoken with dashes # when used as command-line options sub _translate_option { my $self = shift; my $opt = shift; (my $tr_opt = $opt) =~ tr/-/_/; return $tr_opt if grep $tr_opt =~ /^(?:no_?)?$_$/, qw( create_license create_makefile_pl create_readme extra_compiler_flags extra_linker_flags install_base install_path meta_add meta_merge test_files use_rcfile use_tap_harness tap_harness_args cpan_client pureperl_only allow_pureperl ); # normalize only selected option names return $opt; } my %singular_argument = map { ($_ => 1) } qw/install_base prefix destdir installdirs verbose quiet uninst debug sign/; sub _read_arg { my ($self, $args, $key, $val) = @_; $key = $self->_translate_option($key); if ( exists $args->{$key} and not $singular_argument{$key} ) { $args->{$key} = [ $args->{$key} ] unless ref $args->{$key}; push @{$args->{$key}}, $val; } else { $args->{$key} = $val; } } # decide whether or not an option requires/has an operand sub _optional_arg { my $self = shift; my $opt = shift; my $argv = shift; $opt = $self->_translate_option($opt); my @bool_opts = qw( build_bat create_license create_readme pollute quiet uninst use_rcfile verbose debug sign use_tap_harness pureperl_only allow_pureperl ); # inverted boolean options; eg --noverbose or --no-verbose # converted to proper name & returned with false value (verbose, 0) if ( grep $opt =~ /^no[-_]?$_$/, @bool_opts ) { $opt =~ s/^no-?//; return ($opt, 0); } # non-boolean option; return option unchanged along with its argument return ($opt, shift(@$argv)) unless grep $_ eq $opt, @bool_opts; # we're punting a bit here, if an option appears followed by a digit # we take the digit as the argument for the option. If there is # nothing that looks like a digit, we pretend the option is a flag # that is being set and has no argument. my $arg = 1; $arg = shift(@$argv) if @$argv && $argv->[0] =~ /^\d+$/; return ($opt, $arg); } sub read_args { my $self = shift; (my $args, @_) = $self->cull_options(@_); my %args = %$args; my $opt_re = qr/[\w\-]+/; my ($action, @argv); while (@_) { local $_ = shift; if ( /^(?:--)?($opt_re)=(.*)$/ ) { $self->_read_arg(\%args, $1, $2); } elsif ( /^--($opt_re)$/ ) { my($opt, $arg) = $self->_optional_arg($1, \@_); $self->_read_arg(\%args, $opt, $arg); } elsif ( /^($opt_re)$/ and !defined($action)) { $action = $1; } else { push @argv, $_; } } $args{ARGV} = \@argv; for ('extra_compiler_flags', 'extra_linker_flags') { $args{$_} = [ $self->split_like_shell($args{$_}) ] if exists $args{$_}; } # Convert to arrays for ('include_dirs') { $args{$_} = [ $args{$_} ] if exists $args{$_} && !ref $args{$_} } # Hashify these parameters for ($self->hash_properties, 'config') { next unless exists $args{$_}; my %hash; $args{$_} ||= []; $args{$_} = [ $args{$_} ] unless ref $args{$_}; foreach my $arg ( @{$args{$_}} ) { $arg =~ /($opt_re)=(.*)/ or die "Malformed '$_' argument: '$arg' should be something like 'foo=bar'"; $hash{$1} = $2; } $args{$_} = \%hash; } # De-tilde-ify any path parameters for my $key (qw(prefix install_base destdir)) { next if !defined $args{$key}; $args{$key} = $self->_detildefy($args{$key}); } for my $key (qw(install_path)) { next if !defined $args{$key}; for my $subkey (keys %{$args{$key}}) { next if !defined $args{$key}{$subkey}; my $subkey_ext = $self->_detildefy($args{$key}{$subkey}); if ( $subkey eq 'html' ) { # translate for compatibility $args{$key}{binhtml} = $subkey_ext; $args{$key}{libhtml} = $subkey_ext; } else { $args{$key}{$subkey} = $subkey_ext; } } } if ($args{makefile_env_macros}) { require Module::Build::Compat; %args = (%args, Module::Build::Compat->makefile_to_build_macros); } return \%args, $action; } # Default: do nothing. Overridden for Unix & Windows. sub _detildefy {} # merge Module::Build argument lists that have already been parsed # by read_args(). Takes two references to option hashes and merges # the contents, giving priority to the first. sub _merge_arglist { my( $self, $opts1, $opts2 ) = @_; $opts1 ||= {}; $opts2 ||= {}; my %new_opts = %$opts1; while (my ($key, $val) = each %$opts2) { if ( exists( $opts1->{$key} ) ) { if ( ref( $val ) eq 'HASH' ) { while (my ($k, $v) = each %$val) { $new_opts{$key}{$k} = $v unless exists( $opts1->{$key}{$k} ); } } } else { $new_opts{$key} = $val } } return %new_opts; } # Look for a home directory on various systems. sub _home_dir { my @home_dirs; push( @home_dirs, $ENV{HOME} ) if $ENV{HOME}; push( @home_dirs, File::Spec->catpath($ENV{HOMEDRIVE}, $ENV{HOMEPATH}, '') ) if $ENV{HOMEDRIVE} && $ENV{HOMEPATH}; my @other_home_envs = qw( USERPROFILE APPDATA WINDIR SYS$LOGIN ); push( @home_dirs, map $ENV{$_}, grep $ENV{$_}, @other_home_envs ); my @real_home_dirs = grep -d, @home_dirs; return wantarray ? @real_home_dirs : shift( @real_home_dirs ); } sub _find_user_config { my $self = shift; my $file = shift; foreach my $dir ( $self->_home_dir ) { my $path = File::Spec->catfile( $dir, $file ); return $path if -e $path; } return undef; } # read ~/.modulebuildrc returning global options '*' and # options specific to the currently executing $action. sub read_modulebuildrc { my( $self, $action ) = @_; return () unless $self->use_rcfile; my $modulebuildrc; if ( exists($ENV{MODULEBUILDRC}) && $ENV{MODULEBUILDRC} eq 'NONE' ) { return (); } elsif ( exists($ENV{MODULEBUILDRC}) && -e $ENV{MODULEBUILDRC} ) { $modulebuildrc = $ENV{MODULEBUILDRC}; } elsif ( exists($ENV{MODULEBUILDRC}) ) { $self->log_warn("WARNING: Can't find resource file " . "'$ENV{MODULEBUILDRC}' defined in environment.\n" . "No options loaded\n"); return (); } else { $modulebuildrc = $self->_find_user_config( '.modulebuildrc' ); return () unless $modulebuildrc; } open(my $fh, '<', $modulebuildrc ) or die "Can't open $modulebuildrc: $!"; my %options; my $buffer = ''; while (defined( my $line = <$fh> )) { chomp( $line ); $line =~ s/#.*$//; next unless length( $line ); if ( $line =~ /^\S/ ) { if ( $buffer ) { my( $action, $options ) = split( /\s+/, $buffer, 2 ); $options{$action} .= $options . ' '; $buffer = ''; } $buffer = $line; } else { $buffer .= $line; } } if ( $buffer ) { # anything left in $buffer ? my( $action, $options ) = split( /\s+/, $buffer, 2 ); $options{$action} .= $options . ' '; # merge if more than one line } my ($global_opts) = $self->read_args( $self->split_like_shell( $options{'*'} || '' ) ); # let fakeinstall act like install if not provided if ( $action eq 'fakeinstall' && ! exists $options{fakeinstall} ) { $action = 'install'; } my ($action_opts) = $self->read_args( $self->split_like_shell( $options{$action} || '' ) ); # specific $action options take priority over global options '*' return $self->_merge_arglist( $action_opts, $global_opts ); } # merge the relevant options in ~/.modulebuildrc into Module::Build's # option list where they do not conflict with commandline options. sub merge_modulebuildrc { my( $self, $action, %cmdline_opts ) = @_; my %rc_opts = $self->read_modulebuildrc( $action || $self->{action} || 'build' ); my %new_opts = $self->_merge_arglist( \%cmdline_opts, \%rc_opts ); $self->merge_args( $action, %new_opts ); } sub merge_args { my ($self, $action, %args) = @_; $self->{action} = $action if defined $action; my %additive = map { $_ => 1 } $self->hash_properties; # Extract our 'properties' from $cmd_args, the rest are put in 'args'. while (my ($key, $val) = each %args) { $self->{phash}{runtime_params}->access( $key => $val ) if $self->valid_property($key); if ($key eq 'config') { $self->config($_ => $val->{$_}) foreach keys %$val; } else { my $add_to = $additive{$key} ? $self->{properties}{$key} : $self->valid_property($key) ? $self->{properties} : $self->{args} ; if ($additive{$key}) { $add_to->{$_} = $val->{$_} foreach keys %$val; } else { $add_to->{$key} = $val; } } } } sub cull_args { my $self = shift; my @arg_list = @_; unshift @arg_list, $self->split_like_shell($ENV{PERL_MB_OPT}) if $ENV{PERL_MB_OPT}; my ($args, $action) = $self->read_args(@arg_list); $self->merge_args($action, %$args); $self->merge_modulebuildrc( $action, %$args ); } sub super_classes { my ($self, $class, $seen) = @_; $class ||= ref($self) || $self; $seen ||= {}; no strict 'refs'; my @super = grep {not $seen->{$_}++} $class, @{ $class . '::ISA' }; return @super, map {$self->super_classes($_,$seen)} @super; } sub known_actions { my ($self) = @_; my %actions; no strict 'refs'; foreach my $class ($self->super_classes) { foreach ( keys %{ $class . '::' } ) { $actions{$1}++ if /^ACTION_(\w+)/; } } return wantarray ? sort keys %actions : \%actions; } sub get_action_docs { my ($self, $action) = @_; my $actions = $self->known_actions; die "No known action '$action'" unless $actions->{$action}; my ($files_found, @docs) = (0); foreach my $class ($self->super_classes) { (my $file = $class) =~ s{::}{/}g; # NOTE: silently skipping relative paths if any chdir() happened $file = $INC{$file . '.pm'} or next; open(my $fh, '<', $file) or next; $files_found++; # Code below modified from /usr/bin/perldoc # Skip to ACTIONS section local $_; while (<$fh>) { last if /^=head1 ACTIONS\s/; } # Look for our action and determine the style my $style; while (<$fh>) { last if /^=head1 /; # only item and head2 are allowed (3&4 are not in 5.005) if(/^=(item|head2)\s+\Q$action\E\b/) { $style = $1; push @docs, $_; last; } } $style or next; # not here # and the content if($style eq 'item') { my ($found, $inlist) = (0, 0); while (<$fh>) { if (/^=(item|back)/) { last unless $inlist; } push @docs, $_; ++$inlist if /^=over/; --$inlist if /^=back/; } } else { # head2 style # stop at anything equal or greater than the found level while (<$fh>) { last if(/^=(?:head[12]|cut)/); push @docs, $_; } } # TODO maybe disallow overriding just pod for an action # TODO and possibly: @docs and last; } unless ($files_found) { $@ = "Couldn't find any documentation to search"; return; } unless (@docs) { $@ = "Couldn't find any docs for action '$action'"; return; } return join '', @docs; } sub ACTION_prereq_report { my $self = shift; $self->log_info( $self->prereq_report ); } sub ACTION_prereq_data { my $self = shift; $self->log_info( Module::Build::Dumper->_data_dump( $self->prereq_data ) ); } sub prereq_data { my $self = shift; my @types = ('configure_requires', @{ $self->prereq_action_types } ); my $info = { map { $_ => $self->$_() } grep { %{$self->$_()} } @types }; return $info; } sub prereq_report { my $self = shift; my $info = $self->prereq_data; my $output = ''; foreach my $type (sort keys %$info) { my $prereqs = $info->{$type}; $output .= "\n$type:\n"; my $mod_len = 2; my $ver_len = 4; my %mods; foreach my $modname (sort keys %$prereqs) { my $spec = $prereqs->{$modname}; my $len = length $modname; $mod_len = $len if $len > $mod_len; $spec ||= '0'; $len = length $spec; $ver_len = $len if $len > $ver_len; my $mod = $self->check_installed_status($modname, $spec); $mod->{name} = $modname; $mod->{ok} ||= 0; $mod->{ok} = ! $mod->{ok} if $type =~ /^(\w+_)?conflicts$/; $mods{lc $modname} = $mod; } my $space = q{ } x ($mod_len - 3); my $vspace = q{ } x ($ver_len - 3); my $sline = q{-} x ($mod_len - 3); my $vline = q{-} x ($ver_len - 3); my $disposition = ($type =~ /^(\w+_)?conflicts$/) ? 'Clash' : 'Need'; $output .= " Module $space $disposition $vspace Have\n". " ------$sline+------$vline-+----------\n"; for my $k (sort keys %mods) { my $mod = $mods{$k}; my $space = q{ } x ($mod_len - length $k); my $vspace = q{ } x ($ver_len - length $mod->{need}); my $f = $mod->{ok} ? ' ' : '!'; $output .= " $f $mod->{name} $space $mod->{need} $vspace ". (defined($mod->{have}) ? $mod->{have} : "")."\n"; } } return $output; } sub ACTION_help { my ($self) = @_; my $actions = $self->known_actions; if (@{$self->{args}{ARGV}}) { my $msg = eval {$self->get_action_docs($self->{args}{ARGV}[0], $actions)}; print $@ ? "$@\n" : $msg; return; } print <<EOF; Usage: $0 <action> --arg1=value --arg2=value ... Example: $0 test --verbose=1 Actions defined: EOF print $self->_action_listing($actions); print "\nRun `Build help <action>` for details on an individual action.\n"; print "See `perldoc Module::Build` for complete documentation.\n"; } sub _action_listing { my ($self, $actions) = @_; # Flow down columns, not across rows my @actions = sort keys %$actions; @actions = map $actions[($_ + ($_ % 2) * @actions) / 2], 0..$#actions; my $out = ''; while (my ($one, $two) = splice @actions, 0, 2) { $out .= sprintf(" %-12s %-12s\n", $one, $two||''); } $out =~ s{\s*$}{}mg; # remove trailing spaces return $out; } sub ACTION_retest { my ($self) = @_; # Protect others against our @INC changes local @INC = @INC; # Filter out nonsensical @INC entries - some versions of # Test::Harness will really explode the number of entries here @INC = grep {ref() || -d} @INC if @INC > 100; $self->do_tests; } sub ACTION_testall { my ($self) = @_; my @types; for my $action (grep { $_ ne 'all' } $self->get_test_types) { # XXX We can't just dispatch because we get multiple summaries but # we'll need to dispatch to support custom setup/teardown in the # action. To support that, we'll need to call something besides # Harness::runtests() because we'll need to collect the results in # parts, then run the summary. push(@types, $action); #$self->_call_action( "test$action" ); } $self->generic_test(types => ['default', @types]); } sub get_test_types { my ($self) = @_; my $t = $self->{properties}->{test_types}; return ( defined $t ? ( wantarray ? sort keys %$t : keys %$t ) : () ); } sub ACTION_test { my ($self) = @_; $self->generic_test(type => 'default'); } sub generic_test { my $self = shift; (@_ % 2) and croak('Odd number of elements in argument hash'); my %args = @_; my $p = $self->{properties}; my @types = ( (exists($args{type}) ? $args{type} : ()), (exists($args{types}) ? @{$args{types}} : ()), ); @types or croak "need some types of tests to check"; my %test_types = ( default => $p->{test_file_exts}, (defined($p->{test_types}) ? %{$p->{test_types}} : ()), ); for my $type (@types) { croak "$type not defined in test_types!" unless defined $test_types{ $type }; } # we use local here because it ends up two method calls deep local $p->{test_file_exts} = [ map { ref $_ ? @$_ : $_ } @test_types{@types} ]; $self->depends_on('code'); # Protect others against our @INC changes local @INC = @INC; # Make sure we test the module in blib/ unshift @INC, (File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'), File::Spec->catdir($p->{base_dir}, $self->blib, 'arch')); # Filter out nonsensical @INC entries - some versions of # Test::Harness will really explode the number of entries here @INC = grep {ref() || -d} @INC if @INC > 100; $self->do_tests; } # Test::Harness dies on failure but TAP::Harness does not, so we must # die if running under TAP::Harness sub do_tests { my $self = shift; my $tests = $self->find_test_files; local $ENV{PERL_DL_NONLAZY} = 1; if(@$tests) { my $args = $self->tap_harness_args; if($self->use_tap_harness or ($args and %$args)) { my $aggregate = $self->run_tap_harness($tests); if ( $aggregate->has_errors ) { die "Errors in testing. Cannot continue.\n"; } } else { $self->run_test_harness($tests); } } else { $self->log_info("No tests defined.\n"); } $self->run_visual_script; } sub run_tap_harness { my ($self, $tests) = @_; require TAP::Harness::Env; # TODO allow the test @INC to be set via our API? my $aggregate = TAP::Harness::Env->create({ lib => [@INC], verbosity => $self->{properties}{verbose}, switches => [ $self->harness_switches ], %{ $self->tap_harness_args }, })->runtests(@$tests); return $aggregate; } sub run_test_harness { my ($self, $tests) = @_; require Test::Harness; local $Test::Harness::verbose = $self->verbose || 0; local $Test::Harness::switches = join ' ', $self->harness_switches; Test::Harness::runtests(@$tests); } sub run_visual_script { my $self = shift; # This will get run and the user will see the output. It doesn't # emit Test::Harness-style output. $self->run_perl_script('visual.pl', '-Mblib='.$self->blib) if -e 'visual.pl'; } sub harness_switches { my $self = shift; my @res; push @res, qw(-w -d) if $self->{properties}{debugger}; push @res, '-MDevel::Cover' if $self->{properties}{cover}; return @res; } sub test_files { my $self = shift; my $p = $self->{properties}; if (@_) { return $p->{test_files} = (@_ == 1 ? shift : [@_]); } return $self->find_test_files; } sub expand_test_dir { my ($self, $dir) = @_; my $exts = $self->{properties}{test_file_exts}; return sort map { @{$self->rscan_dir($dir, qr{^[^.].*\Q$_\E$})} } @$exts if $self->recursive_test_files; return sort map { glob File::Spec->catfile($dir, "*$_") } @$exts; } sub ACTION_testdb { my ($self) = @_; local $self->{properties}{debugger} = 1; $self->depends_on('test'); } sub ACTION_testcover { my ($self) = @_; unless (Module::Metadata->find_module_by_name('Devel::Cover')) { warn("Cannot run testcover action unless Devel::Cover is installed.\n"); return; } $self->add_to_cleanup('coverage', 'cover_db'); $self->depends_on('code'); # See whether any of the *.pm files have changed since last time # testcover was run. If so, start over. if (-e 'cover_db') { my $pm_files = $self->rscan_dir (File::Spec->catdir($self->blib, 'lib'), $self->file_qr('\.pm$') ); my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not /\.html$/}); $self->do_system(qw(cover -delete)) unless $self->up_to_date($pm_files, $cover_files) && $self->up_to_date($self->test_files, $cover_files); } local $self->{properties}{cover} = 1; $self->depends_on('test'); $self->do_system('cover'); } sub ACTION_code { my ($self) = @_; # All installable stuff gets created in blib/ . # Create blib/arch to keep blib.pm happy my $blib = $self->blib; $self->add_to_cleanup($blib); File::Path::mkpath( File::Spec->catdir($blib, 'arch') ); if (my $split = $self->autosplit) { $self->autosplit_file($_, $blib) for ref($split) ? @$split : ($split); } foreach my $element (@{$self->build_elements}) { my $method = "process_${element}_files"; $method = "process_files_by_extension" unless $self->can($method); $self->$method($element); } $self->depends_on('config_data'); } sub ACTION_build { my $self = shift; $self->log_info("Building " . $self->dist_name . "\n"); $self->depends_on('code'); $self->depends_on('docs'); } sub process_files_by_extension { my ($self, $ext) = @_; my $method = "find_${ext}_files"; my $files = $self->can($method) ? $self->$method() : $self->_find_file_by_type($ext, 'lib'); foreach my $file (sort keys %$files) { $self->copy_if_modified(from => $file, to => File::Spec->catfile($self->blib, $files->{$file}) ); } } sub process_support_files { my $self = shift; my $p = $self->{properties}; return unless $p->{c_source}; my $files; if (ref($p->{c_source}) eq "ARRAY") { push @{$p->{include_dirs}}, @{$p->{c_source}}; for my $path (@{$p->{c_source}}) { push @$files, @{ $self->rscan_dir($path, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$')) }; } } else { push @{$p->{include_dirs}}, $p->{c_source}; $files = $self->rscan_dir($p->{c_source}, $self->file_qr('\.c(c|p|pp|xx|\+\+)?$')); } foreach my $file (@$files) { push @{$p->{objects}}, $self->compile_c($file); } } sub process_share_dir_files { my $self = shift; my $files = $self->_find_share_dir_files; return unless $files; # root for all File::ShareDir paths my $share_prefix = File::Spec->catdir($self->blib, qw/lib auto share/); # copy all share files to blib foreach my $file (sort keys %$files) { $self->copy_if_modified( from => $file, to => File::Spec->catfile( $share_prefix, $files->{$file} ) ); } } sub _find_share_dir_files { my $self = shift; my $share_dir = $self->share_dir; return unless $share_dir; my @file_map; if ( $share_dir->{dist} ) { my $prefix = "dist/".$self->dist_name; push @file_map, $self->_share_dir_map( $prefix, $share_dir->{dist} ); } if ( $share_dir->{module} ) { for my $mod ( sort keys %{ $share_dir->{module} } ) { (my $altmod = $mod) =~ s{::}{-}g; my $prefix = "module/$altmod"; push @file_map, $self->_share_dir_map($prefix, $share_dir->{module}{$mod}); } } return { @file_map }; } sub _share_dir_map { my ($self, $prefix, $list) = @_; my %files; for my $dir ( @$list ) { for my $f ( @{ $self->rscan_dir( $dir, sub {-f} )} ) { $f =~ s{\A.*?\Q$dir\E/}{}; $files{"$dir/$f"} = "$prefix/$f"; } } return %files; } sub process_PL_files { my ($self) = @_; my $files = $self->find_PL_files; foreach my $file (sort keys %$files) { my $to = $files->{$file}; unless ($self->up_to_date( $file, $to )) { $self->run_perl_script($file, [], [@$to]) or die "$file failed"; $self->add_to_cleanup(@$to); } } } sub process_xs_files { my $self = shift; return if $self->pureperl_only && $self->allow_pureperl; my $files = $self->find_xs_files; croak 'Can\'t build xs files under --pureperl-only' if %$files && $self->pureperl_only; foreach my $from (sort keys %$files) { my $to = $files->{$from}; unless ($from eq $to) { $self->add_to_cleanup($to); $self->copy_if_modified( from => $from, to => $to ); } $self->process_xs($to); } } sub process_pod_files { shift()->process_files_by_extension(shift()) } sub process_pm_files { shift()->process_files_by_extension(shift()) } sub process_script_files { my $self = shift; my $files = $self->find_script_files; return unless keys %$files; my $script_dir = File::Spec->catdir($self->blib, 'script'); File::Path::mkpath( $script_dir ); foreach my $file (sort keys %$files) { my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next; $self->fix_shebang_line($result) unless $self->is_vmsish; $self->make_executable($result); } } sub find_PL_files { my $self = shift; if (my $files = $self->{properties}{PL_files}) { # 'PL_files' is given as a Unix file spec, so we localize_file_path(). if (ref $files eq 'ARRAY') { return { map {$_, [/^(.*)\.PL$/]} map $self->localize_file_path($_), @$files }; } elsif (ref $files eq 'HASH') { my %out; while (my ($file, $to) = each %$files) { $out{ $self->localize_file_path($file) } = [ map $self->localize_file_path($_), ref $to ? @$to : ($to) ]; } return \%out; } else { die "'PL_files' must be a hash reference or array reference"; } } return unless -d 'lib'; return { map {$_, [/^(.*)\.PL$/i ]} @{ $self->rscan_dir('lib', $self->file_qr('\.PL$')) } }; } sub find_pm_files { shift->_find_file_by_type('pm', 'lib') } sub find_pod_files { shift->_find_file_by_type('pod', 'lib') } sub find_xs_files { shift->_find_file_by_type('xs', 'lib') } sub find_script_files { my $self = shift; if (my $files = $self->script_files) { # Always given as a Unix file spec. Values in the hash are # meaningless, but we preserve if present. return { map {$self->localize_file_path($_), $files->{$_}} keys %$files }; } # No default location for script files return {}; } sub find_test_files { my $self = shift; my $p = $self->{properties}; if (my $files = $p->{test_files}) { $files = [sort keys %$files] if ref $files eq 'HASH'; $files = [map { -d $_ ? $self->expand_test_dir($_) : $_ } map glob, $self->split_like_shell($files)]; # Always given as a Unix file spec. return [ map $self->localize_file_path($_), @$files ]; } else { # Find all possible tests in t/ or test.pl my @tests; push @tests, 'test.pl' if -e 'test.pl'; push @tests, $self->expand_test_dir('t') if -e 't' and -d _; return \@tests; } } sub _find_file_by_type { my ($self, $type, $dir) = @_; if (my $files = $self->{properties}{"${type}_files"}) { # Always given as a Unix file spec return { map $self->localize_file_path($_), %$files }; } return {} unless -d $dir; return { map {$_, $_} map $self->localize_file_path($_), grep !/\.\#/, @{ $self->rscan_dir($dir, $self->file_qr("\\.$type\$")) } }; } sub localize_file_path { my ($self, $path) = @_; return File::Spec->catfile( split m{/}, $path ); } sub localize_dir_path { my ($self, $path) = @_; return File::Spec->catdir( split m{/}, $path ); } sub fix_shebang_line { # Adapted from fixin() in ExtUtils::MM_Unix 1.35 my ($self, @files) = @_; my $c = ref($self) ? $self->{config} : 'Module::Build::Config'; my ($does_shbang) = $c->get('sharpbang') =~ /^\s*\#\!/; for my $file (@files) { open(my $FIXIN, '<', $file) or die "Can't process '$file': $!"; local $/ = "\n"; chomp(my $line = <$FIXIN>); next unless $line =~ s/^\s*\#!\s*//; # Not a shebang file. my ($cmd, $arg) = (split(' ', $line, 2), ''); next unless $cmd =~ /perl/i; my $interpreter = $self->{properties}{perl}; $self->log_verbose("Changing sharpbang in $file to $interpreter\n"); my $shb = ''; $shb .= $c->get('sharpbang')."$interpreter $arg\n" if $does_shbang; open(my $FIXOUT, '>', "$file.new") or die "Can't create new $file: $!\n"; # Print out the new #! line (or equivalent). local $\; undef $/; # Was localized above print $FIXOUT $shb, <$FIXIN>; close $FIXIN; close $FIXOUT; rename($file, "$file.bak") or die "Can't rename $file to $file.bak: $!"; rename("$file.new", $file) or die "Can't rename $file.new to $file: $!"; $self->delete_filetree("$file.bak") or $self->log_warn("Couldn't clean up $file.bak, leaving it there"); $self->do_system($c->get('eunicefix'), $file) if $c->get('eunicefix') ne ':'; } } sub ACTION_testpod { my $self = shift; $self->depends_on('docs'); eval q{use Test::Pod 0.95; 1} or die "The 'testpod' action requires Test::Pod version 0.95"; my @files = sort keys %{$self->_find_pods($self->libdoc_dirs)}, keys %{$self->_find_pods ($self->bindoc_dirs, exclude => [ $self->file_qr('\.bat$') ])} or die "Couldn't find any POD files to test\n"; { package # hide from PAUSE Module::Build::PodTester; # Don't want to pollute the main namespace Test::Pod->import( tests => scalar @files ); pod_file_ok($_) foreach @files; } } sub ACTION_testpodcoverage { my $self = shift; $self->depends_on('docs'); eval q{use Test::Pod::Coverage 1.00; 1} or die "The 'testpodcoverage' action requires ", "Test::Pod::Coverage version 1.00"; # TODO this needs test coverage! # XXX work-around a bug in Test::Pod::Coverage previous to v1.09 # Make sure we test the module in blib/ local @INC = @INC; my $p = $self->{properties}; unshift(@INC, # XXX any reason to include arch? File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'), #File::Spec->catdir($p->{base_dir}, $self->blib, 'arch') ); all_pod_coverage_ok(); } sub ACTION_docs { my $self = shift; $self->depends_on('code'); $self->depends_on('manpages', 'html'); } # Given a file type, will return true if the file type would normally # be installed when neither install-base nor prefix has been set. # I.e. it will be true only if the path is set from Config.pm or # set explicitly by the user via install-path. sub _is_default_installable { my $self = shift; my $type = shift; return ( $self->install_destination($type) && ( $self->install_path($type) || $self->install_sets($self->installdirs)->{$type} ) ) ? 1 : 0; } sub _is_ActivePerl { # return 0; my $self = shift; unless (exists($self->{_is_ActivePerl})) { $self->{_is_ActivePerl} = (eval { require ActivePerl::DocTools; } || 0); } return $self->{_is_ActivePerl}; } sub _is_ActivePPM { # return 0; my $self = shift; unless (exists($self->{_is_ActivePPM})) { $self->{_is_ActivePPM} = (eval { require ActivePerl::PPM; } || 0); } return $self->{_is_ActivePPM}; } sub ACTION_manpages { my $self = shift; return unless $self->_mb_feature('manpage_support'); $self->depends_on('code'); my %extra_manify_args = $self->{properties}{'extra_manify_args'} ? %{ $self->{properties}{'extra_manify_args'} } : (); foreach my $type ( qw(bin lib) ) { next unless ( $self->invoked_action eq 'manpages' || $self->_is_default_installable("${type}doc")); my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"}, exclude => [ $self->file_qr('\.bat$') ] ); next unless %$files; my $sub = $self->can("manify_${type}_pods"); $self->$sub( %extra_manify_args ) if defined( $sub ); } } sub manify_bin_pods { my $self = shift; my %podman_args = (section => 1, @_); # binaries go in section 1 my $files = $self->_find_pods( $self->{properties}{bindoc_dirs}, exclude => [ $self->file_qr('\.bat$') ] ); return unless keys %$files; my $mandir = File::Spec->catdir( $self->blib, 'bindoc' ); File::Path::mkpath( $mandir, 0, oct(777) ); require Pod::Man; foreach my $file (sort keys %$files) { # Pod::Simple based parsers only support one document per instance. # This is expected to change in a future version (Pod::Simple > 3.03). my $parser = Pod::Man->new( %podman_args ); my $manpage = $self->man1page_name( $file ) . '.' . $self->config( 'man1ext' ); my $outfile = File::Spec->catfile($mandir, $manpage); next if $self->up_to_date( $file, $outfile ); $self->log_verbose("Manifying $file -> $outfile\n"); eval { $parser->parse_from_file( $file, $outfile ); 1 } or $self->log_warn("Error creating '$outfile': $@\n"); $files->{$file} = $outfile; } } sub manify_lib_pods { my $self = shift; my %podman_args = (section => 3, @_); # libraries go in section 3 my $files = $self->_find_pods($self->{properties}{libdoc_dirs}); return unless keys %$files; my $mandir = File::Spec->catdir( $self->blib, 'libdoc' ); File::Path::mkpath( $mandir, 0, oct(777) ); require Pod::Man; foreach my $file (sort keys %$files) { # Pod::Simple based parsers only support one document per instance. # This is expected to change in a future version (Pod::Simple > 3.03). my $parser = Pod::Man->new( %podman_args ); my $manpage = $self->man3page_name( $files->{$file} ) . '.' . $self->config( 'man3ext' ); my $outfile = File::Spec->catfile( $mandir, $manpage); next if $self->up_to_date( $file, $outfile ); $self->log_verbose("Manifying $file -> $outfile\n"); eval { $parser->parse_from_file( $file, $outfile ); 1 } or $self->log_warn("Error creating '$outfile': $@\n"); $files->{$file} = $outfile; } } sub _find_pods { my ($self, $dirs, %args) = @_; my %files; foreach my $spec (@$dirs) { my $dir = $self->localize_dir_path($spec); next unless -e $dir; FILE: foreach my $file ( @{ $self->rscan_dir( $dir ) } ) { foreach my $regexp ( @{ $args{exclude} } ) { next FILE if $file =~ $regexp; } $file = $self->localize_file_path($file); $files{$file} = File::Spec->abs2rel($file, $dir) if $self->contains_pod( $file ) } } return \%files; } sub contains_pod { my ($self, $file) = @_; return '' unless -T $file; # Only look at text files open(my $fh, '<', $file ) or die "Can't open $file: $!"; while (my $line = <$fh>) { return 1 if $line =~ /^\=(?:head|pod|item)/; } return ''; } sub ACTION_html { my $self = shift; return unless $self->_mb_feature('HTML_support'); $self->depends_on('code'); foreach my $type ( qw(bin lib) ) { next unless ( $self->invoked_action eq 'html' || $self->_is_default_installable("${type}html")); $self->htmlify_pods( $type ); } } # 1) If it's an ActiveState perl install, we need to run # ActivePerl::DocTools->UpdateTOC; # 2) Links to other modules are not being generated sub htmlify_pods { my $self = shift; my $type = shift; my $htmldir = shift || File::Spec->catdir($self->blib, "${type}html"); $self->add_to_cleanup('pod2htm*'); my $pods = $self->_find_pods( $self->{properties}{"${type}doc_dirs"}, exclude => [ $self->file_qr('\.(?:bat|com|html)$') ] ); return unless %$pods; # nothing to do unless ( -d $htmldir ) { File::Path::mkpath($htmldir, 0, oct(755)) or die "Couldn't mkdir $htmldir: $!"; } my @rootdirs = ($type eq 'bin') ? qw(bin) : $self->installdirs eq 'core' ? qw(lib) : qw(site lib); my $podroot = $ENV{PERL_CORE} ? File::Basename::dirname($ENV{PERL_CORE}) : $self->original_prefix('core'); my $htmlroot = $self->install_sets('core')->{libhtml}; my $podpath; unless (defined $self->args('html_links') and !$self->args('html_links')) { my @podpath = ( (map { File::Spec->abs2rel($_ ,$podroot) } grep { -d } ( $self->install_sets('core', 'lib'), # lib $self->install_sets('core', 'bin'), # bin $self->install_sets('site', 'lib'), # site/lib ) ), File::Spec->rel2abs($self->blib) ); $podpath = $ENV{PERL_CORE} ? File::Spec->catdir($podroot, 'lib') : join(":", map { tr,:\\,|/,; $_ } @podpath); } my $blibdir = join('/', File::Spec->splitdir( (File::Spec->splitpath(File::Spec->rel2abs($htmldir),1))[1]),'' ); my ($with_ActiveState, $htmltool); if ( $with_ActiveState = $self->_is_ActivePerl && eval { require ActivePerl::DocTools::Pod; 1 } ) { my $tool_v = ActiveState::DocTools::Pod->VERSION; $htmltool = "ActiveState::DocTools::Pod"; $htmltool .= " $tool_v" if $tool_v && length $tool_v; } else { require Module::Build::PodParser; require Pod::Html; $htmltool = "Pod::Html " . Pod::Html->VERSION; } $self->log_verbose("Converting Pod to HTML with $htmltool\n"); my $errors = 0; POD: foreach my $pod ( sort keys %$pods ) { my ($name, $path) = File::Basename::fileparse($pods->{$pod}, $self->file_qr('\.(?:pm|plx?|pod)$') ); my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) ); pop( @dirs ) if scalar(@dirs) && $dirs[-1] eq File::Spec->curdir; my $fulldir = File::Spec->catdir($htmldir, @rootdirs, @dirs); my $tmpfile = File::Spec->catfile($fulldir, "${name}.tmp"); my $outfile = File::Spec->catfile($fulldir, "${name}.html"); my $infile = File::Spec->abs2rel($pod); next if $self->up_to_date($infile, $outfile); unless ( -d $fulldir ){ File::Path::mkpath($fulldir, 0, oct(755)) or die "Couldn't mkdir $fulldir: $!"; } $self->log_verbose("HTMLifying $infile -> $outfile\n"); if ( $with_ActiveState ) { my $depth = @rootdirs + @dirs; my %opts = ( infile => $infile, outfile => $tmpfile, ( defined($podpath) ? (podpath => $podpath) : ()), podroot => $podroot, index => 1, depth => $depth, ); eval { ActivePerl::DocTools::Pod::pod2html(map { ($_, $opts{$_}) } sort keys %opts); 1; } or $self->log_warn("[$htmltool] pod2html (" . join(", ", map { "q{$_} => q{$opts{$_}}" } (sort keys %opts)) . ") failed: $@"); } else { my $path2root = File::Spec->catdir((File::Spec->updir) x @dirs); open(my $fh, '<', $infile) or die "Can't read $infile: $!"; my $abstract = Module::Build::PodParser->new(fh => $fh)->get_abstract(); my $title = join( '::', (@dirs, $name) ); $title .= " - $abstract" if $abstract; my @opts = ( "--title=$title", ( defined($podpath) ? "--podpath=$podpath" : ()), "--infile=$infile", "--outfile=$tmpfile", "--podroot=$podroot", ($path2root ? "--htmlroot=$path2root" : ()), ); unless ( eval{Pod::Html->VERSION(1.12)} ) { push( @opts, ('--flush') ); # caching removed in 1.12 } if ( eval{Pod::Html->VERSION(1.12)} ) { push( @opts, ('--header', '--backlink') ); } elsif ( eval{Pod::Html->VERSION(1.03)} ) { push( @opts, ('--header', '--backlink=Back to Top') ); } $self->log_verbose("P::H::pod2html @opts\n"); { my $orig = Cwd::getcwd(); eval { Pod::Html::pod2html(@opts); 1 } or $self->log_warn("[$htmltool] pod2html( " . join(", ", map { "q{$_}" } @opts) . ") failed: $@"); chdir($orig); } } # We now have to cleanup the resulting html file if ( ! -r $tmpfile ) { $errors++; next POD; } open(my $fh, '<', $tmpfile) or die "Can't read $tmpfile: $!"; my $html = join('',<$fh>); close $fh; if (!$self->_is_ActivePerl) { # These fixups are already done by AP::DT:P:pod2html # The output from pod2html is NOT XHTML! # IE6+ will display content that is not valid for DOCTYPE $html =~ s#^<!DOCTYPE .*?>#<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">#im; $html =~ s#<html xmlns="http://www.w3.org/1999/xhtml">#<html>#i; # IE6+ will not display local HTML files with strict # security without this comment $html =~ s#<head>#<head>\n<!-- saved from url=(0017)http://localhost/ -->#i; } # Fixup links that point to our temp blib $html =~ s/\Q$blibdir\E//g; open($fh, '>', $outfile) or die "Can't write $outfile: $!"; print $fh $html; close $fh; unlink($tmpfile); } return ! $errors; } # Adapted from ExtUtils::MM_Unix sub man1page_name { my $self = shift; return File::Basename::basename( shift ); } # Adapted from ExtUtils::MM_Unix and Pod::Man # Depending on M::B's dependency policy, it might make more sense to refactor # Pod::Man::begin_pod() to extract a name() methods, and use them... # -spurkis sub man3page_name { my $self = shift; my ($vol, $dirs, $file) = File::Spec->splitpath( shift ); my @dirs = File::Spec->splitdir( File::Spec->canonpath($dirs) ); # Remove known exts from the base name $file =~ s/\.p(?:od|m|l)\z//i; return join( $self->manpage_separator, @dirs, $file ); } sub manpage_separator { return '::'; } # For systems that don't have 'diff' executable, should use Algorithm::Diff sub ACTION_diff { my $self = shift; $self->depends_on('build'); my $local_lib = File::Spec->rel2abs('lib'); my @myINC = grep {$_ ne $local_lib} @INC; # The actual install destination might not be in @INC, so check there too. push @myINC, map $self->install_destination($_), qw(lib arch); my @flags = @{$self->{args}{ARGV}}; @flags = $self->split_like_shell($self->{args}{flags} || '') unless @flags; my $installmap = $self->install_map; delete $installmap->{read}; delete $installmap->{write}; my $text_suffix = $self->file_qr('\.(pm|pod)$'); foreach my $localdir (sort keys %$installmap) { my @localparts = File::Spec->splitdir($localdir); my $files = $self->rscan_dir($localdir, sub {-f}); foreach my $file (@$files) { my @parts = File::Spec->splitdir($file); @parts = @parts[@localparts .. $#parts]; # Get rid of blib/lib or similar my $installed = Module::Metadata->find_module_by_name( join('::', @parts), \@myINC ); if (not $installed) { print "Only in lib: $file\n"; next; } my $status = File::Compare::compare($installed, $file); next if $status == 0; # Files are the same die "Can't compare $installed and $file: $!" if $status == -1; if ($file =~ $text_suffix) { $self->do_system('diff', @flags, $installed, $file); } else { print "Binary files $file and $installed differ\n"; } } } } sub ACTION_pure_install { shift()->depends_on('install'); } sub ACTION_install { my ($self) = @_; require ExtUtils::Install; $self->depends_on('build'); # RT#63003 suggest that odd circumstances that we might wind up # in a different directory than we started, so wrap with _do_in_dir to # ensure we get back to where we started; hope this fixes it! $self->_do_in_dir( ".", sub { ExtUtils::Install::install( $self->install_map, $self->verbose, 0, $self->{args}{uninst}||0 ); }); if ($self->_is_ActivePerl && $self->{_completed_actions}{html}) { $self->log_info("Building ActivePerl Table of Contents\n"); eval { ActivePerl::DocTools::WriteTOC(verbose => $self->verbose ? 1 : 0); 1; } or $self->log_warn("AP::DT:: WriteTOC() failed: $@"); } if ($self->_is_ActivePPM) { # We touch 'lib/perllocal.pod'. There is an existing logic in subroutine _init_db() # of 'ActivePerl/PPM/InstallArea.pm' that says that if 'lib/perllocal.pod' has a 'date-last-touched' # greater than that of the PPM SQLite databases ('etc/ppm-perl-area.db' and/or # 'site/etc/ppm-site-area.db') then the PPM SQLite databases are rebuilt from scratch. # in the following line, 'perllocal.pod' this is *always* 'lib/perllocal.pod', never 'site/lib/perllocal.pod' my $F_perllocal = File::Spec->catfile($self->install_sets('core', 'lib'), 'perllocal.pod'); my $dt_stamp = time; $self->log_info("For ActivePerl's PPM: touch '$F_perllocal'\n"); open my $perllocal, ">>", $F_perllocal; close $perllocal; utime($dt_stamp, $dt_stamp, $F_perllocal); } } sub ACTION_fakeinstall { my ($self) = @_; require ExtUtils::Install; my $eui_version = ExtUtils::Install->VERSION; if ( $eui_version < 1.32 ) { $self->log_warn( "The 'fakeinstall' action requires Extutils::Install 1.32 or later.\n" . "(You only have version $eui_version)." ); return; } $self->depends_on('build'); ExtUtils::Install::install($self->install_map, !$self->quiet, 1, $self->{args}{uninst}||0); } sub ACTION_versioninstall { my ($self) = @_; die "You must have only.pm 0.25 or greater installed for this operation: $@\n" unless eval { require only; 'only'->VERSION(0.25); 1 }; $self->depends_on('build'); my %onlyargs = map {exists($self->{args}{$_}) ? ($_ => $self->{args}{$_}) : ()} qw(version versionlib); only::install::install(%onlyargs); } sub ACTION_installdeps { my ($self) = @_; # XXX include feature prerequisites as optional prereqs? my $info = $self->_enum_prereqs; if (! $info ) { $self->log_info( "No prerequisites detected\n" ); return; } my $failures = $self->prereq_failures($info); if ( ! $failures ) { $self->log_info( "All prerequisites satisfied\n" ); return; } my @install; foreach my $type (sort keys %$failures) { my $prereqs = $failures->{$type}; if($type =~ m/^(?:\w+_)?requires$/) { push(@install, sort keys %$prereqs); next; } $self->log_info("Checking optional dependencies:\n"); foreach my $module (sort keys %$prereqs) { push(@install, $module) if($self->y_n("Install $module?", 'y')); } } return unless @install; my ($command, @opts) = $self->split_like_shell($self->cpan_client); # relative command should be relative to our active Perl # so we need to locate that command if ( ! File::Spec->file_name_is_absolute( $command ) ) { # prefer site to vendor to core my @loc = ( 'site', 'vendor', '' ); my @bindirs = File::Basename::dirname($self->perl); push @bindirs, map { ($self->config->{"install${_}bin"}, $self->config->{"install${_}script"}) } @loc; for my $d ( @bindirs ) { my $abs_cmd = $self->find_command(File::Spec->catfile( $d, $command )); if ( defined $abs_cmd ) { $command = $abs_cmd; last; } } } $self->do_system($command, @opts, @install); } sub ACTION_clean { my ($self) = @_; $self->log_info("Cleaning up build files\n"); foreach my $item (map glob($_), $self->cleanup) { $self->delete_filetree($item); } } sub ACTION_realclean { my ($self) = @_; $self->depends_on('clean'); $self->log_info("Cleaning up configuration files\n"); $self->delete_filetree( $self->config_dir, $self->mymetafile, $self->mymetafile2, $self->build_script ); } sub ACTION_ppd { my ($self) = @_; require Module::Build::PPMMaker; my $ppd = Module::Build::PPMMaker->new(); my $file = $ppd->make_ppd(%{$self->{args}}, build => $self); $self->add_to_cleanup($file); } sub ACTION_ppmdist { my ($self) = @_; $self->depends_on( 'build' ); my $ppm = $self->ppm_name; $self->delete_filetree( $ppm ); $self->log_info( "Creating $ppm\n" ); $self->add_to_cleanup( $ppm, "$ppm.tar.gz" ); my %types = ( # translate types/dirs to those expected by ppm lib => 'lib', arch => 'arch', bin => 'bin', script => 'script', bindoc => 'man1', libdoc => 'man3', binhtml => undef, libhtml => undef, ); foreach my $type ($self->install_types) { next if exists( $types{$type} ) && !defined( $types{$type} ); my $dir = File::Spec->catdir( $self->blib, $type ); next unless -e $dir; my $files = $self->rscan_dir( $dir ); foreach my $file ( @$files ) { next unless -f $file; my $rel_file = File::Spec->abs2rel( File::Spec->rel2abs( $file ), File::Spec->rel2abs( $dir ) ); my $to_file = File::Spec->catfile( $ppm, 'blib', exists( $types{$type} ) ? $types{$type} : $type, $rel_file ); $self->copy_if_modified( from => $file, to => $to_file ); } } foreach my $type ( qw(bin lib) ) { $self->htmlify_pods( $type, File::Spec->catdir($ppm, 'blib', 'html') ); } # create a tarball; # the directory tar'ed must be blib so we need to do a chdir first my $target = File::Spec->catfile( File::Spec->updir, $ppm ); $self->_do_in_dir( $ppm, sub { $self->make_tarball( 'blib', $target ) } ); $self->depends_on( 'ppd' ); $self->delete_filetree( $ppm ); } sub ACTION_pardist { my ($self) = @_; # Need PAR::Dist if ( not eval { require PAR::Dist; PAR::Dist->VERSION(0.17) } ) { $self->log_warn( "In order to create .par distributions, you need to\n" . "install PAR::Dist first." ); return(); } $self->depends_on( 'build' ); return PAR::Dist::blib_to_par( name => $self->dist_name, version => $self->dist_version, ); } sub ACTION_dist { my ($self) = @_; # MUST dispatch() and not depends_ok() so we generate a clean distdir $self->dispatch('distdir'); my $dist_dir = $self->dist_dir; $self->make_tarball($dist_dir); $self->delete_filetree($dist_dir); } sub ACTION_distcheck { my ($self) = @_; $self->_check_manifest_skip unless $self->invoked_action eq 'distclean'; require ExtUtils::Manifest; local $^W; # ExtUtils::Manifest is not warnings clean. my ($missing, $extra) = ExtUtils::Manifest::fullcheck(); return unless @$missing || @$extra; my $msg = "MANIFEST appears to be out of sync with the distribution\n"; if ( $self->invoked_action eq 'distcheck' ) { die $msg; } else { warn $msg; } } sub _check_mymeta_skip { my $self = shift; my $maniskip = shift || 'MANIFEST.SKIP'; require ExtUtils::Manifest; local $^W; # ExtUtils::Manifest is not warnings clean. # older ExtUtils::Manifest had a private _maniskip my $skip_factory = ExtUtils::Manifest->can('maniskip') || ExtUtils::Manifest->can('_maniskip'); my $mymetafile = $self->mymetafile; # we can't check it, just add it anyway to be safe for my $file ( $self->mymetafile, $self->mymetafile2 ) { unless ( $skip_factory && $skip_factory->($maniskip)->($file) ) { $self->log_warn("File '$maniskip' does not include '$file'. Adding it now.\n"); my $safe = quotemeta($file); $self->_append_maniskip("^$safe\$", $maniskip); } } } sub _add_to_manifest { my ($self, $manifest, $lines) = @_; $lines = [$lines] unless ref $lines; my $existing_files = $self->_read_manifest($manifest); return unless defined( $existing_files ); @$lines = grep {!exists $existing_files->{$_}} @$lines or return; my $mode = (stat $manifest)[2]; chmod($mode | oct(222), $manifest) or die "Can't make $manifest writable: $!"; open(my $fh, '<', $manifest) or die "Can't read $manifest: $!"; my $last_line = (<$fh>)[-1] || "\n"; my $has_newline = $last_line =~ /\n$/; close $fh; open($fh, '>>', $manifest) or die "Can't write to $manifest: $!"; print $fh "\n" unless $has_newline; print $fh map "$_\n", @$lines; close $fh; chmod($mode, $manifest); $self->log_verbose(map "Added to $manifest: $_\n", @$lines); } sub _sign_dir { my ($self, $dir) = @_; unless (eval { require Module::Signature; 1 }) { $self->log_warn("Couldn't load Module::Signature for 'distsign' action:\n $@\n"); return; } # Add SIGNATURE to the MANIFEST { my $manifest = File::Spec->catfile($dir, 'MANIFEST'); die "Signing a distribution requires a MANIFEST file" unless -e $manifest; $self->_add_to_manifest($manifest, "SIGNATURE Added here by Module::Build"); } # Would be nice if Module::Signature took a directory argument. $self->_do_in_dir($dir, sub {local $Module::Signature::Quiet = 1; Module::Signature::sign()}); } sub _do_in_dir { my ($self, $dir, $do) = @_; my $start_dir = File::Spec->rel2abs($self->cwd); chdir $dir or die "Can't chdir() to $dir: $!"; eval {$do->()}; my @err = $@ ? ($@) : (); chdir $start_dir or push @err, "Can't chdir() back to $start_dir: $!"; die join "\n", @err if @err; } sub ACTION_distsign { my ($self) = @_; { local $self->{properties}{sign} = 0; # We'll sign it ourselves $self->depends_on('distdir') unless -d $self->dist_dir; } $self->_sign_dir($self->dist_dir); } sub ACTION_skipcheck { my ($self) = @_; require ExtUtils::Manifest; local $^W; # ExtUtils::Manifest is not warnings clean. ExtUtils::Manifest::skipcheck(); } sub ACTION_distclean { my ($self) = @_; $self->depends_on('realclean'); $self->depends_on('distcheck'); } sub do_create_makefile_pl { my $self = shift; require Module::Build::Compat; $self->log_info("Creating Makefile.PL\n"); eval { Module::Build::Compat->create_makefile_pl($self->create_makefile_pl, $self, @_) }; if ( $@ ) { 1 while unlink 'Makefile.PL'; die "$@\n"; } $self->_add_to_manifest('MANIFEST', 'Makefile.PL'); } sub do_create_license { my $self = shift; $self->log_info("Creating LICENSE file\n"); if ( ! $self->_mb_feature('license_creation') ) { $self->_warn_mb_feature_deps('license_creation'); die "Aborting.\n"; } my $l = $self->license or die "Can't create LICENSE file: No license specified\n"; my $license = $self->_software_license_object or die << "HERE"; Can't create LICENSE file: '$l' is not a valid license key or Software::License subclass; HERE $self->delete_filetree('LICENSE'); open(my $fh, '>', 'LICENSE') or die "Can't write LICENSE file: $!"; print $fh $license->fulltext; close $fh; $self->_add_to_manifest('MANIFEST', 'LICENSE'); } sub do_create_readme { my $self = shift; $self->delete_filetree('README'); my $docfile = $self->_main_docfile; unless ( $docfile ) { $self->log_warn(<<EOF); Cannot create README: can't determine which file contains documentation; Must supply either 'dist_version_from', or 'module_name' parameter. EOF return; } # work around some odd Pod::Readme->new() failures in test reports by # confirming that new() is available if ( eval {require Pod::Readme; Pod::Readme->can('new') } ) { $self->log_info("Creating README using Pod::Readme\n"); my $parser = Pod::Readme->new; $parser->parse_from_file($docfile, 'README', @_); } elsif ( eval {require Pod::Text; 1} ) { $self->log_info("Creating README using Pod::Text\n"); if ( open(my $fh, '>', 'README') ) { local $^W = 0; no strict "refs"; # work around bug in Pod::Text 3.01, which expects # Pod::Simple::parse_file to take input and output filehandles # when it actually only takes an input filehandle my $old_parse_file; $old_parse_file = \&{"Pod::Simple::parse_file"} and local *{"Pod::Simple::parse_file"} = sub { my $self = shift; $self->output_fh($_[1]) if $_[1]; $self->$old_parse_file($_[0]); } if $Pod::Text::VERSION == 3.01; # Split line to avoid evil version-finder Pod::Text::pod2text( $docfile, $fh ); close $fh; } else { $self->log_warn( "Cannot create 'README' file: Can't open file for writing\n" ); return; } } else { $self->log_warn("Can't load Pod::Readme or Pod::Text to create README\n"); return; } $self->_add_to_manifest('MANIFEST', 'README'); } sub _main_docfile { my $self = shift; if ( my $pm_file = $self->dist_version_from ) { (my $pod_file = $pm_file) =~ s/.pm$/.pod/; return (-e $pod_file ? $pod_file : $pm_file); } else { return undef; } } sub do_create_bundle_inc { my $self = shift; my $dist_inc = File::Spec->catdir( $self->dist_dir, 'inc' ); require inc::latest; inc::latest->write($dist_inc, @{$self->bundle_inc_preload}); inc::latest->bundle_module($_, $dist_inc) for @{$self->bundle_inc}; return 1; } sub ACTION_distdir { my ($self) = @_; if ( @{$self->bundle_inc} && ! $self->_mb_feature('inc_bundling_support') ) { $self->_warn_mb_feature_deps('inc_bundling_support'); die "Aborting.\n"; } $self->depends_on('distmeta'); my $dist_files = $self->_read_manifest('MANIFEST') or die "Can't create distdir without a MANIFEST file - run 'manifest' action first.\n"; delete $dist_files->{SIGNATURE}; # Don't copy, create a fresh one die "No files found in MANIFEST - try running 'manifest' action?\n" unless ($dist_files and keys %$dist_files); my $metafile = $self->metafile; $self->log_warn("*** Did you forget to add $metafile to the MANIFEST?\n") unless exists $dist_files->{$metafile}; my $dist_dir = $self->dist_dir; $self->delete_filetree($dist_dir); $self->log_info("Creating $dist_dir\n"); $self->add_to_cleanup($dist_dir); foreach my $file (sort keys %$dist_files) { next if $file =~ m{^MYMETA\.}; # Double check that we skip MYMETA.* my $new = $self->copy_if_modified(from => $file, to_dir => $dist_dir, verbose => 0); } $self->do_create_bundle_inc if @{$self->bundle_inc}; $self->_sign_dir($dist_dir) if $self->{properties}{sign}; } sub ACTION_disttest { my ($self) = @_; $self->depends_on('distdir'); $self->_do_in_dir ( $self->dist_dir, sub { local $ENV{AUTHOR_TESTING} = 1; local $ENV{RELEASE_TESTING} = 1; # XXX could be different names for scripts $self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile or die "Error executing 'Build.PL' in dist directory: $!"; $self->run_perl_script($self->build_script) or die "Error executing $self->build_script in dist directory: $!"; $self->run_perl_script($self->build_script, [], ['test']) or die "Error executing 'Build test' in dist directory"; }); } sub ACTION_distinstall { my ($self, @args) = @_; $self->depends_on('distdir'); $self->_do_in_dir ( $self->dist_dir, sub { $self->run_perl_script('Build.PL') or die "Error executing 'Build.PL' in dist directory: $!"; $self->run_perl_script($self->build_script) or die "Error executing $self->build_script in dist directory: $!"; $self->run_perl_script($self->build_script, [], ['install']) or die "Error executing 'Build install' in dist directory"; } ); } =begin private my $has_include = $build->_eumanifest_has_include; Returns true if the installed version of ExtUtils::Manifest supports #include and #include_default directives. False otherwise. =end private =cut # #!include and #!include_default were added in 1.50 sub _eumanifest_has_include { my $self = shift; require ExtUtils::Manifest; return eval { ExtUtils::Manifest->VERSION(1.50); 1 }; } =begin private my $maniskip_file = $build->_default_maniskip; Returns the location of the installed MANIFEST.SKIP file used by default. =end private =cut sub _default_maniskip { my $self = shift; my $default_maniskip; for my $dir (@INC) { $default_maniskip = File::Spec->catfile($dir, "ExtUtils", "MANIFEST.SKIP"); last if -r $default_maniskip; } return $default_maniskip; } =begin private my $content = $build->_slurp($file); Reads $file and returns the $content. =end private =cut sub _slurp { my $self = shift; my $file = shift; my $mode = shift || ""; open my $fh, "<$mode", $file or croak "Can't open $file for reading: $!"; local $/; return <$fh>; } sub _spew { my $self = shift; my $file = shift; my $content = shift || ""; my $mode = shift || ""; open my $fh, ">$mode", $file or croak "Can't open $file for writing: $!"; print {$fh} $content; close $fh; } sub _case_tolerant { my $self = shift; if ( ref $self ) { $self->{_case_tolerant} = File::Spec->case_tolerant unless defined($self->{_case_tolerant}); return $self->{_case_tolerant}; } else { return File::Spec->case_tolerant; } } sub _append_maniskip { my $self = shift; my $skip = shift; my $file = shift || 'MANIFEST.SKIP'; return unless defined $skip && length $skip; open(my $fh, '>>', $file) or die "Can't open $file: $!"; print $fh "$skip\n"; close $fh; } sub _write_default_maniskip { my $self = shift; my $file = shift || 'MANIFEST.SKIP'; open(my $fh, '>', $file) or die "Can't open $file: $!"; my $content = $self->_eumanifest_has_include ? "#!include_default\n" : $self->_slurp( $self->_default_maniskip ); $content .= <<'EOF'; # Avoid configuration metadata file ^MYMETA\. # Avoid Module::Build generated and utility files. \bBuild$ \bBuild.bat$ \b_build \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ ^MANIFEST\.SKIP # Avoid archives of this distribution EOF # Skip, for example, 'Module-Build-0.27.tar.gz' $content .= '\b'.$self->dist_name.'-[\d\.\_]+'."\n"; print $fh $content; close $fh; return; } sub _check_manifest_skip { my ($self) = @_; my $maniskip = 'MANIFEST.SKIP'; if ( ! -e $maniskip ) { $self->log_warn("File '$maniskip' does not exist: Creating a temporary '$maniskip'\n"); $self->_write_default_maniskip($maniskip); $self->_unlink_on_exit($maniskip); } else { # MYMETA must not be added to MANIFEST, so always confirm the skip $self->_check_mymeta_skip( $maniskip ); } return; } sub ACTION_manifest { my ($self) = @_; $self->_check_manifest_skip; require ExtUtils::Manifest; # ExtUtils::Manifest is not warnings clean. local ($^W, $ExtUtils::Manifest::Quiet) = (0,1); ExtUtils::Manifest::mkmanifest(); } sub ACTION_manifest_skip { my ($self) = @_; if ( -e 'MANIFEST.SKIP' ) { $self->log_warn("MANIFEST.SKIP already exists.\n"); return 0; } $self->log_info("Creating a new MANIFEST.SKIP file\n"); return $self->_write_default_maniskip; return -e 'MANIFEST.SKIP' } # Case insensitive regex for files sub file_qr { return shift->{_case_tolerant} ? qr($_[0])i : qr($_[0]); } sub dist_dir { my ($self) = @_; my $dir = join "-", $self->dist_name, $self->dist_version; $dir .= "-" . $self->dist_suffix if $self->dist_suffix; return $dir; } sub ppm_name { my $self = shift; return 'PPM-' . $self->dist_dir; } sub _files_in { my ($self, $dir) = @_; return unless -d $dir; local *DH; opendir DH, $dir or die "Can't read directory $dir: $!"; my @files; while (defined (my $file = readdir DH)) { my $full_path = File::Spec->catfile($dir, $file); next if -d $full_path; push @files, $full_path; } return @files; } sub share_dir { my $self = shift; my $p = $self->{properties}; $p->{share_dir} = shift if @_; # Always coerce to proper hash form if ( ! defined $p->{share_dir} ) { return; } elsif ( ! ref $p->{share_dir} ) { # scalar -- treat as a single 'dist' directory $p->{share_dir} = { dist => [ $p->{share_dir} ] }; } elsif ( ref $p->{share_dir} eq 'ARRAY' ) { # array -- treat as a list of 'dist' directories $p->{share_dir} = { dist => $p->{share_dir} }; } elsif ( ref $p->{share_dir} eq 'HASH' ) { # hash -- check structure my $share_dir = $p->{share_dir}; # check dist key if ( defined $share_dir->{dist} ) { if ( ! ref $share_dir->{dist} ) { # scalar, so upgrade to arrayref $share_dir->{dist} = [ $share_dir->{dist} ]; } elsif ( ref $share_dir->{dist} ne 'ARRAY' ) { die "'dist' key in 'share_dir' must be scalar or arrayref"; } } # check module key if ( defined $share_dir->{module} ) { my $mod_hash = $share_dir->{module}; if ( ref $mod_hash eq 'HASH' ) { for my $k ( sort keys %$mod_hash ) { if ( ! ref $mod_hash->{$k} ) { $mod_hash->{$k} = [ $mod_hash->{$k} ]; } elsif( ref $mod_hash->{$k} ne 'ARRAY' ) { die "modules in 'module' key of 'share_dir' must be scalar or arrayref"; } } } else { die "'module' key in 'share_dir' must be hashref"; } } } else { die "'share_dir' must be hashref, arrayref or string"; } return $p->{share_dir}; } sub script_files { my $self = shift; for ($self->{properties}{script_files}) { $_ = shift if @_; next unless $_; # Always coerce into a hash return $_ if ref $_ eq 'HASH'; return $_ = { map {$_,1} @$_ } if ref $_ eq 'ARRAY'; die "'script_files' must be a hashref, arrayref, or string" if ref(); return $_ = { map {$_,1} $self->_files_in( $_ ) } if -d $_; return $_ = {$_ => 1}; } my %pl_files = map { File::Spec->canonpath( $_ ) => 1 } keys %{ $self->PL_files || {} }; my @bin_files = $self->_files_in('bin'); my %bin_map = map { $_ => File::Spec->canonpath( $_ ) } @bin_files; return $_ = { map {$_ => 1} grep !$pl_files{$bin_map{$_}}, @bin_files }; } BEGIN { *scripts = \&script_files; } { my %licenses = ( perl => 'Perl_5', apache => 'Apache_2_0', apache_1_1 => 'Apache_1_1', artistic => 'Artistic_1', artistic_2 => 'Artistic_2', lgpl => 'LGPL_2_1', lgpl2 => 'LGPL_2_1', lgpl3 => 'LGPL_3_0', bsd => 'BSD', gpl => 'GPL_1', gpl2 => 'GPL_2', gpl3 => 'GPL_3', mit => 'MIT', mozilla => 'Mozilla_1_1', restrictive => 'Restricted', open_source => undef, unrestricted => undef, unknown => undef, ); # TODO - would be nice to not have these here, since they're more # properly stored only in Software::License my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', restrictive => undef, open_source => undef, unrestricted => undef, unknown => undef, ); sub valid_licenses { return \%licenses; } sub _license_url { return $license_urls{$_[1]}; } } sub _software_license_class { my ($self, $license) = @_; if ($self->valid_licenses->{$license} && eval { require Software::LicenseUtils; Software::LicenseUtils->VERSION(0.103009) }) { my @classes = Software::LicenseUtils->guess_license_from_meta_key($license, 1); if (@classes == 1) { eval "require $classes[0]"; return $classes[0]; } } LICENSE: for my $l ( $self->valid_licenses->{ $license }, $license ) { next unless defined $l; my $trial = "Software::License::" . $l; if ( eval "require Software::License; Software::License->VERSION(0.014); require $trial; 1" ) { return $trial; } } return; } # use mapping or license name directly sub _software_license_object { my ($self) = @_; return unless defined( my $license = $self->license ); my $class = $self->_software_license_class($license) or return; # Software::License requires a 'holder' argument my $author = join( " & ", @{ $self->dist_author }) || 'unknown'; my $sl = eval { $class->new({holder=>$author}) }; if ( $@ ) { $self->log_warn( "Error getting '$class' object: $@" ); } return $sl; } sub _hash_merge { my ($self, $h, $k, $v) = @_; if (ref $h->{$k} eq 'ARRAY') { push @{$h->{$k}}, ref $v ? @$v : $v; } elsif (ref $h->{$k} eq 'HASH') { $h->{$k}{$_} = $v->{$_} foreach keys %$v; } else { $h->{$k} = $v; } } sub ACTION_distmeta { my ($self) = @_; $self->do_create_makefile_pl if $self->create_makefile_pl; $self->do_create_readme if $self->create_readme; $self->do_create_license if $self->create_license; $self->do_create_metafile; } sub do_create_metafile { my $self = shift; return if $self->{wrote_metadata}; my $p = $self->{properties}; unless ($p->{license}) { $self->log_warn("No license specified, setting license = 'unknown'\n"); $p->{license} = 'unknown'; } my @metafiles = ( $self->metafile, $self->metafile2 ); # If we're in the distdir, the metafile may exist and be non-writable. $self->delete_filetree($_) for @metafiles; # Since we're building ourself, we have to do some special stuff # here: the ConfigData module is found in blib/lib. local @INC = @INC; if (($self->module_name || '') eq 'Module::Build') { $self->depends_on('config_data'); push @INC, File::Spec->catdir($self->blib, 'lib'); } my $meta_obj = $self->_get_meta_object( quiet => 1, fatal => 1, auto => 1 ); my @created = $self->_write_meta_files( $meta_obj, 'META' ); if ( @created ) { $self->{wrote_metadata} = 1; $self->_add_to_manifest('MANIFEST', $_) for @created; } return 1; } sub _write_meta_files { my $self = shift; my ($meta, $file) = @_; $file =~ s{\.(?:yml|json)$}{}; my @created; push @created, "$file\.yml" if $meta && $meta->save( "$file\.yml", {version => "1.4"} ); push @created, "$file\.json" if $meta && $meta->save( "$file\.json" ); if ( @created ) { $self->log_info("Created " . join(" and ", @created) . "\n"); } return @created; } sub _get_meta_object { my $self = shift; my %args = @_; return unless $self->try_require("CPAN::Meta", "2.142060"); my $meta; eval { my $data = $self->get_metadata( fatal => $args{fatal}, auto => $args{auto}, ); $data->{dynamic_config} = $args{dynamic} if defined $args{dynamic}; $meta = CPAN::Meta->create($data); }; if ($@ && ! $args{quiet}) { $self->log_warn( "Could not get valid metadata. Error is: $@\n" ); } return $meta; } sub read_metafile { my $self = shift; my ($metafile) = @_; return unless $self->try_require("CPAN::Meta", "2.110420"); my $meta = CPAN::Meta->load_file($metafile); return $meta->as_struct( {version => "2.0"} ); } sub normalize_version { my ($self, $version) = @_; $version = 0 unless defined $version and length $version; if ( $version =~ /[=<>!,]/ ) { # logic, not just version # take as is without modification } elsif ( ref $version eq 'version') { # version objects $version = $version->is_qv ? $version->normal : $version->stringify; } elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots # normalize string tuples without "v": "1.2.3" -> "v1.2.3" $version = "v$version"; } else { # leave alone } return $version; } my %prereq_map = ( requires => [ qw/runtime requires/], configure_requires => [qw/configure requires/], build_requires => [ qw/build requires/ ], test_requires => [ qw/test requires/ ], test_recommends => [ qw/test recommends/ ], recommends => [ qw/runtime recommends/ ], conflicts => [ qw/runtime conflicts/ ], ); sub _normalize_prereqs { my ($self) = @_; my $p = $self->{properties}; # copy prereq data structures so we can modify them before writing to META my %prereq_types; for my $type ( 'configure_requires', @{$self->prereq_action_types} ) { if (exists $p->{$type} and keys %{ $p->{$type} }) { my ($phase, $relation) = @{ $prereq_map{$type} }; for my $mod ( keys %{ $p->{$type} } ) { $prereq_types{$phase}{$relation}{$mod} = $self->normalize_version($p->{$type}{$mod}); } } } return \%prereq_types; } sub _get_license { my $self = shift; my $license = $self->license; my ($meta_license, $meta_license_url); my $valid_licenses = $self->valid_licenses(); if ( my $sl = $self->_software_license_object ) { $meta_license = $sl->meta2_name; $meta_license_url = $sl->url; } elsif ( exists $valid_licenses->{$license} ) { $meta_license = $valid_licenses->{$license} ? lc $valid_licenses->{$license} : $license; $meta_license_url = $self->_license_url( $license ); } else { $self->log_warn( "Can not determine license type for '" . $self->license . "'\nSetting META license field to 'unknown'.\n"); $meta_license = 'unknown'; } return ($meta_license, $meta_license_url); } sub get_metadata { my ($self, %args) = @_; my $fatal = $args{fatal} || 0; my $p = $self->{properties}; $self->auto_config_requires if $args{auto}; # validate required fields foreach my $f (qw(dist_name dist_version dist_author dist_abstract license)) { my $field = $self->$f(); unless ( defined $field and length $field ) { my $err = "ERROR: Missing required field '$f' for metafile\n"; if ( $fatal ) { die $err; } else { $self->log_warn($err); } } } my %metadata = ( name => $self->dist_name, version => $self->normalize_version($self->dist_version), author => $self->dist_author, abstract => $self->dist_abstract, generated_by => "Module::Build version $Module::Build::VERSION", 'meta-spec' => { version => '2', url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', }, dynamic_config => exists $p->{dynamic_config} ? $p->{dynamic_config} : 1, release_status => $self->release_status, ); my ($meta_license, $meta_license_url) = $self->_get_license; $metadata{license} = [ $meta_license ]; $metadata{resources}{license} = [ $meta_license_url ] if defined $meta_license_url; $metadata{prereqs} = $self->_normalize_prereqs; if (exists $p->{no_index}) { $metadata{no_index} = $p->{no_index}; } elsif (my $pkgs = eval { $self->find_dist_packages }) { $metadata{provides} = $pkgs if %$pkgs; } else { $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" . "Nothing to enter for 'provides' field in metafile.\n"); } if (my $add = $self->meta_add) { if (not exists $add->{'meta-spec'} or $add->{'meta-spec'}{version} != 2) { require CPAN::Meta::Converter; if (CPAN::Meta::Converter->VERSION('2.141170')) { $add = CPAN::Meta::Converter->new($add)->upgrade_fragment; delete $add->{prereqs}; # XXX this would now overwrite all prereqs } else { $self->log_warn("Can't meta_add without CPAN::Meta 2.141170"); } } while (my($k, $v) = each %{$add}) { $metadata{$k} = $v; } } if (my $merge = $self->meta_merge) { if (eval { require CPAN::Meta::Merge }) { %metadata = %{ CPAN::Meta::Merge->new(default_version => '1.4')->merge(\%metadata, $merge) }; } else { $self->log_warn("Can't merge without CPAN::Meta::Merge"); } } return \%metadata; } # To preserve compatibility with old API, $node *must* be a hashref # passed in to prepare_metadata. $keys is an arrayref holding a # list of keys -- it's use is optional and generally no longer needed # but kept for back compatibility. $args is an optional parameter to # support the new 'fatal' toggle sub prepare_metadata { my ($self, $node, $keys, $args) = @_; unless ( ref $node eq 'HASH' ) { croak "prepare_metadata() requires a hashref argument to hold output\n"; } croak 'Keys argument to prepare_metadata is no longer supported' if $keys; %{$node} = %{ $self->get_meta(%{$args}) }; return $node; } sub _read_manifest { my ($self, $file) = @_; return undef unless -e $file; require ExtUtils::Manifest; # ExtUtils::Manifest is not warnings clean. local ($^W, $ExtUtils::Manifest::Quiet) = (0,1); return scalar ExtUtils::Manifest::maniread($file); } sub find_dist_packages { my $self = shift; # Only packages in .pm files are candidates for inclusion here. # Only include things in the MANIFEST, not things in developer's # private stock. my $manifest = $self->_read_manifest('MANIFEST') or die "Can't find dist packages without a MANIFEST file\nRun 'Build manifest' to generate one\n"; # Localize my %dist_files = map { $self->localize_file_path($_) => $_ } keys %$manifest; my @pm_files = sort grep { $_ !~ m{^t} } # skip things in t/ grep {exists $dist_files{$_}} keys %{ $self->find_pm_files }; return $self->find_packages_in_files(\@pm_files, \%dist_files); } # XXX Do not document this function; mst wrote it and now says the API is # stupid and needs to be fixed and it shouldn't become a public API until then sub find_packages_in_files { my ($self, $file_list, $filename_map) = @_; # First, we enumerate all packages & versions, # separating into primary & alternative candidates my( %prime, %alt ); foreach my $file (@{$file_list}) { my $mapped_filename = $filename_map->{$file}; my @path = split( /\//, $mapped_filename ); (my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//; my $pm_info = Module::Metadata->new_from_file( $file ); foreach my $package ( $pm_info->packages_inside ) { next if $package eq 'main'; # main can appear numerous times, ignore next if $package eq 'DB'; # special debugging package, ignore next if grep /^_/, split( /::/, $package ); # private package, ignore my $version = $pm_info->version( $package ); if ( $package eq $prime_package ) { if ( exists( $prime{$package} ) ) { # Module::Metadata will handle this conflict die "Unexpected conflict in '$package'; multiple versions found.\n"; } else { $prime{$package}{file} = $mapped_filename; $prime{$package}{version} = $version if defined( $version ); } } else { push( @{$alt{$package}}, { file => $mapped_filename, version => $version, } ); } } } # Then we iterate over all the packages found above, identifying conflicts # and selecting the "best" candidate for recording the file & version # for each package. foreach my $package ( sort keys( %alt ) ) { my $result = $self->_resolve_module_versions( $alt{$package} ); if ( exists( $prime{$package} ) ) { # primary package selected if ( $result->{err} ) { # Use the selected primary package, but there are conflicting # errors among multiple alternative packages that need to be # reported $self->log_warn( "Found conflicting versions for package '$package'\n" . " $prime{$package}{file} ($prime{$package}{version})\n" . $result->{err} ); } elsif ( defined( $result->{version} ) ) { # There is a primary package selected, and exactly one # alternative package if ( exists( $prime{$package}{version} ) && defined( $prime{$package}{version} ) ) { # Unless the version of the primary package agrees with the # version of the alternative package, report a conflict if ( $self->compare_versions( $prime{$package}{version}, '!=', $result->{version} ) ) { $self->log_warn( "Found conflicting versions for package '$package'\n" . " $prime{$package}{file} ($prime{$package}{version})\n" . " $result->{file} ($result->{version})\n" ); } } else { # The prime package selected has no version so, we choose to # use any alternative package that does have a version $prime{$package}{file} = $result->{file}; $prime{$package}{version} = $result->{version}; } } else { # no alt package found with a version, but we have a prime # package so we use it whether it has a version or not } } else { # No primary package was selected, use the best alternative if ( $result->{err} ) { $self->log_warn( "Found conflicting versions for package '$package'\n" . $result->{err} ); } # Despite possible conflicting versions, we choose to record # something rather than nothing $prime{$package}{file} = $result->{file}; $prime{$package}{version} = $result->{version} if defined( $result->{version} ); } } # Normalize versions or delete them if undef/0 for my $provides ( values %prime ) { if ( $provides->{version} ) { $provides->{version} = $self->normalize_version( $provides->{version} ) } else { delete $provides->{version}; } } return \%prime; } # separate out some of the conflict resolution logic from # $self->find_dist_packages(), above, into a helper function. # sub _resolve_module_versions { my $self = shift; my $packages = shift; my( $file, $version ); my $err = ''; foreach my $p ( @$packages ) { if ( defined( $p->{version} ) ) { if ( defined( $version ) ) { if ( $self->compare_versions( $version, '!=', $p->{version} ) ) { $err .= " $p->{file} ($p->{version})\n"; } else { # same version declared multiple times, ignore } } else { $file = $p->{file}; $version = $p->{version}; } } $file ||= $p->{file} if defined( $p->{file} ); } if ( $err ) { $err = " $file ($version)\n" . $err; } my %result = ( file => $file, version => $version, err => $err ); return \%result; } sub make_tarball { my ($self, $dir, $file) = @_; $file ||= $dir; $self->log_info("Creating $file.tar.gz\n"); if ($self->{args}{tar}) { my $tar_flags = $self->verbose ? 'cvf' : 'cf'; $self->do_system($self->split_like_shell($self->{args}{tar}), $tar_flags, "$file.tar", $dir); $self->do_system($self->split_like_shell($self->{args}{gzip}), "$file.tar") if $self->{args}{gzip}; } else { eval { require Archive::Tar && Archive::Tar->VERSION(1.09); 1 } or die "You must install Archive::Tar 1.09+ to make a distribution tarball\n". "or specify a binary tar program with the '--tar' option.\n". "See the documentation for the 'dist' action.\n"; my $files = $self->rscan_dir($dir); # Archive::Tar versions >= 1.09 use the following to enable a compatibility # hack so that the resulting archive is compatible with older clients. # If no file path is 100 chars or longer, we disable the prefix field # for maximum compatibility. If there are any long file paths then we # need the prefix field after all. $Archive::Tar::DO_NOT_USE_PREFIX = (grep { length($_) >= 100 } @$files) ? 0 : 1; my $tar = Archive::Tar->new; $tar->add_files(@$files); for my $f ($tar->get_files) { $f->mode($f->mode & ~022); # chmod go-w } $tar->write("$file.tar.gz", 1); } } sub install_path { my $self = shift; my( $type, $value ) = ( @_, '<empty>' ); Carp::croak( 'Type argument missing' ) unless defined( $type ); my $map = $self->{properties}{install_path}; return $map unless @_; # delete existing value if $value is literal undef() unless ( defined( $value ) ) { delete( $map->{$type} ); return undef; } # return existing value if no new $value is given if ( $value eq '<empty>' ) { return undef unless exists $map->{$type}; return $map->{$type}; } # set value if $value is a valid relative path return $map->{$type} = $value; } sub install_sets { # Usage: install_sets('site'), install_sets('site', 'lib'), # or install_sets('site', 'lib' => $value); my ($self, $dirs, $key, $value) = @_; $dirs = $self->installdirs unless defined $dirs; # update property before merging with defaults if ( @_ == 4 && defined $dirs && defined $key) { # $value can be undef; will mask default $self->{properties}{install_sets}{$dirs}{$key} = $value; } my $map = { $self->_merge_arglist( $self->{properties}{install_sets}, $self->_default_install_paths->{install_sets} )}; if ( defined $dirs && defined $key ) { return $map->{$dirs}{$key}; } elsif ( defined $dirs ) { return $map->{$dirs}; } else { croak "Can't determine installdirs for install_sets()"; } } sub original_prefix { # Usage: original_prefix(), original_prefix('lib'), # or original_prefix('lib' => $value); my ($self, $key, $value) = @_; # update property before merging with defaults if ( @_ == 3 && defined $key) { # $value can be undef; will mask default $self->{properties}{original_prefix}{$key} = $value; } my $map = { $self->_merge_arglist( $self->{properties}{original_prefix}, $self->_default_install_paths->{original_prefix} )}; return $map unless defined $key; return $map->{$key} } sub install_base_relpaths { # Usage: install_base_relpaths(), install_base_relpaths('lib'), # or install_base_relpaths('lib' => $value); my $self = shift; if ( @_ > 1 ) { # change values before merge $self->_set_relpaths($self->{properties}{install_base_relpaths}, @_); } my $map = { $self->_merge_arglist( $self->{properties}{install_base_relpaths}, $self->_default_install_paths->{install_base_relpaths} )}; return $map unless @_; my $relpath = $map->{$_[0]}; return defined $relpath ? File::Spec->catdir( @$relpath ) : undef; } # Defaults to use in case the config install paths cannot be prefixified. sub prefix_relpaths { # Usage: prefix_relpaths('site'), prefix_relpaths('site', 'lib'), # or prefix_relpaths('site', 'lib' => $value); my $self = shift; my $installdirs = shift || $self->installdirs or croak "Can't determine installdirs for prefix_relpaths()"; if ( @_ > 1 ) { # change values before merge $self->{properties}{prefix_relpaths}{$installdirs} ||= {}; $self->_set_relpaths($self->{properties}{prefix_relpaths}{$installdirs}, @_); } my $map = {$self->_merge_arglist( $self->{properties}{prefix_relpaths}{$installdirs}, $self->_default_install_paths->{prefix_relpaths}{$installdirs} )}; return $map unless @_; my $relpath = $map->{$_[0]}; return defined $relpath ? File::Spec->catdir( @$relpath ) : undef; } sub _set_relpaths { my $self = shift; my( $map, $type, $value ) = @_; Carp::croak( 'Type argument missing' ) unless defined( $type ); # set undef if $value is literal undef() if ( ! defined( $value ) ) { $map->{$type} = undef; return; } # set value if $value is a valid relative path else { Carp::croak( "Value must be a relative path" ) if File::Spec::Unix->file_name_is_absolute($value); my @value = split( /\//, $value ); $map->{$type} = \@value; } } # Translated from ExtUtils::MM_Any::init_INSTALL_from_PREFIX sub prefix_relative { my ($self, $type) = @_; my $installdirs = $self->installdirs; my $relpath = $self->install_sets($installdirs)->{$type}; return $self->_prefixify($relpath, $self->original_prefix($installdirs), $type, ); } # Translated from ExtUtils::MM_Unix::prefixify() sub _prefixify { my($self, $path, $sprefix, $type) = @_; my $rprefix = $self->prefix; $rprefix .= '/' if $sprefix =~ m|/$|; $self->log_verbose(" prefixify $path from $sprefix to $rprefix\n") if defined( $path ) && length( $path ); if( !defined( $path ) || ( length( $path ) == 0 ) ) { $self->log_verbose(" no path to prefixify, falling back to default.\n"); return $self->_prefixify_default( $type, $rprefix ); } elsif( !File::Spec->file_name_is_absolute($path) ) { $self->log_verbose(" path is relative, not prefixifying.\n"); } elsif( $path !~ s{^\Q$sprefix\E\b}{}s ) { $self->log_verbose(" cannot prefixify, falling back to default.\n"); return $self->_prefixify_default( $type, $rprefix ); } $self->log_verbose(" now $path in $rprefix\n"); return $path; } sub _prefixify_default { my $self = shift; my $type = shift; my $rprefix = shift; my $default = $self->prefix_relpaths($self->installdirs, $type); if( !$default ) { $self->log_verbose(" no default install location for type '$type', using prefix '$rprefix'.\n"); return $rprefix; } else { return $default; } } sub install_destination { my ($self, $type) = @_; return $self->install_path($type) if $self->install_path($type); if ( $self->install_base ) { my $relpath = $self->install_base_relpaths($type); return $relpath ? File::Spec->catdir($self->install_base, $relpath) : undef; } if ( $self->prefix ) { my $relpath = $self->prefix_relative($type); return $relpath ? File::Spec->catdir($self->prefix, $relpath) : undef; } return $self->install_sets($self->installdirs)->{$type}; } sub install_types { my $self = shift; my %types; if ( $self->install_base ) { %types = %{$self->install_base_relpaths}; } elsif ( $self->prefix ) { %types = %{$self->prefix_relpaths}; } else { %types = %{$self->install_sets($self->installdirs)}; } %types = (%types, %{$self->install_path}); return sort keys %types; } sub install_map { my ($self, $blib) = @_; $blib ||= $self->blib; my( %map, @skipping ); foreach my $type ($self->install_types) { my $localdir = File::Spec->catdir( $blib, $type ); next unless -e $localdir; # the line "...next if (($type eq 'bindoc'..." was one of many changes introduced for # improving HTML generation on ActivePerl, see https://rt.cpan.org/Public/Bug/Display.html?id=53478 # Most changes were ok, but this particular line caused test failures in t/manifypods.t on windows, # therefore it is commented out. # ********* next if (($type eq 'bindoc' || $type eq 'libdoc') && not $self->is_unixish); if (my $dest = $self->install_destination($type)) { $map{$localdir} = $dest; } else { push( @skipping, $type ); } } $self->log_warn( "WARNING: Can't figure out install path for types: @skipping\n" . "Files will not be installed.\n" ) if @skipping; # Write the packlist into the same place as ExtUtils::MakeMaker. if ($self->create_packlist and my $module_name = $self->module_name) { my $archdir = $self->install_destination('arch'); my @ext = split /::/, $module_name; $map{write} = File::Spec->catfile($archdir, 'auto', @ext, '.packlist'); } # Handle destdir if (length(my $destdir = $self->destdir || '')) { foreach (keys %map) { # Need to remove volume from $map{$_} using splitpath, or else # we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux # VMS will always have the file separate than the path. my ($volume, $path, $file) = File::Spec->splitpath( $map{$_}, 0 ); # catdir needs a list of directories, or it will create something # crazy like volume:[Foo.Bar.volume.Baz.Quux] my @dirs = File::Spec->splitdir($path); # First merge the directories $path = File::Spec->catdir($destdir, @dirs); # Then put the file back on if there is one. if ($file ne '') { $map{$_} = File::Spec->catfile($path, $file) } else { $map{$_} = $path; } } } $map{read} = ''; # To keep ExtUtils::Install quiet return \%map; } sub depends_on { my $self = shift; foreach my $action (@_) { $self->_call_action($action); } } sub rscan_dir { my ($self, $dir, $pattern) = @_; my @result; local $_; # find() can overwrite $_, so protect ourselves my $subr = !$pattern ? sub {push @result, $File::Find::name} : !ref($pattern) || (ref $pattern eq 'Regexp') ? sub {push @result, $File::Find::name if /$pattern/} : ref($pattern) eq 'CODE' ? sub {push @result, $File::Find::name if $pattern->()} : die "Unknown pattern type"; File::Find::find({wanted => $subr, no_chdir => 1, preprocess => sub { sort @_ } }, $dir); return \@result; } sub delete_filetree { my $self = shift; my $deleted = 0; foreach (@_) { next unless -e $_; $self->log_verbose("Deleting $_\n"); File::Path::rmtree($_, 0, 0); die "Couldn't remove '$_': $!\n" if -e $_; $deleted++; } return $deleted; } sub autosplit_file { my ($self, $file, $to) = @_; require AutoSplit; my $dir = File::Spec->catdir($to, 'lib', 'auto'); AutoSplit::autosplit($file, $dir); } sub cbuilder { # Returns a CBuilder object my $self = shift; my $s = $self->{stash}; return $s->{_cbuilder} if $s->{_cbuilder}; require ExtUtils::CBuilder; return $s->{_cbuilder} = ExtUtils::CBuilder->new( config => $self->config, ($self->quiet ? (quiet => 1 ) : ()), ); } sub have_c_compiler { my ($self) = @_; my $p = $self->{properties}; return $p->{_have_c_compiler} if defined $p->{_have_c_compiler}; $self->log_verbose("Checking if compiler tools configured... "); my $b = $self->cbuilder; my $have = $b && eval { $b->have_compiler }; $self->log_verbose($have ? "ok.\n" : "failed.\n"); return $p->{_have_c_compiler} = $have; } sub compile_c { my ($self, $file, %args) = @_; if ( ! $self->have_c_compiler ) { die "Error: no compiler detected to compile '$file'. Aborting\n"; } my $b = $self->cbuilder; my $obj_file = $b->object_file($file); $self->add_to_cleanup($obj_file); return $obj_file if $self->up_to_date($file, $obj_file); $b->compile(source => $file, defines => $args{defines}, object_file => $obj_file, include_dirs => $self->include_dirs, extra_compiler_flags => $self->extra_compiler_flags, ); return $obj_file; } sub link_c { my ($self, $spec) = @_; my $p = $self->{properties}; # For convenience $self->add_to_cleanup($spec->{lib_file}); my $objects = $p->{objects} || []; return $spec->{lib_file} if $self->up_to_date([$spec->{obj_file}, @$objects], $spec->{lib_file}); my $module_name = $spec->{module_name} || $self->module_name; $self->cbuilder->link( module_name => $module_name, objects => [$spec->{obj_file}, @$objects], lib_file => $spec->{lib_file}, extra_linker_flags => $self->extra_linker_flags ); return $spec->{lib_file}; } sub compile_xs { my ($self, $file, %args) = @_; $self->log_verbose("$file -> $args{outfile}\n"); if (eval {require ExtUtils::ParseXS; 1}) { ExtUtils::ParseXS::process_file( filename => $file, prototypes => 0, output => $args{outfile}, ); } else { # Ok, I give up. Just use backticks. my $xsubpp = Module::Metadata->find_module_by_name('ExtUtils::xsubpp') or die "Can't find ExtUtils::xsubpp in INC (@INC)"; my @typemaps; push @typemaps, Module::Metadata->find_module_by_name( 'ExtUtils::typemap', \@INC ); my $lib_typemap = Module::Metadata->find_module_by_name( 'typemap', [File::Basename::dirname($file), File::Spec->rel2abs('.')] ); push @typemaps, $lib_typemap if $lib_typemap; @typemaps = map {+'-typemap', $_} @typemaps; my $cf = $self->{config}; my $perl = $self->{properties}{perl}; my @command = ($perl, "-I".$cf->get('installarchlib'), "-I".$cf->get('installprivlib'), $xsubpp, '-noprototypes', @typemaps, $file); $self->log_info("@command\n"); open(my $fh, '>', $args{outfile}) or die "Couldn't write $args{outfile}: $!"; print {$fh} $self->_backticks(@command); close $fh; } } sub split_like_shell { my ($self, $string) = @_; return () unless defined($string); return @$string if ref $string eq 'ARRAY'; $string =~ s/^\s+|\s+$//g; return () unless length($string); return Text::ParseWords::shellwords($string); } sub oneliner { # Returns a string that the shell can evaluate as a perl command. # This should be avoided whenever possible, since "the shell" really # means zillions of shells on zillions of platforms and it's really # hard to get it right all the time. # Some of this code is stolen with permission from ExtUtils::MakeMaker. my($self, $cmd, $switches, $args) = @_; $switches = [] unless defined $switches; $args = [] unless defined $args; # Strip leading and trailing newlines $cmd =~ s{^\n+}{}; $cmd =~ s{\n+$}{}; my $perl = ref($self) ? $self->perl : $self->find_perl_interpreter; return $self->_quote_args($perl, @$switches, '-e', $cmd, @$args); } sub run_perl_script { my ($self, $script, $preargs, $postargs) = @_; foreach ($preargs, $postargs) { $_ = [ $self->split_like_shell($_) ] unless ref(); } return $self->run_perl_command([@$preargs, $script, @$postargs]); } sub run_perl_command { # XXX Maybe we should accept @args instead of $args? Must resolve # this before documenting. my ($self, $args) = @_; $args = [ $self->split_like_shell($args) ] unless ref($args); my $perl = ref($self) ? $self->perl : $self->find_perl_interpreter; # Make sure our local additions to @INC are propagated to the subprocess local $ENV{PERL5LIB} = join $self->config('path_sep'), $self->_added_to_INC; return $self->do_system($perl, @$args); } # Infer various data from the path of the input filename # that is needed to create output files. # The input filename is expected to be of the form: # lib/Module/Name.ext or Module/Name.ext sub _infer_xs_spec { my $self = shift; my $file = shift; my $cf = $self->{config}; my %spec; my( $v, $d, $f ) = File::Spec->splitpath( $file ); my @d = File::Spec->splitdir( $d ); (my $file_base = $f) =~ s/\.[^.]+$//i; $spec{base_name} = $file_base; $spec{src_dir} = File::Spec->catpath( $v, $d, '' ); # the module name shift( @d ) while @d && ($d[0] eq 'lib' || $d[0] eq ''); pop( @d ) while @d && $d[-1] eq ''; $spec{module_name} = join( '::', (@d, $file_base) ); $spec{archdir} = File::Spec->catdir($self->blib, 'arch', 'auto', @d, $file_base); $spec{c_file} = File::Spec->catfile( $spec{src_dir}, "${file_base}.c" ); $spec{obj_file} = File::Spec->catfile( $spec{src_dir}, "${file_base}".$cf->get('obj_ext') ); require DynaLoader; my $modfname = defined &DynaLoader::mod2fname ? DynaLoader::mod2fname([@d, $file_base]) : $file_base; $spec{bs_file} = File::Spec->catfile($spec{archdir}, "$modfname.bs"); $spec{lib_file} = File::Spec->catfile($spec{archdir}, "$modfname.".$cf->get('dlext')); return \%spec; } sub process_xs { my ($self, $file) = @_; my $spec = $self->_infer_xs_spec($file); # File name, minus the suffix (my $file_base = $file) =~ s/\.[^.]+$//; # .xs -> .c $self->add_to_cleanup($spec->{c_file}); unless ($self->up_to_date($file, $spec->{c_file})) { $self->compile_xs($file, outfile => $spec->{c_file}); } # .c -> .o my $v = $self->dist_version; $self->compile_c($spec->{c_file}, defines => {VERSION => qq{"$v"}, XS_VERSION => qq{"$v"}}); # archdir File::Path::mkpath($spec->{archdir}, 0, oct(777)) unless -d $spec->{archdir}; # .xs -> .bs $self->add_to_cleanup($spec->{bs_file}); unless ($self->up_to_date($file, $spec->{bs_file})) { require ExtUtils::Mkbootstrap; $self->log_info("ExtUtils::Mkbootstrap::Mkbootstrap('$spec->{bs_file}')\n"); ExtUtils::Mkbootstrap::Mkbootstrap($spec->{bs_file}); # Original had $BSLOADLIBS - what's that? open(my $fh, '>>', $spec->{bs_file}); # create utime((time)x2, $spec->{bs_file}); # touch } # .o -> .(a|bundle) $self->link_c($spec); } sub do_system { my ($self, @cmd) = @_; $self->log_verbose("@cmd\n"); # Some systems proliferate huge PERL5LIBs, try to ameliorate: my %seen; my $sep = $self->config('path_sep'); local $ENV{PERL5LIB} = ( !exists($ENV{PERL5LIB}) ? '' : length($ENV{PERL5LIB}) < 500 ? $ENV{PERL5LIB} : join $sep, grep { ! $seen{$_}++ and -d $_ } split($sep, $ENV{PERL5LIB}) ); my $status = system(@cmd); if ($status and $! =~ /Argument list too long/i) { my $env_entries = ''; foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " } warn "'Argument list' was 'too long', env lengths are $env_entries"; } return !$status; } sub copy_if_modified { my $self = shift; my %args = (@_ > 3 ? ( @_ ) : ( from => shift, to_dir => shift, flatten => shift ) ); $args{verbose} = !$self->quiet unless exists $args{verbose}; my $file = $args{from}; unless (defined $file and length $file) { die "No 'from' parameter given to copy_if_modified"; } # makes no sense to replicate an absolute path, so assume flatten $args{flatten} = 1 if File::Spec->file_name_is_absolute( $file ); my $to_path; if (defined $args{to} and length $args{to}) { $to_path = $args{to}; } elsif (defined $args{to_dir} and length $args{to_dir}) { $to_path = File::Spec->catfile( $args{to_dir}, $args{flatten} ? File::Basename::basename($file) : $file ); } else { die "No 'to' or 'to_dir' parameter given to copy_if_modified"; } return if $self->up_to_date($file, $to_path); # Already fresh { local $self->{properties}{quiet} = 1; $self->delete_filetree($to_path); # delete destination if exists } # Create parent directories File::Path::mkpath(File::Basename::dirname($to_path), 0, oct(777)); $self->log_verbose("Copying $file -> $to_path\n"); if ($^O eq 'os2') {# copy will not overwrite; 0x1 = overwrite chmod 0666, $to_path; File::Copy::syscopy($file, $to_path, 0x1) or die "Can't copy('$file', '$to_path'): $!"; } else { File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!"; } # mode is read-only + (executable if source is executable) my $mode = oct(444) | ( $self->is_executable($file) ? oct(111) : 0 ); chmod( $mode, $to_path ); return $to_path; } sub up_to_date { my ($self, $source, $derived) = @_; $source = [$source] unless ref $source; $derived = [$derived] unless ref $derived; # empty $derived means $source should always run return 0 if @$source && !@$derived || grep {not -e} @$derived; my $most_recent_source = time / (24*60*60); foreach my $file (@$source) { unless (-e $file) { $self->log_warn("Can't find source file $file for up-to-date check"); next; } $most_recent_source = -M _ if -M _ < $most_recent_source; } foreach my $derived (@$derived) { return 0 if -M $derived > $most_recent_source; } return 1; } sub dir_contains { my ($self, $first, $second) = @_; # File::Spec doesn't have an easy way to check whether one directory # is inside another, unfortunately. ($first, $second) = map File::Spec->canonpath($_), ($first, $second); my @first_dirs = File::Spec->splitdir($first); my @second_dirs = File::Spec->splitdir($second); return 0 if @second_dirs < @first_dirs; my $is_same = ( $self->_case_tolerant ? sub {lc(shift()) eq lc(shift())} : sub {shift() eq shift()} ); while (@first_dirs) { return 0 unless $is_same->(shift @first_dirs, shift @second_dirs); } return 1; } 1; __END__ =head1 NAME Module::Build::Base - Default methods for Module::Build =head1 SYNOPSIS Please see the Module::Build documentation. =head1 DESCRIPTION The C<Module::Build::Base> module defines the core functionality of C<Module::Build>. Its methods may be overridden by any of the platform-dependent modules in the C<Module::Build::Platform::> namespace, but the intention here is to make this base module as platform-neutral as possible. Nicely enough, Perl has several core tools available in the C<File::> namespace for doing this, so the task isn't very difficult. Please see the C<Module::Build> documentation for more details. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 COPYRIGHT Copyright (c) 2001-2006 Ken Williams. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1), Module::Build(3) =cut ConfigData.pm 0000644 00000015272 15204366373 0007121 0 ustar 00 package Module::Build::ConfigData; use strict; my $arrayref = eval do {local $/; <DATA>} or die "Couldn't load ConfigData data: $@"; close DATA; my ($config, $features, $auto_features) = @$arrayref; sub config { $config->{$_[1]} } sub set_config { $config->{$_[1]} = $_[2] } sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0 sub auto_feature_names { sort grep !exists $features->{$_}, keys %$auto_features } sub feature_names { my @features = (sort keys %$features, auto_feature_names()); @features; } sub config_names { sort keys %$config } sub write { my $me = __FILE__; # Can't use Module::Build::Dumper here because M::B is only a # build-time prereq of this module require Data::Dumper; my $mode_orig = (stat $me)[2] & 07777; chmod($mode_orig | 0222, $me); # Make it writeable open(my $fh, '+<', $me) or die "Can't rewrite $me: $!"; seek($fh, 0, 0); while (<$fh>) { last if /^__DATA__$/; } die "Couldn't find __DATA__ token in $me" if eof($fh); seek($fh, tell($fh), 0); my $data = [$config, $features, $auto_features]; print($fh 'do{ my ' . Data::Dumper->new([$data],['x'])->Purity(1)->Dump() . '$x; }' ); truncate($fh, tell($fh)); close $fh; chmod($mode_orig, $me) or warn "Couldn't restore permissions on $me: $!"; } sub feature { my ($package, $key) = @_; return $features->{$key} if exists $features->{$key}; my $info = $auto_features->{$key} or return 0; require Module::Build; # XXX should get rid of this foreach my $type (sort keys %$info) { my $prereqs = $info->{$type}; next if $type eq 'description' || $type eq 'recommends'; foreach my $modname (sort keys %$prereqs) { my $status = Module::Build->check_installed_status($modname, $prereqs->{$modname}); if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; } if ( ! eval "require $modname; 1" ) { return 0; } } } return 1; } =head1 NAME Module::Build::ConfigData - Configuration for Module::Build =head1 SYNOPSIS use Module::Build::ConfigData; $value = Module::Build::ConfigData->config('foo'); $value = Module::Build::ConfigData->feature('bar'); @names = Module::Build::ConfigData->config_names; @names = Module::Build::ConfigData->feature_names; Module::Build::ConfigData->set_config(foo => $new_value); Module::Build::ConfigData->set_feature(bar => $new_value); Module::Build::ConfigData->write; # Save changes =head1 DESCRIPTION This module holds the configuration data for the C<Module::Build> module. It also provides a programmatic interface for getting or setting that configuration data. Note that in order to actually make changes, you'll have to have write access to the C<Module::Build::ConfigData> module, and you should attempt to understand the repercussions of your actions. =head1 METHODS =over 4 =item config($name) Given a string argument, returns the value of the configuration item by that name, or C<undef> if no such item exists. =item feature($name) Given a string argument, returns the value of the feature by that name, or C<undef> if no such feature exists. =item set_config($name, $value) Sets the configuration item with the given name to the given value. The value may be any Perl scalar that will serialize correctly using C<Data::Dumper>. This includes references, objects (usually), and complex data structures. It probably does not include transient things like filehandles or sockets. =item set_feature($name, $value) Sets the feature with the given name to the given boolean value. The value will be converted to 0 or 1 automatically. =item config_names() Returns a list of all the names of config items currently defined in C<Module::Build::ConfigData>, or in scalar context the number of items. =item feature_names() Returns a list of all the names of features currently defined in C<Module::Build::ConfigData>, or in scalar context the number of features. =item auto_feature_names() Returns a list of all the names of features whose availability is dynamically determined, or in scalar context the number of such features. Does not include such features that have later been set to a fixed value. =item write() Commits any changes from C<set_config()> and C<set_feature()> to disk. Requires write access to the C<Module::Build::ConfigData> module. =back =head1 AUTHOR C<Module::Build::ConfigData> was automatically created using C<Module::Build>. C<Module::Build> was written by Ken Williams, but he holds no authorship claim or copyright claim to the contents of C<Module::Build::ConfigData>. =cut __DATA__ do{ my $x = [ {}, {}, { 'HTML_support' => { 'description' => 'Create HTML documentation', 'requires' => { 'Pod::Html' => 0 } }, 'PPM_support' => { 'description' => 'Generate PPM files for distributions' }, 'dist_authoring' => { 'description' => 'Create new distributions', 'recommends' => { 'Module::Signature' => '0.21', 'Pod::Readme' => '0.04' }, 'requires' => { 'Archive::Tar' => '1.09' } }, 'inc_bundling_support' => { 'description' => 'Bundle Module::Build in inc/', 'requires' => { 'ExtUtils::Install' => '1.54', 'ExtUtils::Installed' => '1.999', 'inc::latest' => '0.5' } }, 'license_creation' => { 'description' => 'Create licenses automatically in distributions', 'requires' => { 'Software::License' => '0.103009' } }, 'manpage_support' => { 'description' => 'Create Unix man pages', 'requires' => { 'Pod::Man' => 0 } } } ]; $x; } Config.pm 0000644 00000002116 15204366373 0006320 0 ustar 00 package Module::Build::Config; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Config; sub new { my ($pack, %args) = @_; return bless { stack => {}, values => $args{values} || {}, }, $pack; } sub get { my ($self, $key) = @_; return $self->{values}{$key} if ref($self) && exists $self->{values}{$key}; return $Config{$key}; } sub set { my ($self, $key, $val) = @_; $self->{values}{$key} = $val; } sub push { my ($self, $key, $val) = @_; push @{$self->{stack}{$key}}, $self->{values}{$key} if exists $self->{values}{$key}; $self->{values}{$key} = $val; } sub pop { my ($self, $key) = @_; my $val = delete $self->{values}{$key}; if ( exists $self->{stack}{$key} ) { $self->{values}{$key} = pop @{$self->{stack}{$key}}; delete $self->{stack}{$key} unless @{$self->{stack}{$key}}; } return $val; } sub values_set { my $self = shift; return undef unless ref($self); return $self->{values}; } sub all_config { my $self = shift; my $v = ref($self) ? $self->{values} : {}; return {%Config, %$v}; } 1; Dumper.pm 0000644 00000000706 15204366373 0006352 0 ustar 00 package Module::Build::Dumper; use strict; use warnings; our $VERSION = '0.4224'; # This is just a split-out of a wrapper function to do Data::Dumper # stuff "the right way". See: # http://groups.google.com/group/perl.module.build/browse_thread/thread/c8065052b2e0d741 use Data::Dumper; sub _data_dump { my ($self, $data) = @_; return ("do{ my " . Data::Dumper->new([$data],['x'])->Purity(1)->Terse(0)->Sortkeys(1)->Dump() . '$x; }') } 1; Bundling.pod 0000644 00000011764 15204366373 0007034 0 ustar 00 =head1 NAME Module::Build::Bundling - How to bundle Module::Build with a distribution =head1 SYNOPSIS # Build.PL use inc::latest 'Module::Build'; Module::Build->new( module_name => 'Foo::Bar', license => 'perl', )->create_build_script; =head1 DESCRIPTION B<WARNING -- THIS IS AN EXPERIMENTAL FEATURE> In order to install a distribution using Module::Build, users must have Module::Build available on their systems. There are two ways to do this. The first way is to include Module::Build in the C<configure_requires> metadata field. This field is supported by recent versions L<CPAN> and L<CPANPLUS> and is a standard feature in the Perl core as of Perl 5.10.1. Module::Build now adds itself to C<configure_requires> by default. The second way supports older Perls that have not upgraded CPAN or CPANPLUS and involves bundling an entire copy of Module::Build into the distribution's C<inc/> directory. This is the same approach used by L<Module::Install>, a modern wrapper around ExtUtils::MakeMaker for Makefile.PL based distributions. The "trick" to making this work for Module::Build is making sure the highest version Module::Build is used, whether this is in C<inc/> or already installed on the user's system. This ensures that all necessary features are available as well as any new bug fixes. This is done using the experimental L<inc::latest> module, available on CPAN. A "normal" Build.PL looks like this (with only the minimum required fields): use Module::Build; Module::Build->new( module_name => 'Foo::Bar', license => 'perl', )->create_build_script; A "bundling" Build.PL replaces the initial "use" line with a nearly transparent replacement: use inc::latest 'Module::Build'; Module::Build->new( module_name => 'Foo::Bar', license => 'perl', )->create_build_script; For I<authors>, when "Build dist" is run, Module::Build will be automatically bundled into C<inc> according to the rules for L<inc::latest>. For I<users>, inc::latest will load the latest Module::Build, whether installed or bundled in C<inc/>. =head1 BUNDLING OTHER CONFIGURATION DEPENDENCIES The same approach works for other configuration dependencies -- modules that I<must> be available for Build.PL to run. All other dependencies can be specified as usual in the Build.PL and CPAN or CPANPLUS will install them after Build.PL finishes. For example, to bundle the L<Devel::AssertOS::Unix> module (which ensures a "Unix-like" operating system), one could do this: use inc::latest 'Devel::AssertOS::Unix'; use inc::latest 'Module::Build'; Module::Build->new( module_name => 'Foo::Bar', license => 'perl', )->create_build_script; The C<inc::latest> module creates bundled directories based on the packlist file of an installed distribution. Even though C<inc::latest> takes module name arguments, it is better to think of it as bundling and making available entire I<distributions>. When a module is loaded through C<inc::latest>, it looks in all bundled distributions in C<inc/> for a newer module than can be found in the existing C<@INC> array. Thus, the module-name provided should usually be the "top-level" module name of a distribution, though this is not strictly required. For example, L<Module::Build> has a number of heuristics to map module names to packlists, allowing users to do things like this: use inc::latest 'Devel::AssertOS::Unix'; even though Devel::AssertOS::Unix is contained within the Devel-CheckOS distribution. At the current time, packlists are required. Thus, bundling dual-core modules, I<including Module::Build>, may require a 'forced install' over versions in the latest version of perl in order to create the necessary packlist for bundling. This limitation will hopefully be addressed in a future version of Module::Build. =head2 WARNING -- How to Manage Dependency Chains Before bundling a distribution you must ensure that all prerequisites are also bundled and load in the correct order. For Module::Build itself, this should not be necessary, but it is necessary for any other distribution. (A future release of Module::Build will hopefully address this deficiency.) For example, if you need C<Wibble>, but C<Wibble> depends on C<Wobble>, your Build.PL might look like this: use inc::latest 'Wobble'; use inc::latest 'Wibble'; use inc::latest 'Module::Build'; Module::Build->new( module_name => 'Foo::Bar', license => 'perl', )->create_build_script; Authors are strongly suggested to limit the bundling of additional dependencies if at all possible and to carefully test their distribution tarballs on older versions of Perl before uploading to CPAN. =head1 AUTHOR David Golden <dagolden@cpan.org> Development questions, bug reports, and patches should be sent to the Module-Build mailing list at <module-build@perl.org>. Bug reports are also welcome at <http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build>. =head1 SEE ALSO perl(1), L<inc::latest>, L<Module::Build>(3), L<Module::Build::API>(3), L<Module::Build::Cookbook>(3), =cut # vim: tw=75 Platform/MacOS.pm 0000644 00000006751 15204366373 0007652 0 ustar 00 package Module::Build::Platform::MacOS; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Module::Build::Base; our @ISA = qw(Module::Build::Base); use ExtUtils::Install; sub have_forkpipe { 0 } sub new { my $class = shift; my $self = $class->SUPER::new(@_); # $Config{sitelib} and $Config{sitearch} are, unfortunately, missing. foreach ('sitelib', 'sitearch') { $self->config($_ => $self->config("install$_")) unless $self->config($_); } # For some reason $Config{startperl} is filled with a bunch of crap. (my $sp = $self->config('startperl')) =~ s/.*Exit \{Status\}\s//; $self->config(startperl => $sp); return $self; } sub make_executable { my $self = shift; require MacPerl; foreach (@_) { MacPerl::SetFileInfo('McPL', 'TEXT', $_); } } sub dispatch { my $self = shift; if( !@_ and !@ARGV ) { require MacPerl; # What comes first in the action list. my @action_list = qw(build test install); my %actions = map {+($_, 1)} $self->known_actions; delete @actions{@action_list}; push @action_list, sort { $a cmp $b } keys %actions; my %toolserver = map {+$_ => 1} qw(test disttest diff testdb); foreach (@action_list) { $_ .= ' *' if $toolserver{$_}; } my $cmd = MacPerl::Pick("What build command? ('*' requires ToolServer)", @action_list); return unless defined $cmd; $cmd =~ s/ \*$//; $ARGV[0] = ($cmd); my $args = MacPerl::Ask('Any extra arguments? (ie. verbose=1)', ''); return unless defined $args; push @ARGV, $self->split_like_shell($args); } $self->SUPER::dispatch(@_); } sub ACTION_realclean { my $self = shift; chmod 0666, $self->{properties}{build_script}; $self->SUPER::ACTION_realclean; } # ExtUtils::Install has a hard-coded '.' directory in versions less # than 1.30. We use a sneaky trick to turn that into ':'. # # Note that we do it here in a cross-platform way, so this code could # actually go in Module::Build::Base. But we put it here to be less # intrusive for other platforms. sub ACTION_install { my $self = shift; return $self->SUPER::ACTION_install(@_) if eval {ExtUtils::Install->VERSION('1.30'); 1}; local $^W = 0; # Avoid a 'redefine' warning local *ExtUtils::Install::find = sub { my ($code, @dirs) = @_; @dirs = map { $_ eq '.' ? File::Spec->curdir : $_ } @dirs; return File::Find::find($code, @dirs); }; return $self->SUPER::ACTION_install(@_); } 1; __END__ =head1 NAME Module::Build::Platform::MacOS - Builder class for MacOS platforms =head1 DESCRIPTION The sole purpose of this module is to inherit from C<Module::Build::Base> and override a few methods. Please see L<Module::Build> for the docs. =head2 Overridden Methods =over 4 =item new() MacPerl doesn't define $Config{sitelib} or $Config{sitearch} for some reason, but $Config{installsitelib} and $Config{installsitearch} are there. So we copy the install variables to the other location =item make_executable() On MacOS we set the file type and creator to MacPerl so it will run with a double-click. =item dispatch() Because there's no easy way to say "./Build test" on MacOS, if dispatch is called with no arguments and no @ARGV a dialog box will pop up asking what action to take and any extra arguments. Default action is "test". =item ACTION_realclean() Need to unlock the Build program before deleting. =back =head1 AUTHOR Michael G Schwern <schwern@pobox.com> =head1 SEE ALSO perl(1), Module::Build(3), ExtUtils::MakeMaker(3) =cut Platform/Unix.pm 0000644 00000003361 15204366373 0007625 0 ustar 00 package Module::Build::Platform::Unix; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Module::Build::Base; our @ISA = qw(Module::Build::Base); sub is_executable { # We consider the owner bit to be authoritative on a file, because # -x will always return true if the user is root and *any* # executable bit is set. The -x test seems to try to answer the # question "can I execute this file", but I think we want "is this # file executable". my ($self, $file) = @_; return +(stat $file)[2] & 0100; } sub _startperl { "#! " . shift()->perl } sub _construct { my $self = shift()->SUPER::_construct(@_); # perl 5.8.1-RC[1-3] had some broken %Config entries, and # unfortunately Red Hat 9 shipped it like that. Fix 'em up here. my $c = $self->{config}; for (qw(siteman1 siteman3 vendorman1 vendorman3)) { $c->{"install${_}dir"} ||= $c->{"install${_}"}; } return $self; } # Open group says username should be portable filename characters, # but some Unix OS working with ActiveDirectory wind up with user-names # with back-slashes in the name. The new code below is very liberal # in what it accepts. sub _detildefy { my ($self, $value) = @_; $value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username [$1 ? (eval{(getpwnam $1)[7]} || "~$1") : ($ENV{HOME} || eval{(getpwuid $>)[7]} || glob("~")) ]ex; return $value; } 1; __END__ =head1 NAME Module::Build::Platform::Unix - Builder class for Unix platforms =head1 DESCRIPTION The sole purpose of this module is to inherit from C<Module::Build::Base>. Please see the L<Module::Build> for the docs. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 SEE ALSO perl(1), Module::Build(3), ExtUtils::MakeMaker(3) =cut Platform/Default.pm 0000644 00000001040 15204366373 0010256 0 ustar 00 package Module::Build::Platform::Default; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Module::Build::Base; our @ISA = qw(Module::Build::Base); 1; __END__ =head1 NAME Module::Build::Platform::Default - Stub class for unknown platforms =head1 DESCRIPTION The sole purpose of this module is to inherit from C<Module::Build::Base>. Please see the L<Module::Build> for the docs. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 SEE ALSO perl(1), Module::Build(3), ExtUtils::MakeMaker(3) =cut Platform/cygwin.pm 0000644 00000002132 15204366373 0010175 0 ustar 00 package Module::Build::Platform::cygwin; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; our @ISA = qw(Module::Build::Platform::Unix); sub manpage_separator { '.' } # Copied from ExtUtils::MM_Cygwin::maybe_command() # If our path begins with F</cygdrive/> then we use the Windows version # to determine if it may be a command. Otherwise we use the tests # from C<ExtUtils::MM_Unix>. sub _maybe_command { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i) { require Module::Build::Platform::Windows; return Module::Build::Platform::Windows->_maybe_command($file); } return $self->SUPER::_maybe_command($file); } 1; __END__ =head1 NAME Module::Build::Platform::cygwin - Builder class for Cygwin platform =head1 DESCRIPTION This module provides some routines very specific to the cygwin platform. Please see the L<Module::Build> for the general docs. =head1 AUTHOR Initial stub by Yitzchak Scott-Thoennes <sthoenna@efn.org> =head1 SEE ALSO perl(1), Module::Build(3), ExtUtils::MakeMaker(3) =cut Platform/Windows.pm 0000644 00000017376 15204366373 0010347 0 ustar 00 package Module::Build::Platform::Windows; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Config; use File::Basename; use File::Spec; use Module::Build::Base; our @ISA = qw(Module::Build::Base); sub manpage_separator { return '.'; } sub have_forkpipe { 0 } sub _detildefy { my ($self, $value) = @_; $value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x if $ENV{HOME}; return $value; } sub ACTION_realclean { my ($self) = @_; $self->SUPER::ACTION_realclean(); my $basename = basename($0); $basename =~ s/(?:\.bat)?$//i; if ( lc $basename eq lc $self->build_script ) { if ( $self->build_bat ) { $self->log_verbose("Deleting $basename.bat\n"); my $full_progname = $0; $full_progname =~ s/(?:\.bat)?$/.bat/i; # Voodoo required to have a batch file delete itself without error; # Syntax differs between 9x & NT: the later requires a null arg (???) require Win32; my $null_arg = (Win32::IsWinNT()) ? '""' : ''; my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname"); open(my $fh, '>>', "$basename.bat") or die "Can't create $basename.bat: $!"; print $fh $cmd; close $fh ; } else { $self->delete_filetree($self->build_script . '.bat'); } } } sub make_executable { my $self = shift; $self->SUPER::make_executable(@_); foreach my $script (@_) { # Native batch script if ( $script =~ /\.(bat|cmd)$/ ) { $self->SUPER::make_executable($script); next; # Perl script that needs to be wrapped in a batch script } else { my %opts = (); if ( $script eq $self->build_script ) { $opts{ntargs} = q(-x -S %0 --build_bat %*); $opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9); } my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)}; if ( $@ ) { $self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@"); } else { $self->SUPER::make_executable($out); } } } } # This routine was copied almost verbatim from the 'pl2bat' utility # distributed with perl. It requires too much voodoo with shell quoting # differences and shortcomings between the various flavors of Windows # to reliably shell out sub pl2bat { my $self = shift; my %opts = @_; # NOTE: %0 is already enclosed in doublequotes by cmd.exe, as appropriate $opts{ntargs} = '-x -S %0 %*' unless exists $opts{ntargs}; $opts{otherargs} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $opts{otherargs}; $opts{stripsuffix} = '/\\.plx?/' unless exists $opts{stripsuffix}; $opts{stripsuffix} = ($opts{stripsuffix} =~ m{^/([^/]*[^/\$]|)\$?/?$} ? $1 : "\Q$opts{stripsuffix}\E"); unless (exists $opts{out}) { $opts{out} = $opts{in}; $opts{out} =~ s/$opts{stripsuffix}$//oi; $opts{out} .= '.bat' unless $opts{in} =~ /\.bat$/i or $opts{in} =~ /^-$/; } my $head = <<EOT; \@rem = '--*-Perl-*-- \@echo off if "%OS%" == "Windows_NT" goto WinNT perl $opts{otherargs} goto endofperl :WinNT perl $opts{ntargs} if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl if %errorlevel% == 9009 echo You do not have Perl in your PATH. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul goto endofperl \@rem '; EOT $head =~ s/^\s+//gm; my $headlines = 2 + ($head =~ tr/\n/\n/); my $tail = "\n__END__\n:endofperl\n"; my $linedone = 0; my $taildone = 0; my $linenum = 0; my $skiplines = 0; my $start = $Config{startperl}; $start = "#!perl" unless $start =~ /^#!.*perl/; open(my $in, '<', "$opts{in}") or die "Can't open $opts{in}: $!"; my @file = <$in>; close($in); foreach my $line ( @file ) { $linenum++; if ( $line =~ /^:endofperl\b/ ) { if (!exists $opts{update}) { warn "$opts{in} has already been converted to a batch file!\n"; return; } $taildone++; } if ( not $linedone and $line =~ /^#!.*perl/ ) { if (exists $opts{update}) { $skiplines = $linenum - 1; $line .= "#line ".(1+$headlines)."\n"; } else { $line .= "#line ".($linenum+$headlines)."\n"; } $linedone++; } if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) { $line = ""; } } open(my $out, '>', "$opts{out}") or die "Can't open $opts{out}: $!"; print $out $head; print $out $start, ( $opts{usewarnings} ? " -w" : "" ), "\n#line ", ($headlines+1), "\n" unless $linedone; print $out @file[$skiplines..$#file]; print $out $tail unless $taildone; close($out); return $opts{out}; } sub _quote_args { # Returns a string that can become [part of] a command line with # proper quoting so that the subprocess sees this same list of args. my ($self, @args) = @_; my @quoted; for (@args) { if ( /^[^\s*?!\$<>;|'"\[\]\{\}]+$/ ) { # Looks pretty safe push @quoted, $_; } else { # XXX this will obviously have to improve - is there already a # core module lying around that does proper quoting? s/"/\\"/g; push @quoted, qq("$_"); } } return join " ", @quoted; } sub split_like_shell { # As it turns out, Windows command-parsing is very different from # Unix command-parsing. Double-quotes mean different things, # backslashes don't necessarily mean escapes, and so on. So we # can't use Text::ParseWords::shellwords() to break a command string # into words. The algorithm below was bashed out by Randy and Ken # (mostly Randy), and there are a lot of regression tests, so we # should feel free to adjust if desired. (my $self, local $_) = @_; return @$_ if defined() && ref() eq 'ARRAY'; my @argv; return @argv unless defined() && length(); my $length = length; m/\G\s*/gc; ARGS: until ( pos == $length ) { my $quote_mode; my $arg = ''; CHARS: until ( pos == $length ) { if ( m/\G((?:\\\\)+)(?=\\?(")?)/gc ) { if (defined $2) { $arg .= '\\' x (length($1) / 2); } else { $arg .= $1; } } elsif ( m/\G\\"/gc ) { $arg .= '"'; } elsif ( m/\G"/gc ) { if ( $quote_mode && m/\G"/gc ) { $arg .= '"'; } $quote_mode = !$quote_mode; } elsif ( !$quote_mode && m/\G\s+/gc ) { last; } elsif ( m/\G(.)/sgc ) { $arg .= $1; } } push @argv, $arg; } return @argv; } # system(@cmd) does not like having double-quotes in it on Windows. # So we quote them and run it as a single command. sub do_system { my ($self, @cmd) = @_; my $cmd = $self->_quote_args(@cmd); my $status = system($cmd); if ($status and $! =~ /Argument list too long/i) { my $env_entries = ''; foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " } warn "'Argument list' was 'too long', env lengths are $env_entries"; } return !$status; } # Copied from ExtUtils::MM_Win32 sub _maybe_command { my($self,$file) = @_; my @e = exists($ENV{'PATHEXT'}) ? split(/;/, $ENV{PATHEXT}) : qw(.com .exe .bat .cmd); my $e = ''; for (@e) { $e .= "\Q$_\E|" } chop $e; # see if file ends in one of the known extensions if ($file =~ /($e)$/i) { return $file if -e $file; } else { for (@e) { return "$file$_" if -e "$file$_"; } } return; } 1; __END__ =head1 NAME Module::Build::Platform::Windows - Builder class for Windows platforms =head1 DESCRIPTION The sole purpose of this module is to inherit from C<Module::Build::Base> and override a few methods. Please see L<Module::Build> for the docs. =head1 AUTHOR Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org> =head1 SEE ALSO perl(1), Module::Build(3) =cut Platform/VMS.pm 0000644 00000027724 15204366373 0007360 0 ustar 00 package Module::Build::Platform::VMS; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Module::Build::Base; use Config; our @ISA = qw(Module::Build::Base); =head1 NAME Module::Build::Platform::VMS - Builder class for VMS platforms =head1 DESCRIPTION This module inherits from C<Module::Build::Base> and alters a few minor details of its functionality. Please see L<Module::Build> for the general docs. =head2 Overridden Methods =over 4 =item _set_defaults Change $self->{build_script} to 'Build.com' so @Build works. =cut sub _set_defaults { my $self = shift; $self->SUPER::_set_defaults(@_); $self->{properties}{build_script} = 'Build.com'; } =item cull_args '@Build foo' on VMS will not preserve the case of 'foo'. Rather than forcing people to write '@Build "foo"' we'll dispatch case-insensitively. =cut sub cull_args { my $self = shift; my($action, $args) = $self->SUPER::cull_args(@_); my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions; die "Ambiguous action '$action'. Could be one of @possible_actions" if @possible_actions > 1; return ($possible_actions[0], $args); } =item manpage_separator Use '__' instead of '::'. =cut sub manpage_separator { return '__'; } =item prefixify Prefixify taking into account VMS' filepath syntax. =cut # Translated from ExtUtils::MM_VMS::prefixify() sub _catprefix { my($self, $rprefix, $default) = @_; my($rvol, $rdirs) = File::Spec->splitpath($rprefix); if( $rvol ) { return File::Spec->catpath($rvol, File::Spec->catdir($rdirs, $default), '' ) } else { return File::Spec->catdir($rdirs, $default); } } sub _prefixify { my($self, $path, $sprefix, $type) = @_; my $rprefix = $self->prefix; return '' unless defined $path; $self->log_verbose(" prefixify $path from $sprefix to $rprefix\n"); # Translate $(PERLPREFIX) to a real path. $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix; $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix; $self->log_verbose(" rprefix translated to $rprefix\n". " sprefix translated to $sprefix\n"); if( length($path) == 0 ) { $self->log_verbose(" no path to prefixify.\n") } elsif( !File::Spec->file_name_is_absolute($path) ) { $self->log_verbose(" path is relative, not prefixifying.\n"); } elsif( $sprefix eq $rprefix ) { $self->log_verbose(" no new prefix.\n"); } else { my($path_vol, $path_dirs) = File::Spec->splitpath( $path ); my $vms_prefix = $self->config('vms_prefix'); if( $path_vol eq $vms_prefix.':' ) { $self->log_verbose(" $vms_prefix: seen\n"); $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.}; $path = $self->_catprefix($rprefix, $path_dirs); } else { $self->log_verbose(" cannot prefixify.\n"); return $self->prefix_relpaths($self->installdirs, $type); } } $self->log_verbose(" now $path\n"); return $path; } =item _quote_args Command-line arguments (but not the command itself) must be quoted to ensure case preservation. =cut sub _quote_args { # Returns a string that can become [part of] a command line with # proper quoting so that the subprocess sees this same list of args, # or if we get a single arg that is an array reference, quote the # elements of it and return the reference. my ($self, @args) = @_; my $got_arrayref = (scalar(@args) == 1 && ref $args[0] eq 'ARRAY') ? 1 : 0; # Do not quote qualifiers that begin with '/'. map { if (!/^\//) { $_ =~ s/\"/""/g; # escape C<"> by doubling $_ = q(").$_.q("); } } ($got_arrayref ? @{$args[0]} : @args ); return $got_arrayref ? $args[0] : join(' ', @args); } =item have_forkpipe There is no native fork(), so some constructs depending on it are not available. =cut sub have_forkpipe { 0 } =item _backticks Override to ensure that we quote the arguments but not the command. =cut sub _backticks { # The command must not be quoted but the arguments to it must be. my ($self, @cmd) = @_; my $cmd = shift @cmd; my $args = $self->_quote_args(@cmd); return `$cmd $args`; } =item find_command Local an executable program =cut sub find_command { my ($self, $command) = @_; # a lot of VMS executables have a symbol defined # check those first if ( $^O eq 'VMS' ) { require VMS::DCLsym; my $syms = VMS::DCLsym->new; return $command if scalar $syms->getsym( uc $command ); } $self->SUPER::find_command($command); } # _maybe_command copied from ExtUtils::MM_VMS::maybe_command =item _maybe_command (override) Follows VMS naming conventions for executable files. If the name passed in doesn't exactly match an executable file, appends F<.Exe> (or equivalent) to check for executable image, and F<.Com> to check for DCL procedure. If this fails, checks directories in DCL$PATH and finally F<Sys$System:> for an executable file having the name specified, with or without the F<.Exe>-equivalent suffix. =cut sub _maybe_command { my($self,$file) = @_; return $file if -x $file && ! -d _; my(@dirs) = (''); my(@exts) = ('',$Config{'exe_ext'},'.exe','.com'); if ($file !~ m![/:>\]]!) { for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) { my $dir = $ENV{"DCL\$PATH;$i"}; $dir .= ':' unless $dir =~ m%[\]:]$%; push(@dirs,$dir); } push(@dirs,'Sys$System:'); foreach my $dir (@dirs) { my $sysfile = "$dir$file"; foreach my $ext (@exts) { return $file if -x "$sysfile$ext" && ! -d _; } } } return; } =item do_system Override to ensure that we quote the arguments but not the command. =cut sub do_system { # The command must not be quoted but the arguments to it must be. my ($self, @cmd) = @_; $self->log_verbose("@cmd\n"); my $cmd = shift @cmd; my $args = $self->_quote_args(@cmd); return !system("$cmd $args"); } =item oneliner Override to ensure that we do not quote the command. =cut sub oneliner { my $self = shift; my $oneliner = $self->SUPER::oneliner(@_); $oneliner =~ s/^\"\S+\"//; return "MCR $^X $oneliner"; } =item rscan_dir Inherit the standard version but remove dots at end of name. If the extended character set is in effect, do not remove dots from filenames with Unix path delimiters. =cut sub rscan_dir { my ($self, $dir, $pattern) = @_; my $result = $self->SUPER::rscan_dir( $dir, $pattern ); for my $file (@$result) { if (!_efs() && ($file =~ m#/#)) { $file =~ s/\.$//; } } return $result; } =item dist_dir Inherit the standard version but replace embedded dots with underscores because a dot is the directory delimiter on VMS. =cut sub dist_dir { my $self = shift; my $dist_dir = $self->SUPER::dist_dir; $dist_dir =~ s/\./_/g unless _efs(); return $dist_dir; } =item man3page_name Inherit the standard version but chop the extra manpage delimiter off the front if there is one. The VMS version of splitdir('[.foo]') returns '', 'foo'. =cut sub man3page_name { my $self = shift; my $mpname = $self->SUPER::man3page_name( shift ); my $sep = $self->manpage_separator; $mpname =~ s/^$sep//; return $mpname; } =item expand_test_dir Inherit the standard version but relativize the paths as the native glob() doesn't do that for us. =cut sub expand_test_dir { my ($self, $dir) = @_; my @reldirs = $self->SUPER::expand_test_dir( $dir ); for my $eachdir (@reldirs) { my ($v,$d,$f) = File::Spec->splitpath( $eachdir ); my $reldir = File::Spec->abs2rel( File::Spec->catpath( $v, $d, '' ) ); $eachdir = File::Spec->catfile( $reldir, $f ); } return @reldirs; } =item _detildefy The home-grown glob() does not currently handle tildes, so provide limited support here. Expect only UNIX format file specifications for now. =cut sub _detildefy { my ($self, $arg) = @_; # Apparently double ~ are not translated. return $arg if ($arg =~ /^~~/); # Apparently ~ followed by whitespace are not translated. return $arg if ($arg =~ /^~ /); if ($arg =~ /^~/) { my $spec = $arg; # Remove the tilde $spec =~ s/^~//; # Remove any slash following the tilde if present. $spec =~ s#^/##; # break up the paths for the merge my $home = VMS::Filespec::unixify($ENV{HOME}); # In the default VMS mode, the trailing slash is present. # In Unix report mode it is not. The parsing logic assumes that # it is present. $home .= '/' unless $home =~ m#/$#; # Trivial case of just ~ by it self if ($spec eq '') { $home =~ s#/$##; return $home; } my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home); if ($hdir eq '') { # Someone has tampered with $ENV{HOME} # So hfile is probably the directory since this should be # a path. $hdir = $hfile; } my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec); my @hdirs = File::Spec::Unix->splitdir($hdir); my @dirs = File::Spec::Unix->splitdir($dir); unless ($arg =~ m#^~/#) { # There is a home directory after the tilde, but it will already # be present in in @hdirs so we need to remove it by from @dirs. shift @dirs; } my $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs); $arg = File::Spec::Unix->catpath($hvol, $newdirs, $file); } return $arg; } =item find_perl_interpreter On VMS, $^X returns the fully qualified absolute path including version number. It's logically impossible to improve on it for getting the perl we're currently running, and attempting to manipulate it is usually lossy. =cut sub find_perl_interpreter { return VMS::Filespec::vmsify($^X); } =item localize_file_path Convert the file path to the local syntax =cut sub localize_file_path { my ($self, $path) = @_; $path = VMS::Filespec::vmsify($path); $path =~ s/\.\z//; return $path; } =item localize_dir_path Convert the directory path to the local syntax =cut sub localize_dir_path { my ($self, $path) = @_; return VMS::Filespec::vmspath($path); } =item ACTION_clean The home-grown glob() expands a bit too aggressively when given a bare name, so default in a zero-length extension. =cut sub ACTION_clean { my ($self) = @_; foreach my $item (map glob(VMS::Filespec::rmsexpand($_, '.;0')), $self->cleanup) { $self->delete_filetree($item); } } # Need to look up the feature settings. The preferred way is to use the # VMS::Feature module, but that may not be available to dual life modules. my $use_feature; BEGIN { if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { $use_feature = 1; } } # Need to look up the UNIX report mode. This may become a dynamic mode # in the future. sub _unix_rpt { my $unix_rpt; if ($use_feature) { $unix_rpt = VMS::Feature::current("filename_unix_report"); } else { my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; } return $unix_rpt; } # Need to look up the EFS character set mode. This may become a dynamic # mode in the future. sub _efs { my $efs; if ($use_feature) { $efs = VMS::Feature::current("efs_charset"); } else { my $env_efs = $ENV{'DECC$EFS_CHARSET'} || ''; $efs = $env_efs =~ /^[ET1]/i; } return $efs; } =back =head1 AUTHOR Michael G Schwern <schwern@pobox.com> Ken Williams <kwilliams@cpan.org> Craig A. Berry <craigberry@mac.com> =head1 SEE ALSO perl(1), Module::Build(3), ExtUtils::MakeMaker(3) =cut 1; __END__ Platform/VOS.pm 0000644 00000001030 15204366373 0007340 0 ustar 00 package Module::Build::Platform::VOS; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Module::Build::Base; our @ISA = qw(Module::Build::Base); 1; __END__ =head1 NAME Module::Build::Platform::VOS - Builder class for VOS platforms =head1 DESCRIPTION The sole purpose of this module is to inherit from C<Module::Build::Base>. Please see the L<Module::Build> for the docs. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 SEE ALSO perl(1), Module::Build(3), ExtUtils::MakeMaker(3) =cut Platform/darwin.pm 0000644 00000001472 15204366373 0010167 0 ustar 00 package Module::Build::Platform::darwin; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; our @ISA = qw(Module::Build::Platform::Unix); # This class isn't necessary anymore, but we can't delete it, because # some people might still have the old copy in their @INC, containing # code we don't want to execute, so we have to make sure an upgrade # will replace it with this empty subclass. 1; __END__ =head1 NAME Module::Build::Platform::darwin - Builder class for Mac OS X platform =head1 DESCRIPTION This module provides some routines very specific to the Mac OS X platform. Please see the L<Module::Build> for the general docs. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 SEE ALSO perl(1), Module::Build(3), ExtUtils::MakeMaker(3) =cut Platform/aix.pm 0000644 00000001452 15204366373 0007462 0 ustar 00 package Module::Build::Platform::aix; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; our @ISA = qw(Module::Build::Platform::Unix); # This class isn't necessary anymore, but we can't delete it, because # some people might still have the old copy in their @INC, containing # code we don't want to execute, so we have to make sure an upgrade # will replace it with this empty subclass. 1; __END__ =head1 NAME Module::Build::Platform::aix - Builder class for AIX platform =head1 DESCRIPTION This module provides some routines very specific to the AIX platform. Please see the L<Module::Build> for the general docs. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 SEE ALSO perl(1), Module::Build(3), ExtUtils::MakeMaker(3) =cut Platform/os2.pm 0000644 00000001576 15204366373 0007413 0 ustar 00 package Module::Build::Platform::os2; use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; our @ISA = qw(Module::Build::Platform::Unix); sub manpage_separator { '.' } sub have_forkpipe { 0 } # Copied from ExtUtils::MM_OS2::maybe_command sub _maybe_command { my($self,$file) = @_; $file =~ s,[/\\]+,/,g; return $file if -x $file && ! -d _; return "$file.exe" if -x "$file.exe" && ! -d _; return "$file.cmd" if -x "$file.cmd" && ! -d _; return; } 1; __END__ =head1 NAME Module::Build::Platform::os2 - Builder class for OS/2 platform =head1 DESCRIPTION This module provides some routines very specific to the OS/2 platform. Please see the L<Module::Build> for the general docs. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 SEE ALSO perl(1), Module::Build(3), ExtUtils::MakeMaker(3) =cut Authoring.pod 0000644 00000025374 15204366373 0007234 0 ustar 00 =head1 NAME Module::Build::Authoring - Authoring Module::Build modules =head1 DESCRIPTION When creating a C<Build.PL> script for a module, something like the following code will typically be used: use Module::Build; my $build = Module::Build->new ( module_name => 'Foo::Bar', license => 'perl', requires => { 'perl' => '5.6.1', 'Some::Module' => '1.23', 'Other::Module' => '>= 1.2, != 1.5, < 2.0', }, ); $build->create_build_script; A simple module could get away with something as short as this for its C<Build.PL> script: use Module::Build; Module::Build->new( module_name => 'Foo::Bar', license => 'perl', )->create_build_script; The model used by C<Module::Build> is a lot like the C<MakeMaker> metaphor, with the following correspondences: In Module::Build In ExtUtils::MakeMaker --------------------------- ------------------------ Build.PL (initial script) Makefile.PL (initial script) Build (a short perl script) Makefile (a long Makefile) _build/ (saved state info) various config text in the Makefile Any customization can be done simply by subclassing C<Module::Build> and adding a method called (for example) C<ACTION_test>, overriding the default 'test' action. You could also add a method called C<ACTION_whatever>, and then you could perform the action C<Build whatever>. For information on providing compatibility with C<ExtUtils::MakeMaker>, see L<Module::Build::Compat> and L<http://www.makemaker.org/wiki/index.cgi?ModuleBuildConversionGuide>. =head1 STRUCTURE Module::Build creates a class hierarchy conducive to customization. Here is the parent-child class hierarchy in classy ASCII art: /--------------------\ | Your::Parent | (If you subclass Module::Build) \--------------------/ | | /--------------------\ (Doesn't define any functionality | Module::Build | of its own - just figures out what \--------------------/ other modules to load.) | | /-----------------------------------\ (Some values of $^O may | Module::Build::Platform::$^O | define specialized functionality. \-----------------------------------/ Otherwise it's ...::Default, a | pass-through class.) | /--------------------------\ | Module::Build::Base | (Most of the functionality of \--------------------------/ Module::Build is defined here.) =head1 SUBCLASSING Right now, there are two ways to subclass Module::Build. The first way is to create a regular module (in a C<.pm> file) that inherits from Module::Build, and use that module's class instead of using Module::Build directly: ------ in Build.PL: ---------- #!/usr/bin/perl use lib q(/nonstandard/library/path); use My::Builder; # Or whatever you want to call it my $build = My::Builder->new ( module_name => 'Foo::Bar', # All the regular args... license => 'perl', dist_author => 'A N Other <me@here.net.au>', requires => { Carp => 0 } ); $build->create_build_script; This is relatively straightforward, and is the best way to do things if your My::Builder class contains lots of code. The C<create_build_script()> method will ensure that the current value of C<@INC> (including the C</nonstandard/library/path>) is propagated to the Build script, so that My::Builder can be found when running build actions. If you find that you need to C<chdir> into a different directories in your subclass methods or actions, be sure to always return to the original directory (available via the C<base_dir()> method) before returning control to the parent class. This is important to avoid data serialization problems. For very small additions, Module::Build provides a C<subclass()> method that lets you subclass Module::Build more conveniently, without creating a separate file for your module: ------ in Build.PL: ---------- #!/usr/bin/perl use Module::Build; my $class = Module::Build->subclass ( class => 'My::Builder', code => q{ sub ACTION_foo { print "I'm fooing to death!\n"; } }, ); my $build = $class->new ( module_name => 'Foo::Bar', # All the regular args... license => 'perl', dist_author => 'A N Other <me@here.net.au>', requires => { Carp => 0 } ); $build->create_build_script; Behind the scenes, this actually does create a C<.pm> file, since the code you provide must persist after Build.PL is run if it is to be very useful. See also the documentation for the L<Module::Build::API/"subclass()"> method. =head1 PREREQUISITES =head2 Types of prerequisites To specify what versions of other modules are used by this distribution, several types of prerequisites can be defined with the following parameters: =over 3 =item configure_requires Items that must be installed I<before> configuring this distribution (i.e. before running the F<Build.PL> script). This might be a specific minimum version of C<Module::Build> or any other module the F<Build.PL> needs in order to do its stuff. Clients like C<CPAN.pm> or C<CPANPLUS> will be expected to pick C<configure_requires> out of the F<META.yml> file and install these items before running the C<Build.PL>. If no configure_requires is specified, the current version of Module::Build is automatically added to configure_requires. =item build_requires Items that are necessary for building and testing this distribution, but aren't necessary after installation. This can help users who only want to install these items temporarily. It also helps reduce the size of the CPAN dependency graph if everything isn't smooshed into C<requires>. =item requires Items that are necessary for basic functioning. =item recommends Items that are recommended for enhanced functionality, but there are ways to use this distribution without having them installed. You might also think of this as "can use" or "is aware of" or "changes behavior in the presence of". =item test_requires Items that are necessary for testing. =item conflicts Items that can cause problems with this distribution when installed. This is pretty rare. =back =head2 Format of prerequisites The prerequisites are given in a hash reference, where the keys are the module names and the values are version specifiers: requires => { Foo::Module => '2.4', Bar::Module => 0, Ken::Module => '>= 1.2, != 1.5, < 2.0', perl => '5.6.0' }, The above four version specifiers have different effects. The value C<'2.4'> means that B<at least> version 2.4 of C<Foo::Module> must be installed. The value C<0> means that B<any> version of C<Bar::Module> is acceptable, even if C<Bar::Module> doesn't define a version. The more verbose value C<'E<gt>= 1.2, != 1.5, E<lt> 2.0'> means that C<Ken::Module>'s version must be B<at least> 1.2, B<less than> 2.0, and B<not equal to> 1.5. The list of criteria is separated by commas, and all criteria must be satisfied. A special C<perl> entry lets you specify the versions of the Perl interpreter that are supported by your module. The same version dependency-checking semantics are available, except that we also understand perl's new double-dotted version numbers. =head2 XS Extensions Modules which need to compile XS code should list C<ExtUtils::CBuilder> as a C<build_requires> element. =head1 SAVING CONFIGURATION INFORMATION Module::Build provides a very convenient way to save configuration information that your installed modules (or your regression tests) can access. If your Build process calls the C<feature()> or C<config_data()> methods, then a C<Foo::Bar::ConfigData> module will automatically be created for you, where C<Foo::Bar> is the C<module_name> parameter as passed to C<new()>. This module provides access to the data saved by these methods, and a way to update the values. There is also a utility script called C<config_data> distributed with Module::Build that provides a command line interface to this same functionality. See also the generated C<Foo::Bar::ConfigData> documentation, and the C<config_data> script's documentation, for more information. =head1 STARTING MODULE DEVELOPMENT When starting development on a new module, it's rarely worth your time to create a tree of all the files by hand. Some automatic module-creators are available: the oldest is C<h2xs>, which has shipped with perl itself for a long time. Its name reflects the fact that modules were originally conceived of as a way to wrap up a C library (thus the C<h> part) into perl extensions (thus the C<xs> part). These days, C<h2xs> has largely been superseded by modules like C<ExtUtils::ModuleMaker>, and C<Module::Starter>. They have varying degrees of support for C<Module::Build>. =head1 AUTOMATION One advantage of Module::Build is that since it's implemented as Perl methods, you can invoke these methods directly if you want to install a module non-interactively. For instance, the following Perl script will invoke the entire build/install procedure: my $build = Module::Build->new(module_name => 'MyModule'); $build->dispatch('build'); $build->dispatch('test'); $build->dispatch('install'); If any of these steps encounters an error, it will throw a fatal exception. You can also pass arguments as part of the build process: my $build = Module::Build->new(module_name => 'MyModule'); $build->dispatch('build'); $build->dispatch('test', verbose => 1); $build->dispatch('install', sitelib => '/my/secret/place/'); Building and installing modules in this way skips creating the C<Build> script. =head1 MIGRATION Note that if you want to provide both a F<Makefile.PL> and a F<Build.PL> for your distribution, you probably want to add the following to C<WriteMakefile> in your F<Makefile.PL> so that C<MakeMaker> doesn't try to run your F<Build.PL> as a normal F<.PL> file: PL_FILES => {}, You may also be interested in looking at the C<Module::Build::Compat> module, which can automatically create various kinds of F<Makefile.PL> compatibility layers. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> Development questions, bug reports, and patches should be sent to the Module-Build mailing list at <module-build@perl.org>. Bug reports are also welcome at <http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build>. The latest development version is available from the Git repository at <https://github.com/Perl-Toolchain-Gang/Module-Build> =head1 SEE ALSO perl(1), L<Module::Build>(3), L<Module::Build::API>(3), L<Module::Build::Cookbook>(3), L<ExtUtils::MakeMaker>(3), L<YAML>(3) F<META.yml> Specification: L<CPAN::Meta::Spec> L<http://www.dsmit.com/cons/> L<http://search.cpan.org/dist/PerlBuildSystem/> =cut Cookbook.pm 0000644 00000041671 15204366373 0006672 0 ustar 00 package Module::Build::Cookbook; use strict; use warnings; our $VERSION = '0.4224'; =head1 NAME Module::Build::Cookbook - Examples of Module::Build Usage =head1 DESCRIPTION C<Module::Build> isn't conceptually very complicated, but examples are always helpful. The following recipes should help developers and/or installers put together the pieces from the other parts of the documentation. =head1 BASIC RECIPES =head2 Installing modules that use Module::Build In most cases, you can just issue the following commands: perl Build.PL ./Build ./Build test ./Build install There's nothing complicated here - first you're running a script called F<Build.PL>, then you're running a (newly-generated) script called F<Build> and passing it various arguments. The exact commands may vary a bit depending on how you invoke perl scripts on your system. For instance, if you have multiple versions of perl installed, you can install to one particular perl's library directories like so: /usr/bin/perl5.8.1 Build.PL ./Build ./Build test ./Build install If you're on Windows where the current directory is always searched first for scripts, you'll probably do something like this: perl Build.PL Build Build test Build install On the old Mac OS (version 9 or lower) using MacPerl, you can double-click on the F<Build.PL> script to create the F<Build> script, then double-click on the F<Build> script to run its C<build>, C<test>, and C<install> actions. The F<Build> script knows what perl was used to run F<Build.PL>, so you don't need to re-invoke the F<Build> script with the complete perl path each time. If you invoke it with the I<wrong> perl path, you'll get a warning or a fatal error. =head2 Modifying Config.pm values C<Module::Build> relies heavily on various values from perl's C<Config.pm> to do its work. For example, default installation paths are given by C<installsitelib> and C<installvendorman3dir> and friends, C linker & compiler settings are given by C<ld>, C<lddlflags>, C<cc>, C<ccflags>, and so on. I<If you're pretty sure you know what you're doing>, you can tell C<Module::Build> to pretend there are different values in F<Config.pm> than what's really there, by passing arguments for the C<--config> parameter on the command line: perl Build.PL --config cc=gcc --config ld=gcc Inside the C<Build.PL> script the same thing can be accomplished by passing values for the C<config> parameter to C<new()>: my $build = Module::Build->new ( ... config => { cc => 'gcc', ld => 'gcc' }, ... ); In custom build code, the same thing can be accomplished by calling the L<Module::Build/config> method: $build->config( cc => 'gcc' ); # Set $build->config( ld => 'gcc' ); # Set ... my $linker = $build->config('ld'); # Get =head2 Installing modules using the programmatic interface If you need to build, test, and/or install modules from within some other perl code (as opposed to having the user type installation commands at the shell), you can use the programmatic interface. Create a Module::Build object (or an object of a custom Module::Build subclass) and then invoke its C<dispatch()> method to run various actions. my $build = Module::Build->new ( module_name => 'Foo::Bar', license => 'perl', requires => { 'Some::Module' => '1.23' }, ); $build->dispatch('build'); $build->dispatch('test', verbose => 1); $build->dispatch('install'); The first argument to C<dispatch()> is the name of the action, and any following arguments are named parameters. This is the interface we use to test Module::Build itself in the regression tests. =head2 Installing to a temporary directory To create packages for package managers like RedHat's C<rpm> or Debian's C<deb>, you may need to install to a temporary directory first and then create the package from that temporary installation. To do this, specify the C<destdir> parameter to the C<install> action: ./Build install --destdir /tmp/my-package-1.003 This essentially just prepends all the installation paths with the F</tmp/my-package-1.003> directory. =head2 Installing to a non-standard directory To install to a non-standard directory (for example, if you don't have permission to install in the system-wide directories), you can use the C<install_base> or C<prefix> parameters: ./Build install --install_base /foo/bar See L<Module::Build/"INSTALL PATHS"> for a much more complete discussion of how installation paths are determined. =head2 Installing in the same location as ExtUtils::MakeMaker With the introduction of C<--prefix> in Module::Build 0.28 and C<INSTALL_BASE> in C<ExtUtils::MakeMaker> 6.31 its easy to get them both to install to the same locations. First, ensure you have at least version 0.28 of Module::Build installed and 6.31 of C<ExtUtils::MakeMaker>. Prior versions have differing (and in some cases quite strange) installation behaviors. The following installation flags are equivalent between C<ExtUtils::MakeMaker> and C<Module::Build>. MakeMaker Module::Build PREFIX=... --prefix ... INSTALL_BASE=... --install_base ... DESTDIR=... --destdir ... LIB=... --install_path lib=... INSTALLDIRS=... --installdirs ... INSTALLDIRS=perl --installdirs core UNINST=... --uninst ... INC=... --extra_compiler_flags ... POLLUTE=1 --extra_compiler_flags -DPERL_POLLUTE For example, if you are currently installing C<MakeMaker> modules with this command: perl Makefile.PL PREFIX=~ make test make install UNINST=1 You can install into the same location with Module::Build using this: perl Build.PL --prefix ~ ./Build test ./Build install --uninst 1 =head3 C<prefix> vs C<install_base> The behavior of C<prefix> is complicated and depends on how your Perl is configured. The resulting installation locations will vary from machine to machine and even different installations of Perl on the same machine. Because of this, it's difficult to document where C<prefix> will place your modules. In contrast, C<install_base> has predictable, easy to explain installation locations. Now that C<Module::Build> and C<MakeMaker> both have C<install_base> there is little reason to use C<prefix> other than to preserve your existing installation locations. If you are starting a fresh Perl installation we encourage you to use C<install_base>. If you have an existing installation installed via C<prefix>, consider moving it to an installation structure matching C<install_base> and using that instead. =head2 Running a single test file C<Module::Build> supports running a single test, which enables you to track down errors more quickly. Use the following format: ./Build test --test_files t/mytest.t In addition, you may want to run the test in verbose mode to get more informative output: ./Build test --test_files t/mytest.t --verbose 1 I run this so frequently that I define the following shell alias: alias t './Build test --verbose 1 --test_files' So then I can just execute C<t t/mytest.t> to run a single test. =head1 ADVANCED RECIPES =head2 Making a CPAN.pm-compatible distribution New versions of CPAN.pm understand how to use a F<Build.PL> script, but old versions don't. If authors want to help users who have old versions, some form of F<Makefile.PL> should be supplied. The easiest way to accomplish this is to use the C<create_makefile_pl> parameter to C<< Module::Build->new() >> in the C<Build.PL> script, which can create various flavors of F<Makefile.PL> during the C<dist> action. As a best practice, we recommend using the "traditional" style of F<Makefile.PL> unless your distribution has needs that can't be accomplished that way. The C<Module::Build::Compat> module, which is part of C<Module::Build>'s distribution, is responsible for creating these F<Makefile.PL>s. Please see L<Module::Build::Compat> for the details. =head2 Changing the order of the build process The C<build_elements> property specifies the steps C<Module::Build> will take when building a distribution. To change the build order, change the order of the entries in that property: # Process pod files first my @e = @{$build->build_elements}; my ($i) = grep {$e[$_] eq 'pod'} 0..$#e; unshift @e, splice @e, $i, 1; Currently, C<build_elements> has the following default value: [qw( PL support pm xs pod script )] Do take care when altering this property, since there may be non-obvious (and non-documented!) ordering dependencies in the C<Module::Build> code. =head2 Adding new file types to the build process Sometimes you might have extra types of files that you want to install alongside the standard types like F<.pm> and F<.pod> files. For instance, you might have a F<Bar.dat> file containing some data related to the C<Foo::Bar> module and you'd like for it to end up as F<Foo/Bar.dat> somewhere in perl's C<@INC> path so C<Foo::Bar> can access it easily at runtime. The following code from a sample C<Build.PL> file demonstrates how to accomplish this: use Module::Build; my $build = Module::Build->new ( module_name => 'Foo::Bar', ...other stuff here... ); $build->add_build_element('dat'); $build->create_build_script; This will find all F<.dat> files in the F<lib/> directory, copy them to the F<blib/lib/> directory during the C<build> action, and install them during the C<install> action. If your extra files aren't located in the C<lib/> directory in your distribution, you can explicitly say where they are, just as you'd do with F<.pm> or F<.pod> files: use Module::Build; my $build = new Module::Build ( module_name => 'Foo::Bar', dat_files => {'some/dir/Bar.dat' => 'lib/Foo/Bar.dat'}, ...other stuff here... ); $build->add_build_element('dat'); $build->create_build_script; If your extra files actually need to be created on the user's machine, or if they need some other kind of special processing, you'll probably want to subclass C<Module::Build> and create a special method to process them, named C<process_${kind}_files()>: use Module::Build; my $class = Module::Build->subclass(code => <<'EOF'); sub process_dat_files { my $self = shift; ... locate and process *.dat files, ... and create something in blib/lib/ } EOF my $build = $class->new ( module_name => 'Foo::Bar', ...other stuff here... ); $build->add_build_element('dat'); $build->create_build_script; If your extra files don't go in F<lib/> but in some other place, see L<"Adding new elements to the install process"> for how to actually get them installed. Please note that these examples use some capabilities of Module::Build that first appeared in version 0.26. Before that it could still be done, but the simple cases took a bit more work. =head2 Adding new elements to the install process By default, Module::Build creates seven subdirectories of the F<blib> directory during the build process: F<lib>, F<arch>, F<bin>, F<script>, F<bindoc>, F<libdoc>, and F<html> (some of these may be missing or empty if there's nothing to go in them). Anything copied to these directories during the build will eventually be installed during the C<install> action (see L<Module::Build/"INSTALL PATHS">. If you need to create a new custom type of installable element, e.g. C<conf>, then you need to tell Module::Build where things in F<blib/conf/> should be installed. To do this, use the C<install_path> parameter to the C<new()> method: my $build = Module::Build->new ( ...other stuff here... install_path => { conf => $installation_path } ); Or you can call the C<install_path()> method later: $build->install_path(conf => $installation_path); The user may also specify the path on the command line: perl Build.PL --install_path conf=/foo/path/etc The important part, though, is that I<somehow> the install path needs to be set, or else nothing in the F<blib/conf/> directory will get installed, and a runtime error during the C<install> action will result. See also L<"Adding new file types to the build process"> for how to create the stuff in F<blib/conf/> in the first place. =head1 EXAMPLES ON CPAN Several distributions on CPAN are making good use of various features of Module::Build. They can serve as real-world examples for others. =head2 SVN-Notify-Mirror L<http://search.cpan.org/~jpeacock/SVN-Notify-Mirror/> John Peacock, author of the C<SVN-Notify-Mirror> distribution, says: =over 4 =item 1. Using C<auto_features>, I check to see whether two optional modules are available - SVN::Notify::Config and Net::SSH; =item 2. If the S::N::Config module is loaded, I automatically generate test files for it during Build (using the C<PL_files> property). =item 3. If the C<ssh_feature> is available, I ask if the user wishes to perform the ssh tests (since it requires a little preliminary setup); =item 4. Only if the user has C<ssh_feature> and answers yes to the testing, do I generate a test file. I'm sure I could not have handled this complexity with EU::MM, but it was very easy to do with M::B. =back =head2 Modifying an action Sometimes you might need an to have an action, say C<./Build install>, do something unusual. For instance, you might need to change the ownership of a file or do something else peculiar to your application. You can subclass C<Module::Build> on the fly using the C<subclass()> method and override the methods that perform the actions. You may need to read through C<Module::Build::Authoring> and C<Module::Build::API> to find the methods you want to override. All "action" methods are implemented by a method called "ACTION_" followed by the action's name, so here's an example of how it would work for the C<install> action: # Build.PL use Module::Build; my $class = Module::Build->subclass( class => "Module::Build::Custom", code => <<'SUBCLASS' ); sub ACTION_install { my $self = shift; # YOUR CODE HERE $self->SUPER::ACTION_install; } SUBCLASS $class->new( module_name => 'Your::Module', # rest of the usual Module::Build parameters )->create_build_script; =head2 Adding an action You can add a new C<./Build> action simply by writing the method for it in your subclass. Use C<depends_on> to declare that another action must have been run before your action. For example, let's say you wanted to be able to write C<./Build commit> to test your code and commit it to Subversion. # Build.PL use Module::Build; my $class = Module::Build->subclass( class => "Module::Build::Custom", code => <<'SUBCLASS' ); sub ACTION_commit { my $self = shift; $self->depends_on("test"); $self->do_system(qw(svn commit)); } SUBCLASS =head2 Bundling Module::Build Note: This section probably needs an update as the technology improves (see contrib/bundle.pl in the distribution). Suppose you want to use some new-ish features of Module::Build, e.g. newer than the version of Module::Build your users are likely to already have installed on their systems. The first thing you should do is set C<configure_requires> to your minimum version of Module::Build. See L<Module::Build::Authoring>. But not every build system honors C<configure_requires> yet. Here's how you can ship a copy of Module::Build, but still use a newer installed version to take advantage of any bug fixes and upgrades. First, install Module::Build into F<Your-Project/inc/Module-Build>. CPAN will not index anything in the F<inc> directory so this copy will not show up in CPAN searches. cd Module-Build perl Build.PL --install_base /path/to/Your-Project/inc/Module-Build ./Build test ./Build install You should now have all the Module::Build .pm files in F<Your-Project/inc/Module-Build/lib/perl5>. Next, add this to the top of your F<Build.PL>. my $Bundled_MB = 0.30; # or whatever version it was. # Find out what version of Module::Build is installed or fail quietly. # This should be cross-platform. my $Installed_MB = `$^X -e "eval q{require Module::Build; print Module::Build->VERSION} or exit 1"`; # some operating systems put a newline at the end of every print. chomp $Installed_MB; $Installed_MB = 0 if $?; # Use our bundled copy of Module::Build if it's newer than the installed. unshift @INC, "inc/Module-Build/lib/perl5" if $Bundled_MB > $Installed_MB; require Module::Build; And write the rest of your F<Build.PL> normally. Module::Build will remember your change to C<@INC> and use it when you run F<./Build>. In the future, we hope to provide a more automated solution for this scenario; see C<inc/latest.pm> in the Module::Build distribution for one indication of the direction we're moving. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 COPYRIGHT Copyright (c) 2001-2008 Ken Williams. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1), L<Module::Build>(3), L<Module::Build::Authoring>(3), L<Module::Build::API>(3) =cut PPMMaker.pm 0000644 00000010672 15204366373 0006535 0 ustar 00 package Module::Build::PPMMaker; use strict; use warnings; use Config; our $VERSION = '0.4224'; $VERSION = eval $VERSION; # This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a # few tweaks based on the PPD spec at # http://www.xav.com/perl/site/lib/XML/PPD.html # The PPD spec is based on <http://www.w3.org/TR/NOTE-OSD> sub new { my $package = shift; return bless {@_}, $package; } sub make_ppd { my ($self, %args) = @_; my $build = delete $args{build}; my @codebase; if (exists $args{codebase}) { @codebase = ref $args{codebase} ? @{$args{codebase}} : ($args{codebase}); } else { my $distfile = $build->ppm_name . '.tar.gz'; print "Using default codebase '$distfile'\n"; @codebase = ($distfile); } my %dist; foreach my $info (qw(name author abstract version)) { my $method = "dist_$info"; $dist{$info} = $build->$method() or die "Can't determine distribution's $info\n"; } $self->_simple_xml_escape($_) foreach $dist{abstract}, @{$dist{author}}; # TODO: could add <LICENSE HREF=...> tag if we knew what the URLs were for # various licenses my $ppd = <<"PPD"; <SOFTPKG NAME=\"$dist{name}\" VERSION=\"$dist{version}\"> <ABSTRACT>$dist{abstract}</ABSTRACT> @{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]} <IMPLEMENTATION> PPD # We don't include recommended dependencies because PPD has no way # to distinguish them from normal dependencies. We don't include # build_requires dependencies because the PPM installer doesn't # build or test before installing. And obviously we don't include # conflicts either. foreach my $type (qw(requires)) { my $prereq = $build->$type(); foreach my $modname (sort keys %$prereq) { next if $modname eq 'perl'; my $min_version = '0.0'; foreach my $c ($build->_parse_conditions($prereq->{$modname})) { my ($op, $version) = $c =~ /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x; # This is a nasty hack because it fails if there is no >= op if ($op eq '>=') { $min_version = $version; last; } } # PPM4 spec requires a '::' for top level modules $modname .= '::' unless $modname =~ /::/; $ppd .= qq! <REQUIRE NAME="$modname" VERSION="$min_version" />\n!; } } # We only include these tags if this module involves XS, on the # assumption that pure Perl modules will work on any OS. if (keys %{$build->find_xs_files}) { my $perl_version = $self->_ppd_version($build->perl_version); $ppd .= sprintf(<<'EOF', $self->_varchname($build->config) ); <ARCHITECTURE NAME="%s" /> EOF } foreach my $codebase (@codebase) { $self->_simple_xml_escape($codebase); $ppd .= sprintf(<<'EOF', $codebase); <CODEBASE HREF="%s" /> EOF } $ppd .= <<'EOF'; </IMPLEMENTATION> </SOFTPKG> EOF my $ppd_file = "$dist{name}.ppd"; open(my $fh, '>', $ppd_file) or die "Cannot write to $ppd_file: $!"; binmode($fh, ":utf8") if $] >= 5.008 && $Config{useperlio}; print $fh $ppd; close $fh; return $ppd_file; } sub _ppd_version { my ($self, $version) = @_; # generates something like "0,18,0,0" return join ',', (split(/\./, $version), (0)x4)[0..3]; } sub _varchname { # Copied from PPM.pm my ($self, $config) = @_; my $varchname = $config->{archname}; # Append "-5.8" to architecture name for Perl 5.8 and later if ($] >= 5.008) { my $vstring = sprintf "%vd", $^V; $vstring =~ s/\.\d+$//; $varchname .= "-$vstring"; } return $varchname; } { my %escapes = ( "\n" => "\\n", '"' => '"', '&' => '&', '>' => '>', '<' => '<', ); my $rx = join '|', keys %escapes; sub _simple_xml_escape { $_[1] =~ s/($rx)/$escapes{$1}/go; } } 1; __END__ =head1 NAME Module::Build::PPMMaker - Perl Package Manager file creation =head1 SYNOPSIS On the command line, builds a .ppd file: ./Build ppd =head1 DESCRIPTION This package contains the code that builds F<.ppd> "Perl Package Description" files, in support of ActiveState's "Perl Package Manager". Details are here: L<http://aspn.activestate.com/ASPN/Downloads/ActivePerl/PPM/> =head1 AUTHOR Dave Rolsky <autarch@urth.org>, Ken Williams <kwilliams@cpan.org> =head1 COPYRIGHT Copyright (c) 2001-2006 Ken Williams. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1), Module::Build(3) =cut Notes.pm 0000644 00000020170 15204366373 0006203 0 ustar 00 package Module::Build::Notes; # A class for persistent hashes use strict; use warnings; our $VERSION = '0.4224'; $VERSION = eval $VERSION; use Data::Dumper; use Module::Build::Dumper; sub new { my ($class, %args) = @_; my $file = delete $args{file} or die "Missing required parameter 'file' to new()"; my $self = bless { disk => {}, new => {}, file => $file, %args, }, $class; } sub restore { my $self = shift; open(my $fh, '<', $self->{file}) or die "Can't read $self->{file}: $!"; $self->{disk} = eval do {local $/; <$fh>}; die $@ if $@; close $fh; $self->{new} = {}; } sub access { my $self = shift; return $self->read() unless @_; my $key = shift; return $self->read($key) unless @_; my $value = shift; $self->write({ $key => $value }); return $self->read($key); } sub has_data { my $self = shift; return keys %{$self->read()} > 0; } sub exists { my ($self, $key) = @_; return exists($self->{new}{$key}) || exists($self->{disk}{$key}); } sub read { my $self = shift; if (@_) { # Return 1 key as a scalar my $key = shift; return $self->{new}{$key} if exists $self->{new}{$key}; return $self->{disk}{$key}; } # Return all data my $out = (keys %{$self->{new}} ? {%{$self->{disk}}, %{$self->{new}}} : $self->{disk}); return wantarray ? %$out : $out; } sub _same { my ($self, $x, $y) = @_; return 1 if !defined($x) and !defined($y); return 0 if !defined($x) or !defined($y); return $x eq $y; } sub write { my ($self, $href) = @_; $href ||= {}; @{$self->{new}}{ keys %$href } = values %$href; # Merge # Do some optimization to avoid unnecessary writes foreach my $key (keys %{ $self->{new} }) { next if ref $self->{new}{$key}; next if ref $self->{disk}{$key} or !exists $self->{disk}{$key}; delete $self->{new}{$key} if $self->_same($self->{new}{$key}, $self->{disk}{$key}); } if (my $file = $self->{file}) { my ($vol, $dir, $base) = File::Spec->splitpath($file); $dir = File::Spec->catpath($vol, $dir, ''); return unless -e $dir && -d $dir; # The user needs to arrange for this return if -e $file and !keys %{ $self->{new} }; # Nothing to do @{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge $self->_dump($file, $self->{disk}); $self->{new} = {}; } return $self->read; } sub _dump { my ($self, $file, $data) = @_; open(my $fh, '>', $file) or die "Can't create '$file': $!"; print {$fh} Module::Build::Dumper->_data_dump($data); close $fh; } my $orig_template = do { local $/; <DATA> }; close DATA; sub write_config_data { my ($self, %args) = @_; my $template = $orig_template; $template =~ s/NOTES_NAME/$args{config_module}/g; $template =~ s/MODULE_NAME/$args{module}/g; $template =~ s/=begin private\n//; $template =~ s/=end private/=cut/; # strip out private POD markers we use to keep pod from being # recognized for *this* source file $template =~ s{$_\n}{} for '=begin private', '=end private'; open(my $fh, '>', $args{file}) or die "Can't create '$args{file}': $!"; print {$fh} $template; print {$fh} "\n__DATA__\n"; print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]); close $fh; } 1; =head1 NAME Module::Build::Notes - Create persistent distribution configuration modules =head1 DESCRIPTION This module is used internally by Module::Build to create persistent configuration files that can be installed with a distribution. See L<Module::Build::ConfigData> for an example. =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 COPYRIGHT Copyright (c) 2001-2006 Ken Williams. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1), L<Module::Build>(3) =cut __DATA__ package NOTES_NAME; use strict; my $arrayref = eval do {local $/; <DATA>} or die "Couldn't load ConfigData data: $@"; close DATA; my ($config, $features, $auto_features) = @$arrayref; sub config { $config->{$_[1]} } sub set_config { $config->{$_[1]} = $_[2] } sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0 sub auto_feature_names { sort grep !exists $features->{$_}, keys %$auto_features } sub feature_names { my @features = (sort keys %$features, auto_feature_names()); @features; } sub config_names { sort keys %$config } sub write { my $me = __FILE__; # Can't use Module::Build::Dumper here because M::B is only a # build-time prereq of this module require Data::Dumper; my $mode_orig = (stat $me)[2] & 07777; chmod($mode_orig | 0222, $me); # Make it writeable open(my $fh, '+<', $me) or die "Can't rewrite $me: $!"; seek($fh, 0, 0); while (<$fh>) { last if /^__DATA__$/; } die "Couldn't find __DATA__ token in $me" if eof($fh); seek($fh, tell($fh), 0); my $data = [$config, $features, $auto_features]; print($fh 'do{ my ' . Data::Dumper->new([$data],['x'])->Purity(1)->Dump() . '$x; }' ); truncate($fh, tell($fh)); close $fh; chmod($mode_orig, $me) or warn "Couldn't restore permissions on $me: $!"; } sub feature { my ($package, $key) = @_; return $features->{$key} if exists $features->{$key}; my $info = $auto_features->{$key} or return 0; require Module::Build; # XXX should get rid of this foreach my $type (sort keys %$info) { my $prereqs = $info->{$type}; next if $type eq 'description' || $type eq 'recommends'; foreach my $modname (sort keys %$prereqs) { my $status = Module::Build->check_installed_status($modname, $prereqs->{$modname}); if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; } if ( ! eval "require $modname; 1" ) { return 0; } } } return 1; } =begin private =head1 NAME NOTES_NAME - Configuration for MODULE_NAME =head1 SYNOPSIS use NOTES_NAME; $value = NOTES_NAME->config('foo'); $value = NOTES_NAME->feature('bar'); @names = NOTES_NAME->config_names; @names = NOTES_NAME->feature_names; NOTES_NAME->set_config(foo => $new_value); NOTES_NAME->set_feature(bar => $new_value); NOTES_NAME->write; # Save changes =head1 DESCRIPTION This module holds the configuration data for the C<MODULE_NAME> module. It also provides a programmatic interface for getting or setting that configuration data. Note that in order to actually make changes, you'll have to have write access to the C<NOTES_NAME> module, and you should attempt to understand the repercussions of your actions. =head1 METHODS =over 4 =item config($name) Given a string argument, returns the value of the configuration item by that name, or C<undef> if no such item exists. =item feature($name) Given a string argument, returns the value of the feature by that name, or C<undef> if no such feature exists. =item set_config($name, $value) Sets the configuration item with the given name to the given value. The value may be any Perl scalar that will serialize correctly using C<Data::Dumper>. This includes references, objects (usually), and complex data structures. It probably does not include transient things like filehandles or sockets. =item set_feature($name, $value) Sets the feature with the given name to the given boolean value. The value will be converted to 0 or 1 automatically. =item config_names() Returns a list of all the names of config items currently defined in C<NOTES_NAME>, or in scalar context the number of items. =item feature_names() Returns a list of all the names of features currently defined in C<NOTES_NAME>, or in scalar context the number of features. =item auto_feature_names() Returns a list of all the names of features whose availability is dynamically determined, or in scalar context the number of such features. Does not include such features that have later been set to a fixed value. =item write() Commits any changes from C<set_config()> and C<set_feature()> to disk. Requires write access to the C<NOTES_NAME> module. =back =head1 AUTHOR C<NOTES_NAME> was automatically created using C<Module::Build>. C<Module::Build> was written by Ken Williams, but he holds no authorship claim or copyright claim to the contents of C<NOTES_NAME>. =end private Compat.pm 0000644 00000044152 15204366373 0006344 0 ustar 00 package Module::Build::Compat; use strict; use warnings; our $VERSION = '0.4224'; use File::Basename (); use File::Spec; use Config; use Module::Build; use Module::Metadata; use version; use Data::Dumper; my %convert_installdirs = ( PERL => 'core', SITE => 'site', VENDOR => 'vendor', ); my %makefile_to_build = ( TEST_VERBOSE => 'verbose', VERBINST => 'verbose', INC => sub { map {(extra_compiler_flags => $_)} Module::Build->split_like_shell(shift) }, POLLUTE => sub { (extra_compiler_flags => '-DPERL_POLLUTE') }, INSTALLDIRS => sub { (installdirs => $convert_installdirs{uc shift()}) }, LIB => sub { my $lib = shift; my %config = ( installprivlib => $lib, installsitelib => $lib, installarchlib => "$lib/$Config{archname}", installsitearch => "$lib/$Config{archname}" ); return map { (config => "$_=$config{$_}") } sort keys %config; }, # Convert INSTALLVENDORLIB and friends. ( map { my $name = $_; $name => sub { my @ret = (config => lc($name) . "=" . shift ); print STDERR "# Converted to @ret\n"; return @ret; } } qw( INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR ) ), # Some names they have in common map {$_, lc($_)} qw(DESTDIR PREFIX INSTALL_BASE UNINST), ); my %macro_to_build = %makefile_to_build; # "LIB=foo make" is not the same as "perl Makefile.PL LIB=foo" delete $macro_to_build{LIB}; sub _merge_prereq { my ($req, $breq) = @_; $req ||= {}; $breq ||= {}; # validate formats for my $p ( $req, $breq ) { for my $k (sort keys %$p) { next if $k eq 'perl'; my $v_obj = eval { version->new($p->{$k}) }; if ( ! defined $v_obj ) { die "A prereq of the form '$p->{$k}' for '$k' is not supported by Module::Build::Compat ( use a simpler version like '0.05' or 'v1.4.25' )\n"; } # It seems like a lot of people trip over "0.1.2" stuff, so we help them here... if ( $v_obj->is_qv ) { my $proper_ver = $v_obj->numify; warn "Dotted-decimal prereq '$p->{$k}' for '$k' is not portable - converting it to '$proper_ver'\n"; $p->{$k} = $proper_ver; } } } # merge my $merge = { %$req }; for my $k ( keys %$breq ) { my $v1 = $merge->{$k} || 0; my $v2 = $breq->{$k}; $merge->{$k} = $v1 > $v2 ? $v1 : $v2; } return %$merge; } sub create_makefile_pl { my ($package, $type, $build, %args) = @_; die "Don't know how to build Makefile.PL of type '$type'" unless $type =~ /^(small|passthrough|traditional)$/; if ($type eq 'passthrough') { $build->log_warn(<<"HERE"); IMPORTANT NOTE: The '$type' style of Makefile.PL is deprecated and may be removed in a future version of Module::Build in favor of the 'configure_requires' property. See Module::Build::Compat documentation for details. HERE } my $fh; if ($args{fh}) { $fh = $args{fh}; } else { $args{file} ||= 'Makefile.PL'; local $build->{properties}{quiet} = 1; $build->delete_filetree($args{file}); open($fh, '>', "$args{file}") or die "Can't write $args{file}: $!"; } print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n"; # Minimum perl version should be specified as "require 5.XXXXXX" in # Makefile.PL my $requires = $build->requires; if ( my $minimum_perl = $requires->{perl} ) { my $min_ver = version->new($minimum_perl)->numify; print {$fh} "require $min_ver;\n"; } # If a *bundled* custom subclass is being used, make sure we add its # directory to @INC. Also, lib.pm always needs paths in Unix format. my $subclass_load = ''; if (ref($build) ne "Module::Build") { my $subclass_dir = $package->subclass_dir($build); if (File::Spec->file_name_is_absolute($subclass_dir)) { my $base_dir = $build->base_dir; if ($build->dir_contains($base_dir, $subclass_dir)) { $subclass_dir = File::Spec->abs2rel($subclass_dir, $base_dir); $subclass_dir = $package->unixify_dir($subclass_dir); $subclass_load = "use lib '$subclass_dir';"; } # Otherwise, leave it the empty string } else { $subclass_dir = $package->unixify_dir($subclass_dir); $subclass_load = "use lib '$subclass_dir';"; } } if ($type eq 'small') { printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build); use Module::Build::Compat 0.02; %s Module::Build::Compat->run_build_pl(args => \@ARGV); require %s; Module::Build::Compat->write_makefile(build_class => '%s'); EOF } elsif ($type eq 'passthrough') { printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build); unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; %s Module::Build::Compat->run_build_pl(args => \@ARGV); my $build_script = 'Build'; $build_script .= '.com' if $^O eq 'VMS'; exit(0) unless(-e $build_script); # cpantesters convention require %s; Module::Build::Compat->write_makefile(build_class => '%s'); EOF } elsif ($type eq 'traditional') { my (%MM_Args, %prereq); if (eval "use Tie::IxHash 1.2; 1") { tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here tie %prereq, 'Tie::IxHash'; # Don't care if it fails here } my %name = ($build->module_name ? (NAME => $build->module_name) : (DISTNAME => $build->dist_name)); my %version = ($build->dist_version_from ? (VERSION_FROM => $build->dist_version_from) : (VERSION => $build->dist_version) ); %MM_Args = (%name, %version); %prereq = _merge_prereq( $build->requires, $build->build_requires ); %prereq = map {$_, $prereq{$_}} sort keys %prereq; delete $prereq{perl}; $MM_Args{PREREQ_PM} = \%prereq; $MM_Args{INSTALLDIRS} = $build->installdirs eq 'core' ? 'perl' : $build->installdirs; $MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files; $MM_Args{PL_FILES} = $build->PL_files || {}; if ($build->recursive_test_files) { $MM_Args{test} = { TESTS => join q{ }, $package->_test_globs($build) }; } local $Data::Dumper::Terse = 1; my $args = Data::Dumper::Dumper(\%MM_Args); $args =~ s/\{(.*)\}/($1)/s; print $fh <<"EOF"; use ExtUtils::MakeMaker; WriteMakefile $args; EOF } } sub _test_globs { my ($self, $build) = @_; return map { File::Spec->catfile($_, '*.t') } @{$build->rscan_dir('t', sub { -d $File::Find::name })}; } sub subclass_dir { my ($self, $build) = @_; return (Module::Metadata->find_module_dir_by_name(ref $build) || File::Spec->catdir($build->config_dir, 'lib')); } sub unixify_dir { my ($self, $path) = @_; return join '/', File::Spec->splitdir($path); } sub makefile_to_build_args { my $class = shift; my @out; foreach my $arg (@_) { next if $arg eq ''; my ($key, $val) = ($arg =~ /^(\w+)=(.+)/ ? ($1, $2) : die "Malformed argument '$arg'"); # Do tilde-expansion if it looks like a tilde prefixed path ( $val ) = Module::Build->_detildefy( $val ) if $val =~ /^~/; if (exists $makefile_to_build{$key}) { my $trans = $makefile_to_build{$key}; push @out, $class->_argvify( ref($trans) ? $trans->($val) : ($trans => $val) ); } elsif (exists $Config{lc($key)}) { push @out, $class->_argvify( config => lc($key) . "=$val" ); } else { # Assume M::B can handle it in lowercase form push @out, $class->_argvify("\L$key" => $val); } } return @out; } sub _argvify { my ($self, @pairs) = @_; my @out; while (@pairs) { my ($k, $v) = splice @pairs, 0, 2; push @out, ("--$k", $v); } return @out; } sub makefile_to_build_macros { my @out; my %config; # must accumulate and return as a hashref foreach my $macro (sort keys %macro_to_build) { my $trans = $macro_to_build{$macro}; # On some platforms (e.g. Cygwin with 'make'), the mere presence # of "EXPORT: FOO" in the Makefile will make $ENV{FOO} defined. # Therefore we check length() too. next unless exists $ENV{$macro} && length $ENV{$macro}; my $val = $ENV{$macro}; my @args = ref($trans) ? $trans->($val) : ($trans => $val); while (@args) { my ($k, $v) = splice(@args, 0, 2); if ( $k eq 'config' ) { if ( $v =~ /^([^=]+)=(.*)$/ ) { $config{$1} = $2; } else { warn "Couldn't parse config '$v'\n"; } } else { push @out, ($k => $v); } } } push @out, (config => \%config) if %config; return @out; } sub run_build_pl { my ($pack, %in) = @_; $in{script} ||= 'Build.PL'; my @args = $in{args} ? $pack->makefile_to_build_args(@{$in{args}}) : (); print "# running $in{script} @args\n"; Module::Build->run_perl_script($in{script}, [], \@args) or die "Couldn't run $in{script}: $!"; } sub fake_makefile { my ($self, %args) = @_; unless (exists $args{build_class}) { warn "Unknown 'build_class', defaulting to 'Module::Build'\n"; $args{build_class} = 'Module::Build'; } my $class = $args{build_class}; my $perl = $class->find_perl_interpreter; # VMS MMS/MMK need to use MCR to run the Perl image. $perl = 'MCR ' . $perl if $self->_is_vms_mms; my $noop = ($class->is_windowsish ? 'rem>nul' : $self->_is_vms_mms ? 'Continue' : 'true'); my $filetype = $class->is_vmsish ? '.COM' : ''; my $Build = 'Build' . $filetype . ' --makefile_env_macros 1'; my $unlink = $class->oneliner('1 while unlink $ARGV[0]', [], [$args{makefile}]); $unlink =~ s/\$/\$\$/g unless $class->is_vmsish; my $maketext = join '', map { "$_=\n" } sort keys %macro_to_build; $maketext .= ($^O eq 'os2' ? "SHELL = sh\n\n" : $^O eq 'MSWin32' && $Config{make} =~ /gmake/ ? "SHELL = $ENV{COMSPEC}\n\n" : "\n\n"); $maketext .= <<"EOF"; all : force_do_it $perl $Build realclean : force_do_it $perl $Build realclean $unlink distclean : force_do_it $perl $Build distclean $unlink force_do_it : @ $noop EOF foreach my $action ($class->known_actions) { next if $action =~ /^(all|distclean|realclean|force_do_it)$/; # Don't double-define $maketext .= <<"EOF"; $action : force_do_it $perl $Build $action EOF } if ($self->_is_vms_mms) { # Roll our own .EXPORT as MMS/MMK don't honor that directive. $maketext .= "\n.FIRST\n\t\@ $noop\n"; for my $macro (sort keys %macro_to_build) { $maketext .= ".IFDEF $macro\n\tDEFINE $macro \"\$($macro)\"\n.ENDIF\n"; } $maketext .= "\n"; } else { $maketext .= "\n.EXPORT : " . join(' ', sort keys %macro_to_build) . "\n\n"; } return $maketext; } sub fake_prereqs { my $file = File::Spec->catfile('_build', 'prereqs'); open(my $fh, '<', "$file") or die "Can't read $file: $!"; my $prereqs = eval do {local $/; <$fh>}; close $fh; my %merged = _merge_prereq( $prereqs->{requires}, $prereqs->{build_requires} ); my @prereq; foreach (sort keys %merged) { next if $_ eq 'perl'; push @prereq, "$_=>q[$merged{$_}]"; } return unless @prereq; return "# PREREQ_PM => { " . join(", ", @prereq) . " }\n\n"; } sub write_makefile { my ($pack, %in) = @_; unless (exists $in{build_class}) { warn "Unknown 'build_class', defaulting to 'Module::Build'\n"; $in{build_class} = 'Module::Build'; } my $class = $in{build_class}; $in{makefile} ||= $pack->_is_vms_mms ? 'Descrip.MMS' : 'Makefile'; open MAKE, "> $in{makefile}" or die "Cannot write $in{makefile}: $!"; print MAKE $pack->fake_prereqs; print MAKE $pack->fake_makefile(%in); close MAKE; } sub _is_vms_mms { return Module::Build->is_vmsish && ($Config{make} =~ m/MM[SK]/i); } 1; __END__ =for :stopwords passthrough =head1 NAME Module::Build::Compat - Compatibility with ExtUtils::MakeMaker =head1 SYNOPSIS # In a Build.PL : use Module::Build; my $build = Module::Build->new ( module_name => 'Foo::Bar', license => 'perl', create_makefile_pl => 'traditional' ); ... =head1 DESCRIPTION Because C<ExtUtils::MakeMaker> has been the standard way to distribute modules for a long time, many tools (CPAN.pm, or your system administrator) may expect to find a working F<Makefile.PL> in every distribution they download from CPAN. If you want to throw them a bone, you can use C<Module::Build::Compat> to automatically generate a F<Makefile.PL> for you, in one of several different styles. C<Module::Build::Compat> also provides some code that helps out the F<Makefile.PL> at runtime. =head1 METHODS =over 4 =item create_makefile_pl($style, $build) Creates a F<Makefile.PL> in the current directory in one of several styles, based on the supplied C<Module::Build> object C<$build>. This is typically controlled by passing the desired style as the C<create_makefile_pl> parameter to C<Module::Build>'s C<new()> method; the F<Makefile.PL> will then be automatically created during the C<distdir> action. The currently supported styles are: =over 4 =item traditional A F<Makefile.PL> will be created in the "traditional" style, i.e. it will use C<ExtUtils::MakeMaker> and won't rely on C<Module::Build> at all. In order to create the F<Makefile.PL>, we'll include the C<requires> and C<build_requires> dependencies as the C<PREREQ_PM> parameter. You don't want to use this style if during the C<perl Build.PL> stage you ask the user questions, or do some auto-sensing about the user's environment, or if you subclass C<Module::Build> to do some customization, because the vanilla F<Makefile.PL> won't do any of that. =item small A small F<Makefile.PL> will be created that passes all functionality through to the F<Build.PL> script in the same directory. The user must already have C<Module::Build> installed in order to use this, or else they'll get a module-not-found error. =item passthrough (DEPRECATED) This is just like the C<small> option above, but if C<Module::Build> is not already installed on the user's system, the script will offer to use C<CPAN.pm> to download it and install it before continuing with the build. This option has been deprecated and may be removed in a future version of Module::Build. Modern CPAN.pm and CPANPLUS will recognize the C<configure_requires> metadata property and install Module::Build before running Build.PL if Module::Build is listed and Module::Build now adds itself to configure_requires by default. Perl 5.10.1 includes C<configure_requires> support. In the future, when C<configure_requires> support is deemed sufficiently widespread, the C<passthrough> style will be removed. =back =item run_build_pl(args => \@ARGV) This method runs the F<Build.PL> script, passing it any arguments the user may have supplied to the C<perl Makefile.PL> command. Because C<ExtUtils::MakeMaker> and C<Module::Build> accept different arguments, this method also performs some translation between the two. C<run_build_pl()> accepts the following named parameters: =over 4 =item args The C<args> parameter specifies the parameters that would usually appear on the command line of the C<perl Makefile.PL> command - typically you'll just pass a reference to C<@ARGV>. =item script This is the filename of the script to run - it defaults to C<Build.PL>. =back =item write_makefile() This method writes a 'dummy' F<Makefile> that will pass all commands through to the corresponding C<Module::Build> actions. C<write_makefile()> accepts the following named parameters: =over 4 =item makefile The name of the file to write - defaults to the string C<Makefile>. =back =back =head1 SCENARIOS So, some common scenarios are: =over 4 =item 1. Just include a F<Build.PL> script (without a F<Makefile.PL> script), and give installation directions in a F<README> or F<INSTALL> document explaining how to install the module. In particular, explain that the user must install C<Module::Build> before installing your module. Note that if you do this, you may make things easier for yourself, but harder for people with older versions of CPAN or CPANPLUS on their system, because those tools generally only understand the F<Makefile.PL>/C<ExtUtils::MakeMaker> way of doing things. =item 2. Include a F<Build.PL> script and a "traditional" F<Makefile.PL>, created either manually or with C<create_makefile_pl()>. Users won't ever have to install C<Module::Build> if they use the F<Makefile.PL>, but they won't get to take advantage of C<Module::Build>'s extra features either. For good measure, of course, test both the F<Makefile.PL> and the F<Build.PL> before shipping. =item 3. Include a F<Build.PL> script and a "pass-through" F<Makefile.PL> built using C<Module::Build::Compat>. This will mean that people can continue to use the "old" installation commands, and they may never notice that it's actually doing something else behind the scenes. It will also mean that your installation process is compatible with older versions of tools like CPAN and CPANPLUS. =back =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 COPYRIGHT Copyright (c) 2001-2006 Ken Williams. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Module::Build>(3), L<ExtUtils::MakeMaker>(3) =cut API.pod 0000644 00000206131 15204366373 0005675 0 ustar 00 =head1 NAME Module::Build::API - API Reference for Module Authors =for :stopwords apache bsd distdir distsign gpl installdirs lgpl mit mozilla packlists =head1 DESCRIPTION I list here some of the most important methods in C<Module::Build>. Normally you won't need to deal with these methods unless you want to subclass C<Module::Build>. But since one of the reasons I created this module in the first place was so that subclassing is possible (and easy), I will certainly write more docs as the interface stabilizes. =head2 CONSTRUCTORS =over 4 =item current() [version 0.20] This method returns a reasonable facsimile of the currently-executing C<Module::Build> object representing the current build. You can use this object to query its L</notes()> method, inquire about installed modules, and so on. This is a great way to share information between different parts of your build process. For instance, you can ask the user a question during C<perl Build.PL>, then use their answer during a regression test: # In Build.PL: my $color = $build->prompt("What is your favorite color?"); $build->notes(color => $color); # In t/colortest.t: use Module::Build; my $build = Module::Build->current; my $color = $build->notes('color'); ... The way the C<current()> method is currently implemented, there may be slight differences between the C<$build> object in Build.PL and the one in C<t/colortest.t>. It is our goal to minimize these differences in future releases of Module::Build, so please report any anomalies you find. One important caveat: in its current implementation, C<current()> will B<NOT> work correctly if you have changed out of the directory that C<Module::Build> was invoked from. =item new() [version 0.03] Creates a new Module::Build object. Arguments to the new() method are listed below. Most arguments are optional, but you must provide either the L</module_name> argument, or L</dist_name> and one of L</dist_version> or L</dist_version_from>. In other words, you must provide enough information to determine both a distribution name and version. =over 4 =item add_to_cleanup [version 0.19] An array reference of files to be cleaned up when the C<clean> action is performed. See also the L<add_to_cleanup()|/"add_to_cleanup(@files)"> method. =item allow_pureperl [version 0.4005] A bool indicating the module is still functional without its xs parts. When an XS module is build with --pureperl_only, it will otherwise fail. =item auto_configure_requires [version 0.34] This parameter determines whether Module::Build will add itself automatically to configure_requires (and build_requires) if Module::Build is not already there. The required version will be the last 'major' release, as defined by the decimal version truncated to two decimal places (e.g. 0.34, instead of 0.3402). The default value is true. =item auto_features [version 0.26] This parameter supports the setting of features (see L</feature($name)>) automatically based on a set of prerequisites. For instance, for a module that could optionally use either MySQL or PostgreSQL databases, you might use C<auto_features> like this: my $build = Module::Build->new ( ...other stuff here... auto_features => { pg_support => { description => "Interface with Postgres databases", requires => { 'DBD::Pg' => 23.3, 'DateTime::Format::Pg' => 0 }, }, mysql_support => { description => "Interface with MySQL databases", requires => { 'DBD::mysql' => 17.9, 'DateTime::Format::MySQL' => 0 }, }, } ); For each feature named, the required prerequisites will be checked, and if there are no failures, the feature will be enabled (set to C<1>). Otherwise the failures will be displayed to the user and the feature will be disabled (set to C<0>). See the documentation for L</requires> for the details of how requirements can be specified. =item autosplit [version 0.04] An optional C<autosplit> argument specifies a file which should be run through the L<AutoSplit::autosplit()|AutoSplit/autosplit> function. If multiple files should be split, the argument may be given as an array of the files to split. In general I don't consider autosplitting a great idea, because it's not always clear that autosplitting achieves its intended performance benefits. It may even harm performance in environments like mod_perl, where as much as possible of a module's code should be loaded during startup. =item build_class [version 0.28] The Module::Build class or subclass to use in the build script. Defaults to "Module::Build" or the class name passed to or created by a call to L</subclass()>. This property is useful if you're writing a custom Module::Build subclass and have a bootstrapping problem--that is, your subclass requires modules that may not be installed when C<perl Build.PL> is executed, but you've listed in L</build_requires> so that they should be available when C<./Build> is executed. =item build_requires [version 0.07] Modules listed in this section are necessary to build and install the given module, but are not necessary for regular usage of it. This is actually an important distinction - it allows for tighter control over the body of installed modules, and facilitates correct dependency checking on binary/packaged distributions of the module. See the documentation for L<Module::Build::Authoring/"PREREQUISITES"> for the details of how requirements can be specified. =item configure_requires [version 0.30] Modules listed in this section must be installed I<before> configuring this distribution (i.e. before running the F<Build.PL> script). This might be a specific minimum version of C<Module::Build> or any other module the F<Build.PL> needs in order to do its stuff. Clients like C<CPAN.pm> or C<CPANPLUS> will be expected to pick C<configure_requires> out of the F<META.yml> file and install these items before running the C<Build.PL>. Module::Build may automatically add itself to configure_requires. See L</auto_configure_requires> for details. See the documentation for L<Module::Build::Authoring/"PREREQUISITES"> for the details of how requirements can be specified. =item test_requires [version 0.4004] Modules listed in this section must be installed before testing the distribution. See the documentation for L<Module::Build::Authoring/"PREREQUISITES"> for the details of how requirements can be specified. =item create_packlist [version 0.28] If true, this parameter tells Module::Build to create a F<.packlist> file during the C<install> action, just like C<ExtUtils::MakeMaker> does. The file is created in a subdirectory of the C<arch> installation location. It is used by some other tools (CPAN, CPANPLUS, etc.) for determining what files are part of an install. The default value is true. This parameter was introduced in Module::Build version 0.2609; previously no packlists were ever created by Module::Build. =item c_source [version 0.04] An optional C<c_source> argument specifies a directory which contains C source files that the rest of the build may depend on. Any C<.c> files in the directory will be compiled to object files. The directory will be added to the search path during the compilation and linking phases of any C or XS files. [version 0.3604] A list of directories can be supplied using an anonymous array reference of strings. =item conflicts [version 0.07] Modules listed in this section conflict in some serious way with the given module. C<Module::Build> (or some higher-level tool) will refuse to install the given module if the given module/version is also installed. See the documentation for L<Module::Build::Authoring/"PREREQUISITES"> for the details of how requirements can be specified. =item create_license [version 0.31] This parameter tells Module::Build to automatically create a F<LICENSE> file at the top level of your distribution, containing the full text of the author's chosen license. This requires C<Software::License> on the author's machine, and further requires that the C<license> parameter specifies a license that it knows about. =item create_makefile_pl [version 0.19] This parameter lets you use C<Module::Build::Compat> during the C<distdir> (or C<dist>) action to automatically create a Makefile.PL for compatibility with C<ExtUtils::MakeMaker>. The parameter's value should be one of the styles named in the L<Module::Build::Compat> documentation. =item create_readme [version 0.22] This parameter tells Module::Build to automatically create a F<README> file at the top level of your distribution. Currently it will simply use C<Pod::Text> (or C<Pod::Readme> if it's installed) on the file indicated by C<dist_version_from> and put the result in the F<README> file. This is by no means the only recommended style for writing a F<README>, but it seems to be one common one used on the CPAN. If you generate a F<README> in this way, it's probably a good idea to create a separate F<INSTALL> file if that information isn't in the generated F<README>. =item dist_abstract [version 0.20] This should be a short description of the distribution. This is used when generating metadata for F<META.yml> and PPD files. If it is not given then C<Module::Build> looks in the POD of the module from which it gets the distribution's version. If it finds a POD section marked "=head1 NAME", then it looks for the first line matching C<\s+-\s+(.+)>, and uses the captured text as the abstract. =item dist_author [version 0.20] This should be something like "John Doe <jdoe@example.com>", or if there are multiple authors, an anonymous array of strings may be specified. This is used when generating metadata for F<META.yml> and PPD files. If this is not specified, then C<Module::Build> looks at the module from which it gets the distribution's version. If it finds a POD section marked "=head1 AUTHOR", then it uses the contents of this section. =item dist_name [version 0.11] Specifies the name for this distribution. Most authors won't need to set this directly, they can use C<module_name> to set C<dist_name> to a reasonable default. However, some agglomerative distributions like C<libwww-perl> or C<bioperl> have names that don't correspond directly to a module name, so C<dist_name> can be set independently. =item dist_suffix [version 0.37] Specifies an optional suffix to include after the version number in the distribution directory (and tarball) name. The only suffix currently recognized by PAUSE is 'TRIAL', which indicates that the distribution should not be indexed. For example: Foo-Bar-1.23-TRIAL.tar.gz This will automatically do the "right thing" depending on C<dist_version> and C<release_status>. When C<dist_version> does not have an underscore and C<release_status> is not 'stable', then C<dist_suffix> will default to 'TRIAL'. Otherwise it will default to the empty string, disabling the suffix. In general, authors should only set this if they B<must> override the default behavior for some particular purpose. =item dist_version [version 0.11] Specifies a version number for the distribution. See L</module_name> or L</dist_version_from> for ways to have this set automatically from a C<$VERSION> variable in a module. One way or another, a version number needs to be set. =item dist_version_from [version 0.11] Specifies a file to look for the distribution version in. Most authors won't need to set this directly, they can use L</module_name> to set it to a reasonable default. The version is extracted from the specified file according to the same rules as L<ExtUtils::MakeMaker> and C<CPAN.pm>. It involves finding the first line that matches the regular expression /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ eval()-ing that line, then checking the value of the C<$VERSION> variable. Quite ugly, really, but all the modules on CPAN depend on this process, so there's no real opportunity to change to something better. If the target file of L</dist_version_from> contains more than one package declaration, the version returned will be the one matching the configured L</module_name>. =item dynamic_config [version 0.07] A boolean flag indicating whether the F<Build.PL> file must be executed, or whether this module can be built, tested and installed solely from consulting its metadata file. The main reason to set this to a true value is that your module performs some dynamic configuration as part of its build/install process. If the flag is omitted, the F<META.yml> spec says that installation tools should treat it as 1 (true), because this is a safer way to behave. Currently C<Module::Build> doesn't actually do anything with this flag - it's up to higher-level tools like C<CPAN.pm> to do something useful with it. It can potentially bring lots of security, packaging, and convenience improvements. =item extra_compiler_flags =item extra_linker_flags [version 0.19] These parameters can contain array references (or strings, in which case they will be split into arrays) to pass through to the compiler and linker phases when compiling/linking C code. For example, to tell the compiler that your code is C++, you might do: my $build = Module::Build->new ( module_name => 'Foo::Bar', extra_compiler_flags => ['-x', 'c++'], ); To link your XS code against glib you might write something like: my $build = Module::Build->new ( module_name => 'Foo::Bar', dynamic_config => 1, extra_compiler_flags => scalar `glib-config --cflags`, extra_linker_flags => scalar `glib-config --libs`, ); =item extra_manify_args [version 0.4006] Any extra arguments to pass to C<< Pod::Man->new() >> when building man pages. One common choice might be C<< utf8 => 1 >> to get Unicode support. =item get_options [version 0.26] You can pass arbitrary command line options to F<Build.PL> or F<Build>, and they will be stored in the Module::Build object and can be accessed via the L</args()> method. However, sometimes you want more flexibility out of your argument processing than this allows. In such cases, use the C<get_options> parameter to pass in a hash reference of argument specifications, and the list of arguments to F<Build.PL> or F<Build> will be processed according to those specifications before they're passed on to C<Module::Build>'s own argument processing. The supported option specification hash keys are: =over 4 =item type The type of option. The types are those supported by Getopt::Long; consult its documentation for a complete list. Typical types are C<=s> for strings, C<+> for additive options, and C<!> for negatable options. If the type is not specified, it will be considered a boolean, i.e. no argument is taken and a value of 1 will be assigned when the option is encountered. =item store A reference to a scalar in which to store the value passed to the option. If not specified, the value will be stored under the option name in the hash returned by the C<args()> method. =item default A default value for the option. If no default value is specified and no option is passed, then the option key will not exist in the hash returned by C<args()>. =back You can combine references to your own variables or subroutines with unreferenced specifications, for which the result will also be stored in the hash returned by C<args()>. For example: my $loud = 0; my $build = Module::Build->new ( module_name => 'Foo::Bar', get_options => { Loud => { store => \$loud }, Dbd => { type => '=s' }, Quantity => { type => '+' }, } ); print STDERR "HEY, ARE YOU LISTENING??\n" if $loud; print "We'll use the ", $build->args('Dbd'), " DBI driver\n"; print "Are you sure you want that many?\n" if $build->args('Quantity') > 2; The arguments for such a specification can be called like so: perl Build.PL --Loud --Dbd=DBD::pg --Quantity --Quantity --Quantity B<WARNING:> Any option specifications that conflict with Module::Build's own options (defined by its properties) will throw an exception. Use capitalized option names to avoid unintended conflicts with future Module::Build options. Consult the Getopt::Long documentation for details on its usage. =item include_dirs [version 0.24] Specifies any additional directories in which to search for C header files. May be given as a string indicating a single directory, or as a list reference indicating multiple directories. =item install_path [version 0.19] You can set paths for individual installable elements by using the C<install_path> parameter: my $build = Module::Build->new ( ...other stuff here... install_path => { lib => '/foo/lib', arch => '/foo/lib/arch', } ); =item installdirs [version 0.19] Determines where files are installed within the normal perl hierarchy as determined by F<Config.pm>. Valid values are: C<core>, C<site>, C<vendor>. The default is C<site>. See L<Module::Build/"INSTALL PATHS"> =item license [version 0.07] Specifies the licensing terms of your distribution. As of Module::Build version 0.36_14, you may use a L<Software::License> subclass name (e.g. 'Apache_2_0') instead of one of the keys below. The legacy list of valid license values include: =over 4 =item apache The distribution is licensed under the Apache License, Version 2.0 (L<http://apache.org/licenses/LICENSE-2.0>). =item apache_1_1 The distribution is licensed under the Apache Software License, Version 1.1 (L<http://apache.org/licenses/LICENSE-1.1>). =item artistic The distribution is licensed under the Artistic License, as specified by the F<Artistic> file in the standard Perl distribution. =item artistic_2 The distribution is licensed under the Artistic 2.0 License (L<http://opensource.org/licenses/artistic-license-2.0.php>.) =item bsd The distribution is licensed under the BSD License (L<http://www.opensource.org/licenses/bsd-license.php>). =item gpl The distribution is licensed under the terms of the GNU General Public License (L<http://www.opensource.org/licenses/gpl-license.php>). =item lgpl The distribution is licensed under the terms of the GNU Lesser General Public License (L<http://www.opensource.org/licenses/lgpl-license.php>). =item mit The distribution is licensed under the MIT License (L<http://opensource.org/licenses/mit-license.php>). =item mozilla The distribution is licensed under the Mozilla Public License. (L<http://opensource.org/licenses/mozilla1.0.php> or L<http://opensource.org/licenses/mozilla1.1.php>) =item open_source The distribution is licensed under some other Open Source Initiative-approved license listed at L<http://www.opensource.org/licenses/>. =item perl The distribution may be copied and redistributed under the same terms as Perl itself (this is by far the most common licensing option for modules on CPAN). This is a dual license, in which the user may choose between either the GPL or the Artistic license. =item restrictive The distribution may not be redistributed without special permission from the author and/or copyright holder. =item unrestricted The distribution is licensed under a license that is B<not> approved by www.opensource.org but that allows distribution without restrictions. =back Note that you must still include the terms of your license in your code and documentation - this field only sets the information that is included in distribution metadata to let automated tools figure out your licensing restrictions. Humans still need something to read. If you choose to provide this field, you should make sure that you keep it in sync with your written documentation if you ever change your licensing terms. You may also use a license type of C<unknown> if you don't wish to specify your terms in the metadata. Also see the C<create_license> parameter. =item meta_add [version 0.28] A hash of key/value pairs that should be added to the F<META.yml> file during the C<distmeta> action. Any existing entries with the same names will be overridden. See the L</"MODULE METADATA"> section for details. =item meta_merge [version 0.28] A hash of key/value pairs that should be merged into the F<META.yml> file during the C<distmeta> action. Any existing entries with the same names will be overridden. The only difference between C<meta_add> and C<meta_merge> is their behavior on hash-valued and array-valued entries: C<meta_add> will completely blow away the existing hash or array value, but C<meta_merge> will merge the supplied data into the existing hash or array value. See the L</"MODULE METADATA"> section for details. =item module_name [version 0.03] The C<module_name> is a shortcut for setting default values of C<dist_name> and C<dist_version_from>, reflecting the fact that the majority of CPAN distributions are centered around one "main" module. For instance, if you set C<module_name> to C<Foo::Bar>, then C<dist_name> will default to C<Foo-Bar> and C<dist_version_from> will default to C<lib/Foo/Bar.pm>. C<dist_version_from> will in turn be used to set C<dist_version>. Setting C<module_name> won't override a C<dist_*> parameter you specify explicitly. =item needs_compiler [version 0.36] The C<needs_compiler> parameter indicates whether a compiler is required to build the distribution. The default is false, unless XS files are found or the C<c_source> parameter is set, in which case it is true. If true, L<ExtUtils::CBuilder> is automatically added to C<build_requires> if needed. For a distribution where a compiler is I<optional>, e.g. a dual XS/pure-Perl distribution, C<needs_compiler> should explicitly be set to a false value. =item PL_files [version 0.06] An optional parameter specifying a set of C<.PL> files in your distribution. These will be run as Perl scripts prior to processing the rest of the files in your distribution with the name of the file they're generating as an argument. They are usually used as templates for creating other files dynamically, so that a file like C<lib/Foo/Bar.pm.PL> might create the file C<lib/Foo/Bar.pm>. The files are specified with the C<.PL> files as hash keys, and the file(s) they generate as hash values, like so: my $build = Module::Build->new ( module_name => 'Foo::Bar', ... PL_files => { 'lib/Foo/Bar.pm.PL' => 'lib/Foo/Bar.pm' }, ); Note that the path specifications are I<always> given in Unix-like format, not in the style of the local system. If your C<.PL> scripts don't create any files, or if they create files with unexpected names, or even if they create multiple files, you can indicate that so that Module::Build can properly handle these created files: PL_files => { 'lib/Foo/Bar.pm.PL' => 'lib/Foo/Bar.pm', 'lib/something.PL' => ['/lib/something', '/lib/else'], 'lib/funny.PL' => [], } Here's an example of a simple PL file. my $output_file = shift; open my $fh, ">", $output_file or die "Can't open $output_file: $!"; print $fh <<'END'; #!/usr/bin/perl print "Hello, world!\n"; END PL files are not installed by default, so its safe to put them in F<lib/> and F<bin/>. =item pm_files [version 0.19] An optional parameter specifying the set of C<.pm> files in this distribution, specified as a hash reference whose keys are the files' locations in the distributions, and whose values are their logical locations based on their package name, i.e. where they would be found in a "normal" Module::Build-style distribution. This parameter is mainly intended to support alternative layouts of files. For instance, if you have an old-style C<MakeMaker> distribution for a module called C<Foo::Bar> and a F<Bar.pm> file at the top level of the distribution, you could specify your layout in your C<Build.PL> like this: my $build = Module::Build->new ( module_name => 'Foo::Bar', ... pm_files => { 'Bar.pm' => 'lib/Foo/Bar.pm' }, ); Note that the values should include C<lib/>, because this is where they would be found in a "normal" Module::Build-style distribution. Note also that the path specifications are I<always> given in Unix-like format, not in the style of the local system. =item pod_files [version 0.19] Just like C<pm_files>, but used for specifying the set of C<.pod> files in your distribution. =item recommends [version 0.08] This is just like the L</requires> argument, except that modules listed in this section aren't essential, just a good idea. We'll just print a friendly warning if one of these modules aren't found, but we'll continue running. If a module is recommended but not required, all tests should still pass if the module isn't installed. This may mean that some tests may be skipped if recommended dependencies aren't present. Automated tools like CPAN.pm should inform the user when recommended modules aren't installed, and it should offer to install them if it wants to be helpful. See the documentation for L<Module::Build::Authoring/"PREREQUISITES"> for the details of how requirements can be specified. =item recursive_test_files [version 0.28] Normally, C<Module::Build> does not search subdirectories when looking for tests to run. When this options is set it will search recursively in all subdirectories of the standard 't' test directory. =item release_status [version 0.37] The CPAN Meta Spec version 2 adds C<release_status> to allow authors to specify how a distribution should be indexed. Consistent with the spec, this parameter can only have one three values: 'stable', 'testing' or 'unstable'. Unless explicitly set by the author, C<release_status> will default to 'stable' unless C<dist_version> contains an underscore, in which case it will default to 'testing'. It is an error to specify a C<release_status> of 'stable' when C<dist_version> contains an underscore character. =item requires [version 0.07] An optional C<requires> argument specifies any module prerequisites that the current module depends on. One note: currently C<Module::Build> doesn't actually I<require> the user to have dependencies installed, it just strongly urges. In the future we may require it. There's also a L</recommends> section for things that aren't absolutely required. Automated tools like CPAN.pm should refuse to install a module if one of its dependencies isn't satisfied, unless a "force" command is given by the user. If the tools are helpful, they should also offer to install the dependencies. A synonym for C<requires> is C<prereq>, to help succour people transitioning from C<ExtUtils::MakeMaker>. The C<requires> term is preferred, but the C<prereq> term will remain valid in future distributions. See the documentation for L<Module::Build::Authoring/"PREREQUISITES"> for the details of how requirements can be specified. =item script_files [version 0.18] An optional parameter specifying a set of files that should be installed as executable Perl scripts when the module is installed. May be given as an array reference of the files, as a hash reference whose keys are the files (and whose values will currently be ignored), as a string giving the name of a directory in which to find scripts, or as a string giving the name of a single script file. The default is to install any scripts found in a F<bin> directory at the top level of the distribution, minus any keys of L<PL_files>. For backward compatibility, you may use the parameter C<scripts> instead of C<script_files>. Please consider this usage deprecated, though it will continue to exist for several version releases. =item share_dir [version 0.36] An optional parameter specifying directories of static data files to be installed as read-only files for use with L<File::ShareDir>. The C<share_dir> property supports both distribution-level and module-level share files. The simplest use of C<share_dir> is to set it to a directory name or an arrayref of directory names containing files to be installed in the distribution-level share directory. share_dir => 'share' Alternatively, if C<share_dir> is a hashref, it may have C<dist> or C<module> keys providing full flexibility in defining how share directories should be installed. share_dir => { dist => [ 'examples', 'more_examples' ], module => { Foo::Templates => ['share/html', 'share/text'], Foo::Config => 'share/config', } } If C<share_dir> is set, then File::ShareDir will automatically be added to the C<requires> hash. =item sign [version 0.16] If a true value is specified for this parameter, L<Module::Signature> will be used (via the 'distsign' action) to create a SIGNATURE file for your distribution during the 'distdir' action, and to add the SIGNATURE file to the MANIFEST (therefore, don't add it yourself). The default value is false. In the future, the default may change to true if you have C<Module::Signature> installed on your system. =item tap_harness_args [version 0.2808_03] An optional parameter specifying parameters to be passed to TAP::Harness when running tests. Must be given as a hash reference of parameters; see the L<TAP::Harness|TAP::Harness> documentation for details. Note that specifying this parameter will implicitly set C<use_tap_harness> to a true value. You must therefore be sure to add TAP::Harness as a requirement for your module in L</build_requires>. =item test_files [version 0.23] An optional parameter specifying a set of files that should be used as C<Test::Harness>-style regression tests to be run during the C<test> action. May be given as an array reference of the files, or as a hash reference whose keys are the files (and whose values will currently be ignored). If the argument is given as a single string (not in an array reference), that string will be treated as a C<glob()> pattern specifying the files to use. The default is to look for a F<test.pl> script in the top-level directory of the distribution, and any files matching the glob pattern C<*.t> in the F<t/> subdirectory. If the C<recursive_test_files> property is true, then the C<t/> directory will be scanned recursively for C<*.t> files. =item use_tap_harness [version 0.2808_03] An optional parameter indicating whether or not to use TAP::Harness for testing rather than Test::Harness. Defaults to false. If set to true, you must therefore be sure to add TAP::Harness as a requirement for your module in L</build_requires>. Implicitly set to a true value if C<tap_harness_args> is specified. =item xs_files [version 0.19] Just like C<pm_files>, but used for specifying the set of C<.xs> files in your distribution. =back =item new_from_context(%args) [version 0.28] When called from a directory containing a F<Build.PL> script (in other words, the base directory of a distribution), this method will run the F<Build.PL> and call C<resume()> to return the resulting C<Module::Build> object to the caller. Any key-value arguments given to C<new_from_context()> are essentially like command line arguments given to the F<Build.PL> script, so for example you could pass C<< verbose => 1 >> to this method to turn on verbosity. =item resume() [version 0.03] You'll probably never call this method directly, it's only called from the auto-generated C<Build> script (and the C<new_from_context> method). The C<new()> method is only called once, when the user runs C<perl Build.PL>. Thereafter, when the user runs C<Build test> or another action, the C<Module::Build> object is created using the C<resume()> method to re-instantiate with the settings given earlier to C<new()>. =item subclass() [version 0.06] This creates a new C<Module::Build> subclass on the fly, as described in the L<Module::Build::Authoring/"SUBCLASSING"> section. The caller must provide either a C<class> or C<code> parameter, or both. The C<class> parameter indicates the name to use for the new subclass, and defaults to C<MyModuleBuilder>. The C<code> parameter specifies Perl code to use as the body of the subclass. =item add_property [version 0.31] package 'My::Build'; use base 'Module::Build'; __PACKAGE__->add_property( 'pedantic' ); __PACKAGE__->add_property( answer => 42 ); __PACKAGE__->add_property( 'epoch', default => sub { time }, check => sub { return 1 if /^\d+$/; shift->property_error( "'$_' is not an epoch time" ); return 0; }, ); Adds a property to a Module::Build class. Properties are those attributes of a Module::Build object which can be passed to the constructor and which have accessors to get and set them. All of the core properties, such as C<module_name> and C<license>, are defined using this class method. The first argument to C<add_property()> is always the name of the property. The second argument can be either a default value for the property, or a list of key/value pairs. The supported keys are: =over =item C<default> The default value. May optionally be specified as a code reference, in which case the return value from the execution of the code reference will be used. If you need the default to be a code reference, just use a code reference to return it, e.g.: default => sub { sub { ... } }, =item C<check> A code reference that checks that a value specified for the property is valid. During the execution of the code reference, the new value will be included in the C<$_> variable. If the value is correct, the C<check> code reference should return true. If the value is not correct, it sends an error message to C<property_error()> and returns false. =back When this method is called, a new property will be installed in the Module::Build class, and an accessor will be built to allow the property to be get or set on the build object. print $build->pedantic, $/; $build->pedantic(0); If the default value is a hash reference, this generates a special-case accessor method, wherein individual key/value pairs may be set or fetched: print "stuff{foo} is: ", $build->stuff( 'foo' ), $/; $build->stuff( foo => 'bar' ); print $build->stuff( 'foo' ), $/; # Outputs "bar" Of course, you can still set the entire hash reference at once, as well: $build->stuff( { foo => 'bar', baz => 'yo' } ); In either case, if a C<check> has been specified for the property, it will be applied to the entire hash. So the check code reference should look something like: check => sub { return 1 if defined $_ && exists $_->{foo}; shift->property_error(qq{Property "stuff" needs "foo"}); return 0; }, =item property_error [version 0.31] =back =head2 METHODS =over 4 =item add_build_element($type) [version 0.26] Adds a new type of entry to the build process. Accepts a single string specifying its type-name. There must also be a method defined to process things of that type, e.g. if you add a build element called C<'foo'>, then you must also define a method called C<process_foo_files()>. See also L<Module::Build::Cookbook/"Adding new file types to the build process">. =item add_to_cleanup(@files) [version 0.03] You may call C<< $self->add_to_cleanup(@patterns) >> to tell C<Module::Build> that certain files should be removed when the user performs the C<Build clean> action. The arguments to the method are patterns suitable for passing to Perl's C<glob()> function, specified in either Unix format or the current machine's native format. It's usually convenient to use Unix format when you hard-code the filenames (e.g. in F<Build.PL>) and the native format when the names are programmatically generated (e.g. in a testing script). I decided to provide a dynamic method of the C<$build> object, rather than just use a static list of files named in the F<Build.PL>, because these static lists can get difficult to manage. I usually prefer to keep the responsibility for registering temporary files close to the code that creates them. =item args() [version 0.26] my $args_href = $build->args; my %args = $build->args; my $arg_value = $build->args($key); $build->args($key, $value); This method is the preferred interface for retrieving the arguments passed via command line options to F<Build.PL> or F<Build>, minus the Module-Build specific options. When called in a scalar context with no arguments, this method returns a reference to the hash storing all of the arguments; in an array context, it returns the hash itself. When passed a single argument, it returns the value stored in the args hash for that option key. When called with two arguments, the second argument is assigned to the args hash under the key passed as the first argument. =item autosplit_file($from, $to) [version 0.28] Invokes the L<AutoSplit> module on the C<$from> file, sending the output to the C<lib/auto> directory inside C<$to>. C<$to> is typically the C<blib/> directory. =item base_dir() [version 0.14] Returns a string containing the root-level directory of this build, i.e. where the C<Build.PL> script and the C<lib> directory can be found. This is usually the same as the current working directory, because the C<Build> script will C<chdir()> into this directory as soon as it begins execution. =item build_requires() [version 0.21] Returns a hash reference indicating the C<build_requires> prerequisites that were passed to the C<new()> method. =item can_action( $action ) Returns a reference to the method that defines C<$action>, or false otherwise. This is handy for actions defined (or maybe not!) in subclasses. [version 0.32_xx] =item cbuilder() [version 0.2809] Returns the internal ExtUtils::CBuilder object that can be used for compiling & linking C code. If no such object is available (e.g. if the system has no compiler installed) an exception will be thrown. =item check_installed_status($module, $version) [version 0.11] This method returns a hash reference indicating whether a version dependency on a certain module is satisfied. The C<$module> argument is given as a string like C<"Data::Dumper"> or C<"perl">, and the C<$version> argument can take any of the forms described in L</requires> above. This allows very fine-grained version checking. The returned hash reference has the following structure: { ok => $whether_the_dependency_is_satisfied, have => $version_already_installed, need => $version_requested, # Same as incoming $version argument message => $informative_error_message, } If no version of C<$module> is currently installed, the C<have> value will be the string C<< "<none>" >>. Otherwise the C<have> value will simply be the version of the installed module. Note that this means that if C<$module> is installed but doesn't define a version number, the C<have> value will be C<undef> - this is why we don't use C<undef> for the case when C<$module> isn't installed at all. This method may be called either as an object method (C<< $build->check_installed_status($module, $version) >>) or as a class method (C<< Module::Build->check_installed_status($module, $version) >>). =item check_installed_version($module, $version) [version 0.05] Like L<check_installed_status()|/"check_installed_status($module, $version)">, but simply returns true or false depending on whether module C<$module> satisfies the dependency C<$version>. If the check succeeds, the return value is the actual version of C<$module> installed on the system. This allows you to do the following: my $installed = $build->check_installed_version('DBI', '1.15'); if ($installed) { print "Congratulations, version $installed of DBI is installed.\n"; } else { die "Sorry, you must install DBI.\n"; } If the check fails, we return false and set C<$@> to an informative error message. If C<$version> is any non-true value (notably zero) and any version of C<$module> is installed, we return true. In this case, if C<$module> doesn't define a version, or if its version is zero, we return the special value "0 but true", which is numerically zero, but logically true. In general you might prefer to use C<check_installed_status> if you need detailed information, or this method if you just need a yes/no answer. =item compare_versions($v1, $op, $v2) [version 0.28] Compares two module versions C<$v1> and C<$v2> using the operator C<$op>, which should be one of Perl's numeric operators like C<!=> or C<< >= >> or the like. We do at least a halfway-decent job of handling versions that aren't strictly numeric, like C<0.27_02>, but exotic stuff will likely cause problems. In the future, the guts of this method might be replaced with a call out to C<version.pm>. =item config($key) =item config($key, $value) =item config() [deprecated] [version 0.22] With a single argument C<$key>, returns the value associated with that key in the C<Config.pm> hash, including any changes the author or user has specified. With C<$key> and C<$value> arguments, sets the value for future callers of C<config($key)>. With no arguments, returns a hash reference containing all such key-value pairs. This usage is deprecated, though, because it's a resource hog and violates encapsulation. =item config_data($name) =item config_data($name => $value) [version 0.26] With a single argument, returns the value of the configuration variable C<$name>. With two arguments, sets the given configuration variable to the given value. The value may be any Perl scalar that's serializable with C<Data::Dumper>. For instance, if you write a module that can use a MySQL or PostgreSQL back-end, you might create configuration variables called C<mysql_connect> and C<postgres_connect>, and set each to an array of connection parameters for C<< DBI->connect() >>. Configuration values set in this way using the Module::Build object will be available for querying during the build/test process and after installation via the generated C<...::ConfigData> module, as C<< ...::ConfigData->config($name) >>. The L<feature()|/"feature($name)"> and C<config_data()> methods represent Module::Build's main support for configuration of installed modules. See also L<Module::Build::Authoring/"SAVING CONFIGURATION INFORMATION">. =item conflicts() [version 0.21] Returns a hash reference indicating the C<conflicts> prerequisites that were passed to the C<new()> method. =item contains_pod($file) [deprecated] [version 0.20] [Deprecated] Please see L<Module::Metadata> instead. Returns true if the given file appears to contain POD documentation. Currently this checks whether the file has a line beginning with '=pod', '=head', or '=item', but the exact semantics may change in the future. =item copy_if_modified(%parameters) [version 0.19] Takes the file in the C<from> parameter and copies it to the file in the C<to> parameter, or the directory in the C<to_dir> parameter, if the file has changed since it was last copied (or if it doesn't exist in the new location). By default the entire directory structure of C<from> will be copied into C<to_dir>; an optional C<flatten> parameter will copy into C<to_dir> without doing so. Returns the path to the destination file, or C<undef> if nothing needed to be copied. Any directories that need to be created in order to perform the copying will be automatically created. The destination file is set to read-only. If the source file has the executable bit set, then the destination file will be made executable. =item create_build_script() [version 0.05] Creates an executable script called C<Build> in the current directory that will be used to execute further user actions. This script is roughly analogous (in function, not in form) to the Makefile created by C<ExtUtils::MakeMaker>. This method also creates some temporary data in a directory called C<_build/>. Both of these will be removed when the C<realclean> action is performed. Among the files created in C<_build/> is a F<_build/prereqs> file containing the set of prerequisites for this distribution, as a hash of hashes. This file may be C<eval()>-ed to obtain the authoritative set of prerequisites, which might be different from the contents of F<META.yml> (because F<Build.PL> might have set them dynamically). But fancy developers take heed: do not put any fancy custom runtime code in the F<_build/prereqs> file, leave it as a static declaration containing only strings and numbers. Similarly, do not alter the structure of the internal C<< $self->{properties}{requires} >> (etc.) data members, because that's where this data comes from. =item current_action() [version 0.28] Returns the name of the currently-running action, such as "build" or "test". This action is not necessarily the action that was originally invoked by the user. For example, if the user invoked the "test" action, current_action() would initially return "test". However, action "test" depends on action "code", so current_action() will return "code" while that dependency is being executed. Once that action has completed, current_action() will again return "test". If you need to know the name of the original action invoked by the user, see L</invoked_action()> below. =item depends_on(@actions) [version 0.28] Invokes the named action or list of actions in sequence. Using this method is preferred to calling the action explicitly because it performs some internal record-keeping, and it ensures that the same action is not invoked multiple times (note: in future versions of Module::Build it's conceivable that this run-only-once mechanism will be changed to something more intelligent). Note that the name of this method is something of a misnomer; it should really be called something like C<invoke_actions_unless_already_invoked()> or something, but for better or worse (perhaps better!) we were still thinking in C<make>-like dependency terms when we created this method. See also L<dispatch()|/"dispatch($action, %args)">. The main distinction between the two is that C<depends_on()> is meant to call an action from inside another action, whereas C<dispatch()> is meant to set the very top action in motion. =item dir_contains($first_dir, $second_dir) [version 0.28] Returns true if the first directory logically contains the second directory. This is just a convenience function because C<File::Spec> doesn't really provide an easy way to figure this out (but C<Path::Class> does...). =item dispatch($action, %args) [version 0.03] Invokes the build action C<$action>. Optionally, a list of options and their values can be passed in. This is equivalent to invoking an action at the command line, passing in a list of options. Custom options that have not been registered must be passed in as a hash reference in a key named "args": $build->dispatch('foo', verbose => 1, args => { my_option => 'value' }); This method is intended to be used to programmatically invoke build actions, e.g. by applications controlling Module::Build-based builds rather than by subclasses. See also L<depends_on()|/"depends_on(@actions)">. The main distinction between the two is that C<depends_on()> is meant to call an action from inside another action, whereas C<dispatch()> is meant to set the very top action in motion. =item dist_dir() [version 0.28] Returns the name of the directory that will be created during the C<dist> action. The name is derived from the C<dist_name> and C<dist_version> properties. =item dist_name() [version 0.21] Returns the name of the current distribution, as passed to the C<new()> method in a C<dist_name> or modified C<module_name> parameter. =item dist_version() [version 0.21] Returns the version of the current distribution, as determined by the C<new()> method from a C<dist_version>, C<dist_version_from>, or C<module_name> parameter. =item do_system($cmd, @args) [version 0.21] This is a fairly simple wrapper around Perl's C<system()> built-in command. Given a command and an array of optional arguments, this method will print the command to C<STDOUT>, and then execute it using Perl's C<system()>. It returns true or false to indicate success or failure (the opposite of how C<system()> works, but more intuitive). Note that if you supply a single argument to C<do_system()>, it will/may be processed by the system's shell, and any special characters will do their special things. If you supply multiple arguments, no shell will get involved and the command will be executed directly. =item extra_compiler_flags() =item extra_compiler_flags(@flags) [version 0.25] Set or retrieve the extra compiler flags. Returns an arrayref of flags. =item extra_linker_flags() =item extra_linker_flags(@flags) [version 0.25] Set or retrieve the extra linker flags. Returns an arrayref of flags. =item feature($name) =item feature($name => $value) [version 0.26] With a single argument, returns true if the given feature is set. With two arguments, sets the given feature to the given boolean value. In this context, a "feature" is any optional functionality of an installed module. For instance, if you write a module that could optionally support a MySQL or PostgreSQL backend, you might create features called C<mysql_support> and C<postgres_support>, and set them to true/false depending on whether the user has the proper databases installed and configured. Features set in this way using the Module::Build object will be available for querying during the build/test process and after installation via the generated C<...::ConfigData> module, as C<< ...::ConfigData->feature($name) >>. The C<feature()> and C<config_data()> methods represent Module::Build's main support for configuration of installed modules. See also L<Module::Build::Authoring/"SAVING CONFIGURATION INFORMATION">. =item fix_shebang_line(@files) [version 0.??] Modify any "shebang" line in the specified files to use the path to the perl executable being used for the current build. Files are modified in-place. The existing shebang line must have a command that contains "C<perl>"; arguments to the command do not count. In particular, this means that the use of C<#!/usr/bin/env perl> will not be changed. For an explanation of shebang lines, see L<http://en.wikipedia.org/wiki/Shebang_%28Unix%29>. =item have_c_compiler() [version 0.21] Returns true if the current system seems to have a working C compiler. We currently determine this by attempting to compile a simple C source file and reporting whether the attempt was successful. =item install_base_relpaths() =item install_base_relpaths($type) =item install_base_relpaths($type => $path) [version 0.28] Set or retrieve the relative paths that are appended to C<install_base> for any installable element. This is useful if you want to set the relative install path for custom build elements. With no argument, it returns a reference to a hash containing all elements and their respective values. This hash should not be modified directly; use the multiple argument below form to change values. The single argument form returns the value associated with the element C<$type>. The multiple argument form allows you to set the paths for element types. C<$value> must be a relative path using Unix-like paths. (A series of directories separated by slashes, e.g. C<foo/bar>.) The return value is a localized path based on C<$value>. Assigning the value C<undef> to an element causes it to be removed. =item install_destination($type) [version 0.28] Returns the directory in which items of type C<$type> (e.g. C<lib>, C<arch>, C<bin>, or anything else returned by the L</install_types()> method) will be installed during the C<install> action. Any settings for C<install_path>, C<install_base>, and C<prefix> are taken into account when determining the return value. =item install_path() =item install_path($type) =item install_path($type => $path) [version 0.28] Set or retrieve paths for specific installable elements. This is useful when you want to examine any explicit install paths specified by the user on the command line, or if you want to set the install path for a specific installable element based on another attribute like C<install_base()>. With no argument, it returns a reference to a hash containing all elements and their respective values. This hash should not be modified directly; use the multiple argument below form to change values. The single argument form returns the value associated with the element C<$type>. The multiple argument form allows you to set the paths for element types. The supplied C<$path> should be an absolute path to install elements of C<$type>. The return value is C<$path>. Assigning the value C<undef> to an element causes it to be removed. =item install_types() [version 0.28] Returns a list of installable types that this build knows about. These types each correspond to the name of a directory in F<blib/>, and the list usually includes items such as C<lib>, C<arch>, C<bin>, C<script>, C<libdoc>, C<bindoc>, and if HTML documentation is to be built, C<libhtml> and C<binhtml>. Other user-defined types may also exist. =item invoked_action() [version 0.28] This is the name of the original action invoked by the user. This value is set when the user invokes F<Build.PL>, the F<Build> script, or programmatically through the L<dispatch()|/"dispatch($action, %args)"> method. It does not change as sub-actions are executed as dependencies are evaluated. To get the name of the currently executing dependency, see L</current_action()> above. =item notes() =item notes($key) =item notes($key => $value) [version 0.20] The C<notes()> value allows you to store your own persistent information about the build, and to share that information among different entities involved in the build. See the example in the C<current()> method. The C<notes()> method is essentially a glorified hash access. With no arguments, C<notes()> returns the entire hash of notes. With one argument, C<notes($key)> returns the value associated with the given key. With two arguments, C<notes($key, $value)> sets the value associated with the given key to C<$value> and returns the new value. The lifetime of the C<notes> data is for "a build" - that is, the C<notes> hash is created when C<perl Build.PL> is run (or when the C<new()> method is run, if the Module::Build Perl API is being used instead of called from a shell), and lasts until C<perl Build.PL> is run again or the C<clean> action is run. =item orig_dir() [version 0.28] Returns a string containing the working directory that was in effect before the F<Build> script chdir()-ed into the C<base_dir>. This might be useful for writing wrapper tools that might need to chdir() back out. =item os_type() [version 0.04] If you're subclassing Module::Build and some code needs to alter its behavior based on the current platform, you may only need to know whether you're running on Windows, Unix, MacOS, VMS, etc., and not the fine-grained value of Perl's C<$^O> variable. The C<os_type()> method will return a string like C<Windows>, C<Unix>, C<MacOS>, C<VMS>, or whatever is appropriate. If you're running on an unknown platform, it will return C<undef> - there shouldn't be many unknown platforms though. =item is_vmsish() =item is_windowsish() =item is_unixish() Convenience functions that return a boolean value indicating whether this platform behaves respectively like VMS, Windows, or Unix. For arbitrary reasons other platforms don't get their own such functions, at least not yet. =item prefix_relpaths() =item prefix_relpaths($installdirs) =item prefix_relpaths($installdirs, $type) =item prefix_relpaths($installdirs, $type => $path) [version 0.28] Set or retrieve the relative paths that are appended to C<prefix> for any installable element. This is useful if you want to set the relative install path for custom build elements. With no argument, it returns a reference to a hash containing all elements and their respective values as defined by the current C<installdirs> setting. With a single argument, it returns a reference to a hash containing all elements and their respective values as defined by C<$installdirs>. The hash returned by the above calls should not be modified directly; use the three-argument below form to change values. The two argument form returns the value associated with the element C<$type>. The multiple argument form allows you to set the paths for element types. C<$value> must be a relative path using Unix-like paths. (A series of directories separated by slashes, e.g. C<foo/bar>.) The return value is a localized path based on C<$value>. Assigning the value C<undef> to an element causes it to be removed. =item get_metadata() [version 0.36] This method returns a hash reference of metadata that can be used to create a YAML datastream. It is provided for authors to override or customize the fields of F<META.yml>. E.g. package My::Builder; use base 'Module::Build'; sub get_metadata { my $self, @args = @_; my $data = $self->SUPER::get_metadata(@args); $data->{custom_field} = 'foo'; return $data; } Valid arguments include: =over =item * C<fatal> -- indicates whether missing required metadata fields should be a fatal error or not. For META creation, it generally should, but for MYMETA creation for end-users, it should not be fatal. =item * C<auto> -- indicates whether any necessary configure_requires should be automatically added. This is used in META creation. =back This method is a wrapper around the old prepare_metadata API now that we no longer use YAML::Node to hold metadata. =item prepare_metadata() [deprecated] [version 0.36] [Deprecated] As of 0.36, authors should use C<get_metadata> instead. This method is preserved for backwards compatibility only. It takes three positional arguments: a hashref (to which metadata will be added), an optional arrayref (to which metadata keys will be added in order if the arrayref exists), and a hashref of arguments (as provided to get_metadata). The latter argument is new as of 0.36. Earlier versions are always fatal on errors. Prior to version 0.36, this method took a YAML::Node as an argument to hold assembled metadata. =item prereq_failures() [version 0.11] Returns a data structure containing information about any failed prerequisites (of any of the types described above), or C<undef> if all prerequisites are met. The data structure returned is a hash reference. The top level keys are the type of prerequisite failed, one of "requires", "build_requires", "conflicts", or "recommends". The associated values are hash references whose keys are the names of required (or conflicting) modules. The associated values of those are hash references indicating some information about the failure. For example: { have => '0.42', need => '0.59', message => 'Version 0.42 is installed, but we need version 0.59', } or { have => '<none>', need => '0.59', message => 'Prerequisite Foo isn't installed', } This hash has the same structure as the hash returned by the C<check_installed_status()> method, except that in the case of "conflicts" dependencies we change the "need" key to "conflicts" and construct a proper message. Examples: # Check a required dependency on Foo::Bar if ( $build->prereq_failures->{requires}{Foo::Bar} ) { ... # Check whether there were any failures if ( $build->prereq_failures ) { ... # Show messages for all failures my $failures = $build->prereq_failures; while (my ($type, $list) = each %$failures) { while (my ($name, $hash) = each %$list) { print "Failure for $name: $hash->{message}\n"; } } =item prereq_data() [version 0.32] Returns a reference to a hash describing all prerequisites. The keys of the hash will be the various prerequisite types ('requires', 'build_requires', 'test_requires', 'configure_requires', 'recommends', or 'conflicts') and the values will be references to hashes of module names and version numbers. Only prerequisites types that are defined will be included. The C<prereq_data> action is just a thin wrapper around the C<prereq_data()> method and dumps the hash as a string that can be loaded using C<eval()>. =item prereq_report() [version 0.28] Returns a human-readable (table-form) string showing all prerequisites, the versions required, and the versions actually installed. This can be useful for reviewing the configuration of your system prior to a build, or when compiling data to send for a bug report. The C<prereq_report> action is just a thin wrapper around the C<prereq_report()> method. =item prompt($message, $default) [version 0.12] Asks the user a question and returns their response as a string. The first argument specifies the message to display to the user (for example, C<"Where do you keep your money?">). The second argument, which is optional, specifies a default answer (for example, C<"wallet">). The user will be asked the question once. If C<prompt()> detects that it is not running interactively and there is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable is set to true, the $default will be used without prompting. To prevent automated processes from blocking, the user must either set PERL_MM_USE_DEFAULT or attach something to STDIN (this can be a pipe/file containing a scripted set of answers or /dev/null.) If no $default is provided an empty string will be used instead. In non-interactive mode, the absence of $default is an error (though explicitly passing C<undef()> as the default is valid as of 0.27.) This method may be called as a class or object method. =item recommends() [version 0.21] Returns a hash reference indicating the C<recommends> prerequisites that were passed to the C<new()> method. =item requires() [version 0.21] Returns a hash reference indicating the C<requires> prerequisites that were passed to the C<new()> method. =item rscan_dir($dir, $pattern) [version 0.28] Uses C<File::Find> to traverse the directory C<$dir>, returning a reference to an array of entries matching C<$pattern>. C<$pattern> may either be a regular expression (using C<qr//> or just a plain string), or a reference to a subroutine that will return true for wanted entries. If C<$pattern> is not given, all entries will be returned. Examples: # All the *.pm files in lib/ $m->rscan_dir('lib', qr/\.pm$/) # All the files in blib/ that aren't *.html files $m->rscan_dir('blib', sub {-f $_ and not /\.html$/}); # All the files in t/ $m->rscan_dir('t'); =item runtime_params() =item runtime_params($key) [version 0.28] The C<runtime_params()> method stores the values passed on the command line for valid properties (that is, any command line options for which C<valid_property()> returns a true value). The value on the command line may override the default value for a property, as well as any value specified in a call to C<new()>. This allows you to programmatically tell if C<perl Build.PL> or any execution of C<./Build> had command line options specified that override valid properties. The C<runtime_params()> method is essentially a glorified read-only hash. With no arguments, C<runtime_params()> returns the entire hash of properties specified on the command line. With one argument, C<runtime_params($key)> returns the value associated with the given key. The lifetime of the C<runtime_params> data is for "a build" - that is, the C<runtime_params> hash is created when C<perl Build.PL> is run (or when the C<new()> method is called, if the Module::Build Perl API is being used instead of called from a shell), and lasts until C<perl Build.PL> is run again or the C<clean> action is run. =item script_files() [version 0.18] Returns a hash reference whose keys are the perl script files to be installed, if any. This corresponds to the C<script_files> parameter to the C<new()> method. With an optional argument, this parameter may be set dynamically. For backward compatibility, the C<scripts()> method does exactly the same thing as C<script_files()>. C<scripts()> is deprecated, but it will stay around for several versions to give people time to transition. =item up_to_date($source_file, $derived_file) =item up_to_date(\@source_files, \@derived_files) [version 0.20] This method can be used to compare a set of source files to a set of derived files. If any of the source files are newer than any of the derived files, it returns false. Additionally, if any of the derived files do not exist, it returns false. Otherwise it returns true. The arguments may be either a scalar or an array reference of file names. =item y_n($message, $default) [version 0.12] Asks the user a yes/no question using C<prompt()> and returns true or false accordingly. The user will be asked the question repeatedly until they give an answer that looks like "yes" or "no". The first argument specifies the message to display to the user (for example, C<"Shall I invest your money for you?">), and the second argument specifies the default answer (for example, C<"y">). Note that the default is specified as a string like C<"y"> or C<"n">, and the return value is a Perl boolean value like 1 or 0. I thought about this for a while and this seemed like the most useful way to do it. This method may be called as a class or object method. =back =head2 Autogenerated Accessors In addition to the aforementioned methods, there are also some get/set accessor methods for the following properties: =over 4 =item PL_files() =item allow_mb_mismatch() =item allow_pureperl() =item auto_configure_requires() =item autosplit() =item base_dir() =item bindoc_dirs() =item blib() =item build_bat() =item build_class() =item build_elements() =item build_requires() =item build_script() =item bundle_inc() =item bundle_inc_preload() =item c_source() =item config_dir() =item configure_requires() =item conflicts() =item cover() =item cpan_client() =item create_license() =item create_makefile_pl() =item create_packlist() =item create_readme() =item debug() =item debugger() =item destdir() =item dynamic_config() =item extra_manify_args() =item get_options() =item html_css() =item include_dirs() =item install_base() =item installdirs() =item libdoc_dirs() =item license() =item magic_number() =item mb_version() =item meta_add() =item meta_merge() =item metafile() =item metafile2() =item module_name() =item mymetafile() =item mymetafile2() =item needs_compiler() =item orig_dir() =item perl() =item pm_files() =item pod_files() =item pollute() =item prefix() =item prereq_action_types() =item program_name() =item pureperl_only() =item quiet() =item recommends() =item recurse_into() =item recursive_test_files() =item requires() =item scripts() =item sign() =item tap_harness_args() =item test_file_exts() =item test_requires() =item use_rcfile() =item use_tap_harness() =item verbose() =item xs_files() =back =head1 MODULE METADATA If you would like to add other useful metadata, C<Module::Build> supports this with the C<meta_add> and C<meta_merge> arguments to L</new()>. The authoritative list of supported metadata can be found at L<CPAN::Meta::Spec> but for convenience - here are a few of the more useful ones: =over 4 =item keywords For describing the distribution using keyword (or "tags") in order to make CPAN.org indexing and search more efficient and useful. =item resources A list of additional resources available for users of the distribution. This can include links to a homepage on the web, a bug tracker, the repository location, and even a subscription page for the distribution mailing list. =back =head1 AUTHOR Ken Williams <kwilliams@cpan.org> =head1 COPYRIGHT Copyright (c) 2001-2006 Ken Williams. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl(1), L<Module::Build>(3), L<Module::Build::Authoring>(3), L<Module::Build::Cookbook>(3), L<ExtUtils::MakeMaker>(3) F<META.yml> Specification: L<CPAN::Meta::Spec> =cut
| ver. 1.4 |
Github
|
.
| PHP 8.1.34 | ���֧ߧ֧�ѧ�ڧ� ����ѧߧڧ��: 0.1 |
proxy
|
phpinfo
|
���ѧ����ۧܧ�