home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / MM_Win32.pm < prev    next >
Text File  |  2005-01-27  |  12KB  |  522 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 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.09';
  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<find_tests>
  125.  
  126. The Win9x shell does not expand globs and I'll play it safe and assume
  127. other Windows variants don't either.
  128.  
  129. So we do it for them.
  130.  
  131. =cut
  132.  
  133. sub find_tests {
  134.     return join(' ', <t\\*.t>);
  135. }
  136.  
  137.  
  138. =item B<init_DIRFILESEP>
  139.  
  140. Using \ for Windows.
  141.  
  142. =cut
  143.  
  144. sub init_DIRFILESEP {
  145.     my($self) = shift;
  146.  
  147.     # The ^ makes sure its not interpreted as an escape in nmake
  148.     $self->{DIRFILESEP} = $NMAKE ? '^\\' :
  149.                           $DMAKE ? '\\\\'
  150.                                  : '\\';
  151. }
  152.  
  153. =item B<init_others>
  154.  
  155. Override some of the Unix specific commands with portable
  156. ExtUtils::Command ones.
  157.  
  158. Also provide defaults for LD and AR in case the %Config values aren't
  159. set.
  160.  
  161. LDLOADLIBS's default is changed to $Config{libs}.
  162.  
  163. Adjustments are made for Borland's quirks needing -L to come first.
  164.  
  165. =cut
  166.  
  167. sub init_others {
  168.     my ($self) = @_;
  169.  
  170.     # Used in favor of echo because echo won't strip quotes. :(
  171.     $self->{ECHO}     ||= $self->oneliner('print qq{@ARGV}', ['-l']);
  172.     $self->{ECHO_N}   ||= $self->oneliner('print qq{@ARGV}');
  173.  
  174.     $self->{TOUCH}    ||= '$(PERLRUN) -MExtUtils::Command -e touch';
  175.     $self->{CHMOD}    ||= '$(PERLRUN) -MExtUtils::Command -e chmod'; 
  176.     $self->{CP}       ||= '$(PERLRUN) -MExtUtils::Command -e cp';
  177.     $self->{RM_F}     ||= '$(PERLRUN) -MExtUtils::Command -e rm_f';
  178.     $self->{RM_RF}    ||= '$(PERLRUN) -MExtUtils::Command -e rm_rf';
  179.     $self->{MV}       ||= '$(PERLRUN) -MExtUtils::Command -e mv';
  180.     $self->{NOOP}     ||= 'rem';
  181.     $self->{TEST_F}   ||= '$(PERLRUN) -MExtUtils::Command -e test_f';
  182.     $self->{DEV_NULL} ||= '> NUL';
  183.  
  184.     $self->{LD}     ||= $Config{ld} || 'link';
  185.     $self->{AR}     ||= $Config{ar} || 'lib';
  186.  
  187.     $self->SUPER::init_others;
  188.  
  189.     # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
  190.     delete $self->{SHELL};
  191.  
  192.     $self->{LDLOADLIBS} ||= $Config{libs};
  193.     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
  194.     if ($BORLAND) {
  195.         my $libs = $self->{LDLOADLIBS};
  196.         my $libpath = '';
  197.         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
  198.             $libpath .= ' ' if length $libpath;
  199.             $libpath .= $1;
  200.         }
  201.         $self->{LDLOADLIBS} = $libs;
  202.         $self->{LDDLFLAGS} ||= $Config{lddlflags};
  203.         $self->{LDDLFLAGS} .= " $libpath";
  204.     }
  205.  
  206.     return 1;
  207. }
  208.  
  209.  
  210. =item init_platform (o)
  211.  
  212. Add MM_Win32_VERSION.
  213.  
  214. =item platform_constants (o)
  215.  
  216. =cut
  217.  
  218. sub init_platform {
  219.     my($self) = shift;
  220.  
  221.     $self->{MM_Win32_VERSION} = $VERSION;
  222. }
  223.  
  224. sub platform_constants {
  225.     my($self) = shift;
  226.     my $make_frag = '';
  227.  
  228.     foreach my $macro (qw(MM_Win32_VERSION))
  229.     {
  230.         next unless defined $self->{$macro};
  231.         $make_frag .= "$macro = $self->{$macro}\n";
  232.     }
  233.  
  234.     return $make_frag;
  235. }
  236.  
  237.  
  238. =item special_targets (o)
  239.  
  240. Add .USESHELL target for dmake.
  241.  
  242. =cut
  243.  
  244. sub special_targets {
  245.     my($self) = @_;
  246.  
  247.     my $make_frag = $self->SUPER::special_targets;
  248.  
  249.     $make_frag .= <<'MAKE_FRAG' if $DMAKE;
  250. .USESHELL :
  251. MAKE_FRAG
  252.  
  253.     return $make_frag;
  254. }
  255.  
  256.  
  257. =item static_lib (o)
  258.  
  259. Changes how to run the linker.
  260.  
  261. The rest is duplicate code from MM_Unix.  Should move the linker code
  262. to its own method.
  263.  
  264. =cut
  265.  
  266. sub static_lib {
  267.     my($self) = @_;
  268.     return '' unless $self->has_link_code;
  269.  
  270.     my(@m);
  271.     push(@m, <<'END');
  272. $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
  273.     $(RM_RF) $@
  274. END
  275.  
  276.     # If this extension has its own library (eg SDBM_File)
  277.     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
  278.     push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
  279.     $(CP) $(MYEXTLIB) $@
  280. MAKE_FRAG
  281.  
  282.     push @m,
  283. q{    $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
  284.               : ($GCC ? '-ru $@ $(OBJECT)'
  285.                       : '-out:$@ $(OBJECT)')).q{
  286.     $(CHMOD) $(PERM_RWX) $@
  287.     $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
  288. };
  289.  
  290.     # Old mechanism - still available:
  291.     push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
  292.     $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
  293. MAKE_FRAG
  294.  
  295.     push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)');
  296.     join('', @m);
  297. }
  298.  
  299.  
  300. =item dynamic_lib (o)
  301.  
  302. Complicated stuff for Win32 that I don't understand. :(
  303.  
  304. =cut
  305.  
  306. sub dynamic_lib {
  307.     my($self, %attribs) = @_;
  308.     return '' unless $self->needs_linking(); #might be because of a subdir
  309.  
  310.     return '' unless $self->has_link_code;
  311.  
  312.     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
  313.     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
  314.     my($ldfrom) = '$(LDFROM)';
  315.     my(@m);
  316.  
  317. # one thing for GCC/Mingw32:
  318. # we try to overcome non-relocateable-DLL problems by generating
  319. #    a (hopefully unique) image-base from the dll's name
  320. # -- BKS, 10-19-1999
  321.     if ($GCC) { 
  322.     my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
  323.     $dllname =~ /(....)(.{0,4})/;
  324.     my $baseaddr = unpack("n", $1 ^ $2);
  325.     $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
  326.     }
  327.  
  328.     push(@m,'
  329. # This section creates the dynamically loadable $(INST_DYNAMIC)
  330. # from $(OBJECT) and possibly $(MYEXTLIB).
  331. OTHERLDFLAGS = '.$otherldflags.'
  332. INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
  333.  
  334. $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  335. ');
  336.     if ($GCC) {
  337.       push(@m,  
  338.        q{    dlltool --def $(EXPORT_LIST) --output-exp dll.exp
  339.     $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
  340.     dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
  341.     $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
  342.     } elsif ($BORLAND) {
  343.       push(@m,
  344.        q{    $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
  345.        .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
  346.          .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
  347.         : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
  348.          .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
  349.        .q{,$(RESFILES)});
  350.     } else {    # VC
  351.       push(@m,
  352.        q{    $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
  353.       .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
  354.     }
  355.     push @m, '
  356.     $(CHMOD) $(PERM_RWX) $@
  357. ';
  358.  
  359.     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
  360.     join('',@m);
  361. }
  362.  
  363. =item clean
  364.  
  365. Clean out some extra dll.{base,exp} files which might be generated by
  366. gcc.  Otherwise, take out all *.pdb files.
  367.  
  368. =cut
  369.  
  370. sub clean
  371. {
  372.     my ($self) = shift;
  373.     my $s = $self->SUPER::clean(@_);
  374.     my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb';
  375.     $s .= <<END;
  376. clean ::
  377.     -\$(RM_F) $clean
  378.  
  379. END
  380.     return $s;
  381. }
  382.  
  383. =item init_linker
  384.  
  385. =cut
  386.  
  387. sub init_linker {
  388.     my $self = shift;
  389.  
  390.     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
  391.     $self->{PERL_ARCHIVE_AFTER} = '';
  392.     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
  393. }
  394.  
  395.  
  396. =item perl_script
  397.  
  398. Checks for the perl program under several common perl extensions.
  399.  
  400. =cut
  401.  
  402. sub perl_script {
  403.     my($self,$file) = @_;
  404.     return $file if -r $file && -f _;
  405.     return "$file.pl"  if -r "$file.pl" && -f _;
  406.     return "$file.plx" if -r "$file.plx" && -f _;
  407.     return "$file.bat" if -r "$file.bat" && -f _;
  408.     return;
  409. }
  410.  
  411.  
  412. =item xs_o (o)
  413.  
  414. This target is stubbed out.  Not sure why.
  415.  
  416. =cut
  417.  
  418. sub xs_o {
  419.     return ''
  420. }
  421.  
  422.  
  423. =item pasthru (o)
  424.  
  425. All we send is -nologo to nmake to prevent it from printing its damned
  426. banner.
  427.  
  428. =cut
  429.  
  430. sub pasthru {
  431.     my($self) = shift;
  432.     return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
  433. }
  434.  
  435.  
  436. =item oneliner (o)
  437.  
  438. These are based on what command.com does on Win98.  They may be wrong
  439. for other Windows shells, I don't know.
  440.  
  441. =cut
  442.  
  443. sub oneliner {
  444.     my($self, $cmd, $switches) = @_;
  445.     $switches = [] unless defined $switches;
  446.  
  447.     # Strip leading and trailing newlines
  448.     $cmd =~ s{^\n+}{};
  449.     $cmd =~ s{\n+$}{};
  450.  
  451.     $cmd = $self->quote_literal($cmd);
  452.     $cmd = $self->escape_newlines($cmd);
  453.  
  454.     $switches = join ' ', @$switches;
  455.  
  456.     return qq{\$(PERLRUN) $switches -e $cmd};
  457. }
  458.  
  459.  
  460. sub quote_literal {
  461.     my($self, $text) = @_;
  462.  
  463.     # I don't know if this is correct, but it seems to work on
  464.     # Win98's command.com
  465.     $text =~ s{"}{\\"}g;
  466.  
  467.     # dmake eats '{' inside double quotes and leaves alone { outside double
  468.     # quotes; however it transforms {{ into { either inside and outside double
  469.     # quotes.  It also translates }} into }.  The escaping below is not
  470.     # 100% correct.
  471.     if( $DMAKE ) {
  472.         $text =~ s/{/{{/g;
  473.         $text =~ s/}}/}}}/g;
  474.     }
  475.  
  476.     return qq{"$text"};
  477. }
  478.  
  479.  
  480. sub escape_newlines {
  481.     my($self, $text) = @_;
  482.  
  483.     # Escape newlines
  484.     $text =~ s{\n}{\\\n}g;
  485.  
  486.     return $text;
  487. }
  488.  
  489.  
  490. =item max_exec_len
  491.  
  492. nmake 1.50 limits command length to 2048 characters.
  493.  
  494. =cut
  495.  
  496. sub max_exec_len {
  497.     my $self = shift;
  498.  
  499.     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
  500. }
  501.  
  502.  
  503. =item os_flavor
  504.  
  505. Windows is Win32.
  506.  
  507. =cut
  508.  
  509. sub os_flavor {
  510.     return('Win32');
  511. }
  512.  
  513.  
  514. 1;
  515. __END__
  516.  
  517. =back
  518.  
  519. =cut 
  520.  
  521.  
  522.