--- /dev/null
+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.23';
+@ISA = qw(ExtUtils::CBuilder::Base);
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ my $cf = $self->{config};
+
+ # Inherit from an appropriate compiler driver class
+ unshift @ISA, "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
+
+ 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;
+
+########################################################################
+
+=begin comment
+
+The packages below 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
+
+########################################################################
+package ExtUtils::CBuilder::Platform::Windows::MSVC;
+
+sub format_compiler_cmd {
+ my ($self, %spec) = @_;
+
+ foreach my $path ( @{ $spec{includes} || [] },
+ @{ $spec{perlinc} || [] } ) {
+ $path = '-I' . $path;
+ }
+
+ %spec = $self->write_compiler_script(%spec)
+ if $spec{use_scripts};
+
+ return [ grep {defined && length} (
+ $spec{cc},'-nologo','-c',
+ @{$spec{includes}} ,
+ @{$spec{cflags}} ,
+ @{$spec{optimize}} ,
+ @{$spec{defines}} ,
+ @{$spec{perlinc}} ,
+ "-Fo$spec{output}" ,
+ $spec{source} ,
+ ) ];
+}
+
+sub write_compiler_script {
+ my ($self, %spec) = @_;
+
+ my $script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.ccs' );
+
+ $self->add_to_cleanup($script);
+ print "Generating script '$script'\n" if !$self->{quiet};
+
+ my $SCRIPT = IO::File->new( ">$script" )
+ or die( "Could not create script '$script': $!" );
+
+ print $SCRIPT join( "\n",
+ map { ref $_ ? @{$_} : $_ }
+ grep defined,
+ delete(
+ @spec{ qw(includes cflags optimize defines perlinc) } )
+ );
+
+ push @{$spec{includes}}, '@"' . $script . '"';
+
+ return %spec;
+}
+
+sub format_linker_cmd {
+ my ($self, %spec) = @_;
+ my $cf = $self->{config};
+
+ foreach my $path ( @{$spec{libpath}} ) {
+ $path = "-libpath:$path";
+ }
+
+ my $output = $spec{output};
+
+ $spec{def_file} &&= '-def:' . $spec{def_file};
+ $spec{output} &&= '-out:' . $spec{output};
+ $spec{manifest} &&= '-manifest ' . $spec{manifest};
+ $spec{implib} &&= '-implib:' . $spec{implib};
+ $spec{map_file} &&= '-map:' . $spec{map_file};
+
+ %spec = $self->write_linker_script(%spec)
+ if $spec{use_scripts};
+
+ my @cmds; # Stores the series of commands needed to build the module.
+
+ push @cmds, [ grep {defined && length} (
+ $spec{ld} ,
+ @{$spec{lddlflags}} ,
+ @{$spec{libpath}} ,
+ @{$spec{other_ldflags}} ,
+ @{$spec{startup}} ,
+ @{$spec{objects}} ,
+ $spec{map_file} ,
+ $spec{libperl} ,
+ @{$spec{perllibs}} ,
+ $spec{def_file} ,
+ $spec{implib} ,
+ $spec{output} ,
+ ) ];
+
+ # Embed the manifest file for VC 2005 (aka VC 8) or higher, but not for the 64-bit Platform SDK compiler
+ if ($cf->{ivsize} == 4 && $cf->{cc} eq 'cl' and $cf->{ccversion} =~ /^(\d+)/ and $1 >= 14) {
+ push @cmds, [
+ 'mt', '-nologo', $spec{manifest}, '-outputresource:' . "$output;2"
+ ];
+ }
+
+ return @cmds;
+}
+
+sub write_linker_script {
+ my ($self, %spec) = @_;
+
+ my $script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.lds' );
+
+ $self->add_to_cleanup($script);
+
+ print "Generating script '$script'\n" if !$self->{quiet};
+
+ my $SCRIPT = IO::File->new( ">$script" )
+ or die( "Could not create script '$script': $!" );
+
+ print $SCRIPT join( "\n",
+ map { ref $_ ? @{$_} : $_ }
+ grep defined,
+ delete(
+ @spec{ qw(lddlflags libpath other_ldflags
+ startup objects libperl perllibs
+ def_file implib map_file) } )
+ );
+
+ push @{$spec{lddlflags}}, '@"' . $script . '"';
+
+ return %spec;
+}
+
+1;
+
+########################################################################
+package ExtUtils::CBuilder::Platform::Windows::BCC;
+
+sub format_compiler_cmd {
+ my ($self, %spec) = @_;
+
+ foreach my $path ( @{ $spec{includes} || [] },
+ @{ $spec{perlinc} || [] } ) {
+ $path = '-I' . $path;
+ }
+
+ %spec = $self->write_compiler_script(%spec)
+ if $spec{use_scripts};
+
+ return [ grep {defined && length} (
+ $spec{cc}, '-c' ,
+ @{$spec{includes}} ,
+ @{$spec{cflags}} ,
+ @{$spec{optimize}} ,
+ @{$spec{defines}} ,
+ @{$spec{perlinc}} ,
+ "-o$spec{output}" ,
+ $spec{source} ,
+ ) ];
+}
+
+sub write_compiler_script {
+ my ($self, %spec) = @_;
+
+ my $script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.ccs' );
+
+ $self->add_to_cleanup($script);
+
+ print "Generating script '$script'\n" if !$self->{quiet};
+
+ my $SCRIPT = IO::File->new( ">$script" )
+ or die( "Could not create script '$script': $!" );
+
+ # XXX Borland "response files" seem to be unable to accept macro
+ # definitions containing quoted strings. Escaping strings with
+ # backslash doesn't work, and any level of quotes are stripped. The
+ # result is is a floating point number in the source file where a
+ # string is expected. So we leave the macros on the command line.
+ print $SCRIPT join( "\n",
+ map { ref $_ ? @{$_} : $_ }
+ grep defined,
+ delete(
+ @spec{ qw(includes cflags optimize perlinc) } )
+ );
+
+ push @{$spec{includes}}, '@"' . $script . '"';
+
+ return %spec;
+}
+
+sub format_linker_cmd {
+ my ($self, %spec) = @_;
+
+ foreach my $path ( @{$spec{libpath}} ) {
+ $path = "-L$path";
+ }
+
+ push( @{$spec{startup}}, 'c0d32.obj' )
+ unless ( $spec{starup} && @{$spec{startup}} );
+
+ %spec = $self->write_linker_script(%spec)
+ if $spec{use_scripts};
+
+ return [ grep {defined && length} (
+ $spec{ld} ,
+ @{$spec{lddlflags}} ,
+ @{$spec{libpath}} ,
+ @{$spec{other_ldflags}} ,
+ @{$spec{startup}} ,
+ @{$spec{objects}} , ',',
+ $spec{output} , ',',
+ $spec{map_file} , ',',
+ $spec{libperl} ,
+ @{$spec{perllibs}} , ',',
+ $spec{def_file}
+ ) ];
+}
+
+sub write_linker_script {
+ my ($self, %spec) = @_;
+
+ # To work around Borlands "unique" commandline syntax,
+ # two scripts are used:
+
+ my $ld_script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.lds' );
+ my $ld_libs = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.lbs' );
+
+ $self->add_to_cleanup($ld_script, $ld_libs);
+
+ print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
+
+ # Script 1: contains options & names of object files.
+ my $LD_SCRIPT = IO::File->new( ">$ld_script" )
+ or die( "Could not create linker script '$ld_script': $!" );
+
+ print $LD_SCRIPT join( " +\n",
+ map { @{$_} }
+ grep defined,
+ delete(
+ @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
+ );
+
+ # Script 2: contains name of libs to link against.
+ my $LD_LIBS = IO::File->new( ">$ld_libs" )
+ or die( "Could not create linker script '$ld_libs': $!" );
+
+ print $LD_LIBS join( " +\n",
+ (delete $spec{libperl} || ''),
+ @{delete $spec{perllibs} || []},
+ );
+
+ push @{$spec{lddlflags}}, '@"' . $ld_script . '"';
+ push @{$spec{perllibs}}, '@"' . $ld_libs . '"';
+
+ return %spec;
+}
+
+1;
+
+########################################################################
+package ExtUtils::CBuilder::Platform::Windows::GCC;
+
+sub format_compiler_cmd {
+ my ($self, %spec) = @_;
+
+ foreach my $path ( @{ $spec{includes} || [] },
+ @{ $spec{perlinc} || [] } ) {
+ $path = '-I' . $path;
+ }
+
+ # split off any -arguments included in cc
+ my @cc = split / (?=-)/, $spec{cc};
+
+ return [ grep {defined && length} (
+ @cc, '-c' ,
+ @{$spec{includes}} ,
+ @{$spec{cflags}} ,
+ @{$spec{optimize}} ,
+ @{$spec{defines}} ,
+ @{$spec{perlinc}} ,
+ '-o', $spec{output} ,
+ $spec{source} ,
+ ) ];
+}
+
+sub format_linker_cmd {
+ my ($self, %spec) = @_;
+
+ # The Config.pm variable 'libperl' is hardcoded to the full name
+ # of the perl import library (i.e. 'libperl56.a'). GCC will not
+ # find it unless the 'lib' prefix & the extension are stripped.
+ $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
+
+ unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
+ if ( $spec{startup} && @{$spec{startup}} );
+
+ # From ExtUtils::MM_Win32:
+ #
+ ## 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
+ File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
+ $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
+
+ %spec = $self->write_linker_script(%spec)
+ if $spec{use_scripts};
+
+ foreach my $path ( @{$spec{libpath}} ) {
+ $path = "-L$path";
+ }
+
+ my @cmds; # Stores the series of commands needed to build the module.
+
+ push @cmds, [
+ 'dlltool', '--def' , $spec{def_file},
+ '--output-exp' , $spec{explib}
+ ];
+
+ # split off any -arguments included in ld
+ my @ld = split / (?=-)/, $spec{ld};
+
+ push @cmds, [ grep {defined && length} (
+ @ld ,
+ '-o', $spec{output} ,
+ "-Wl,--base-file,$spec{base_file}" ,
+ "-Wl,--image-base,$spec{image_base}" ,
+ @{$spec{lddlflags}} ,
+ @{$spec{libpath}} ,
+ @{$spec{startup}} ,
+ @{$spec{objects}} ,
+ @{$spec{other_ldflags}} ,
+ $spec{libperl} ,
+ @{$spec{perllibs}} ,
+ $spec{explib} ,
+ $spec{map_file} ? ('-Map', $spec{map_file}) : ''
+ ) ];
+
+ push @cmds, [
+ 'dlltool', '--def' , $spec{def_file},
+ '--output-exp' , $spec{explib},
+ '--base-file' , $spec{base_file}
+ ];
+
+ push @cmds, [ grep {defined && length} (
+ @ld ,
+ '-o', $spec{output} ,
+ "-Wl,--image-base,$spec{image_base}" ,
+ @{$spec{lddlflags}} ,
+ @{$spec{libpath}} ,
+ @{$spec{startup}} ,
+ @{$spec{objects}} ,
+ @{$spec{other_ldflags}} ,
+ $spec{libperl} ,
+ @{$spec{perllibs}} ,
+ $spec{explib} ,
+ $spec{map_file} ? ('-Map', $spec{map_file}) : ''
+ ) ];
+
+ return @cmds;
+}
+
+sub write_linker_script {
+ my ($self, %spec) = @_;
+
+ my $script = File::Spec->catfile( $spec{srcdir},
+ $spec{basename} . '.lds' );
+
+ $self->add_to_cleanup($script);
+
+ print "Generating script '$script'\n" if !$self->{quiet};
+
+ my $SCRIPT = IO::File->new( ">$script" )
+ or die( "Could not create script '$script': $!" );
+
+ print $SCRIPT ( 'SEARCH_DIR(' . $_ . ")\n" )
+ for @{delete $spec{libpath} || []};
+
+ # gcc takes only one startup file, so the first object in startup is
+ # specified as the startup file and any others are shifted into the
+ # beginning of the list of objects.
+ if ( $spec{startup} && @{$spec{startup}} ) {
+ print $SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
+ unshift @{$spec{objects}},
+ @{delete $spec{startup} || []};
+ }
+
+ print $SCRIPT 'INPUT(' . join( ',',
+ @{delete $spec{objects} || []}
+ ) . ")\n";
+
+ print $SCRIPT 'INPUT(' . join( ' ',
+ (delete $spec{libperl} || ''),
+ @{delete $spec{perllibs} || []},
+ ) . ")\n";
+
+ push @{$spec{other_ldflags}}, '"' . $script . '"';
+
+ return %spec;
+}
+
+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
projects / dh-make-perl / blobdiff