1 package ExtUtils::CBuilder::Platform::Windows;
9 use ExtUtils::CBuilder::Base;
11 use vars qw($VERSION @ISA);
13 @ISA = qw(ExtUtils::CBuilder::Base);
17 my $self = $class->SUPER::new(@_);
18 my $cf = $self->{config};
20 # Inherit from an appropriate compiler driver class
21 unshift @ISA, "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
28 my $cc = $self->{config}{cc};
30 return ( $cc =~ /cl(\.exe)?$/ ? 'MSVC'
31 : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
35 sub split_like_shell {
36 # As it turns out, Windows command-parsing is very different from
37 # Unix command-parsing. Double-quotes mean different things,
38 # backslashes don't necessarily mean escapes, and so on. So we
39 # can't use Text::ParseWords::shellwords() to break a command string
40 # into words. The algorithm below was bashed out by Randy and Ken
41 # (mostly Randy), and there are a lot of regression tests, so we
42 # should feel free to adjust if desired.
44 (my $self, local $_) = @_;
46 return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
49 return @argv unless defined() && length();
52 my( $i, $quote_mode ) = ( 0, 0 );
54 while ( $i < length() ) {
56 my $ch = substr( $_, $i , 1 );
57 my $next_ch = substr( $_, $i+1, 1 );
59 if ( $ch eq '\\' && $next_ch eq '"' ) {
62 } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
65 } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
66 $quote_mode = !$quote_mode;
69 } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
70 ( $i + 2 == length() ||
71 substr( $_, $i + 2, 1 ) eq ' ' )
72 ) { # for cases like: a"" => [ 'a' ]
76 } elsif ( $ch eq '"' ) {
77 $quote_mode = !$quote_mode;
78 } elsif ( $ch eq ' ' && !$quote_mode ) {
79 push( @argv, $arg ) if $arg;
81 ++$i while substr( $_, $i + 1, 1 ) eq ' ';
89 push( @argv, $arg ) if defined( $arg ) && length( $arg );
94 my ($self, %args) = @_;
95 s/"/\\"/g foreach values %args;
96 return map "-D$_=$args{$_}", keys %args;
100 my ($self, %args) = @_;
101 my $cf = $self->{config};
103 die "Missing 'source' argument to compile()" unless defined $args{source};
105 my ($basename, $srcdir) =
106 ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
108 $srcdir ||= File::Spec->curdir();
110 my @defines = $self->arg_defines( %{ $args{defines} || {} } );
115 basename => $basename,
116 source => $args{source},
117 output => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
120 $self->split_like_shell($cf->{ccflags}),
121 $self->split_like_shell($cf->{cccdlflags}),
122 $self->split_like_shell($cf->{extra_compiler_flags}),
124 optimize => [ $self->split_like_shell($cf->{optimize}) ],
125 defines => \@defines,
126 includes => [ @{$args{include_dirs} || []} ],
129 $self->split_like_shell($cf->{incpath}),
131 use_scripts => 1, # XXX provide user option to change this???
134 $self->normalize_filespecs(
141 my @cmds = $self->format_compiler_cmd(%spec);
142 while ( my $cmd = shift @cmds ) {
143 $self->do_system( @$cmd )
144 or die "error building $cf->{dlext} file from '$args{source}'";
147 (my $out = $spec{output}) =~ tr/'"//d;
151 sub need_prelink { 1 }
154 my ($self, %args) = @_;
155 my $cf = $self->{config};
157 my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
158 my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
159 $to ||= File::Spec->curdir();
161 (my $file_base = $args{module_name}) =~ s/.*:://;
162 my $output = $args{lib_file} ||
163 File::Spec->catfile($to, "$file_base.$cf->{dlext}");
165 # if running in perl source tree, look for libs there, not installed
166 my $lddlflags = $cf->{lddlflags};
167 my $perl_src = $self->perl_src();
168 $lddlflags =~ s/\Q$cf->{archlibexp}\E[\\\/]CORE/$perl_src/ if $perl_src;
174 objects => \@objects,
178 libperl => $cf->{libperl},
179 perllibs => [ $self->split_like_shell($cf->{perllibs}) ],
180 libpath => [ $self->split_like_shell($cf->{libpth}) ],
181 lddlflags => [ $self->split_like_shell($lddlflags) ],
182 other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
183 use_scripts => 1, # XXX provide user option to change this???
186 unless ( $spec{basename} ) {
187 ($spec{basename} = $args{module_name}) =~ s/.*:://;
190 $spec{srcdir} = File::Spec->canonpath( $spec{srcdir} );
191 $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
193 $spec{output} ||= File::Spec->catfile( $spec{builddir},
194 $spec{basename} . '.'.$cf->{dlext} );
195 $spec{implib} ||= File::Spec->catfile( $spec{builddir},
196 $spec{basename} . $cf->{lib_ext} );
197 $spec{explib} ||= File::Spec->catfile( $spec{builddir},
198 $spec{basename} . '.exp' );
199 $spec{def_file} ||= File::Spec->catfile( $spec{srcdir} ,
200 $spec{basename} . '.def' );
201 $spec{base_file} ||= File::Spec->catfile( $spec{srcdir} ,
202 $spec{basename} . '.base' );
204 $self->add_to_cleanup(
206 @{[ @spec{qw(implib explib def_file base_file map_file)} ]}
209 foreach my $opt ( qw(output implib explib def_file map_file base_file) ) {
210 $self->normalize_filespecs( \$spec{$opt} );
213 foreach my $opt ( qw(libpath startup objects) ) {
214 $self->normalize_filespecs( $spec{$opt} );
217 (my $def_base = $spec{def_file}) =~ tr/'"//d;
218 $def_base =~ s/\.def$//;
219 $self->prelink( dl_name => $args{module_name},
220 dl_file => $def_base,
221 dl_base => $spec{basename} );
223 my @cmds = $self->format_linker_cmd(%spec);
224 while ( my $cmd = shift @cmds ) {
225 $self->do_system( @$cmd );
228 $spec{output} =~ tr/'"//d;
230 ? grep defined, @spec{qw[output implib explib def_file map_file base_file]}
234 # canonize & quote paths
235 sub normalize_filespecs {
236 my ($self, @specs) = @_;
237 foreach my $spec ( grep defined, @specs ) {
238 if ( ref $spec eq 'ARRAY') {
239 $self->normalize_filespecs( map {\$_} grep defined, @$spec )
240 } elsif ( ref $spec eq 'SCALAR' ) {
241 $$spec =~ tr/"//d if $$spec;
243 $$spec = '"' . File::Spec->canonpath($$spec) . '"';
244 } elsif ( ref $spec eq '' ) {
245 $spec = '"' . File::Spec->canonpath($spec) . '"';
247 die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
252 # directory of perl's include files
256 my $perl_src = $self->perl_src();
259 File::Spec->catdir($perl_src, "lib", "CORE");
261 File::Spec->catdir($self->{config}{archlibexp},"CORE");
267 ########################################################################
271 The packages below implement functions for generating properly
272 formatted commandlines for the compiler being used. Each package
273 defines two primary functions 'format_linker_cmd()' &
274 'format_compiler_cmd()' that accepts a list of named arguments (a
275 hash) and returns a list of formatted options suitable for invoking the
276 compiler. By default, if the compiler supports scripting of its
277 operation then a script file is built containing the options while
278 those options are removed from the commandline, and a reference to the
279 script is pushed onto the commandline in their place. Scripting the
280 compiler in this way helps to avoid the problems associated with long
281 commandlines under some shells.
287 ########################################################################
288 package ExtUtils::CBuilder::Platform::Windows::MSVC;
290 sub format_compiler_cmd {
291 my ($self, %spec) = @_;
293 foreach my $path ( @{ $spec{includes} || [] },
294 @{ $spec{perlinc} || [] } ) {
295 $path = '-I' . $path;
298 %spec = $self->write_compiler_script(%spec)
299 if $spec{use_scripts};
301 return [ grep {defined && length} (
302 $spec{cc},'-nologo','-c',
313 sub write_compiler_script {
314 my ($self, %spec) = @_;
316 my $script = File::Spec->catfile( $spec{srcdir},
317 $spec{basename} . '.ccs' );
319 $self->add_to_cleanup($script);
320 print "Generating script '$script'\n" if !$self->{quiet};
322 open( SCRIPT, ">$script" )
323 or die( "Could not create script '$script': $!" );
325 print SCRIPT join( "\n",
326 map { ref $_ ? @{$_} : $_ }
329 @spec{ qw(includes cflags optimize defines perlinc) } )
334 push @{$spec{includes}}, '@"' . $script . '"';
339 sub format_linker_cmd {
340 my ($self, %spec) = @_;
342 foreach my $path ( @{$spec{libpath}} ) {
343 $path = "-libpath:$path";
346 $spec{def_file} &&= '-def:' . $spec{def_file};
347 $spec{output} &&= '-out:' . $spec{output};
348 $spec{implib} &&= '-implib:' . $spec{implib};
349 $spec{map_file} &&= '-map:' . $spec{map_file};
351 %spec = $self->write_linker_script(%spec)
352 if $spec{use_scripts};
354 return [ grep {defined && length} (
356 @{$spec{lddlflags}} ,
358 @{$spec{other_ldflags}} ,
370 sub write_linker_script {
371 my ($self, %spec) = @_;
373 my $script = File::Spec->catfile( $spec{srcdir},
374 $spec{basename} . '.lds' );
376 $self->add_to_cleanup($script);
378 print "Generating script '$script'\n" if !$self->{quiet};
380 open( SCRIPT, ">$script" )
381 or die( "Could not create script '$script': $!" );
383 print SCRIPT join( "\n",
384 map { ref $_ ? @{$_} : $_ }
387 @spec{ qw(lddlflags libpath other_ldflags
388 startup objects libperl perllibs
389 def_file implib map_file) } )
394 push @{$spec{lddlflags}}, '@"' . $script . '"';
401 ########################################################################
402 package ExtUtils::CBuilder::Platform::Windows::BCC;
404 sub format_compiler_cmd {
405 my ($self, %spec) = @_;
407 foreach my $path ( @{ $spec{includes} || [] },
408 @{ $spec{perlinc} || [] } ) {
409 $path = '-I' . $path;
412 %spec = $self->write_compiler_script(%spec)
413 if $spec{use_scripts};
415 return [ grep {defined && length} (
427 sub write_compiler_script {
428 my ($self, %spec) = @_;
430 my $script = File::Spec->catfile( $spec{srcdir},
431 $spec{basename} . '.ccs' );
433 $self->add_to_cleanup($script);
435 print "Generating script '$script'\n" if !$self->{quiet};
437 open( SCRIPT, ">$script" )
438 or die( "Could not create script '$script': $!" );
440 print SCRIPT join( "\n",
441 map { ref $_ ? @{$_} : $_ }
444 @spec{ qw(includes cflags optimize defines perlinc) } )
449 push @{$spec{includes}}, '@"' . $script . '"';
454 sub format_linker_cmd {
455 my ($self, %spec) = @_;
457 foreach my $path ( @{$spec{libpath}} ) {
461 push( @{$spec{startup}}, 'c0d32.obj' )
462 unless ( $spec{starup} && @{$spec{startup}} );
464 %spec = $self->write_linker_script(%spec)
465 if $spec{use_scripts};
467 return [ grep {defined && length} (
469 @{$spec{lddlflags}} ,
471 @{$spec{other_ldflags}} ,
473 @{$spec{objects}} , ',',
475 $spec{map_file} , ',',
477 @{$spec{perllibs}} , ',',
482 sub write_linker_script {
483 my ($self, %spec) = @_;
485 # To work around Borlands "unique" commandline syntax,
486 # two scripts are used:
488 my $ld_script = File::Spec->catfile( $spec{srcdir},
489 $spec{basename} . '.lds' );
490 my $ld_libs = File::Spec->catfile( $spec{srcdir},
491 $spec{basename} . '.lbs' );
493 $self->add_to_cleanup($ld_script, $ld_libs);
495 print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
497 # Script 1: contains options & names of object files.
498 open( LD_SCRIPT, ">$ld_script" )
499 or die( "Could not create linker script '$ld_script': $!" );
501 print LD_SCRIPT join( " +\n",
505 @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
510 # Script 2: contains name of libs to link against.
511 open( LD_LIBS, ">$ld_libs" )
512 or die( "Could not create linker script '$ld_libs': $!" );
514 print LD_LIBS join( " +\n",
515 (delete $spec{libperl} || ''),
516 @{delete $spec{perllibs} || []},
521 push @{$spec{lddlflags}}, '@"' . $ld_script . '"';
522 push @{$spec{perllibs}}, '@"' . $ld_libs . '"';
529 ########################################################################
530 package ExtUtils::CBuilder::Platform::Windows::GCC;
532 sub format_compiler_cmd {
533 my ($self, %spec) = @_;
535 foreach my $path ( @{ $spec{includes} || [] },
536 @{ $spec{perlinc} || [] } ) {
537 $path = '-I' . $path;
540 # split off any -arguments included in cc
541 my @cc = split / (?=-)/, $spec{cc};
543 return [ grep {defined && length} (
550 '-o', $spec{output} ,
555 sub format_linker_cmd {
556 my ($self, %spec) = @_;
558 # The Config.pm variable 'libperl' is hardcoded to the full name
559 # of the perl import library (i.e. 'libperl56.a'). GCC will not
560 # find it unless the 'lib' prefix & the extension are stripped.
561 $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
563 unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
564 if ( $spec{startup} && @{$spec{startup}} );
566 # From ExtUtils::MM_Win32:
568 ## one thing for GCC/Mingw32:
569 ## we try to overcome non-relocateable-DLL problems by generating
570 ## a (hopefully unique) image-base from the dll's name
571 ## -- BKS, 10-19-1999
572 File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
573 $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
575 %spec = $self->write_linker_script(%spec)
576 if $spec{use_scripts};
578 foreach my $path ( @{$spec{libpath}} ) {
582 my @cmds; # Stores the series of commands needed to build the module.
585 'dlltool', '--def' , $spec{def_file},
586 '--output-exp' , $spec{explib}
589 # split off any -arguments included in ld
590 my @ld = split / (?=-)/, $spec{ld};
592 push @cmds, [ grep {defined && length} (
594 '-o', $spec{output} ,
595 "-Wl,--base-file,$spec{base_file}" ,
596 "-Wl,--image-base,$spec{image_base}" ,
597 @{$spec{lddlflags}} ,
601 @{$spec{other_ldflags}} ,
605 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
609 'dlltool', '--def' , $spec{def_file},
610 '--output-exp' , $spec{explib},
611 '--base-file' , $spec{base_file}
614 push @cmds, [ grep {defined && length} (
616 '-o', $spec{output} ,
617 "-Wl,--image-base,$spec{image_base}" ,
618 @{$spec{lddlflags}} ,
622 @{$spec{other_ldflags}} ,
626 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
632 sub write_linker_script {
633 my ($self, %spec) = @_;
635 my $script = File::Spec->catfile( $spec{srcdir},
636 $spec{basename} . '.lds' );
638 $self->add_to_cleanup($script);
640 print "Generating script '$script'\n" if !$self->{quiet};
642 open( SCRIPT, ">$script" )
643 or die( "Could not create script '$script': $!" );
645 print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
646 for @{delete $spec{libpath} || []};
648 # gcc takes only one startup file, so the first object in startup is
649 # specified as the startup file and any others are shifted into the
650 # beginning of the list of objects.
651 if ( $spec{startup} && @{$spec{startup}} ) {
652 print SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
653 unshift @{$spec{objects}},
654 @{delete $spec{startup} || []};
657 print SCRIPT 'INPUT(' . join( ',',
658 @{delete $spec{objects} || []}
661 print SCRIPT 'INPUT(' . join( ' ',
662 (delete $spec{libperl} || ''),
663 @{delete $spec{perllibs} || []},
668 push @{$spec{other_ldflags}}, '"' . $script . '"';
679 ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
683 This module implements the Windows-specific parts of ExtUtils::CBuilder.
684 Most of the Windows-specific stuff has to do with compiling and
685 linking C code. Currently we support the 3 compilers perl itself
686 supports: MSVC, BCC, and GCC.
688 This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
689 not implemented here will be implemented there. The interfaces are
690 defined by the L<ExtUtils::CBuilder> documentation.
694 Ken Williams <ken@mathforum.org>
696 Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
700 perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)