use File::Spec;
use ExtUtils::CBuilder::Base;
+use IO::File;
use vars qw($VERSION @ISA);
-$VERSION = '0.12_01';
+$VERSION = '0.24';
@ISA = qw(ExtUtils::CBuilder::Base);
sub new {
}
sub split_like_shell {
- # As it turns out, Windows command-parsing is very different from
- # Unix command-parsing. Double-quotes mean different things,
- # backslashes don't necessarily mean escapes, and so on. So we
- # can't use Text::ParseWords::shellwords() to break a command string
- # into words. The algorithm below was bashed out by Randy and Ken
- # (mostly Randy), and there are a lot of regression tests, so we
- # should feel free to adjust if desired.
-
+ # 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');
-
- my @argv;
- return @argv unless defined() && length();
-
- my $arg = '';
- my( $i, $quote_mode ) = ( 0, 0 );
-
- while ( $i < length() ) {
-
- my $ch = substr( $_, $i , 1 );
- my $next_ch = substr( $_, $i+1, 1 );
-
- if ( $ch eq '\\' && $next_ch eq '"' ) {
- $arg .= '"';
- $i++;
- } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
- $arg .= '\\';
- $i++;
- } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
- $quote_mode = !$quote_mode;
- $arg .= '"';
- $i++;
- } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
- ( $i + 2 == length() ||
- substr( $_, $i + 2, 1 ) eq ' ' )
- ) { # for cases like: a"" => [ 'a' ]
- push( @argv, $arg );
- $arg = '';
- $i += 2;
- } elsif ( $ch eq '"' ) {
- $quote_mode = !$quote_mode;
- } elsif ( $ch eq ' ' && !$quote_mode ) {
- push( @argv, $arg ) if $arg;
- $arg = '';
- ++$i while substr( $_, $i + 1, 1 ) eq ' ';
- } else {
- $arg .= $ch;
- }
-
- $i++;
- }
-
- push( @argv, $arg ) if defined( $arg ) && length( $arg );
- return @argv;
+ 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 {
cflags => [
$self->split_like_shell($cf->{ccflags}),
$self->split_like_shell($cf->{cccdlflags}),
- $self->split_like_shell($cf->{extra_compiler_flags}),
+ $self->split_like_shell($args{extra_compiler_flags}),
],
optimize => [ $self->split_like_shell($cf->{optimize}) ],
defines => \@defines,
$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} ,
$self->add_to_cleanup(
grep defined,
- @{[ @spec{qw(manifest implib explib def_file base_file map_file)} ]}
+ @{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]}
);
- foreach my $opt ( qw(output manifest implib explib def_file map_file base_file) ) {
+ foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) {
$self->normalize_filespecs( \$spec{$opt} );
}
$spec{output} =~ tr/'"//d;
return wantarray
- ? grep defined, @spec{qw[output manifest implib explib def_file map_file base_file]}
+ ? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]}
: $spec{output};
}
$self->add_to_cleanup($script);
print "Generating script '$script'\n" if !$self->{quiet};
- open( SCRIPT, ">$script" )
+ my $SCRIPT = IO::File->new( ">$script" )
or die( "Could not create script '$script': $!" );
- print SCRIPT join( "\n",
+ print $SCRIPT join( "\n",
map { ref $_ ? @{$_} : $_ }
grep defined,
delete(
@spec{ qw(includes cflags optimize defines perlinc) } )
);
- close SCRIPT;
-
push @{$spec{includes}}, '@"' . $script . '"';
return %spec;
$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"
- ];
- }
+ # Embed the manifest file if it exists
+ push @cmds, [
+ 'if', 'exist', $spec{manifest}, 'mt', '-nologo', $spec{manifest}, '-outputresource:' . "$output;2"
+ ];
return @cmds;
}
print "Generating script '$script'\n" if !$self->{quiet};
- open( SCRIPT, ">$script" )
+ my $SCRIPT = IO::File->new( ">$script" )
or die( "Could not create script '$script': $!" );
- print SCRIPT join( "\n",
+ print $SCRIPT join( "\n",
map { ref $_ ? @{$_} : $_ }
grep defined,
delete(
def_file implib map_file) } )
);
- close SCRIPT;
-
push @{$spec{lddlflags}}, '@"' . $script . '"';
return %spec;
print "Generating script '$script'\n" if !$self->{quiet};
- open( SCRIPT, ">$script" )
+ my $SCRIPT = IO::File->new( ">$script" )
or die( "Could not create script '$script': $!" );
# XXX Borland "response files" seem to be unable to accept macro
# 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",
+ print $SCRIPT join( "\n",
map { ref $_ ? @{$_} : $_ }
grep defined,
delete(
@spec{ qw(includes cflags optimize perlinc) } )
);
- close SCRIPT;
-
push @{$spec{includes}}, '@"' . $script . '"';
return %spec;
print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
# Script 1: contains options & names of object files.
- open( LD_SCRIPT, ">$ld_script" )
+ my $LD_SCRIPT = IO::File->new( ">$ld_script" )
or die( "Could not create linker script '$ld_script': $!" );
- print LD_SCRIPT join( " +\n",
+ print $LD_SCRIPT join( " +\n",
map { @{$_} }
grep defined,
delete(
@spec{ qw(lddlflags libpath other_ldflags startup objects) } )
);
- close LD_SCRIPT;
-
# Script 2: contains name of libs to link against.
- open( LD_LIBS, ">$ld_libs" )
+ my $LD_LIBS = IO::File->new( ">$ld_libs" )
or die( "Could not create linker script '$ld_libs': $!" );
- print LD_LIBS join( " +\n",
+ print $LD_LIBS join( " +\n",
(delete $spec{libperl} || ''),
@{delete $spec{perllibs} || []},
);
- close LD_LIBS;
-
push @{$spec{lddlflags}}, '@"' . $ld_script . '"';
push @{$spec{perllibs}}, '@"' . $ld_libs . '"';
print "Generating script '$script'\n" if !$self->{quiet};
- open( SCRIPT, ">$script" )
+ my $SCRIPT = IO::File->new( ">$script" )
or die( "Could not create script '$script': $!" );
- print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
+ 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";
+ print $SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
unshift @{$spec{objects}},
@{delete $spec{startup} || []};
}
- print SCRIPT 'INPUT(' . join( ',',
+ print $SCRIPT 'INPUT(' . join( ',',
@{delete $spec{objects} || []}
) . ")\n";
- print SCRIPT 'INPUT(' . join( ' ',
+ print $SCRIPT 'INPUT(' . join( ' ',
(delete $spec{libperl} || ''),
@{delete $spec{perllibs} || []},
) . ")\n";
- close SCRIPT;
-
push @{$spec{other_ldflags}}, '"' . $script . '"';
return %spec;
https://perl5.git.perl.org / perl5.git / blobdiff