local-lib5/lib/perl5/ExtUtils/CBuilder/Platform/Windows/BCC.pm

   1 package ExtUtils::CBuilder::Platform::Windows::BCC;
   2
   3 use vars qw($VERSION);
   4 $VERSION = '0.27';
   5
   6 sub format_compiler_cmd {
   7   my ($self, %spec) = @_;
   8
   9   foreach my $path ( @{ $spec{includes} || [] },
  10                      @{ $spec{perlinc}  || [] } ) {
  11     $path = '-I' . $path;
  12   }
  13
  14   %spec = $self->write_compiler_script(%spec)
  15     if $spec{use_scripts};
  16
  17   return [ grep {defined && length} (
  18     $spec{cc}, '-c'         ,
  19     @{$spec{includes}}      ,
  20     @{$spec{cflags}}        ,
  21     @{$spec{optimize}}      ,
  22     @{$spec{defines}}       ,
  23     @{$spec{perlinc}}       ,
  24     "-o$spec{output}"       ,
  25     $spec{source}           ,
  26   ) ];
  27 }
  28
  29 sub write_compiler_script {
  30   my ($self, %spec) = @_;
  31
  32   my $script = File::Spec->catfile( $spec{srcdir},
  33                                     $spec{basename} . '.ccs' );
  34
  35   $self->add_to_cleanup($script);
  36
  37   print "Generating script '$script'\n" if !$self->{quiet};
  38
  39   my $SCRIPT = IO::File->new( ">$script" )
  40     or die( "Could not create script '$script': $!" );
  41
  42   # XXX Borland "response files" seem to be unable to accept macro
  43   # definitions containing quoted strings. Escaping strings with
  44   # backslash doesn't work, and any level of quotes are stripped. The
  45   # result is is a floating point number in the source file where a
  46   # string is expected. So we leave the macros on the command line.
  47   print $SCRIPT join( "\n",
  48     map { ref $_ ? @{$_} : $_ }
  49     grep defined,
  50     delete(
  51       @spec{ qw(includes cflags optimize perlinc) } )
  52   );
  53
  54   push @{$spec{includes}}, '@"' . $script . '"';
  55
  56   return %spec;
  57 }
  58
  59 sub format_linker_cmd {
  60   my ($self, %spec) = @_;
  61
  62   foreach my $path ( @{$spec{libpath}} ) {
  63     $path = "-L$path";
  64   }
  65
  66   push( @{$spec{startup}}, 'c0d32.obj' )
  67     unless ( $spec{starup} && @{$spec{startup}} );
  68
  69   %spec = $self->write_linker_script(%spec)
  70     if $spec{use_scripts};
  71
  72   return [ grep {defined && length} (
  73     $spec{ld}               ,
  74     @{$spec{lddlflags}}     ,
  75     @{$spec{libpath}}       ,
  76     @{$spec{other_ldflags}} ,
  77     @{$spec{startup}}       ,
  78     @{$spec{objects}}       , ',',
  79     $spec{output}           , ',',
  80     $spec{map_file}         , ',',
  81     $spec{libperl}          ,
  82     @{$spec{perllibs}}      , ',',
  83     $spec{def_file}
  84   ) ];
  85 }
  86
  87 sub write_linker_script {
  88   my ($self, %spec) = @_;
  89
  90   # To work around Borlands "unique" commandline syntax,
  91   # two scripts are used:
  92
  93   my $ld_script = File::Spec->catfile( $spec{srcdir},
  94                                        $spec{basename} . '.lds' );
  95   my $ld_libs   = File::Spec->catfile( $spec{srcdir},
  96                                        $spec{basename} . '.lbs' );
  97
  98   $self->add_to_cleanup($ld_script, $ld_libs);
  99
 100   print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
 101
 102   # Script 1: contains options & names of object files.
 103   my $LD_SCRIPT = IO::File->new( ">$ld_script" )
 104     or die( "Could not create linker script '$ld_script': $!" );
 105
 106   print $LD_SCRIPT join( " +\n",
 107     map { @{$_} }
 108     grep defined,
 109     delete(
 110       @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
 111   );
 112
 113   # Script 2: contains name of libs to link against.
 114   my $LD_LIBS = IO::File->new( ">$ld_libs" )
 115     or die( "Could not create linker script '$ld_libs': $!" );
 116
 117   print $LD_LIBS join( " +\n",
 118      (delete $spec{libperl}  || ''),
 119     @{delete $spec{perllibs} || []},
 120   );
 121
 122   push @{$spec{lddlflags}}, '@"' . $ld_script  . '"';
 123   push @{$spec{perllibs}},  '@"' . $ld_libs    . '"';
 124
 125   return %spec;
 126 }
 127
 128 1;
 129
 130