X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExtUtils%2FMM_Win32.pm;h=76e1bd1538265851a41c0ce9936fdbc1fefc2b29;hb=a6d5bf86f91571574c0f404a036824df50194368;hp=ab8570d70273ca412439404bdbd94fa4ace85957;hpb=1d7c184104c076988718a01b77c8706aae05b092;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm index ab8570d..76e1bd1 100644 --- a/lib/ExtUtils/MM_Win32.pm +++ b/lib/ExtUtils/MM_Win32.pm @@ -1,5 +1,7 @@ package ExtUtils::MM_Win32; +our $VERSION = '1.00_02'; + =head1 NAME ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker @@ -14,17 +16,18 @@ See ExtUtils::MM_Unix for a documentation of the methods provided there. This package overrides the implementation of these methods, not the semantics. -=over +=over 4 =cut use Config; #use Cwd; use File::Basename; +use File::Spec; require Exporter; -Exporter::import('ExtUtils::MakeMaker', - qw( $Verbose &neatvalue)); +require ExtUtils::MakeMaker; +ExtUtils::MakeMaker->import(qw( $Verbose &neatvalue)); $ENV{EMXSHELL} = 'sh'; # to run `commands` unshift @MM::ISA, 'ExtUtils::MM_Win32'; @@ -34,7 +37,6 @@ $GCC = 1 if $Config{'cc'} =~ /^gcc/i; $DMAKE = 1 if $Config{'make'} =~ /^dmake/i; $NMAKE = 1 if $Config{'make'} =~ /^nmake/i; $PERLMAKE = 1 if $Config{'make'} =~ /^pmake/i; -$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i; # a few workarounds for command.com (very basic) { @@ -94,8 +96,12 @@ sub dlsyms { $self->{BASEEXT}.def: Makefile.PL ", q! $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Mksymlists \\ - -e "Mksymlists('NAME' => '!, $self->{NAME}, - q!', 'DLBASE' => '!,$self->{DLBASE}, + -e "Mksymlists('NAME'=>\"!, $self->{NAME}, + q!\", 'DLBASE' => '!,$self->{DLBASE}, + # The above two lines quoted differently to work around + # a bug in the 4DOS/4NT command line interpreter. The visible + # result of the bug was files named q('extension_name',) *with the + # single quotes and the comma* in the extension build directories. q!', 'DL_FUNCS' => !,neatvalue($funcs), q!, 'FUNCLIST' => !,neatvalue($funclist), q!, 'IMPORTS' => !,neatvalue($imports), @@ -132,12 +138,14 @@ sub maybe_command { } sub file_name_is_absolute { - my($self,$file) = @_; - $file =~ m{^([a-z]:)?[\\/]}i ; + shift; + return File::Spec->file_name_is_absolute(@_); } sub find_perl { my($self, $ver, $names, $dirs, $trace) = @_; + $trace ||= 0; + my($name, $dir); if ($trace >= 2){ print "Looking for perl $ver by these names: @@ -150,12 +158,12 @@ in these dirs: next unless defined $dir; # $self->{PERL_SRC} may be undefined foreach $name (@$names){ my ($abs, $val); - if ($self->file_name_is_absolute($name)) { # /foo/bar + if (File::Spec->file_name_is_absolute($name)) { # /foo/bar $abs = $name; - } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo - $abs = $self->catfile($dir, $name); + } elsif (File::Spec->canonpath($name) eq File::Spec->canonpath(basename($name))) { # foo + $abs = File::Spec->catfile($dir, $name); } else { # foo/bar - $abs = $self->canonpath($self->catfile($self->curdir, $name)); + $abs = File::Spec->canonpath(File::Spec->catfile(File::Spec->curdir, $name)); } print "Checking $abs\n" if ($trace >= 2); next unless $self->maybe_command($abs); @@ -174,14 +182,8 @@ in these dirs: } sub catdir { - my $self = shift; - my @args = @_; - for (@args) { - # append a slash to each argument unless it has one there - $_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\"; - } - my $result = $self->canonpath(join('', @args)); - $result; + shift; + return File::Spec->catdir(@_); } =item catfile @@ -192,13 +194,8 @@ complete path ending with a filename =cut sub catfile { - my $self = shift @_; - my $file = pop @_; - return $file unless @_; - my $dir = $self->catdir(@_); - $dir =~ s/(\\\.)$//; - $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\"; - return $dir.$file; + shift; + return File::Spec->catfile(@_); } sub init_others @@ -252,7 +249,8 @@ sub constants { INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC - PERL_INC PERL FULLPERL + PERL_INC PERL FULLPERL PERLRUN PERLRUNINST TEST_LIBS + FULL_AR PERL_CORE / ) { next unless defined $self->{$tmp}; @@ -267,7 +265,7 @@ XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\" }; push @m, qq{ -MAKEMAKER = $INC{'ExtUtils\MakeMaker.pm'} +MAKEMAKER = $INC{'ExtUtils/MakeMaker.pm'} MM_VERSION = $ExtUtils::MakeMaker::VERSION }; @@ -326,10 +324,10 @@ makemakerdflt: all .SUFFIXES: .xs .c .C .cpp .cxx .cc \$(OBJ_EXT) -# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that -# some make implementations will delete the Makefile when we rebuild it. Because -# we call false(1) when we rebuild it. So make(1) is not completely wrong when it -# does so. Our milage may vary. +# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to +# recall, that some make implementations will delete the Makefile when we +# rebuild it. Because we call false(1) when we rebuild it. So make(1) is +# not completely wrong when it does so. Our milage may vary. # .PRECIOUS: Makefile # seems to be not necessary anymore .PHONY: all config static dynamic test linkext manifest @@ -341,11 +339,11 @@ CONFIGDEP = \$(PERL_ARCHLIB)\\Config.pm \$(PERL_INC)\\config.h my @parentdir = split(/::/, $self->{PARENT_NAME}); push @m, q{ # Where to put things: -INST_LIBDIR = }. $self->catdir('$(INST_LIB)',@parentdir) .q{ -INST_ARCHLIBDIR = }. $self->catdir('$(INST_ARCHLIB)',@parentdir) .q{ +INST_LIBDIR = }. File::Spec->catdir('$(INST_LIB)',@parentdir) .q{ +INST_ARCHLIBDIR = }. File::Spec->catdir('$(INST_ARCHLIB)',@parentdir) .q{ -INST_AUTODIR = }. $self->catdir('$(INST_LIB)','auto','$(FULLEXT)') .q{ -INST_ARCHAUTODIR = }. $self->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)') .q{ +INST_AUTODIR = }. File::Spec->catdir('$(INST_LIB)','auto','$(FULLEXT)') .q{ +INST_ARCHAUTODIR = }. File::Spec->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)') .q{ }; if ($self->has_link_code()) { @@ -388,12 +386,7 @@ PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{ sub path { - local $^W = 1; - my($self) = @_; - my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; - my @path = split(';',$path); - foreach(@path) { $_ = '.' if $_ eq '' } - @path; + return File::Spec->path(); } =item static_lib (o) @@ -414,7 +407,7 @@ sub static_lib { $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)\.exists $(RM_RF) $@ END - # If this extension has it's own library (eg SDBM_File) + # If this extension has its own library (eg SDBM_File) # then copy that to $(INST_STATIC) and add $(OBJECT) into it. push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB}; @@ -485,13 +478,11 @@ sub dynamic_lib { my($ldfrom) = '$(LDFROM)'; my(@m); -# several things for GCC/Mingw32: -# 1. use correct CRT startup objects (possibly unnecessary) -# 2. try to overcome non-relocateable-DLL problems by generating +# one thing for GCC/Mingw32: +# we try to overcome non-relocateable-DLL problems by generating # a (hopefully unique) image-base from the dll's name # -- BKS, 10-19-1999 if ($GCC) { - $otherldflags .= ' -L$(PERL_ARCHIVE:d) -nostdlib $(PERL_ARCHIVE:d)gdllcrt0.o '; my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT}; $dllname =~ /(....)(.{0,4})/; my $baseaddr = unpack("n", $1 ^ $2); @@ -533,6 +524,21 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists join('',@m); } +sub clean +{ + my ($self) = @_; + my $s = &ExtUtils::MM_Unix::clean; + my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb'; + $s .= < sub pm_to_blib { my $self = shift; - my($autodir) = $self->catdir('$(INST_LIB)','auto'); + my($autodir) = File::Spec->catdir('$(INST_LIB)','auto'); return q{ pm_to_blib: $(TO_INST_PM) }.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ @@ -599,7 +605,7 @@ pm_to_blib: $(TO_INST_PM) ($NMAKE ? 'qw[ <', ' L<', shift, '>';" \ +-e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', $$arg=shift, '|', $$arg, '>';" \ -e "print '=over 4';" \ -e "while (defined($$key = shift) and defined($$val = shift)) { print '=item *';print 'C<', \"$$key: $$val\", '>'; }" \ -e "print '=back';" @@ -751,12 +757,6 @@ config :: $(INST_AUTODIR)\.exists '.$self->{NOECHO}.'$(NOOP) '; - push @m, qq{ -config :: Version_check - $self->{NOECHO}\$(NOOP) - -} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC}; - push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]); if (%{$self->{HTMLLIBPODS}}) { @@ -830,9 +830,9 @@ sub htmlifypods { my($dist); my($pod2html_exe); if (defined $self->{PERL_SRC}) { - $pod2html_exe = $self->catfile($self->{PERL_SRC},'pod','pod2html'); + $pod2html_exe = File::Spec->catfile($self->{PERL_SRC},'pod','pod2html'); } else { - $pod2html_exe = $self->catfile($Config{scriptdirexp},'pod2html'); + $pod2html_exe = File::Spec->catfile($Config{scriptdirexp},'pod2html'); } unless ($pod2html_exe = $self->perl_script($pod2html_exe)) { # No pod2html but some HTMLxxxPODS to be installed