diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm | 288 |
1 files changed, 288 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm new file mode 100644 index 00000000000..f0b98dbaa30 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/ExtUtils/CBuilder/Platform/Windows.pm @@ -0,0 +1,288 @@ +package ExtUtils::CBuilder::Platform::Windows; + +use strict; +use warnings; + +use File::Basename; +use File::Spec; + +use ExtUtils::CBuilder::Base; +use IO::File; + +use vars qw($VERSION @ISA); +$VERSION = '0.27'; +@ISA = qw(ExtUtils::CBuilder::Base); + +=begin comment + +The compiler-specific packages implement functions for generating properly +formatted commandlines for the compiler being used. Each package +defines two primary functions 'format_linker_cmd()' & +'format_compiler_cmd()' that accepts a list of named arguments (a +hash) and returns a list of formatted options suitable for invoking the +compiler. By default, if the compiler supports scripting of its +operation then a script file is built containing the options while +those options are removed from the commandline, and a reference to the +script is pushed onto the commandline in their place. Scripting the +compiler in this way helps to avoid the problems associated with long +commandlines under some shells. + +=end comment + +=cut + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + my $cf = $self->{config}; + + # Inherit from an appropriate compiler driver class + my $driver = "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type; + eval "require $driver" or die "Could not load compiler driver: $@"; + unshift @ISA, $driver; + + return $self; +} + +sub _compiler_type { + my $self = shift; + my $cc = $self->{config}{cc}; + + return ( $cc =~ /cl(\.exe)?$/ ? 'MSVC' + : $cc =~ /bcc32(\.exe)?$/ ? 'BCC' + : 'GCC'); +} + +sub split_like_shell { + # Since Windows will pass the whole command string (not an argument + # array) to the target program and make the program parse it itself, + # we don't actually need to do any processing here. + (my $self, local $_) = @_; + + return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY'); + return unless defined() && length(); + return ($_); +} + +sub do_system { + # See above + my $self = shift; + my $cmd = join(" ", + grep length, + map {$a=$_;$a=~s/\t/ /g;$a=~s/^\s+|\s+$//;$a} + grep defined, @_); + return $self->SUPER::do_system($cmd); +} + +sub arg_defines { + my ($self, %args) = @_; + s/"/\\"/g foreach values %args; + return map qq{"-D$_=$args{$_}"}, keys %args; +} + +sub compile { + my ($self, %args) = @_; + my $cf = $self->{config}; + + die "Missing 'source' argument to compile()" unless defined $args{source}; + + my ($basename, $srcdir) = + ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1]; + + $srcdir ||= File::Spec->curdir(); + + my @defines = $self->arg_defines( %{ $args{defines} || {} } ); + + my %spec = ( + srcdir => $srcdir, + builddir => $srcdir, + basename => $basename, + source => $args{source}, + output => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext}, + cc => $cf->{cc}, + cflags => [ + $self->split_like_shell($cf->{ccflags}), + $self->split_like_shell($cf->{cccdlflags}), + $self->split_like_shell($args{extra_compiler_flags}), + ], + optimize => [ $self->split_like_shell($cf->{optimize}) ], + defines => \@defines, + includes => [ @{$args{include_dirs} || []} ], + perlinc => [ + $self->perl_inc(), + $self->split_like_shell($cf->{incpath}), + ], + use_scripts => 1, # XXX provide user option to change this??? + ); + + $self->normalize_filespecs( + \$spec{source}, + \$spec{output}, + $spec{includes}, + $spec{perlinc}, + ); + + my @cmds = $self->format_compiler_cmd(%spec); + while ( my $cmd = shift @cmds ) { + $self->do_system( @$cmd ) + or die "error building $cf->{dlext} file from '$args{source}'"; + } + + (my $out = $spec{output}) =~ tr/'"//d; + return $out; +} + +sub need_prelink { 1 } + +sub link { + my ($self, %args) = @_; + my $cf = $self->{config}; + + my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} ); + my $to = join '', (File::Spec->splitpath($objects[0]))[0,1]; + $to ||= File::Spec->curdir(); + + (my $file_base = $args{module_name}) =~ s/.*:://; + my $output = $args{lib_file} || + File::Spec->catfile($to, "$file_base.$cf->{dlext}"); + + # if running in perl source tree, look for libs there, not installed + my $lddlflags = $cf->{lddlflags}; + my $perl_src = $self->perl_src(); + $lddlflags =~ s/\Q$cf->{archlibexp}\E[\\\/]CORE/$perl_src/ if $perl_src; + + my %spec = ( + srcdir => $to, + builddir => $to, + startup => [ ], + objects => \@objects, + libs => [ ], + output => $output, + ld => $cf->{ld}, + libperl => $cf->{libperl}, + perllibs => [ $self->split_like_shell($cf->{perllibs}) ], + libpath => [ $self->split_like_shell($cf->{libpth}) ], + lddlflags => [ $self->split_like_shell($lddlflags) ], + other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ], + use_scripts => 1, # XXX provide user option to change this??? + ); + + unless ( $spec{basename} ) { + ($spec{basename} = $args{module_name}) =~ s/.*:://; + } + + $spec{srcdir} = File::Spec->canonpath( $spec{srcdir} ); + $spec{builddir} = File::Spec->canonpath( $spec{builddir} ); + + $spec{output} ||= File::Spec->catfile( $spec{builddir}, + $spec{basename} . '.'.$cf->{dlext} ); + $spec{manifest} ||= File::Spec->catfile( $spec{builddir}, + $spec{basename} . '.'.$cf->{dlext}.'.manifest'); + $spec{implib} ||= File::Spec->catfile( $spec{builddir}, + $spec{basename} . $cf->{lib_ext} ); + $spec{explib} ||= File::Spec->catfile( $spec{builddir}, + $spec{basename} . '.exp' ); + if ($cf->{cc} eq 'cl') { + $spec{dbg_file} ||= File::Spec->catfile( $spec{builddir}, + $spec{basename} . '.pdb' ); + } + elsif ($cf->{cc} eq 'bcc32') { + $spec{dbg_file} ||= File::Spec->catfile( $spec{builddir}, + $spec{basename} . '.tds' ); + } + $spec{def_file} ||= File::Spec->catfile( $spec{srcdir} , + $spec{basename} . '.def' ); + $spec{base_file} ||= File::Spec->catfile( $spec{srcdir} , + $spec{basename} . '.base' ); + + $self->add_to_cleanup( + grep defined, + @{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]} + ); + + foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) { + $self->normalize_filespecs( \$spec{$opt} ); + } + + foreach my $opt ( qw(libpath startup objects) ) { + $self->normalize_filespecs( $spec{$opt} ); + } + + (my $def_base = $spec{def_file}) =~ tr/'"//d; + $def_base =~ s/\.def$//; + $self->prelink( dl_name => $args{module_name}, + dl_file => $def_base, + dl_base => $spec{basename} ); + + my @cmds = $self->format_linker_cmd(%spec); + while ( my $cmd = shift @cmds ) { + $self->do_system( @$cmd ); + } + + $spec{output} =~ tr/'"//d; + return wantarray + ? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]} + : $spec{output}; +} + +# canonize & quote paths +sub normalize_filespecs { + my ($self, @specs) = @_; + foreach my $spec ( grep defined, @specs ) { + if ( ref $spec eq 'ARRAY') { + $self->normalize_filespecs( map {\$_} grep defined, @$spec ) + } elsif ( ref $spec eq 'SCALAR' ) { + $$spec =~ tr/"//d if $$spec; + next unless $$spec; + $$spec = '"' . File::Spec->canonpath($$spec) . '"'; + } elsif ( ref $spec eq '' ) { + $spec = '"' . File::Spec->canonpath($spec) . '"'; + } else { + die "Don't know how to normalize " . (ref $spec || $spec) . "\n"; + } + } +} + +# directory of perl's include files +sub perl_inc { + my $self = shift; + + my $perl_src = $self->perl_src(); + + if ($perl_src) { + File::Spec->catdir($perl_src, "lib", "CORE"); + } else { + File::Spec->catdir($self->{config}{archlibexp},"CORE"); + } +} + +1; + +__END__ + +=head1 NAME + +ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms + +=head1 DESCRIPTION + +This module implements the Windows-specific parts of ExtUtils::CBuilder. +Most of the Windows-specific stuff has to do with compiling and +linking C code. Currently we support the 3 compilers perl itself +supports: MSVC, BCC, and GCC. + +This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality +not implemented here will be implemented there. The interfaces are +defined by the L<ExtUtils::CBuilder> documentation. + +=head1 AUTHOR + +Ken Williams <ken@mathforum.org> + +Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>. + +=head1 SEE ALSO + +perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3) + +=cut |