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.2602'; @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, [ 'if', 'exist', $spec{manifest}, '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, so any functionality not implemented here will be implemented there. The interfaces are defined by the L documentation. =head1 AUTHOR Ken Williams Most of the code here was written by Randy W. Sims . =head1 SEE ALSO perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3) =cut