[catagits/Gitalist.git] / local-lib5 / lib / perl5 / ExtUtils / CBuilder / Platform / Windows.pm

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.27';
@ISA = qw(ExtUtils::CBuilder::Base);

=begin comment

The compiler-specific packages 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

sub new {
  my $class = shift;
  my $self = $class->SUPER::new(@_);
  my $cf = $self->{config};

  # Inherit from an appropriate compiler driver class
  my $driver = "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
  eval "require $driver" or die "Could not load compiler driver: $@";
  unshift @ISA, $driver;

  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;

__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
Commit	Line	Data
3fea05b9	1	package ExtUtils::CBuilder::Platform::Windows;
	2
	3	use strict;
	4	use warnings;
	5
	6	use File::Basename;
	7	use File::Spec;
	8
	9	use ExtUtils::CBuilder::Base;
	10	use IO::File;
	11
	12	use vars qw($VERSION @ISA);
	13	$VERSION = '0.27';
	14	@ISA = qw(ExtUtils::CBuilder::Base);
	15
	16	=begin comment
	17
	18	The compiler-specific packages implement functions for generating properly
	19	formatted commandlines for the compiler being used. Each package
	20	defines two primary functions 'format_linker_cmd()' &
	21	'format_compiler_cmd()' that accepts a list of named arguments (a
	22	hash) and returns a list of formatted options suitable for invoking the
	23	compiler. By default, if the compiler supports scripting of its
	24	operation then a script file is built containing the options while
	25	those options are removed from the commandline, and a reference to the
	26	script is pushed onto the commandline in their place. Scripting the
	27	compiler in this way helps to avoid the problems associated with long
	28	commandlines under some shells.
	29
	30	=end comment
	31
	32	=cut
	33
	34	sub new {
	35	my $class = shift;
	36	my $self = $class->SUPER::new(@_);
	37	my $cf = $self->{config};
	38
	39	# Inherit from an appropriate compiler driver class
	40	my $driver = "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
	41	eval "require $driver" or die "Could not load compiler driver: $@";
	42	unshift @ISA, $driver;
	43
	44	return $self;
	45	}
	46
	47	sub _compiler_type {
	48	my $self = shift;
	49	my $cc = $self->{config}{cc};
	50
	51	return ( $cc =~ /cl(\.exe)?$/ ? 'MSVC'
	52	: $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
	53	: 'GCC');
	54	}
	55
	56	sub split_like_shell {
	57	# Since Windows will pass the whole command string (not an argument
	58	# array) to the target program and make the program parse it itself,
	59	# we don't actually need to do any processing here.
	60	(my $self, local $_) = @_;
	61
	62	return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
	63	return unless defined() && length();
	64	return ($_);
65	}
66
67	sub do_system {
68	# See above
69	my $self = shift;
70	my $cmd = join(" ",
71	grep length,
72	map {$a=$_;$a=~s/\t/ /g;$a=~s/^\s+\|\s+$//;$a}
73	grep defined, @_);
74	return $self->SUPER::do_system($cmd);
75	}
76
77	sub arg_defines {
78	my ($self, %args) = @_;
79	s/"/\\"/g foreach values %args;
80	return map qq{"-D$_=$args{$_}"}, keys %args;
81	}
82
83	sub compile {
84	my ($self, %args) = @_;
85	my $cf = $self->{config};
86
87	die "Missing 'source' argument to compile()" unless defined $args{source};
88
89	my ($basename, $srcdir) =
90	( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
91
92	$srcdir \|\|= File::Spec->curdir();
93
94	my @defines = $self->arg_defines( %{ $args{defines} \|\| {} } );
95
96	my %spec = (
97	srcdir => $srcdir,
98	builddir => $srcdir,
99	basename => $basename,
100	source => $args{source},
101	output => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
102	cc => $cf->{cc},
103	cflags => [
104	$self->split_like_shell($cf->{ccflags}),
105	$self->split_like_shell($cf->{cccdlflags}),
106	$self->split_like_shell($args{extra_compiler_flags}),
107	],
108	optimize => [ $self->split_like_shell($cf->{optimize}) ],
109	defines => \@defines,
110	includes => [ @{$args{include_dirs} \|\| []} ],
111	perlinc => [
112	$self->perl_inc(),
113	$self->split_like_shell($cf->{incpath}),
114	],
115	use_scripts => 1, # XXX provide user option to change this???
116	);
117
118	$self->normalize_filespecs(
119	\$spec{source},
120	\$spec{output},
121	$spec{includes},
122	$spec{perlinc},
123	);
124
125	my @cmds = $self->format_compiler_cmd(%spec);
126	while ( my $cmd = shift @cmds ) {
127	$self->do_system( @$cmd )
128	or die "error building $cf->{dlext} file from '$args{source}'";
129	}
130
131	(my $out = $spec{output}) =~ tr/'"//d;
132	return $out;
133	}
134
135	sub need_prelink { 1 }
136
137	sub link {
138	my ($self, %args) = @_;
139	my $cf = $self->{config};
140
141	my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
142	my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
143	$to \|\|= File::Spec->curdir();
144
145	(my $file_base = $args{module_name}) =~ s/.*:://;
146	my $output = $args{lib_file} \|\|
147	File::Spec->catfile($to, "$file_base.$cf->{dlext}");
148
149	# if running in perl source tree, look for libs there, not installed
150	my $lddlflags = $cf->{lddlflags};
151	my $perl_src = $self->perl_src();
152	$lddlflags =~ s/\Q$cf->{archlibexp}\E[\\\/]CORE/$perl_src/ if $perl_src;
153
154	my %spec = (
155	srcdir => $to,
156	builddir => $to,
157	startup => [ ],
158	objects => \@objects,
159	libs => [ ],
160	output => $output,
161	ld => $cf->{ld},
162	libperl => $cf->{libperl},
163	perllibs => [ $self->split_like_shell($cf->{perllibs}) ],
164	libpath => [ $self->split_like_shell($cf->{libpth}) ],
165	lddlflags => [ $self->split_like_shell($lddlflags) ],
166	other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} \|\| '') ],
167	use_scripts => 1, # XXX provide user option to change this???
168	);
169
170	unless ( $spec{basename} ) {
171	($spec{basename} = $args{module_name}) =~ s/.*:://;
172	}
173
174	$spec{srcdir} = File::Spec->canonpath( $spec{srcdir} );
175	$spec{builddir} = File::Spec->canonpath( $spec{builddir} );
176
177	$spec{output} \|\|= File::Spec->catfile( $spec{builddir},
178	$spec{basename} . '.'.$cf->{dlext} );
179	$spec{manifest} \|\|= File::Spec->catfile( $spec{builddir},
180	$spec{basename} . '.'.$cf->{dlext}.'.manifest');
181	$spec{implib} \|\|= File::Spec->catfile( $spec{builddir},
182	$spec{basename} . $cf->{lib_ext} );
183	$spec{explib} \|\|= File::Spec->catfile( $spec{builddir},
184	$spec{basename} . '.exp' );
185	if ($cf->{cc} eq 'cl') {
186	$spec{dbg_file} \|\|= File::Spec->catfile( $spec{builddir},
187	$spec{basename} . '.pdb' );
188	}
189	elsif ($cf->{cc} eq 'bcc32') {
190	$spec{dbg_file} \|\|= File::Spec->catfile( $spec{builddir},
191	$spec{basename} . '.tds' );
192	}
193	$spec{def_file} \|\|= File::Spec->catfile( $spec{srcdir} ,
194	$spec{basename} . '.def' );
195	$spec{base_file} \|\|= File::Spec->catfile( $spec{srcdir} ,
196	$spec{basename} . '.base' );
197
198	$self->add_to_cleanup(
199	grep defined,
200	@{[ @spec{qw(manifest implib explib dbg_file def_file base_file map_file)} ]}
201	);
202
203	foreach my $opt ( qw(output manifest implib explib dbg_file def_file map_file base_file) ) {
204	$self->normalize_filespecs( \$spec{$opt} );
205	}
206
207	foreach my $opt ( qw(libpath startup objects) ) {
208	$self->normalize_filespecs( $spec{$opt} );
209	}
210
211	(my $def_base = $spec{def_file}) =~ tr/'"//d;
212	$def_base =~ s/\.def$//;
213	$self->prelink( dl_name => $args{module_name},
214	dl_file => $def_base,
215	dl_base => $spec{basename} );
216
217	my @cmds = $self->format_linker_cmd(%spec);
218	while ( my $cmd = shift @cmds ) {
219	$self->do_system( @$cmd );
220	}
221
222	$spec{output} =~ tr/'"//d;
223	return wantarray
224	? grep defined, @spec{qw[output manifest implib explib dbg_file def_file map_file base_file]}
225	: $spec{output};
226	}
227
228	# canonize & quote paths
229	sub normalize_filespecs {
230	my ($self, @specs) = @_;
231	foreach my $spec ( grep defined, @specs ) {
232	if ( ref $spec eq 'ARRAY') {
233	$self->normalize_filespecs( map {\$_} grep defined, @$spec )
234	} elsif ( ref $spec eq 'SCALAR' ) {
235	$$spec =~ tr/"//d if $$spec;
236	next unless $$spec;
237	$$spec = '"' . File::Spec->canonpath($$spec) . '"';
238	} elsif ( ref $spec eq '' ) {
239	$spec = '"' . File::Spec->canonpath($spec) . '"';
240	} else {
241	die "Don't know how to normalize " . (ref $spec \|\| $spec) . "\n";
242	}
243	}
244	}
245
246	# directory of perl's include files
247	sub perl_inc {
248	my $self = shift;
249
250	my $perl_src = $self->perl_src();
251
252	if ($perl_src) {
253	File::Spec->catdir($perl_src, "lib", "CORE");
254	} else {
255	File::Spec->catdir($self->{config}{archlibexp},"CORE");
256	}
257	}
258
259	1;
260
261	__END__
262
263	=head1 NAME
264
265	ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
266
267	=head1 DESCRIPTION
268
269	This module implements the Windows-specific parts of ExtUtils::CBuilder.
270	Most of the Windows-specific stuff has to do with compiling and
271	linking C code. Currently we support the 3 compilers perl itself
272	supports: MSVC, BCC, and GCC.
273
274	This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
275	not implemented here will be implemented there. The interfaces are
276	defined by the L<ExtUtils::CBuilder> documentation.
277
278	=head1 AUTHOR
279
280	Ken Williams <ken@mathforum.org>
281
282	Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
283
284	=head1 SEE ALSO
285
286	perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)
287
288	=cut