home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl / 5.8.8 / ExtUtils / MM_Win32.pm < prev    next >
Encoding:
Perl POD Document  |  2006-07-07  |  11.8 KB  |  538 lines
  1. package ExtUtils::MM_Win32;
  2.  
  3. use strict;
  4.  
  5.  
  6. =head1 NAME
  7.  
  8. ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.  use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed
  13.  
  14. =head1 DESCRIPTION
  15.  
  16. See ExtUtils::MM_Unix for a documentation of the methods provided
  17. there. This package overrides the implementation of these methods, not
  18. the semantics.
  19.  
  20. =cut 
  21.  
  22. use ExtUtils::MakeMaker::Config;
  23. use File::Basename;
  24. use File::Spec;
  25. use ExtUtils::MakeMaker qw( neatvalue );
  26.  
  27. use vars qw(@ISA $VERSION $BORLAND $GCC $DMAKE $NMAKE);
  28.  
  29. require ExtUtils::MM_Any;
  30. require ExtUtils::MM_Unix;
  31. @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  32. $VERSION = '1.12';
  33.  
  34. $ENV{EMXSHELL} = 'sh'; # to run `commands`
  35.  
  36. $BORLAND = 1 if $Config{'cc'} =~ /^bcc/i;
  37. $GCC     = 1 if $Config{'cc'} =~ /^gcc/i;
  38. $DMAKE = 1 if $Config{'make'} =~ /^dmake/i;
  39. $NMAKE = 1 if $Config{'make'} =~ /^nmake/i;
  40.  
  41.  
  42. =head2 Overridden methods
  43.  
  44. =over 4
  45.  
  46. =item B<dlsyms>
  47.  
  48. =cut
  49.  
  50. sub dlsyms {
  51.     my($self,%attribs) = @_;
  52.  
  53.     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
  54.     my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
  55.     my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
  56.     my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
  57.     my(@m);
  58.  
  59.     if (not $self->{SKIPHASH}{'dynamic'}) {
  60.     push(@m,"
  61. $self->{BASEEXT}.def: Makefile.PL
  62. ",
  63.      q!    $(PERLRUN) -MExtUtils::Mksymlists \\
  64.      -e "Mksymlists('NAME'=>\"!, $self->{NAME},
  65.      q!\", 'DLBASE' => '!,$self->{DLBASE},
  66.      # The above two lines quoted differently to work around
  67.      # a bug in the 4DOS/4NT command line interpreter.  The visible
  68.      # result of the bug was files named q('extension_name',) *with the
  69.      # single quotes and the comma* in the extension build directories.
  70.      q!', 'DL_FUNCS' => !,neatvalue($funcs),
  71.      q!, 'FUNCLIST' => !,neatvalue($funclist),
  72.      q!, 'IMPORTS' => !,neatvalue($imports),
  73.      q!, 'DL_VARS' => !, neatvalue($vars), q!);"
  74. !);
  75.     }
  76.     join('',@m);
  77. }
  78.  
  79. =item replace_manpage_separator
  80.  
  81. Changes the path separator with .
  82.  
  83. =cut
  84.  
  85. sub replace_manpage_separator {
  86.     my($self,$man) = @_;
  87.     $man =~ s,/+,.,g;
  88.     $man;
  89. }
  90.  
  91.  
  92. =item B<maybe_command>
  93.  
  94. Since Windows has nothing as simple as an executable bit, we check the
  95. file extension.
  96.  
  97. The PATHEXT env variable will be used to get a list of extensions that
  98. might indicate a command, otherwise .com, .exe, .bat and .cmd will be
  99. used by default.
  100.  
  101. =cut
  102.  
  103. sub maybe_command {
  104.     my($self,$file) = @_;
  105.     my @e = exists($ENV{'PATHEXT'})
  106.           ? split(/;/, $ENV{PATHEXT})
  107.       : qw(.com .exe .bat .cmd);
  108.     my $e = '';
  109.     for (@e) { $e .= "\Q$_\E|" }
  110.     chop $e;
  111.     # see if file ends in one of the known extensions
  112.     if ($file =~ /($e)$/i) {
  113.     return $file if -e $file;
  114.     }
  115.     else {
  116.     for (@e) {
  117.         return "$file$_" if -e "$file$_";
  118.     }
  119.     }
  120.     return;
  121. }
  122.  
  123.  
  124. =item B<init_DIRFILESEP>
  125.  
  126. Using \ for Windows.
  127.  
  128. =cut
  129.  
  130. sub init_DIRFILESEP {
  131.     my($self) = shift;
  132.  
  133.     # The ^ makes sure its not interpreted as an escape in nmake
  134.     $self->{DIRFILESEP} = $NMAKE ? '^\\' :
  135.                           $DMAKE ? '\\\\'
  136.                                  : '\\';
  137. }
  138.  
  139. =item B<init_others>
  140.  
  141. Override some of the Unix specific commands with portable
  142. ExtUtils::Command ones.
  143.  
  144. Also provide defaults for LD and AR in case the %Config values aren't
  145. set.
  146.  
  147. LDLOADLIBS's default is changed to $Config{libs}.
  148.  
  149. Adjustments are made for Borland's quirks needing -L to come first.
  150.  
  151. =cut
  152.  
  153. sub init_others {
  154.     my ($self) = @_;
  155.  
  156.     # Used in favor of echo because echo won't strip quotes. :(
  157.     $self->{ECHO}     ||= $self->oneliner('print qq{@ARGV}', ['-l']);
  158.     $self->{ECHO_N}   ||= $self->oneliner('print qq{@ARGV}');
  159.  
  160.     $self->{TOUCH}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e touch';
  161.     $self->{CHMOD}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e chmod'; 
  162.     $self->{CP}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e cp';
  163.     $self->{RM_F}     ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_f';
  164.     $self->{RM_RF}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_rf';
  165.     $self->{MV}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e mv';
  166.     $self->{NOOP}     ||= 'rem';
  167.     $self->{TEST_F}   ||= '$(ABSPERLRUN) -MExtUtils::Command -e test_f';
  168.     $self->{DEV_NULL} ||= '> NUL';
  169.  
  170.     $self->{FIXIN}    ||= $self->{PERL_CORE} ? 
  171.       "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" : 
  172.       'pl2bat.bat';
  173.  
  174.     $self->{LD}     ||= $Config{ld} || 'link';
  175.     $self->{AR}     ||= $Config{ar} || 'lib';
  176.  
  177.     $self->SUPER::init_others;
  178.  
  179.     # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
  180.     delete $self->{SHELL};
  181.  
  182.     $self->{LDLOADLIBS} ||= $Config{libs};
  183.     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
  184.     if ($BORLAND) {
  185.         my $libs = $self->{LDLOADLIBS};
  186.         my $libpath = '';
  187.         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
  188.             $libpath .= ' ' if length $libpath;
  189.             $libpath .= $1;
  190.         }
  191.         $self->{LDLOADLIBS} = $libs;
  192.         $self->{LDDLFLAGS} ||= $Config{lddlflags};
  193.         $self->{LDDLFLAGS} .= " $libpath";
  194.     }
  195.  
  196.     return 1;
  197. }
  198.  
  199.  
  200. =item init_platform
  201.  
  202. Add MM_Win32_VERSION.
  203.  
  204. =item platform_constants
  205.  
  206. =cut
  207.  
  208. sub init_platform {
  209.     my($self) = shift;
  210.  
  211.     $self->{MM_Win32_VERSION} = $VERSION;
  212. }
  213.  
  214. sub platform_constants {
  215.     my($self) = shift;
  216.     my $make_frag = '';
  217.  
  218.     foreach my $macro (qw(MM_Win32_VERSION))
  219.     {
  220.         next unless defined $self->{$macro};
  221.         $make_frag .= "$macro = $self->{$macro}\n";
  222.     }
  223.  
  224.     return $make_frag;
  225. }
  226.  
  227.  
  228. =item special_targets
  229.  
  230. Add .USESHELL target for dmake.
  231.  
  232. =cut
  233.  
  234. sub special_targets {
  235.     my($self) = @_;
  236.  
  237.     my $make_frag = $self->SUPER::special_targets;
  238.  
  239.     $make_frag .= <<'MAKE_FRAG' if $DMAKE;
  240. .USESHELL :
  241. MAKE_FRAG
  242.  
  243.     return $make_frag;
  244. }
  245.  
  246.  
  247. =item static_lib
  248.  
  249. Changes how to run the linker.
  250.  
  251. The rest is duplicate code from MM_Unix.  Should move the linker code
  252. to its own method.
  253.  
  254. =cut
  255.  
  256. sub static_lib {
  257.     my($self) = @_;
  258.     return '' unless $self->has_link_code;
  259.  
  260.     my(@m);
  261.     push(@m, <<'END');
  262. $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
  263.     $(RM_RF) $@
  264. END
  265.  
  266.     # If this extension has its own library (eg SDBM_File)
  267.     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
  268.     push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
  269.     $(CP) $(MYEXTLIB) $@
  270. MAKE_FRAG
  271.  
  272.     push @m,
  273. q{    $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
  274.               : ($GCC ? '-ru $@ $(OBJECT)'
  275.                       : '-out:$@ $(OBJECT)')).q{
  276.     $(CHMOD) $(PERM_RWX) $@
  277.     $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
  278. };
  279.  
  280.     # Old mechanism - still available:
  281.     push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
  282.     $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
  283. MAKE_FRAG
  284.  
  285.     join('', @m);
  286. }
  287.  
  288.  
  289. =item dynamic_lib
  290.  
  291. Complicated stuff for Win32 that I don't understand. :(
  292.  
  293. =cut
  294.  
  295. sub dynamic_lib {
  296.     my($self, %attribs) = @_;
  297.     return '' unless $self->needs_linking(); #might be because of a subdir
  298.  
  299.     return '' unless $self->has_link_code;
  300.  
  301.     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
  302.     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
  303.     my($ldfrom) = '$(LDFROM)';
  304.     my(@m);
  305.  
  306. # one thing for GCC/Mingw32:
  307. # we try to overcome non-relocateable-DLL problems by generating
  308. #    a (hopefully unique) image-base from the dll's name
  309. # -- BKS, 10-19-1999
  310.     if ($GCC) { 
  311.     my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
  312.     $dllname =~ /(....)(.{0,4})/;
  313.     my $baseaddr = unpack("n", $1 ^ $2);
  314.     $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
  315.     }
  316.  
  317.     push(@m,'
  318. # This section creates the dynamically loadable $(INST_DYNAMIC)
  319. # from $(OBJECT) and possibly $(MYEXTLIB).
  320. OTHERLDFLAGS = '.$otherldflags.'
  321. INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
  322.  
  323. $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  324. ');
  325.     if ($GCC) {
  326.       push(@m,  
  327.        q{    dlltool --def $(EXPORT_LIST) --output-exp dll.exp
  328.     $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
  329.     dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
  330.     $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
  331.     } elsif ($BORLAND) {
  332.       push(@m,
  333.        q{    $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
  334.        .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
  335.          .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
  336.         : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
  337.          .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
  338.        .q{,$(RESFILES)});
  339.     } else {    # VC
  340.       push(@m,
  341.        q{    $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
  342.       .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
  343.     }
  344.     push @m, '
  345.     $(CHMOD) $(PERM_RWX) $@
  346. ';
  347.  
  348.     join('',@m);
  349. }
  350.  
  351. =item extra_clean_files
  352.  
  353. Clean out some extra dll.{base,exp} files which might be generated by
  354. gcc.  Otherwise, take out all *.pdb files.
  355.  
  356. =cut
  357.  
  358. sub extra_clean_files {
  359.     my $self = shift;
  360.  
  361.     return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
  362. }
  363.  
  364. =item init_linker
  365.  
  366. =cut
  367.  
  368. sub init_linker {
  369.     my $self = shift;
  370.  
  371.     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
  372.     $self->{PERL_ARCHIVE_AFTER} = '';
  373.     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
  374. }
  375.  
  376.  
  377. =item perl_script
  378.  
  379. Checks for the perl program under several common perl extensions.
  380.  
  381. =cut
  382.  
  383. sub perl_script {
  384.     my($self,$file) = @_;
  385.     return $file if -r $file && -f _;
  386.     return "$file.pl"  if -r "$file.pl" && -f _;
  387.     return "$file.plx" if -r "$file.plx" && -f _;
  388.     return "$file.bat" if -r "$file.bat" && -f _;
  389.     return;
  390. }
  391.  
  392.  
  393. =item xs_o
  394.  
  395. This target is stubbed out.  Not sure why.
  396.  
  397. =cut
  398.  
  399. sub xs_o {
  400.     return ''
  401. }
  402.  
  403.  
  404. =item pasthru
  405.  
  406. All we send is -nologo to nmake to prevent it from printing its damned
  407. banner.
  408.  
  409. =cut
  410.  
  411. sub pasthru {
  412.     my($self) = shift;
  413.     return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
  414. }
  415.  
  416.  
  417. =item oneliner
  418.  
  419. These are based on what command.com does on Win98.  They may be wrong
  420. for other Windows shells, I don't know.
  421.  
  422. =cut
  423.  
  424. sub oneliner {
  425.     my($self, $cmd, $switches) = @_;
  426.     $switches = [] unless defined $switches;
  427.  
  428.     # Strip leading and trailing newlines
  429.     $cmd =~ s{^\n+}{};
  430.     $cmd =~ s{\n+$}{};
  431.  
  432.     $cmd = $self->quote_literal($cmd);
  433.     $cmd = $self->escape_newlines($cmd);
  434.  
  435.     $switches = join ' ', @$switches;
  436.  
  437.     return qq{\$(ABSPERLRUN) $switches -e $cmd};
  438. }
  439.  
  440.  
  441. sub quote_literal {
  442.     my($self, $text) = @_;
  443.  
  444.     # I don't know if this is correct, but it seems to work on
  445.     # Win98's command.com
  446.     $text =~ s{"}{\\"}g;
  447.  
  448.     # dmake eats '{' inside double quotes and leaves alone { outside double
  449.     # quotes; however it transforms {{ into { either inside and outside double
  450.     # quotes.  It also translates }} into }.  The escaping below is not
  451.     # 100% correct.
  452.     if( $DMAKE ) {
  453.         $text =~ s/{/{{/g;
  454.         $text =~ s/}}/}}}/g;
  455.     }
  456.  
  457.     return qq{"$text"};
  458. }
  459.  
  460.  
  461. sub escape_newlines {
  462.     my($self, $text) = @_;
  463.  
  464.     # Escape newlines
  465.     $text =~ s{\n}{\\\n}g;
  466.  
  467.     return $text;
  468. }
  469.  
  470.  
  471. =item cd
  472.  
  473. dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
  474. wants:
  475.  
  476.     cd dir
  477.     command
  478.     another_command
  479.     cd ..
  480.  
  481. B<NOTE> This cd can only go one level down.  So far this sufficient for
  482. what MakeMaker needs.
  483.  
  484. =cut
  485.  
  486. sub cd {
  487.     my($self, $dir, @cmds) = @_;
  488.  
  489.     return $self->SUPER::cd($dir, @cmds) unless $NMAKE;
  490.  
  491.     my $cmd = join "\n\t", map "$_", @cmds;
  492.  
  493.     # No leading tab and no trailing newline makes for easier embedding.
  494.     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd;
  495. cd %s
  496.     %s
  497.     cd ..
  498. MAKE_FRAG
  499.  
  500.     chomp $make_frag;
  501.  
  502.     return $make_frag;
  503. }
  504.  
  505.  
  506. =item max_exec_len
  507.  
  508. nmake 1.50 limits command length to 2048 characters.
  509.  
  510. =cut
  511.  
  512. sub max_exec_len {
  513.     my $self = shift;
  514.  
  515.     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
  516. }
  517.  
  518.  
  519. =item os_flavor
  520.  
  521. Windows is Win32.
  522.  
  523. =cut
  524.  
  525. sub os_flavor {
  526.     return('Win32');
  527. }
  528.  
  529.  
  530. 1;
  531. __END__
  532.  
  533. =back
  534.  
  535. =cut 
  536.  
  537.  
  538.