1package ExtUtils::MM_Any; 2 3use strict; 4our $VERSION = '6.63_02'; 5 6use Carp; 7use File::Spec; 8use File::Basename; 9BEGIN { our @ISA = qw(File::Spec); } 10 11# We need $Verbose 12use ExtUtils::MakeMaker qw($Verbose); 13 14use ExtUtils::MakeMaker::Config; 15 16 17# So we don't have to keep calling the methods over and over again, 18# we have these globals to cache the values. Faster and shrtr. 19my $Curdir = __PACKAGE__->curdir; 20my $Rootdir = __PACKAGE__->rootdir; 21my $Updir = __PACKAGE__->updir; 22 23 24=head1 NAME 25 26ExtUtils::MM_Any - Platform-agnostic MM methods 27 28=head1 SYNOPSIS 29 30 FOR INTERNAL USE ONLY! 31 32 package ExtUtils::MM_SomeOS; 33 34 # Temporarily, you have to subclass both. Put MM_Any first. 35 require ExtUtils::MM_Any; 36 require ExtUtils::MM_Unix; 37 @ISA = qw(ExtUtils::MM_Any ExtUtils::Unix); 38 39=head1 DESCRIPTION 40 41B<FOR INTERNAL USE ONLY!> 42 43ExtUtils::MM_Any is a superclass for the ExtUtils::MM_* set of 44modules. It contains methods which are either inherently 45cross-platform or are written in a cross-platform manner. 46 47Subclass off of ExtUtils::MM_Any I<and> ExtUtils::MM_Unix. This is a 48temporary solution. 49 50B<THIS MAY BE TEMPORARY!> 51 52 53=head1 METHODS 54 55Any methods marked I<Abstract> must be implemented by subclasses. 56 57 58=head2 Cross-platform helper methods 59 60These are methods which help writing cross-platform code. 61 62 63 64=head3 os_flavor I<Abstract> 65 66 my @os_flavor = $mm->os_flavor; 67 68@os_flavor is the style of operating system this is, usually 69corresponding to the MM_*.pm file we're using. 70 71The first element of @os_flavor is the major family (ie. Unix, 72Windows, VMS, OS/2, etc...) and the rest are sub families. 73 74Some examples: 75 76 Cygwin98 ('Unix', 'Cygwin', 'Cygwin9x') 77 Windows ('Win32') 78 Win98 ('Win32', 'Win9x') 79 Linux ('Unix', 'Linux') 80 MacOS X ('Unix', 'Darwin', 'MacOS', 'MacOS X') 81 OS/2 ('OS/2') 82 83This is used to write code for styles of operating system. 84See os_flavor_is() for use. 85 86 87=head3 os_flavor_is 88 89 my $is_this_flavor = $mm->os_flavor_is($this_flavor); 90 my $is_this_flavor = $mm->os_flavor_is(@one_of_these_flavors); 91 92Checks to see if the current operating system is one of the given flavors. 93 94This is useful for code like: 95 96 if( $mm->os_flavor_is('Unix') ) { 97 $out = `foo 2>&1`; 98 } 99 else { 100 $out = `foo`; 101 } 102 103=cut 104 105sub os_flavor_is { 106 my $self = shift; 107 my %flavors = map { ($_ => 1) } $self->os_flavor; 108 return (grep { $flavors{$_} } @_) ? 1 : 0; 109} 110 111 112=head3 can_load_xs 113 114 my $can_load_xs = $self->can_load_xs; 115 116Returns true if we have the ability to load XS. 117 118This is important because miniperl, used to build XS modules in the 119core, can not load XS. 120 121=cut 122 123sub can_load_xs { 124 return defined &DynaLoader::boot_DynaLoader ? 1 : 0; 125} 126 127 128=head3 split_command 129 130 my @cmds = $MM->split_command($cmd, @args); 131 132Most OS have a maximum command length they can execute at once. Large 133modules can easily generate commands well past that limit. Its 134necessary to split long commands up into a series of shorter commands. 135 136C<split_command> will return a series of @cmds each processing part of 137the args. Collectively they will process all the arguments. Each 138individual line in @cmds will not be longer than the 139$self->max_exec_len being careful to take into account macro expansion. 140 141$cmd should include any switches and repeated initial arguments. 142 143If no @args are given, no @cmds will be returned. 144 145Pairs of arguments will always be preserved in a single command, this 146is a heuristic for things like pm_to_blib and pod2man which work on 147pairs of arguments. This makes things like this safe: 148 149 $self->split_command($cmd, %pod2man); 150 151 152=cut 153 154sub split_command { 155 my($self, $cmd, @args) = @_; 156 157 my @cmds = (); 158 return(@cmds) unless @args; 159 160 # If the command was given as a here-doc, there's probably a trailing 161 # newline. 162 chomp $cmd; 163 164 # set aside 30% for macro expansion. 165 my $len_left = int($self->max_exec_len * 0.70); 166 $len_left -= length $self->_expand_macros($cmd); 167 168 do { 169 my $arg_str = ''; 170 my @next_args; 171 while( @next_args = splice(@args, 0, 2) ) { 172 # Two at a time to preserve pairs. 173 my $next_arg_str = "\t ". join ' ', @next_args, "\n"; 174 175 if( !length $arg_str ) { 176 $arg_str .= $next_arg_str 177 } 178 elsif( length($arg_str) + length($next_arg_str) > $len_left ) { 179 unshift @args, @next_args; 180 last; 181 } 182 else { 183 $arg_str .= $next_arg_str; 184 } 185 } 186 chop $arg_str; 187 188 push @cmds, $self->escape_newlines("$cmd \n$arg_str"); 189 } while @args; 190 191 return @cmds; 192} 193 194 195sub _expand_macros { 196 my($self, $cmd) = @_; 197 198 $cmd =~ s{\$\((\w+)\)}{ 199 defined $self->{$1} ? $self->{$1} : "\$($1)" 200 }e; 201 return $cmd; 202} 203 204 205=head3 echo 206 207 my @commands = $MM->echo($text); 208 my @commands = $MM->echo($text, $file); 209 my @commands = $MM->echo($text, $file, \%opts); 210 211Generates a set of @commands which print the $text to a $file. 212 213If $file is not given, output goes to STDOUT. 214 215If $opts{append} is true the $file will be appended to rather than 216overwritten. Default is to overwrite. 217 218If $opts{allow_variables} is true, make variables of the form 219C<$(...)> will not be escaped. Other C<$> will. Default is to escape 220all C<$>. 221 222Example of use: 223 224 my $make = map "\t$_\n", $MM->echo($text, $file); 225 226=cut 227 228sub echo { 229 my($self, $text, $file, $opts) = @_; 230 231 # Compatibility with old options 232 if( !ref $opts ) { 233 my $append = $opts; 234 $opts = { append => $append || 0 }; 235 } 236 $opts->{allow_variables} = 0 unless defined $opts->{allow_variables}; 237 238 my $ql_opts = { allow_variables => $opts->{allow_variables} }; 239 my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_, $ql_opts) } 240 split /\n/, $text; 241 if( $file ) { 242 my $redirect = $opts->{append} ? '>>' : '>'; 243 $cmds[0] .= " $redirect $file"; 244 $_ .= " >> $file" foreach @cmds[1..$#cmds]; 245 } 246 247 return @cmds; 248} 249 250 251=head3 wraplist 252 253 my $args = $mm->wraplist(@list); 254 255Takes an array of items and turns them into a well-formatted list of 256arguments. In most cases this is simply something like: 257 258 FOO \ 259 BAR \ 260 BAZ 261 262=cut 263 264sub wraplist { 265 my $self = shift; 266 return join " \\\n\t", @_; 267} 268 269 270=head3 maketext_filter 271 272 my $filter_make_text = $mm->maketext_filter($make_text); 273 274The text of the Makefile is run through this method before writing to 275disk. It allows systems a chance to make portability fixes to the 276Makefile. 277 278By default it does nothing. 279 280This method is protected and not intended to be called outside of 281MakeMaker. 282 283=cut 284 285sub maketext_filter { return $_[1] } 286 287 288=head3 cd I<Abstract> 289 290 my $subdir_cmd = $MM->cd($subdir, @cmds); 291 292This will generate a make fragment which runs the @cmds in the given 293$dir. The rough equivalent to this, except cross platform. 294 295 cd $subdir && $cmd 296 297Currently $dir can only go down one level. "foo" is fine. "foo/bar" is 298not. "../foo" is right out. 299 300The resulting $subdir_cmd has no leading tab nor trailing newline. This 301makes it easier to embed in a make string. For example. 302 303 my $make = sprintf <<'CODE', $subdir_cmd; 304 foo : 305 $(ECHO) what 306 %s 307 $(ECHO) mouche 308 CODE 309 310 311=head3 oneliner I<Abstract> 312 313 my $oneliner = $MM->oneliner($perl_code); 314 my $oneliner = $MM->oneliner($perl_code, \@switches); 315 316This will generate a perl one-liner safe for the particular platform 317you're on based on the given $perl_code and @switches (a -e is 318assumed) suitable for using in a make target. It will use the proper 319shell quoting and escapes. 320 321$(PERLRUN) will be used as perl. 322 323Any newlines in $perl_code will be escaped. Leading and trailing 324newlines will be stripped. Makes this idiom much easier: 325 326 my $code = $MM->oneliner(<<'CODE', [...switches...]); 327some code here 328another line here 329CODE 330 331Usage might be something like: 332 333 # an echo emulation 334 $oneliner = $MM->oneliner('print "Foo\n"'); 335 $make = '$oneliner > somefile'; 336 337All dollar signs must be doubled in the $perl_code if you expect them 338to be interpreted normally, otherwise it will be considered a make 339macro. Also remember to quote make macros else it might be used as a 340bareword. For example: 341 342 # Assign the value of the $(VERSION_FROM) make macro to $vf. 343 $oneliner = $MM->oneliner('$$vf = "$(VERSION_FROM)"'); 344 345Its currently very simple and may be expanded sometime in the figure 346to include more flexible code and switches. 347 348 349=head3 quote_literal I<Abstract> 350 351 my $safe_text = $MM->quote_literal($text); 352 my $safe_text = $MM->quote_literal($text, \%options); 353 354This will quote $text so it is interpreted literally in the shell. 355 356For example, on Unix this would escape any single-quotes in $text and 357put single-quotes around the whole thing. 358 359If $options{allow_variables} is true it will leave C<'$(FOO)'> make 360variables untouched. If false they will be escaped like any other 361C<$>. Defaults to true. 362 363=head3 escape_dollarsigns 364 365 my $escaped_text = $MM->escape_dollarsigns($text); 366 367Escapes stray C<$> so they are not interpreted as make variables. 368 369It lets by C<$(...)>. 370 371=cut 372 373sub escape_dollarsigns { 374 my($self, $text) = @_; 375 376 # Escape dollar signs which are not starting a variable 377 $text =~ s{\$ (?!\() }{\$\$}gx; 378 379 return $text; 380} 381 382 383=head3 escape_all_dollarsigns 384 385 my $escaped_text = $MM->escape_all_dollarsigns($text); 386 387Escapes all C<$> so they are not interpreted as make variables. 388 389=cut 390 391sub escape_all_dollarsigns { 392 my($self, $text) = @_; 393 394 # Escape dollar signs 395 $text =~ s{\$}{\$\$}gx; 396 397 return $text; 398} 399 400 401=head3 escape_newlines I<Abstract> 402 403 my $escaped_text = $MM->escape_newlines($text); 404 405Shell escapes newlines in $text. 406 407 408=head3 max_exec_len I<Abstract> 409 410 my $max_exec_len = $MM->max_exec_len; 411 412Calculates the maximum command size the OS can exec. Effectively, 413this is the max size of a shell command line. 414 415=for _private 416$self->{_MAX_EXEC_LEN} is set by this method, but only for testing purposes. 417 418 419=head3 make 420 421 my $make = $MM->make; 422 423Returns the make variant we're generating the Makefile for. This attempts 424to do some normalization on the information from %Config or the user. 425 426=cut 427 428sub make { 429 my $self = shift; 430 431 my $make = lc $self->{MAKE}; 432 433 # Truncate anything like foomake6 to just foomake. 434 $make =~ s/^(\w+make).*/$1/; 435 436 # Turn gnumake into gmake. 437 $make =~ s/^gnu/g/; 438 439 return $make; 440} 441 442 443=head2 Targets 444 445These are methods which produce make targets. 446 447 448=head3 all_target 449 450Generate the default target 'all'. 451 452=cut 453 454sub all_target { 455 my $self = shift; 456 457 return <<'MAKE_EXT'; 458all :: pure_all 459 $(NOECHO) $(NOOP) 460MAKE_EXT 461 462} 463 464 465=head3 blibdirs_target 466 467 my $make_frag = $mm->blibdirs_target; 468 469Creates the blibdirs target which creates all the directories we use 470in blib/. 471 472The blibdirs.ts target is deprecated. Depend on blibdirs instead. 473 474 475=cut 476 477sub blibdirs_target { 478 my $self = shift; 479 480 my @dirs = map { uc "\$(INST_$_)" } qw(libdir archlib 481 autodir archautodir 482 bin script 483 man1dir man3dir 484 ); 485 486 my @exists = map { $_.'$(DFSEP).exists' } @dirs; 487 488 my $make = sprintf <<'MAKE', join(' ', @exists); 489blibdirs : %s 490 $(NOECHO) $(NOOP) 491 492# Backwards compat with 6.18 through 6.25 493blibdirs.ts : blibdirs 494 $(NOECHO) $(NOOP) 495 496MAKE 497 498 $make .= $self->dir_target(@dirs); 499 500 return $make; 501} 502 503 504=head3 clean (o) 505 506Defines the clean target. 507 508=cut 509 510sub clean { 511# --- Cleanup and Distribution Sections --- 512 513 my($self, %attribs) = @_; 514 my @m; 515 push(@m, ' 516# Delete temporary files but do not touch installed files. We don\'t delete 517# the Makefile here so a later make realclean still has a makefile to use. 518 519clean :: clean_subdirs 520'); 521 522 my @files = values %{$self->{XS}}; # .c files from *.xs files 523 my @dirs = qw(blib); 524 525 # Normally these are all under blib but they might have been 526 # redefined. 527 # XXX normally this would be a good idea, but the Perl core sets 528 # INST_LIB = ../../lib rather than actually installing the files. 529 # So a "make clean" in an ext/ directory would blow away lib. 530 # Until the core is adjusted let's leave this out. 531# push @dirs, qw($(INST_ARCHLIB) $(INST_LIB) 532# $(INST_BIN) $(INST_SCRIPT) 533# $(INST_MAN1DIR) $(INST_MAN3DIR) 534# $(INST_LIBDIR) $(INST_ARCHLIBDIR) $(INST_AUTODIR) 535# $(INST_STATIC) $(INST_DYNAMIC) $(INST_BOOT) 536# ); 537 538 539 if( $attribs{FILES} ) { 540 # Use @dirs because we don't know what's in here. 541 push @dirs, ref $attribs{FILES} ? 542 @{$attribs{FILES}} : 543 split /\s+/, $attribs{FILES} ; 544 } 545 546 push(@files, qw[$(MAKE_APERL_FILE) 547 MYMETA.json MYMETA.yml perlmain.c tmon.out mon.out so_locations 548 blibdirs.ts pm_to_blib pm_to_blib.ts 549 *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT) 550 $(BOOTSTRAP) $(BASEEXT).bso 551 $(BASEEXT).def lib$(BASEEXT).def 552 $(BASEEXT).exp $(BASEEXT).x 553 ]); 554 555 push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.all')); 556 push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.ld')); 557 558 # core files 559 push(@files, qw[core core.*perl.*.? *perl.core]); 560 push(@files, map { "core." . "[0-9]"x$_ } (1..5)); 561 562 # OS specific things to clean up. Use @dirs since we don't know 563 # what might be in here. 564 push @dirs, $self->extra_clean_files; 565 566 # Occasionally files are repeated several times from different sources 567 { my(%f) = map { ($_ => 1) } @files; @files = keys %f; } 568 { my(%d) = map { ($_ => 1) } @dirs; @dirs = keys %d; } 569 570 push @m, map "\t$_\n", $self->split_command('- $(RM_F)', @files); 571 push @m, map "\t$_\n", $self->split_command('- $(RM_RF)', @dirs); 572 573 # Leave Makefile.old around for realclean 574 push @m, <<'MAKE'; 575 - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL) 576MAKE 577 578 push(@m, "\t$attribs{POSTOP}\n") if $attribs{POSTOP}; 579 580 join("", @m); 581} 582 583 584=head3 clean_subdirs_target 585 586 my $make_frag = $MM->clean_subdirs_target; 587 588Returns the clean_subdirs target. This is used by the clean target to 589call clean on any subdirectories which contain Makefiles. 590 591=cut 592 593sub clean_subdirs_target { 594 my($self) = shift; 595 596 # No subdirectories, no cleaning. 597 return <<'NOOP_FRAG' unless @{$self->{DIR}}; 598clean_subdirs : 599 $(NOECHO) $(NOOP) 600NOOP_FRAG 601 602 603 my $clean = "clean_subdirs :\n"; 604 605 for my $dir (@{$self->{DIR}}) { 606 my $subclean = $self->oneliner(sprintf <<'CODE', $dir); 607chdir '%s'; system '$(MAKE) clean' if -f '$(FIRST_MAKEFILE)'; 608CODE 609 610 $clean .= "\t$subclean\n"; 611 } 612 613 return $clean; 614} 615 616 617=head3 dir_target 618 619 my $make_frag = $mm->dir_target(@directories); 620 621Generates targets to create the specified directories and set its 622permission to PERM_DIR. 623 624Because depending on a directory to just ensure it exists doesn't work 625too well (the modified time changes too often) dir_target() creates a 626.exists file in the created directory. It is this you should depend on. 627For portability purposes you should use the $(DIRFILESEP) macro rather 628than a '/' to seperate the directory from the file. 629 630 yourdirectory$(DIRFILESEP).exists 631 632=cut 633 634sub dir_target { 635 my($self, @dirs) = @_; 636 637 my $make = ''; 638 foreach my $dir (@dirs) { 639 $make .= sprintf <<'MAKE', ($dir) x 7; 640%s$(DFSEP).exists :: Makefile.PL 641 $(NOECHO) $(MKPATH) %s 642 $(NOECHO) $(CHMOD) $(PERM_DIR) %s 643 $(NOECHO) $(TOUCH) %s$(DFSEP).exists 644 645MAKE 646 647 } 648 649 return $make; 650} 651 652 653=head3 distdir 654 655Defines the scratch directory target that will hold the distribution 656before tar-ing (or shar-ing). 657 658=cut 659 660# For backwards compatibility. 661*dist_dir = *distdir; 662 663sub distdir { 664 my($self) = shift; 665 666 my $meta_target = $self->{NO_META} ? '' : 'distmeta'; 667 my $sign_target = !$self->{SIGN} ? '' : 'distsignature'; 668 669 return sprintf <<'MAKE_FRAG', $meta_target, $sign_target; 670create_distdir : 671 $(RM_RF) $(DISTVNAME) 672 $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \ 673 -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" 674 675distdir : create_distdir %s %s 676 $(NOECHO) $(NOOP) 677 678MAKE_FRAG 679 680} 681 682 683=head3 dist_test 684 685Defines a target that produces the distribution in the 686scratchdirectory, and runs 'perl Makefile.PL; make ;make test' in that 687subdirectory. 688 689=cut 690 691sub dist_test { 692 my($self) = shift; 693 694 my $mpl_args = join " ", map qq["$_"], @ARGV; 695 696 my $test = $self->cd('$(DISTVNAME)', 697 '$(ABSPERLRUN) Makefile.PL '.$mpl_args, 698 '$(MAKE) $(PASTHRU)', 699 '$(MAKE) test $(PASTHRU)' 700 ); 701 702 return sprintf <<'MAKE_FRAG', $test; 703disttest : distdir 704 %s 705 706MAKE_FRAG 707 708 709} 710 711 712=head3 dynamic (o) 713 714Defines the dynamic target. 715 716=cut 717 718sub dynamic { 719# --- Dynamic Loading Sections --- 720 721 my($self) = shift; 722 ' 723dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT) 724 $(NOECHO) $(NOOP) 725'; 726} 727 728 729=head3 makemakerdflt_target 730 731 my $make_frag = $mm->makemakerdflt_target 732 733Returns a make fragment with the makemakerdeflt_target specified. 734This target is the first target in the Makefile, is the default target 735and simply points off to 'all' just in case any make variant gets 736confused or something gets snuck in before the real 'all' target. 737 738=cut 739 740sub makemakerdflt_target { 741 return <<'MAKE_FRAG'; 742makemakerdflt : all 743 $(NOECHO) $(NOOP) 744MAKE_FRAG 745 746} 747 748 749=head3 manifypods_target 750 751 my $manifypods_target = $self->manifypods_target; 752 753Generates the manifypods target. This target generates man pages from 754all POD files in MAN1PODS and MAN3PODS. 755 756=cut 757 758sub manifypods_target { 759 my($self) = shift; 760 761 my $man1pods = ''; 762 my $man3pods = ''; 763 my $dependencies = ''; 764 765 # populate manXpods & dependencies: 766 foreach my $name (keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}}) { 767 $dependencies .= " \\\n\t$name"; 768 } 769 770 my $manify = <<END; 771manifypods : pure_all $dependencies 772END 773 774 my @man_cmds; 775 foreach my $section (qw(1 3)) { 776 my $pods = $self->{"MAN${section}PODS"}; 777 push @man_cmds, $self->split_command(<<CMD, %$pods); 778 \$(NOECHO) \$(POD2MAN) --section=$section --perm_rw=\$(PERM_RW) 779CMD 780 } 781 782 $manify .= "\t\$(NOECHO) \$(NOOP)\n" unless @man_cmds; 783 $manify .= join '', map { "$_\n" } @man_cmds; 784 785 return $manify; 786} 787 788sub _has_cpan_meta { 789 return eval { 790 require CPAN::Meta; 791 CPAN::Meta->VERSION(2.112150); 792 1; 793 }; 794} 795 796=head3 metafile_target 797 798 my $target = $mm->metafile_target; 799 800Generate the metafile target. 801 802Writes the file META.yml YAML encoded meta-data about the module in 803the distdir. The format follows Module::Build's as closely as 804possible. 805 806=cut 807 808sub metafile_target { 809 my $self = shift; 810 return <<'MAKE_FRAG' if $self->{NO_META} or ! _has_cpan_meta(); 811metafile : 812 $(NOECHO) $(NOOP) 813MAKE_FRAG 814 815 my %metadata = $self->metafile_data( 816 $self->{META_ADD} || {}, 817 $self->{META_MERGE} || {}, 818 ); 819 820 _fix_metadata_before_conversion( \%metadata ); 821 822 # paper over validation issues, but still complain, necessary because 823 # there's no guarantee that the above will fix ALL errors 824 my $meta = eval { CPAN::Meta->create( \%metadata, { lazy_validation => 1 } ) }; 825 warn $@ if $@ and 826 $@ !~ /encountered CODE.*, but JSON can only represent references to arrays or hashes/; 827 828 # use the original metadata straight if the conversion failed 829 # or if it can't be stringified. 830 if( !$meta || 831 !eval { $meta->as_string( { version => "1.4" } ) } || 832 !eval { $meta->as_string } 833 ) 834 { 835 $meta = bless \%metadata, 'CPAN::Meta'; 836 } 837 838 my @write_metayml = $self->echo( 839 $meta->as_string({version => "1.4"}), 'META_new.yml' 840 ); 841 my @write_metajson = $self->echo( 842 $meta->as_string(), 'META_new.json' 843 ); 844 845 my $metayml = join("\n\t", @write_metayml); 846 my $metajson = join("\n\t", @write_metajson); 847 return sprintf <<'MAKE_FRAG', $metayml, $metajson; 848metafile : create_distdir 849 $(NOECHO) $(ECHO) Generating META.yml 850 %s 851 -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml 852 $(NOECHO) $(ECHO) Generating META.json 853 %s 854 -$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json 855MAKE_FRAG 856 857} 858 859=begin private 860 861=head3 _fix_metadata_before_conversion 862 863 _fix_metadata_before_conversion( \%metadata ); 864 865Fixes errors in the metadata before it's handed off to CPAN::Meta for 866conversion. This hopefully results in something that can be used further 867on, no guarantee is made though. 868 869=end private 870 871=cut 872 873sub _fix_metadata_before_conversion { 874 my ( $metadata ) = @_; 875 876 # we should never be called unless this already passed but 877 # prefer to be defensive in case somebody else calls this 878 879 return unless _has_cpan_meta; 880 881 my $bad_version = $metadata->{version} && 882 !CPAN::Meta::Validator->new->version( 'version', $metadata->{version} ); 883 884 # just delete all invalid versions 885 if( $bad_version ) { 886 warn "Can't parse version '$metadata->{version}'\n"; 887 $metadata->{version} = ''; 888 } 889 890 my $validator = CPAN::Meta::Validator->new( $metadata ); 891 return if $validator->is_valid; 892 893 # fix non-camelcase custom resource keys (only other trick we know) 894 for my $error ( $validator->errors ) { 895 my ( $key ) = ( $error =~ /Custom resource '(.*)' must be in CamelCase./ ); 896 next if !$key; 897 898 # first try to remove all non-alphabetic chars 899 ( my $new_key = $key ) =~ s/[^_a-zA-Z]//g; 900 901 # if that doesn't work, uppercase first one 902 $new_key = ucfirst $new_key if !$validator->custom_1( $new_key ); 903 904 # copy to new key if that worked 905 $metadata->{resources}{$new_key} = $metadata->{resources}{$key} 906 if $validator->custom_1( $new_key ); 907 908 # and delete old one in any case 909 delete $metadata->{resources}{$key}; 910 } 911 912 return; 913} 914 915 916=begin private 917 918=head3 _sort_pairs 919 920 my @pairs = _sort_pairs($sort_sub, \%hash); 921 922Sorts the pairs of a hash based on keys ordered according 923to C<$sort_sub>. 924 925=end private 926 927=cut 928 929sub _sort_pairs { 930 my $sort = shift; 931 my $pairs = shift; 932 return map { $_ => $pairs->{$_} } 933 sort $sort 934 keys %$pairs; 935} 936 937 938# Taken from Module::Build::Base 939sub _hash_merge { 940 my ($self, $h, $k, $v) = @_; 941 if (ref $h->{$k} eq 'ARRAY') { 942 push @{$h->{$k}}, ref $v ? @$v : $v; 943 } elsif (ref $h->{$k} eq 'HASH') { 944 $self->_hash_merge($h->{$k}, $_, $v->{$_}) foreach keys %$v; 945 } else { 946 $h->{$k} = $v; 947 } 948} 949 950 951=head3 metafile_data 952 953 my @metadata_pairs = $mm->metafile_data(\%meta_add, \%meta_merge); 954 955Returns the data which MakeMaker turns into the META.yml file. 956 957Values of %meta_add will overwrite any existing metadata in those 958keys. %meta_merge will be merged with them. 959 960=cut 961 962sub metafile_data { 963 my $self = shift; 964 my($meta_add, $meta_merge) = @_; 965 966 my %meta = ( 967 # required 968 name => $self->{DISTNAME}, 969 version => _normalize_version($self->{VERSION}), 970 abstract => $self->{ABSTRACT} || 'unknown', 971 license => $self->{LICENSE} || 'unknown', 972 dynamic_config => 1, 973 974 # optional 975 distribution_type => $self->{PM} ? 'module' : 'script', 976 977 no_index => { 978 directory => [qw(t inc)] 979 }, 980 981 generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION", 982 'meta-spec' => { 983 url => 'http://module-build.sourceforge.net/META-spec-v1.4.html', 984 version => 1.4 985 }, 986 ); 987 988 # The author key is required and it takes a list. 989 $meta{author} = defined $self->{AUTHOR} ? $self->{AUTHOR} : []; 990 991 # Check the original args so we can tell between the user setting it 992 # to an empty hash and it just being initialized. 993 if( $self->{ARGS}{CONFIGURE_REQUIRES} ) { 994 $meta{configure_requires} 995 = _normalize_prereqs($self->{CONFIGURE_REQUIRES}); 996 } else { 997 $meta{configure_requires} = { 998 'ExtUtils::MakeMaker' => 0, 999 }; 1000 } 1001 1002 %meta = $self->_add_requirements_to_meta( %meta ); 1003 1004 while( my($key, $val) = each %$meta_add ) { 1005 $meta{$key} = $val; 1006 } 1007 1008 while( my($key, $val) = each %$meta_merge ) { 1009 $self->_hash_merge(\%meta, $key, $val); 1010 } 1011 1012 return %meta; 1013} 1014 1015 1016=begin private 1017 1018=cut 1019 1020sub _add_requirements_to_meta { 1021 my ( $self, %meta ) = @_; 1022 1023 # Check the original args so we can tell between the user setting it 1024 # to an empty hash and it just being initialized. 1025 1026 if( $self->{ARGS}{BUILD_REQUIRES} ) { 1027 $meta{build_requires} = _normalize_prereqs($self->{BUILD_REQUIRES}); 1028 } else { 1029 $meta{build_requires} = { 1030 'ExtUtils::MakeMaker' => 0, 1031 }; 1032 } 1033 1034 $meta{requires} = _normalize_prereqs($self->{PREREQ_PM}) 1035 if defined $self->{PREREQ_PM}; 1036 $meta{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION}) 1037 if $self->{MIN_PERL_VERSION}; 1038 1039 return %meta; 1040} 1041 1042sub _normalize_prereqs { 1043 my ($hash) = @_; 1044 my %prereqs; 1045 while ( my ($k,$v) = each %$hash ) { 1046 $prereqs{$k} = _normalize_version($v); 1047 } 1048 return \%prereqs; 1049} 1050 1051# Adapted from Module::Build::Base 1052sub _normalize_version { 1053 my ($version) = @_; 1054 $version = 0 unless defined $version; 1055 1056 if ( ref $version eq 'version' ) { # version objects 1057 $version = $version->is_qv ? $version->normal : $version->stringify; 1058 } 1059 elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots 1060 # normalize string tuples without "v": "1.2.3" -> "v1.2.3" 1061 $version = "v$version"; 1062 } 1063 else { 1064 # leave alone 1065 } 1066 return $version; 1067} 1068 1069=head3 _dump_hash 1070 1071 $yaml = _dump_hash(\%options, %hash); 1072 1073Implements a fake YAML dumper for a hash given 1074as a list of pairs. No quoting/escaping is done. Keys 1075are supposed to be strings. Values are undef, strings, 1076hash refs or array refs of strings. 1077 1078Supported options are: 1079 1080 delta => STR - indentation delta 1081 use_header => BOOL - whether to include a YAML header 1082 indent => STR - a string of spaces 1083 default: '' 1084 1085 max_key_length => INT - maximum key length used to align 1086 keys and values of the same hash 1087 default: 20 1088 key_sort => CODE - a sort sub 1089 It may be undef, which means no sorting by keys 1090 default: sub { lc $a cmp lc $b } 1091 1092 customs => HASH - special options for certain keys 1093 (whose values are hashes themselves) 1094 may contain: max_key_length, key_sort, customs 1095 1096=end private 1097 1098=cut 1099 1100sub _dump_hash { 1101 croak "first argument should be a hash ref" unless ref $_[0] eq 'HASH'; 1102 my $options = shift; 1103 my %hash = @_; 1104 1105 # Use a list to preserve order. 1106 my @pairs; 1107 1108 my $k_sort 1109 = exists $options->{key_sort} ? $options->{key_sort} 1110 : sub { lc $a cmp lc $b }; 1111 if ($k_sort) { 1112 croak "'key_sort' should be a coderef" unless ref $k_sort eq 'CODE'; 1113 @pairs = _sort_pairs($k_sort, \%hash); 1114 } else { # list of pairs, no sorting 1115 @pairs = @_; 1116 } 1117 1118 my $yaml = $options->{use_header} ? "--- #YAML:1.0\n" : ''; 1119 my $indent = $options->{indent} || ''; 1120 my $k_length = min( 1121 ($options->{max_key_length} || 20), 1122 max(map { length($_) + 1 } grep { !ref $hash{$_} } keys %hash) 1123 ); 1124 my $customs = $options->{customs} || {}; 1125 1126 # printf format for key 1127 my $k_format = "%-${k_length}s"; 1128 1129 while( @pairs ) { 1130 my($key, $val) = splice @pairs, 0, 2; 1131 $val = '~' unless defined $val; 1132 if(ref $val eq 'HASH') { 1133 if ( keys %$val ) { 1134 my %k_options = ( # options for recursive call 1135 delta => $options->{delta}, 1136 use_header => 0, 1137 indent => $indent . $options->{delta}, 1138 ); 1139 if (exists $customs->{$key}) { 1140 my %k_custom = %{$customs->{$key}}; 1141 foreach my $k (qw(key_sort max_key_length customs)) { 1142 $k_options{$k} = $k_custom{$k} if exists $k_custom{$k}; 1143 } 1144 } 1145 $yaml .= $indent . "$key:\n" 1146 . _dump_hash(\%k_options, %$val); 1147 } 1148 else { 1149 $yaml .= $indent . "$key: {}\n"; 1150 } 1151 } 1152 elsif (ref $val eq 'ARRAY') { 1153 if( @$val ) { 1154 $yaml .= $indent . "$key:\n"; 1155 1156 for (@$val) { 1157 croak "only nested arrays of non-refs are supported" if ref $_; 1158 $yaml .= $indent . $options->{delta} . "- $_\n"; 1159 } 1160 } 1161 else { 1162 $yaml .= $indent . "$key: []\n"; 1163 } 1164 } 1165 elsif( ref $val and !blessed($val) ) { 1166 croak "only nested hashes, arrays and objects are supported"; 1167 } 1168 else { # if it's an object, just stringify it 1169 $yaml .= $indent . sprintf "$k_format %s\n", "$key:", $val; 1170 } 1171 }; 1172 1173 return $yaml; 1174 1175} 1176 1177sub blessed { 1178 return eval { $_[0]->isa("UNIVERSAL"); }; 1179} 1180 1181sub max { 1182 return (sort { $b <=> $a } @_)[0]; 1183} 1184 1185sub min { 1186 return (sort { $a <=> $b } @_)[0]; 1187} 1188 1189=head3 metafile_file 1190 1191 my $meta_yml = $mm->metafile_file(@metadata_pairs); 1192 1193Turns the @metadata_pairs into YAML. 1194 1195This method does not implement a complete YAML dumper, being limited 1196to dump a hash with values which are strings, undef's or nested hashes 1197and arrays of strings. No quoting/escaping is done. 1198 1199=cut 1200 1201sub metafile_file { 1202 my $self = shift; 1203 1204 my %dump_options = ( 1205 use_header => 1, 1206 delta => ' ' x 4, 1207 key_sort => undef, 1208 ); 1209 return _dump_hash(\%dump_options, @_); 1210 1211} 1212 1213 1214=head3 distmeta_target 1215 1216 my $make_frag = $mm->distmeta_target; 1217 1218Generates the distmeta target to add META.yml to the MANIFEST in the 1219distdir. 1220 1221=cut 1222 1223sub distmeta_target { 1224 my $self = shift; 1225 1226 my @add_meta = ( 1227 $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']), 1228exit unless -e q{META.yml}; 1229eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) } 1230 or print "Could not add META.yml to MANIFEST: $${'@'}\n" 1231CODE 1232 $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']) 1233exit unless -f q{META.json}; 1234eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) } 1235 or print "Could not add META.json to MANIFEST: $${'@'}\n" 1236CODE 1237 ); 1238 1239 my @add_meta_to_distdir = map { $self->cd('$(DISTVNAME)', $_) } @add_meta; 1240 1241 return sprintf <<'MAKE', @add_meta_to_distdir; 1242distmeta : create_distdir metafile 1243 $(NOECHO) %s 1244 $(NOECHO) %s 1245 1246MAKE 1247 1248} 1249 1250 1251=head3 mymeta 1252 1253 my $mymeta = $mm->mymeta; 1254 1255Generate MYMETA information as a hash either from an existing META.yml 1256or from internal data. 1257 1258=cut 1259 1260sub mymeta { 1261 my $self = shift; 1262 my $file = shift || ''; # for testing 1263 1264 my $mymeta = $self->_mymeta_from_meta($file); 1265 1266 unless ( $mymeta ) { 1267 my @metadata = $self->metafile_data( 1268 $self->{META_ADD} || {}, 1269 $self->{META_MERGE} || {}, 1270 ); 1271 $mymeta = {@metadata}; 1272 } 1273 1274 # Overwrite the non-configure dependency hashes 1275 1276 $mymeta = { $self->_add_requirements_to_meta( %$mymeta ) }; 1277 1278 $mymeta->{dynamic_config} = 0; 1279 1280 return $mymeta; 1281} 1282 1283 1284sub _mymeta_from_meta { 1285 my $self = shift; 1286 my $metafile = shift || ''; # for testing 1287 1288 return unless _has_cpan_meta(); 1289 1290 my $meta; 1291 for my $file ( $metafile, "META.json", "META.yml" ) { 1292 next unless -e $file; 1293 eval { 1294 $meta = CPAN::Meta->load_file($file)->as_struct( {version => "1.4"} ); 1295 }; 1296 last if $meta; 1297 } 1298 return undef unless $meta; 1299 1300 # META.yml before 6.25_01 cannot be trusted. META.yml lived in the source directory. 1301 # There was a good chance the author accidentally uploaded a stale META.yml if they 1302 # rolled their own tarball rather than using "make dist". 1303 if ($meta->{generated_by} && 1304 $meta->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) { 1305 my $eummv = do { local $^W = 0; $1+0; }; 1306 if ($eummv < 6.2501) { 1307 return undef; 1308 } 1309 } 1310 1311 return $meta; 1312} 1313 1314=head3 write_mymeta 1315 1316 $self->write_mymeta( $mymeta ); 1317 1318Write MYMETA information to MYMETA.yml. 1319 1320This will probably be refactored into a more generic YAML dumping method. 1321 1322=cut 1323 1324sub write_mymeta { 1325 my $self = shift; 1326 my $mymeta = shift; 1327 1328 return unless _has_cpan_meta(); 1329 1330 _fix_metadata_before_conversion( $mymeta ); 1331 1332 # this can still blow up 1333 # not sure if i should just eval this and skip file creation if it 1334 # blows up 1335 my $meta_obj = CPAN::Meta->new( $mymeta, { lazy_validation => 1 } ); 1336 $meta_obj->save( 'MYMETA.json' ); 1337 $meta_obj->save( 'MYMETA.yml', { version => "1.4" } ); 1338 return 1; 1339} 1340 1341=head3 realclean (o) 1342 1343Defines the realclean target. 1344 1345=cut 1346 1347sub realclean { 1348 my($self, %attribs) = @_; 1349 1350 my @dirs = qw($(DISTVNAME)); 1351 my @files = qw($(FIRST_MAKEFILE) $(MAKEFILE_OLD)); 1352 1353 # Special exception for the perl core where INST_* is not in blib. 1354 # This cleans up the files built from the ext/ directory (all XS). 1355 if( $self->{PERL_CORE} ) { 1356 push @dirs, qw($(INST_AUTODIR) $(INST_ARCHAUTODIR)); 1357 push @files, values %{$self->{PM}}; 1358 } 1359 1360 if( $self->has_link_code ){ 1361 push @files, qw($(OBJECT)); 1362 } 1363 1364 if( $attribs{FILES} ) { 1365 if( ref $attribs{FILES} ) { 1366 push @dirs, @{ $attribs{FILES} }; 1367 } 1368 else { 1369 push @dirs, split /\s+/, $attribs{FILES}; 1370 } 1371 } 1372 1373 # Occasionally files are repeated several times from different sources 1374 { my(%f) = map { ($_ => 1) } @files; @files = keys %f; } 1375 { my(%d) = map { ($_ => 1) } @dirs; @dirs = keys %d; } 1376 1377 my $rm_cmd = join "\n\t", map { "$_" } 1378 $self->split_command('- $(RM_F)', @files); 1379 my $rmf_cmd = join "\n\t", map { "$_" } 1380 $self->split_command('- $(RM_RF)', @dirs); 1381 1382 my $m = sprintf <<'MAKE', $rm_cmd, $rmf_cmd; 1383# Delete temporary files (via clean) and also delete dist files 1384realclean purge :: clean realclean_subdirs 1385 %s 1386 %s 1387MAKE 1388 1389 $m .= "\t$attribs{POSTOP}\n" if $attribs{POSTOP}; 1390 1391 return $m; 1392} 1393 1394 1395=head3 realclean_subdirs_target 1396 1397 my $make_frag = $MM->realclean_subdirs_target; 1398 1399Returns the realclean_subdirs target. This is used by the realclean 1400target to call realclean on any subdirectories which contain Makefiles. 1401 1402=cut 1403 1404sub realclean_subdirs_target { 1405 my $self = shift; 1406 1407 return <<'NOOP_FRAG' unless @{$self->{DIR}}; 1408realclean_subdirs : 1409 $(NOECHO) $(NOOP) 1410NOOP_FRAG 1411 1412 my $rclean = "realclean_subdirs :\n"; 1413 1414 foreach my $dir (@{$self->{DIR}}) { 1415 foreach my $makefile ('$(MAKEFILE_OLD)', '$(FIRST_MAKEFILE)' ) { 1416 my $subrclean .= $self->oneliner(sprintf <<'CODE', $dir, ($makefile) x 2); 1417chdir '%s'; system '$(MAKE) $(USEMAKEFILE) %s realclean' if -f '%s'; 1418CODE 1419 1420 $rclean .= sprintf <<'RCLEAN', $subrclean; 1421 - %s 1422RCLEAN 1423 1424 } 1425 } 1426 1427 return $rclean; 1428} 1429 1430 1431=head3 signature_target 1432 1433 my $target = $mm->signature_target; 1434 1435Generate the signature target. 1436 1437Writes the file SIGNATURE with "cpansign -s". 1438 1439=cut 1440 1441sub signature_target { 1442 my $self = shift; 1443 1444 return <<'MAKE_FRAG'; 1445signature : 1446 cpansign -s 1447MAKE_FRAG 1448 1449} 1450 1451 1452=head3 distsignature_target 1453 1454 my $make_frag = $mm->distsignature_target; 1455 1456Generates the distsignature target to add SIGNATURE to the MANIFEST in the 1457distdir. 1458 1459=cut 1460 1461sub distsignature_target { 1462 my $self = shift; 1463 1464 my $add_sign = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']); 1465eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } 1466 or print "Could not add SIGNATURE to MANIFEST: $${'@'}\n" 1467CODE 1468 1469 my $sign_dist = $self->cd('$(DISTVNAME)' => 'cpansign -s'); 1470 1471 # cpansign -s complains if SIGNATURE is in the MANIFEST yet does not 1472 # exist 1473 my $touch_sig = $self->cd('$(DISTVNAME)' => '$(TOUCH) SIGNATURE'); 1474 my $add_sign_to_dist = $self->cd('$(DISTVNAME)' => $add_sign ); 1475 1476 return sprintf <<'MAKE', $add_sign_to_dist, $touch_sig, $sign_dist 1477distsignature : create_distdir 1478 $(NOECHO) %s 1479 $(NOECHO) %s 1480 %s 1481 1482MAKE 1483 1484} 1485 1486 1487=head3 special_targets 1488 1489 my $make_frag = $mm->special_targets 1490 1491Returns a make fragment containing any targets which have special 1492meaning to make. For example, .SUFFIXES and .PHONY. 1493 1494=cut 1495 1496sub special_targets { 1497 my $make_frag = <<'MAKE_FRAG'; 1498.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT) 1499 1500.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir 1501 1502MAKE_FRAG 1503 1504 $make_frag .= <<'MAKE_FRAG' if $ENV{CLEARCASE_ROOT}; 1505.NO_CONFIG_REC: Makefile 1506 1507MAKE_FRAG 1508 1509 return $make_frag; 1510} 1511 1512 1513 1514 1515=head2 Init methods 1516 1517Methods which help initialize the MakeMaker object and macros. 1518 1519 1520=head3 init_ABSTRACT 1521 1522 $mm->init_ABSTRACT 1523 1524=cut 1525 1526sub init_ABSTRACT { 1527 my $self = shift; 1528 1529 if( $self->{ABSTRACT_FROM} and $self->{ABSTRACT} ) { 1530 warn "Both ABSTRACT_FROM and ABSTRACT are set. ". 1531 "Ignoring ABSTRACT_FROM.\n"; 1532 return; 1533 } 1534 1535 if ($self->{ABSTRACT_FROM}){ 1536 $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or 1537 carp "WARNING: Setting ABSTRACT via file ". 1538 "'$self->{ABSTRACT_FROM}' failed\n"; 1539 } 1540} 1541 1542=head3 init_INST 1543 1544 $mm->init_INST; 1545 1546Called by init_main. Sets up all INST_* variables except those related 1547to XS code. Those are handled in init_xs. 1548 1549=cut 1550 1551sub init_INST { 1552 my($self) = shift; 1553 1554 $self->{INST_ARCHLIB} ||= $self->catdir($Curdir,"blib","arch"); 1555 $self->{INST_BIN} ||= $self->catdir($Curdir,'blib','bin'); 1556 1557 # INST_LIB typically pre-set if building an extension after 1558 # perl has been built and installed. Setting INST_LIB allows 1559 # you to build directly into, say $Config{privlibexp}. 1560 unless ($self->{INST_LIB}){ 1561 if ($self->{PERL_CORE}) { 1562 if (defined $Cross::platform) { 1563 $self->{INST_LIB} = $self->{INST_ARCHLIB} = 1564 $self->catdir($self->{PERL_LIB},"..","xlib", 1565 $Cross::platform); 1566 } 1567 else { 1568 $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB}; 1569 } 1570 } else { 1571 $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib"); 1572 } 1573 } 1574 1575 my @parentdir = split(/::/, $self->{PARENT_NAME}); 1576 $self->{INST_LIBDIR} = $self->catdir('$(INST_LIB)', @parentdir); 1577 $self->{INST_ARCHLIBDIR} = $self->catdir('$(INST_ARCHLIB)', @parentdir); 1578 $self->{INST_AUTODIR} = $self->catdir('$(INST_LIB)', 'auto', 1579 '$(FULLEXT)'); 1580 $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)', 'auto', 1581 '$(FULLEXT)'); 1582 1583 $self->{INST_SCRIPT} ||= $self->catdir($Curdir,'blib','script'); 1584 1585 $self->{INST_MAN1DIR} ||= $self->catdir($Curdir,'blib','man1'); 1586 $self->{INST_MAN3DIR} ||= $self->catdir($Curdir,'blib','man3'); 1587 1588 return 1; 1589} 1590 1591 1592=head3 init_INSTALL 1593 1594 $mm->init_INSTALL; 1595 1596Called by init_main. Sets up all INSTALL_* variables (except 1597INSTALLDIRS) and *PREFIX. 1598 1599=cut 1600 1601sub init_INSTALL { 1602 my($self) = shift; 1603 1604 if( $self->{ARGS}{INSTALL_BASE} and $self->{ARGS}{PREFIX} ) { 1605 die "Only one of PREFIX or INSTALL_BASE can be given. Not both.\n"; 1606 } 1607 1608 if( $self->{ARGS}{INSTALL_BASE} ) { 1609 $self->init_INSTALL_from_INSTALL_BASE; 1610 } 1611 else { 1612 $self->init_INSTALL_from_PREFIX; 1613 } 1614} 1615 1616 1617=head3 init_INSTALL_from_PREFIX 1618 1619 $mm->init_INSTALL_from_PREFIX; 1620 1621=cut 1622 1623sub init_INSTALL_from_PREFIX { 1624 my $self = shift; 1625 1626 $self->init_lib2arch; 1627 1628 # There are often no Config.pm defaults for these new man variables so 1629 # we fall back to the old behavior which is to use installman*dir 1630 foreach my $num (1, 3) { 1631 my $k = 'installsiteman'.$num.'dir'; 1632 1633 $self->{uc $k} ||= uc "\$(installman${num}dir)" 1634 unless $Config{$k}; 1635 } 1636 1637 foreach my $num (1, 3) { 1638 my $k = 'installvendorman'.$num.'dir'; 1639 1640 unless( $Config{$k} ) { 1641 $self->{uc $k} ||= $Config{usevendorprefix} 1642 ? uc "\$(installman${num}dir)" 1643 : ''; 1644 } 1645 } 1646 1647 $self->{INSTALLSITEBIN} ||= '$(INSTALLBIN)' 1648 unless $Config{installsitebin}; 1649 $self->{INSTALLSITESCRIPT} ||= '$(INSTALLSCRIPT)' 1650 unless $Config{installsitescript}; 1651 1652 unless( $Config{installvendorbin} ) { 1653 $self->{INSTALLVENDORBIN} ||= $Config{usevendorprefix} 1654 ? $Config{installbin} 1655 : ''; 1656 } 1657 unless( $Config{installvendorscript} ) { 1658 $self->{INSTALLVENDORSCRIPT} ||= $Config{usevendorprefix} 1659 ? $Config{installscript} 1660 : ''; 1661 } 1662 1663 1664 my $iprefix = $Config{installprefixexp} || $Config{installprefix} || 1665 $Config{prefixexp} || $Config{prefix} || ''; 1666 my $vprefix = $Config{usevendorprefix} ? $Config{vendorprefixexp} : ''; 1667 my $sprefix = $Config{siteprefixexp} || ''; 1668 1669 # 5.005_03 doesn't have a siteprefix. 1670 $sprefix = $iprefix unless $sprefix; 1671 1672 1673 $self->{PREFIX} ||= ''; 1674 1675 if( $self->{PREFIX} ) { 1676 @{$self}{qw(PERLPREFIX SITEPREFIX VENDORPREFIX)} = 1677 ('$(PREFIX)') x 3; 1678 } 1679 else { 1680 $self->{PERLPREFIX} ||= $iprefix; 1681 $self->{SITEPREFIX} ||= $sprefix; 1682 $self->{VENDORPREFIX} ||= $vprefix; 1683 1684 # Lots of MM extension authors like to use $(PREFIX) so we 1685 # put something sensible in there no matter what. 1686 $self->{PREFIX} = '$('.uc $self->{INSTALLDIRS}.'PREFIX)'; 1687 } 1688 1689 my $arch = $Config{archname}; 1690 my $version = $Config{version}; 1691 1692 # default style 1693 my $libstyle = $Config{installstyle} || 'lib/perl5'; 1694 my $manstyle = ''; 1695 1696 if( $self->{LIBSTYLE} ) { 1697 $libstyle = $self->{LIBSTYLE}; 1698 $manstyle = $self->{LIBSTYLE} eq 'lib/perl5' ? 'lib/perl5' : ''; 1699 } 1700 1701 # Some systems, like VOS, set installman*dir to '' if they can't 1702 # read man pages. 1703 for my $num (1, 3) { 1704 $self->{'INSTALLMAN'.$num.'DIR'} ||= 'none' 1705 unless $Config{'installman'.$num.'dir'}; 1706 } 1707 1708 my %bin_layouts = 1709 ( 1710 bin => { s => $iprefix, 1711 t => 'perl', 1712 d => 'bin' }, 1713 vendorbin => { s => $vprefix, 1714 t => 'vendor', 1715 d => 'bin' }, 1716 sitebin => { s => $sprefix, 1717 t => 'site', 1718 d => 'bin' }, 1719 script => { s => $iprefix, 1720 t => 'perl', 1721 d => 'bin' }, 1722 vendorscript=> { s => $vprefix, 1723 t => 'vendor', 1724 d => 'bin' }, 1725 sitescript => { s => $sprefix, 1726 t => 'site', 1727 d => 'bin' }, 1728 ); 1729 1730 my %man_layouts = 1731 ( 1732 man1dir => { s => $iprefix, 1733 t => 'perl', 1734 d => 'man/man1', 1735 style => $manstyle, }, 1736 siteman1dir => { s => $sprefix, 1737 t => 'site', 1738 d => 'man/man1', 1739 style => $manstyle, }, 1740 vendorman1dir => { s => $vprefix, 1741 t => 'vendor', 1742 d => 'man/man1', 1743 style => $manstyle, }, 1744 1745 man3dir => { s => $iprefix, 1746 t => 'perl', 1747 d => 'man/man3', 1748 style => $manstyle, }, 1749 siteman3dir => { s => $sprefix, 1750 t => 'site', 1751 d => 'man/man3', 1752 style => $manstyle, }, 1753 vendorman3dir => { s => $vprefix, 1754 t => 'vendor', 1755 d => 'man/man3', 1756 style => $manstyle, }, 1757 ); 1758 1759 my %lib_layouts = 1760 ( 1761 privlib => { s => $iprefix, 1762 t => 'perl', 1763 d => '', 1764 style => $libstyle, }, 1765 vendorlib => { s => $vprefix, 1766 t => 'vendor', 1767 d => '', 1768 style => $libstyle, }, 1769 sitelib => { s => $sprefix, 1770 t => 'site', 1771 d => 'site_perl', 1772 style => $libstyle, }, 1773 1774 archlib => { s => $iprefix, 1775 t => 'perl', 1776 d => "$version/$arch", 1777 style => $libstyle }, 1778 vendorarch => { s => $vprefix, 1779 t => 'vendor', 1780 d => "$version/$arch", 1781 style => $libstyle }, 1782 sitearch => { s => $sprefix, 1783 t => 'site', 1784 d => "site_perl/$version/$arch", 1785 style => $libstyle }, 1786 ); 1787 1788 1789 # Special case for LIB. 1790 if( $self->{LIB} ) { 1791 foreach my $var (keys %lib_layouts) { 1792 my $Installvar = uc "install$var"; 1793 1794 if( $var =~ /arch/ ) { 1795 $self->{$Installvar} ||= 1796 $self->catdir($self->{LIB}, $Config{archname}); 1797 } 1798 else { 1799 $self->{$Installvar} ||= $self->{LIB}; 1800 } 1801 } 1802 } 1803 1804 my %type2prefix = ( perl => 'PERLPREFIX', 1805 site => 'SITEPREFIX', 1806 vendor => 'VENDORPREFIX' 1807 ); 1808 1809 my %layouts = (%bin_layouts, %man_layouts, %lib_layouts); 1810 while( my($var, $layout) = each(%layouts) ) { 1811 my($s, $t, $d, $style) = @{$layout}{qw(s t d style)}; 1812 my $r = '$('.$type2prefix{$t}.')'; 1813 1814 print STDERR "Prefixing $var\n" if $Verbose >= 2; 1815 1816 my $installvar = "install$var"; 1817 my $Installvar = uc $installvar; 1818 next if $self->{$Installvar}; 1819 1820 $d = "$style/$d" if $style; 1821 $self->prefixify($installvar, $s, $r, $d); 1822 1823 print STDERR " $Installvar == $self->{$Installvar}\n" 1824 if $Verbose >= 2; 1825 } 1826 1827 # Generate these if they weren't figured out. 1828 $self->{VENDORARCHEXP} ||= $self->{INSTALLVENDORARCH}; 1829 $self->{VENDORLIBEXP} ||= $self->{INSTALLVENDORLIB}; 1830 1831 return 1; 1832} 1833 1834 1835=head3 init_from_INSTALL_BASE 1836 1837 $mm->init_from_INSTALL_BASE 1838 1839=cut 1840 1841my %map = ( 1842 lib => [qw(lib perl5)], 1843 arch => [('lib', 'perl5', $Config{archname})], 1844 bin => [qw(bin)], 1845 man1dir => [qw(man man1)], 1846 man3dir => [qw(man man3)] 1847 ); 1848$map{script} = $map{bin}; 1849 1850sub init_INSTALL_from_INSTALL_BASE { 1851 my $self = shift; 1852 1853 @{$self}{qw(PREFIX VENDORPREFIX SITEPREFIX PERLPREFIX)} = 1854 '$(INSTALL_BASE)'; 1855 1856 my %install; 1857 foreach my $thing (keys %map) { 1858 foreach my $dir (('', 'SITE', 'VENDOR')) { 1859 my $uc_thing = uc $thing; 1860 my $key = "INSTALL".$dir.$uc_thing; 1861 1862 $install{$key} ||= 1863 $self->catdir('$(INSTALL_BASE)', @{$map{$thing}}); 1864 } 1865 } 1866 1867 # Adjust for variable quirks. 1868 $install{INSTALLARCHLIB} ||= delete $install{INSTALLARCH}; 1869 $install{INSTALLPRIVLIB} ||= delete $install{INSTALLLIB}; 1870 1871 foreach my $key (keys %install) { 1872 $self->{$key} ||= $install{$key}; 1873 } 1874 1875 return 1; 1876} 1877 1878 1879=head3 init_VERSION I<Abstract> 1880 1881 $mm->init_VERSION 1882 1883Initialize macros representing versions of MakeMaker and other tools 1884 1885MAKEMAKER: path to the MakeMaker module. 1886 1887MM_VERSION: ExtUtils::MakeMaker Version 1888 1889MM_REVISION: ExtUtils::MakeMaker version control revision (for backwards 1890 compat) 1891 1892VERSION: version of your module 1893 1894VERSION_MACRO: which macro represents the version (usually 'VERSION') 1895 1896VERSION_SYM: like version but safe for use as an RCS revision number 1897 1898DEFINE_VERSION: -D line to set the module version when compiling 1899 1900XS_VERSION: version in your .xs file. Defaults to $(VERSION) 1901 1902XS_VERSION_MACRO: which macro represents the XS version. 1903 1904XS_DEFINE_VERSION: -D line to set the xs version when compiling. 1905 1906Called by init_main. 1907 1908=cut 1909 1910sub init_VERSION { 1911 my($self) = shift; 1912 1913 $self->{MAKEMAKER} = $ExtUtils::MakeMaker::Filename; 1914 $self->{MM_VERSION} = $ExtUtils::MakeMaker::VERSION; 1915 $self->{MM_REVISION}= $ExtUtils::MakeMaker::Revision; 1916 $self->{VERSION_FROM} ||= ''; 1917 1918 if ($self->{VERSION_FROM}){ 1919 $self->{VERSION} = $self->parse_version($self->{VERSION_FROM}); 1920 if( $self->{VERSION} eq 'undef' ) { 1921 carp("WARNING: Setting VERSION via file ". 1922 "'$self->{VERSION_FROM}' failed\n"); 1923 } 1924 } 1925 1926 # strip blanks 1927 if (defined $self->{VERSION}) { 1928 $self->{VERSION} =~ s/^\s+//; 1929 $self->{VERSION} =~ s/\s+$//; 1930 } 1931 else { 1932 $self->{VERSION} = ''; 1933 } 1934 1935 1936 $self->{VERSION_MACRO} = 'VERSION'; 1937 ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g; 1938 $self->{DEFINE_VERSION} = '-D$(VERSION_MACRO)=\"$(VERSION)\"'; 1939 1940 1941 # Graham Barr and Paul Marquess had some ideas how to ensure 1942 # version compatibility between the *.pm file and the 1943 # corresponding *.xs file. The bottomline was, that we need an 1944 # XS_VERSION macro that defaults to VERSION: 1945 $self->{XS_VERSION} ||= $self->{VERSION}; 1946 1947 $self->{XS_VERSION_MACRO} = 'XS_VERSION'; 1948 $self->{XS_DEFINE_VERSION} = '-D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"'; 1949 1950} 1951 1952 1953=head3 init_tools 1954 1955 $MM->init_tools(); 1956 1957Initializes the simple macro definitions used by tools_other() and 1958places them in the $MM object. These use conservative cross platform 1959versions and should be overridden with platform specific versions for 1960performance. 1961 1962Defines at least these macros. 1963 1964 Macro Description 1965 1966 NOOP Do nothing 1967 NOECHO Tell make not to display the command itself 1968 1969 SHELL Program used to run shell commands 1970 1971 ECHO Print text adding a newline on the end 1972 RM_F Remove a file 1973 RM_RF Remove a directory 1974 TOUCH Update a file's timestamp 1975 TEST_F Test for a file's existence 1976 CP Copy a file 1977 MV Move a file 1978 CHMOD Change permissions on a file 1979 FALSE Exit with non-zero 1980 TRUE Exit with zero 1981 1982 UMASK_NULL Nullify umask 1983 DEV_NULL Suppress all command output 1984 1985=cut 1986 1987sub init_tools { 1988 my $self = shift; 1989 1990 $self->{ECHO} ||= $self->oneliner('print qq{@ARGV}', ['-l']); 1991 $self->{ECHO_N} ||= $self->oneliner('print qq{@ARGV}'); 1992 1993 $self->{TOUCH} ||= $self->oneliner('touch', ["-MExtUtils::Command"]); 1994 $self->{CHMOD} ||= $self->oneliner('chmod', ["-MExtUtils::Command"]); 1995 $self->{RM_F} ||= $self->oneliner('rm_f', ["-MExtUtils::Command"]); 1996 $self->{RM_RF} ||= $self->oneliner('rm_rf', ["-MExtUtils::Command"]); 1997 $self->{TEST_F} ||= $self->oneliner('test_f', ["-MExtUtils::Command"]); 1998 $self->{FALSE} ||= $self->oneliner('exit 1'); 1999 $self->{TRUE} ||= $self->oneliner('exit 0'); 2000 2001 $self->{MKPATH} ||= $self->oneliner('mkpath', ["-MExtUtils::Command"]); 2002 2003 $self->{CP} ||= $self->oneliner('cp', ["-MExtUtils::Command"]); 2004 $self->{MV} ||= $self->oneliner('mv', ["-MExtUtils::Command"]); 2005 2006 $self->{MOD_INSTALL} ||= 2007 $self->oneliner(<<'CODE', ['-MExtUtils::Install']); 2008install([ from_to => {@ARGV}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]); 2009CODE 2010 $self->{DOC_INSTALL} ||= $self->oneliner('perllocal_install', ["-MExtUtils::Command::MM"]); 2011 $self->{UNINSTALL} ||= $self->oneliner('uninstall', ["-MExtUtils::Command::MM"]); 2012 $self->{WARN_IF_OLD_PACKLIST} ||= 2013 $self->oneliner('warn_if_old_packlist', ["-MExtUtils::Command::MM"]); 2014 $self->{FIXIN} ||= $self->oneliner('MY->fixin(shift)', ["-MExtUtils::MY"]); 2015 $self->{EQUALIZE_TIMESTAMP} ||= $self->oneliner('eqtime', ["-MExtUtils::Command"]); 2016 2017 $self->{UNINST} ||= 0; 2018 $self->{VERBINST} ||= 0; 2019 2020 $self->{SHELL} ||= $Config{sh}; 2021 2022 # UMASK_NULL is not used by MakeMaker but some CPAN modules 2023 # make use of it. 2024 $self->{UMASK_NULL} ||= "umask 0"; 2025 2026 # Not the greatest default, but its something. 2027 $self->{DEV_NULL} ||= "> /dev/null 2>&1"; 2028 2029 $self->{NOOP} ||= '$(TRUE)'; 2030 $self->{NOECHO} = '@' unless defined $self->{NOECHO}; 2031 2032 $self->{FIRST_MAKEFILE} ||= $self->{MAKEFILE} || 'Makefile'; 2033 $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE}; 2034 $self->{MAKEFILE_OLD} ||= $self->{MAKEFILE}.'.old'; 2035 $self->{MAKE_APERL_FILE} ||= $self->{MAKEFILE}.'.aperl'; 2036 2037 # Not everybody uses -f to indicate "use this Makefile instead" 2038 $self->{USEMAKEFILE} ||= '-f'; 2039 2040 # Some makes require a wrapper around macros passed in on the command 2041 # line. 2042 $self->{MACROSTART} ||= ''; 2043 $self->{MACROEND} ||= ''; 2044 2045 return; 2046} 2047 2048 2049=head3 init_others 2050 2051 $MM->init_others(); 2052 2053Initializes the macro definitions having to do with compiling and 2054linking used by tools_other() and places them in the $MM object. 2055 2056If there is no description, its the same as the parameter to 2057WriteMakefile() documented in ExtUtils::MakeMaker. 2058 2059=cut 2060 2061sub init_others { 2062 my $self = shift; 2063 2064 $self->{LD_RUN_PATH} = ""; 2065 2066 $self->{LIBS} = $self->_fix_libs($self->{LIBS}); 2067 2068 # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS} 2069 foreach my $libs ( @{$self->{LIBS}} ){ 2070 $libs =~ s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace 2071 my(@libs) = $self->extliblist($libs); 2072 if ($libs[0] or $libs[1] or $libs[2]){ 2073 # LD_RUN_PATH now computed by ExtUtils::Liblist 2074 ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, 2075 $self->{LDLOADLIBS}, $self->{LD_RUN_PATH}) = @libs; 2076 last; 2077 } 2078 } 2079 2080 if ( $self->{OBJECT} ) { 2081 $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g; 2082 } else { 2083 # init_dirscan should have found out, if we have C files 2084 $self->{OBJECT} = ""; 2085 $self->{OBJECT} = '$(BASEEXT)$(OBJ_EXT)' if @{$self->{C}||[]}; 2086 } 2087 $self->{OBJECT} =~ s/\n+/ \\\n\t/g; 2088 2089 $self->{BOOTDEP} = (-f "$self->{BASEEXT}_BS") ? "$self->{BASEEXT}_BS" : ""; 2090 $self->{PERLMAINCC} ||= '$(CC)'; 2091 $self->{LDFROM} = '$(OBJECT)' unless $self->{LDFROM}; 2092 2093 # Sanity check: don't define LINKTYPE = dynamic if we're skipping 2094 # the 'dynamic' section of MM. We don't have this problem with 2095 # 'static', since we either must use it (%Config says we can't 2096 # use dynamic loading) or the caller asked for it explicitly. 2097 if (!$self->{LINKTYPE}) { 2098 $self->{LINKTYPE} = $self->{SKIPHASH}{'dynamic'} 2099 ? 'static' 2100 : ($Config{usedl} ? 'dynamic' : 'static'); 2101 } 2102 2103 return; 2104} 2105 2106 2107# Lets look at $self->{LIBS} carefully: It may be an anon array, a string or 2108# undefined. In any case we turn it into an anon array 2109sub _fix_libs { 2110 my($self, $libs) = @_; 2111 2112 return !defined $libs ? [''] : 2113 !ref $libs ? [$libs] : 2114 !defined $libs->[0] ? [''] : 2115 $libs ; 2116} 2117 2118 2119=head3 tools_other 2120 2121 my $make_frag = $MM->tools_other; 2122 2123Returns a make fragment containing definitions for the macros init_others() 2124initializes. 2125 2126=cut 2127 2128sub tools_other { 2129 my($self) = shift; 2130 my @m; 2131 2132 # We set PM_FILTER as late as possible so it can see all the earlier 2133 # on macro-order sensitive makes such as nmake. 2134 for my $tool (qw{ SHELL CHMOD CP MV NOOP NOECHO RM_F RM_RF TEST_F TOUCH 2135 UMASK_NULL DEV_NULL MKPATH EQUALIZE_TIMESTAMP 2136 FALSE TRUE 2137 ECHO ECHO_N 2138 UNINST VERBINST 2139 MOD_INSTALL DOC_INSTALL UNINSTALL 2140 WARN_IF_OLD_PACKLIST 2141 MACROSTART MACROEND 2142 USEMAKEFILE 2143 PM_FILTER 2144 FIXIN 2145 } ) 2146 { 2147 next unless defined $self->{$tool}; 2148 push @m, "$tool = $self->{$tool}\n"; 2149 } 2150 2151 return join "", @m; 2152} 2153 2154 2155=head3 init_DIRFILESEP I<Abstract> 2156 2157 $MM->init_DIRFILESEP; 2158 my $dirfilesep = $MM->{DIRFILESEP}; 2159 2160Initializes the DIRFILESEP macro which is the seperator between the 2161directory and filename in a filepath. ie. / on Unix, \ on Win32 and 2162nothing on VMS. 2163 2164For example: 2165 2166 # instead of $(INST_ARCHAUTODIR)/extralibs.ld 2167 $(INST_ARCHAUTODIR)$(DIRFILESEP)extralibs.ld 2168 2169Something of a hack but it prevents a lot of code duplication between 2170MM_* variants. 2171 2172Do not use this as a seperator between directories. Some operating 2173systems use different seperators between subdirectories as between 2174directories and filenames (for example: VOLUME:[dir1.dir2]file on VMS). 2175 2176=head3 init_linker I<Abstract> 2177 2178 $mm->init_linker; 2179 2180Initialize macros which have to do with linking. 2181 2182PERL_ARCHIVE: path to libperl.a equivalent to be linked to dynamic 2183extensions. 2184 2185PERL_ARCHIVE_AFTER: path to a library which should be put on the 2186linker command line I<after> the external libraries to be linked to 2187dynamic extensions. This may be needed if the linker is one-pass, and 2188Perl includes some overrides for C RTL functions, such as malloc(). 2189 2190EXPORT_LIST: name of a file that is passed to linker to define symbols 2191to be exported. 2192 2193Some OSes do not need these in which case leave it blank. 2194 2195 2196=head3 init_platform 2197 2198 $mm->init_platform 2199 2200Initialize any macros which are for platform specific use only. 2201 2202A typical one is the version number of your OS specific mocule. 2203(ie. MM_Unix_VERSION or MM_VMS_VERSION). 2204 2205=cut 2206 2207sub init_platform { 2208 return ''; 2209} 2210 2211 2212=head3 init_MAKE 2213 2214 $mm->init_MAKE 2215 2216Initialize MAKE from either a MAKE environment variable or $Config{make}. 2217 2218=cut 2219 2220sub init_MAKE { 2221 my $self = shift; 2222 2223 $self->{MAKE} ||= $ENV{MAKE} || $Config{make}; 2224} 2225 2226 2227=head2 Tools 2228 2229A grab bag of methods to generate specific macros and commands. 2230 2231 2232 2233=head3 manifypods 2234 2235Defines targets and routines to translate the pods into manpages and 2236put them into the INST_* directories. 2237 2238=cut 2239 2240sub manifypods { 2241 my $self = shift; 2242 2243 my $POD2MAN_macro = $self->POD2MAN_macro(); 2244 my $manifypods_target = $self->manifypods_target(); 2245 2246 return <<END_OF_TARGET; 2247 2248$POD2MAN_macro 2249 2250$manifypods_target 2251 2252END_OF_TARGET 2253 2254} 2255 2256 2257=head3 POD2MAN_macro 2258 2259 my $pod2man_macro = $self->POD2MAN_macro 2260 2261Returns a definition for the POD2MAN macro. This is a program 2262which emulates the pod2man utility. You can add more switches to the 2263command by simply appending them on the macro. 2264 2265Typical usage: 2266 2267 $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) podfile1 man_page1 ... 2268 2269=cut 2270 2271sub POD2MAN_macro { 2272 my $self = shift; 2273 2274# Need the trailing '--' so perl stops gobbling arguments and - happens 2275# to be an alternative end of line seperator on VMS so we quote it 2276 return <<'END_OF_DEF'; 2277POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--" 2278POD2MAN = $(POD2MAN_EXE) 2279END_OF_DEF 2280} 2281 2282 2283=head3 test_via_harness 2284 2285 my $command = $mm->test_via_harness($perl, $tests); 2286 2287Returns a $command line which runs the given set of $tests with 2288Test::Harness and the given $perl. 2289 2290Used on the t/*.t files. 2291 2292=cut 2293 2294sub test_via_harness { 2295 my($self, $perl, $tests) = @_; 2296 2297 return qq{\t$perl "-MExtUtils::Command::MM" }. 2298 qq{"-e" "test_harness(\$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n}; 2299} 2300 2301=head3 test_via_script 2302 2303 my $command = $mm->test_via_script($perl, $script); 2304 2305Returns a $command line which just runs a single test without 2306Test::Harness. No checks are done on the results, they're just 2307printed. 2308 2309Used for test.pl, since they don't always follow Test::Harness 2310formatting. 2311 2312=cut 2313 2314sub test_via_script { 2315 my($self, $perl, $script) = @_; 2316 return qq{\t$perl "-I\$(INST_LIB)" "-I\$(INST_ARCHLIB)" $script\n}; 2317} 2318 2319 2320=head3 tool_autosplit 2321 2322Defines a simple perl call that runs autosplit. May be deprecated by 2323pm_to_blib soon. 2324 2325=cut 2326 2327sub tool_autosplit { 2328 my($self, %attribs) = @_; 2329 2330 my $maxlen = $attribs{MAXLEN} ? '$$AutoSplit::Maxlen=$attribs{MAXLEN};' 2331 : ''; 2332 2333 my $asplit = $self->oneliner(sprintf <<'PERL_CODE', $maxlen); 2334use AutoSplit; %s autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) 2335PERL_CODE 2336 2337 return sprintf <<'MAKE_FRAG', $asplit; 2338# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto 2339AUTOSPLITFILE = %s 2340 2341MAKE_FRAG 2342 2343} 2344 2345 2346=head3 arch_check 2347 2348 my $arch_ok = $mm->arch_check( 2349 $INC{"Config.pm"}, 2350 File::Spec->catfile($Config{archlibexp}, "Config.pm") 2351 ); 2352 2353A sanity check that what Perl thinks the architecture is and what 2354Config thinks the architecture is are the same. If they're not it 2355will return false and show a diagnostic message. 2356 2357When building Perl it will always return true, as nothing is installed 2358yet. 2359 2360The interface is a bit odd because this is the result of a 2361quick refactoring. Don't rely on it. 2362 2363=cut 2364 2365sub arch_check { 2366 my $self = shift; 2367 my($pconfig, $cconfig) = @_; 2368 2369 return 1 if $self->{PERL_SRC}; 2370 2371 my($pvol, $pthinks) = $self->splitpath($pconfig); 2372 my($cvol, $cthinks) = $self->splitpath($cconfig); 2373 2374 $pthinks = $self->canonpath($pthinks); 2375 $cthinks = $self->canonpath($cthinks); 2376 2377 my $ret = 1; 2378 if ($pthinks ne $cthinks) { 2379 print "Have $pthinks\n"; 2380 print "Want $cthinks\n"; 2381 2382 $ret = 0; 2383 2384 my $arch = (grep length, $self->splitdir($pthinks))[-1]; 2385 2386 print STDOUT <<END unless $self->{UNINSTALLED_PERL}; 2387Your perl and your Config.pm seem to have different ideas about the 2388architecture they are running on. 2389Perl thinks: [$arch] 2390Config says: [$Config{archname}] 2391This may or may not cause problems. Please check your installation of perl 2392if you have problems building this extension. 2393END 2394 } 2395 2396 return $ret; 2397} 2398 2399 2400 2401=head2 File::Spec wrappers 2402 2403ExtUtils::MM_Any is a subclass of File::Spec. The methods noted here 2404override File::Spec. 2405 2406 2407 2408=head3 catfile 2409 2410File::Spec <= 0.83 has a bug where the file part of catfile is not 2411canonicalized. This override fixes that bug. 2412 2413=cut 2414 2415sub catfile { 2416 my $self = shift; 2417 return $self->canonpath($self->SUPER::catfile(@_)); 2418} 2419 2420 2421 2422=head2 Misc 2423 2424Methods I can't really figure out where they should go yet. 2425 2426 2427=head3 find_tests 2428 2429 my $test = $mm->find_tests; 2430 2431Returns a string suitable for feeding to the shell to return all 2432tests in t/*.t. 2433 2434=cut 2435 2436sub find_tests { 2437 my($self) = shift; 2438 return -d 't' ? 't/*.t' : ''; 2439} 2440 2441 2442=head3 extra_clean_files 2443 2444 my @files_to_clean = $MM->extra_clean_files; 2445 2446Returns a list of OS specific files to be removed in the clean target in 2447addition to the usual set. 2448 2449=cut 2450 2451# An empty method here tickled a perl 5.8.1 bug and would return its object. 2452sub extra_clean_files { 2453 return; 2454} 2455 2456 2457=head3 installvars 2458 2459 my @installvars = $mm->installvars; 2460 2461A list of all the INSTALL* variables without the INSTALL prefix. Useful 2462for iteration or building related variable sets. 2463 2464=cut 2465 2466sub installvars { 2467 return qw(PRIVLIB SITELIB VENDORLIB 2468 ARCHLIB SITEARCH VENDORARCH 2469 BIN SITEBIN VENDORBIN 2470 SCRIPT SITESCRIPT VENDORSCRIPT 2471 MAN1DIR SITEMAN1DIR VENDORMAN1DIR 2472 MAN3DIR SITEMAN3DIR VENDORMAN3DIR 2473 ); 2474} 2475 2476 2477=head3 libscan 2478 2479 my $wanted = $self->libscan($path); 2480 2481Takes a path to a file or dir and returns an empty string if we don't 2482want to include this file in the library. Otherwise it returns the 2483the $path unchanged. 2484 2485Mainly used to exclude version control administrative directories from 2486installation. 2487 2488=cut 2489 2490sub libscan { 2491 my($self,$path) = @_; 2492 my($dirs,$file) = ($self->splitpath($path))[1,2]; 2493 return '' if grep /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/, 2494 $self->splitdir($dirs), $file; 2495 2496 return $path; 2497} 2498 2499 2500=head3 platform_constants 2501 2502 my $make_frag = $mm->platform_constants 2503 2504Returns a make fragment defining all the macros initialized in 2505init_platform() rather than put them in constants(). 2506 2507=cut 2508 2509sub platform_constants { 2510 return ''; 2511} 2512 2513=begin private 2514 2515=head3 _PREREQ_PRINT 2516 2517 $self->_PREREQ_PRINT; 2518 2519Implements PREREQ_PRINT. 2520 2521Refactored out of MakeMaker->new(). 2522 2523=end private 2524 2525=cut 2526 2527sub _PREREQ_PRINT { 2528 my $self = shift; 2529 2530 require Data::Dumper; 2531 my @what = ('PREREQ_PM'); 2532 push @what, 'MIN_PERL_VERSION' if $self->{MIN_PERL_VERSION}; 2533 push @what, 'BUILD_REQUIRES' if $self->{BUILD_REQUIRES}; 2534 print Data::Dumper->Dump([@{$self}{@what}], \@what); 2535 exit 0; 2536} 2537 2538 2539=begin private 2540 2541=head3 _PRINT_PREREQ 2542 2543 $mm->_PRINT_PREREQ; 2544 2545Implements PRINT_PREREQ, a slightly different version of PREREQ_PRINT 2546added by Redhat to, I think, support generating RPMs from Perl modules. 2547 2548Should not include BUILD_REQUIRES as RPMs do not incluide them. 2549 2550Refactored out of MakeMaker->new(). 2551 2552=end private 2553 2554=cut 2555 2556sub _PRINT_PREREQ { 2557 my $self = shift; 2558 2559 my $prereqs= $self->{PREREQ_PM}; 2560 my @prereq = map { [$_, $prereqs->{$_}] } keys %$prereqs; 2561 2562 if ( $self->{MIN_PERL_VERSION} ) { 2563 push @prereq, ['perl' => $self->{MIN_PERL_VERSION}]; 2564 } 2565 2566 print join(" ", map { "perl($_->[0])>=$_->[1] " } 2567 sort { $a->[0] cmp $b->[0] } @prereq), "\n"; 2568 exit 0; 2569} 2570 2571 2572=begin private 2573 2574=head3 _all_prereqs 2575 2576 my $prereqs = $self->_all_prereqs; 2577 2578Returns a hash ref of both PREREQ_PM and BUILD_REQUIRES. 2579 2580=end private 2581 2582=cut 2583 2584sub _all_prereqs { 2585 my $self = shift; 2586 2587 return { %{$self->{PREREQ_PM}}, %{$self->{BUILD_REQUIRES}} }; 2588} 2589 2590 2591=head1 AUTHOR 2592 2593Michael G Schwern <schwern@pobox.com> and the denizens of 2594makemaker@perl.org with code from ExtUtils::MM_Unix and 2595ExtUtils::MM_Win32. 2596 2597 2598=cut 2599 26001; 2601