home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / ExtUtils / MM_Win32.pm < prev    next >
Text File  |  1997-05-18  |  13KB  |  494 lines
  1. package ExtUtils::MM_Win32;
  2.  
  3. =head1 NAME
  4.  
  5. ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.  use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed
  10.  
  11. =head1 DESCRIPTION
  12.  
  13. See ExtUtils::MM_Unix for a documentation of the methods provided
  14. there. This package overrides the implementation of these methods, not
  15. the semantics.
  16.  
  17. =over
  18.  
  19. =cut 
  20.  
  21. #use Config;
  22. #use Cwd;
  23. use File::Basename;
  24. require Exporter;
  25.  
  26. Exporter::import('ExtUtils::MakeMaker',
  27.        qw( $Verbose &neatvalue));
  28.  
  29. $ENV{EMXSHELL} = 'sh'; # to run `commands`
  30. unshift @MM::ISA, 'ExtUtils::MM_Win32';
  31.  
  32. sub dlsyms {
  33.     my($self,%attribs) = @_;
  34.  
  35.     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
  36.     my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
  37.     my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
  38.     my(@m);
  39.     (my $boot = $self->{NAME}) =~ s/:/_/g;
  40.  
  41.     if (not $self->{SKIPHASH}{'dynamic'}) {
  42.     push(@m,"
  43. $self->{BASEEXT}.def: Makefile.PL
  44. ",
  45.      q!    $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Mksymlists \\
  46.      -e "Mksymlists('NAME' => '!, $self->{NAME},
  47.      q!', 'DLBASE' => '!,$self->{DLBASE},
  48.      q!', 'DL_FUNCS' => !,neatvalue($funcs),
  49.      q!, 'IMPORTS' => !,neatvalue($imports),
  50.      q!, 'DL_VARS' => !, neatvalue($vars), q!);"
  51. !);
  52.     }
  53.     join('',@m);
  54. }
  55.  
  56. sub replace_manpage_separator {
  57.     my($self,$man) = @_;
  58.     $man =~ s,/+,.,g;
  59.     $man;
  60. }
  61.  
  62. sub maybe_command {
  63.     my($self,$file) = @_;
  64.     return "$file.exe" if -e "$file.exe";
  65.     return;
  66. }
  67.  
  68. sub file_name_is_absolute {
  69.     my($self,$file) = @_;
  70.     $file =~ m{^([a-z]:)?[\\/]}i ;
  71. }
  72.  
  73. sub find_perl {
  74.     my($self, $ver, $names, $dirs, $trace) = @_;
  75.     my($name, $dir);
  76.     if ($trace >= 2){
  77.     print "Looking for perl $ver by these names:
  78. @$names
  79. in these dirs:
  80. @$dirs
  81. ";
  82.     }
  83.     foreach $dir (@$dirs){
  84.     next unless defined $dir; # $self->{PERL_SRC} may be undefined
  85.     foreach $name (@$names){
  86.         my ($abs, $val);
  87.         if ($self->file_name_is_absolute($name)) { # /foo/bar
  88.         $abs = $name;
  89.         } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo
  90.         $abs = $self->catfile($dir, $name);
  91.         } else { # foo/bar
  92.         $abs = $self->canonpath($self->catfile($self->curdir, $name));
  93.         }
  94.         print "Checking $abs\n" if ($trace >= 2);
  95.         next unless $self->maybe_command($abs);
  96.         print "Executing $abs\n" if ($trace >= 2);
  97.         $val = `$abs -e "require $ver;" 2>&1`;
  98.         if ($? == 0) {
  99.             print "Using PERL=$abs\n" if $trace;
  100.             return $abs;
  101.         } elsif ($trace >= 2) {
  102.         print "Result: `$val'\n";
  103.         }
  104.     }
  105.     }
  106.     print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
  107.     0; # false and not empty
  108. }
  109.  
  110. sub catdir {
  111.     my $self = shift;
  112.     my @args = @_;
  113.     for (@args) {
  114.     # append a slash to each argument unless it has one there
  115.     $_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\";
  116.     }
  117.     my $result = $self->canonpath(join('', @args));
  118.     $result;
  119. }
  120.  
  121. =item catfile
  122.  
  123. Concatenate one or more directory names and a filename to form a
  124. complete path ending with a filename
  125.  
  126. =cut
  127.  
  128. sub catfile {
  129.     my $self = shift @_;
  130.     my $file = pop @_;
  131.     return $file unless @_;
  132.     my $dir = $self->catdir(@_);
  133.     $dir =~ s/(\\\.)$//;
  134.     $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\";
  135.     return $dir.$file;
  136. }
  137.  
  138. sub init_others
  139. {
  140.  my ($self) = @_;
  141.  &ExtUtils::MM_Unix::init_others;
  142.  $self->{'TOUCH'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e touch';
  143.  $self->{'CHMOD'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e chmod'; 
  144.  $self->{'CP'}     = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e cp';
  145.  $self->{'RM_F'}   = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_f';
  146.  $self->{'RM_RF'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_rf';
  147.  $self->{'MV'}     = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mv';
  148.  $self->{'NOOP'}   = 'rem';
  149.  $self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f';
  150.  $self->{'LD'}     = 'link';
  151.  $self->{'DEV_NULL'} = '> NUL';
  152.  # $self->{'NOECHO'} = ''; # till we have it working
  153. }
  154.  
  155. sub path {
  156.     local $^W = 1;
  157.     my($self) = @_;
  158.     my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
  159.     my @path = split(';',$path);
  160.     foreach(@path) { $_ = '.' if $_ eq '' }
  161.     @path;
  162. }
  163.  
  164. =item static_lib (o)
  165.  
  166. Defines how to produce the *.a (or equivalent) files.
  167.  
  168. =cut
  169.  
  170. sub static_lib {
  171.     my($self) = @_;
  172. # Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC
  173. #    return '' unless $self->needs_linking(); #might be because of a subdir
  174.  
  175.     return '' unless $self->has_link_code;
  176.  
  177.     my(@m);
  178.     push(@m, <<'END');
  179. $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists
  180.     $(RM_RF) $@
  181. END
  182.     # If this extension has it's own library (eg SDBM_File)
  183.     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
  184.     push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB};
  185.  
  186.     push @m,
  187. q{    lib -nologo -out:$@ $(OBJECT)
  188.     }.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
  189.     $(CHMOD) 755 $@
  190. };
  191.  
  192. # Old mechanism - still available:
  193.  
  194.     push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs}."\n\n"
  195.     if $self->{PERL_SRC};
  196.  
  197.     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
  198.     join('', "\n",@m);
  199. }
  200.  
  201.  
  202.  
  203. =item dynamic_lib (o)
  204.  
  205. Defines how to produce the *.so (or equivalent) files.
  206.  
  207. =cut
  208.  
  209. sub dynamic_lib {
  210.     my($self, %attribs) = @_;
  211.     return '' unless $self->needs_linking(); #might be because of a subdir
  212.  
  213.     return '' unless $self->has_link_code;
  214.  
  215.     my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
  216.     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
  217.     my($ldfrom) = '$(LDFROM)';
  218.     my(@m);
  219.     push(@m,'
  220. # This section creates the dynamically loadable $(INST_DYNAMIC)
  221. # from $(OBJECT) and possibly $(MYEXTLIB).
  222. OTHERLDFLAGS = '.$otherldflags.'
  223. INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
  224.  
  225. $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  226. ');
  227.  
  228.     push(@m,'    $(LD) -out:$@ $(LDDLFLAGS) '.$ldfrom.
  229.         ' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)');
  230.     push @m, '
  231.     $(CHMOD) 755 $@
  232. ';
  233.  
  234.     push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
  235.     join('',@m);
  236. }
  237.  
  238. sub perl_archive
  239. {
  240.  return '$(PERL_INC)\perl$(LIB_EXT)';
  241. }
  242.  
  243. sub export_list
  244. {
  245.  my ($self) = @_;
  246.  return "$self->{BASEEXT}.def";
  247. }
  248.  
  249. =item canonpath
  250.  
  251. No physical check on the filesystem, but a logical cleanup of a
  252. path. On UNIX eliminated successive slashes and successive "/.".
  253.  
  254. =cut
  255.  
  256. sub canonpath {
  257.     my($self,$path) = @_;
  258.     $path =~ s/^([a-z]:)/\u$1/;
  259.     $path =~ s|/|\\|g;
  260.     $path =~ s|\\+|\\|g ;                          # xx////xx  -> xx/xx
  261.     $path =~ s|(\\\.)+\\|\\|g ;                    # xx/././xx -> xx/xx
  262.     $path =~ s|^(\.\\)+|| unless $path eq ".\\";   # ./xx      -> xx
  263.     $path =~ s|\\$|| 
  264.              unless $path =~ m#^([a-z]:)?\\#;      # xx/       -> xx
  265.     $path .= '.' if $path =~ m#\\$#;
  266.     $path;
  267. }
  268.  
  269. =item perl_script
  270.  
  271. Takes one argument, a file name, and returns the file name, if the
  272. argument is likely to be a perl script. On MM_Unix this is true for
  273. any ordinary, readable file.
  274.  
  275. =cut
  276.  
  277. sub perl_script {
  278.     my($self,$file) = @_;
  279.     return "$file.pl" if -r "$file.pl" && -f _;
  280.     return;
  281. }
  282.  
  283. =item pm_to_blib
  284.  
  285. Defines target that copies all files in the hash PM to their
  286. destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
  287.  
  288. =cut
  289.  
  290. sub pm_to_blib {
  291.     my $self = shift;
  292.     my($autodir) = $self->catdir('$(INST_LIB)','auto');
  293.     return q{
  294. pm_to_blib: $(TO_INST_PM)
  295.     }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
  296.     "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
  297.         -e "pm_to_blib(qw{ <<pmfiles.dat },'}.$autodir.q{')"
  298.     }.q{
  299. $(PM_TO_BLIB)
  300. <<
  301.     }.$self->{NOECHO}.q{$(TOUCH) $@
  302. };
  303. }
  304.  
  305. =item test_via_harness (o)
  306.  
  307. Helper method to write the test targets
  308.  
  309. =cut
  310.  
  311. sub test_via_harness {
  312.     my($self, $perl, $tests) = @_;
  313.     "\t$perl".q! -Mblib -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e "use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;" !."$tests\n";
  314. }
  315.  
  316. =item tool_autosplit (override)
  317.  
  318. Use Win32 quoting on command line.
  319.  
  320. =cut
  321.  
  322. sub tool_autosplit{
  323.     my($self, %attribs) = @_;
  324.     my($asl) = "";
  325.     $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
  326.     q{
  327. # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
  328. AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MAutoSplit }.$asl.q{ -e "autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1);"
  329. };
  330. }
  331.  
  332. =item tools_other (o)
  333.  
  334. Win32 overrides.
  335.  
  336. Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in
  337. the Makefile. Also defines the perl programs MKPATH,
  338. WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL.
  339.  
  340. =cut
  341.  
  342. sub tools_other {
  343.     my($self) = shift;
  344.     my @m;
  345.     my $bin_sh = $Config{sh} || 'cmd /c';
  346.     push @m, qq{
  347. SHELL = $bin_sh
  348. };
  349.  
  350.     for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) {
  351.     push @m, "$_ = $self->{$_}\n";
  352.     }
  353.  
  354.     push @m, q{
  355. # The following is a portable way to say mkdir -p
  356. # To see which directories are created, change the if 0 to if 1
  357. MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
  358.  
  359. # This helps us to minimize the effect of the .exists files A yet
  360. # better solution would be to have a stable file in the perl
  361. # distribution with a timestamp of zero. But this solution doesn't
  362. # need any changes to the core distribution and works with older perls
  363. EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
  364. };
  365.  
  366.  
  367.     return join "", @m if $self->{PARENT};
  368.  
  369.     push @m, q{
  370. # Here we warn users that an old packlist file was found somewhere,
  371. # and that they should call some uninstall routine
  372. WARN_IF_OLD_PACKLIST = $(PERL) -lwe "exit unless -f $$ARGV[0];" \\
  373. -e "print 'WARNING: I have found an old package in';" \\
  374. -e "print '    ', $$ARGV[0], '.';" \\
  375. -e "print 'Please make sure the two installations are not conflicting';"
  376.  
  377. UNINST=0
  378. VERBINST=1
  379.  
  380. MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
  381. -e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"
  382.  
  383. DOC_INSTALL = $(PERL) -e "$$\=\"\n\n\";" \
  384. -e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', shift, '>';" \
  385. -e "print '=over 4';" \
  386. -e "while (defined($$key = shift) and defined($$val = shift)){print '=item *';print 'C<', \"$$key: $$val\", '>';}" \
  387. -e "print '=back';"
  388.  
  389. UNINSTALL =   $(PERL) -MExtUtils::Install \
  390. -e "uninstall($$ARGV[0],1,1); print \"\nUninstall is deprecated. Please check the";" \
  391. -e "print \" packlist above carefully.\n  There may be errors. Remove the\";" \
  392. -e "print \" appropriate files manually.\n  Sorry for the inconveniences.\n\""
  393. };
  394.  
  395.     return join "", @m;
  396. }
  397.  
  398. =item manifypods (o)
  399.  
  400. We don't want manpage process.  XXX add pod2html support later.
  401.  
  402. =cut
  403.  
  404. sub manifypods {
  405.     return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n";
  406. }
  407.  
  408. =item dist_ci (o)
  409.  
  410. Same as MM_Unix version (changes command-line quoting).
  411.  
  412. =cut
  413.  
  414. sub dist_ci {
  415.     my($self) = shift;
  416.     my @m;
  417.     push @m, q{
  418. ci :
  419.     $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\
  420.         -e "@all = keys %{ maniread() };" \\
  421.         -e "print(\"Executing $(CI) @all\n\"); system(\"$(CI) @all\");" \\
  422.         -e "print(\"Executing $(RCS_LABEL) ...\n\"); system(\"$(RCS_LABEL) @all\");"
  423. };
  424.     join "", @m;
  425. }
  426.  
  427. =item dist_core (o)
  428.  
  429. Same as MM_Unix version (changes command-line quoting).
  430.  
  431. =cut
  432.  
  433. sub dist_core {
  434.     my($self) = shift;
  435.     my @m;
  436.     push @m, q{
  437. dist : $(DIST_DEFAULT)
  438.     }.$self->{NOECHO}.q{$(PERL) -le "print \"Warning: Makefile possibly out of date with $$vf\" if " \
  439.         -e "-e ($$vf=\"$(VERSION_FROM)\") and -M $$vf < -M \"}.$self->{MAKEFILE}.q{\";"
  440.  
  441. tardist : $(DISTVNAME).tar$(SUFFIX)
  442.  
  443. zipdist : $(DISTVNAME).zip
  444.  
  445. $(DISTVNAME).tar$(SUFFIX) : distdir
  446.     $(PREOP)
  447.     $(TO_UNIX)
  448.     $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
  449.     $(RM_RF) $(DISTVNAME)
  450.     $(COMPRESS) $(DISTVNAME).tar
  451.     $(POSTOP)
  452.  
  453. $(DISTVNAME).zip : distdir
  454.     $(PREOP)
  455.     $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
  456.     $(RM_RF) $(DISTVNAME)
  457.     $(POSTOP)
  458.  
  459. uutardist : $(DISTVNAME).tar$(SUFFIX)
  460.     uuencode $(DISTVNAME).tar$(SUFFIX) \\
  461.         $(DISTVNAME).tar$(SUFFIX) > \\
  462.         $(DISTVNAME).tar$(SUFFIX)_uu
  463.  
  464. shdist : distdir
  465.     $(PREOP)
  466.     $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
  467.     $(RM_RF) $(DISTVNAME)
  468.     $(POSTOP)
  469. };
  470.     join "", @m;
  471. }
  472.  
  473. =item pasthru (o)
  474.  
  475. Defines the string that is passed to recursive make calls in
  476. subdirectories.
  477.  
  478. =cut
  479.  
  480. sub pasthru {
  481.     my($self) = shift;
  482.     return "PASTHRU = /nologo"
  483. }
  484.  
  485.  
  486.  
  487. 1;
  488. __END__
  489.  
  490. =back
  491.  
  492. =cut 
  493.  
  494.