This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bfdc0d49c1b2ce068725c4ce4113d0cdaa77eb52
[perl5.git] / dist / ExtUtils-CBuilder / lib / ExtUtils / CBuilder / Platform / VMS.pm
1 package ExtUtils::CBuilder::Platform::VMS;
2 $ExtUtils::CBuilder::Platform::VMS::VERSION = '0.280223';
3 use strict;
4 use ExtUtils::CBuilder::Base;
5
6 use vars qw(@ISA);
7 @ISA = qw(ExtUtils::CBuilder::Base);
8
9 use File::Spec::Functions qw(catfile catdir);
10 use Config;
11
12 # We do prelink, but don't want the parent to redo it.
13
14 sub need_prelink { 0 }
15
16 sub arg_defines {
17   my ($self, %args) = @_;
18
19   s/"/""/g foreach values %args;
20
21   my @config_defines;
22
23   # VMS can only have one define qualifier; add the one from config, if any.
24   if ($self->{config}{ccflags} =~ s{/  def[^=]+  =+  \(?  ([^\/\)]*)  } {}ix) {
25     push @config_defines, $1;
26   }
27
28   return '' unless keys(%args) || @config_defines;
29
30   return ('/define=('
31           . join(',',
32                  @config_defines,
33                  map "\"$_" . ( length($args{$_}) ? "=$args{$_}" : '') . "\"",
34                      sort keys %args)
35           . ')');
36 }
37
38 sub arg_include_dirs {
39   my ($self, @dirs) = @_;
40
41   # VMS can only have one include list, add the one from config.
42   if ($self->{config}{ccflags} =~ s{/inc[^=]+(?:=)+(?:\()?([^\/\)]*)} {}i) {
43     unshift @dirs, $1;
44   }
45   return unless @dirs;
46
47   return ('/include=(' . join(',', @dirs) . ')');
48 }
49
50 # We override the compile method because we consume the includes and defines
51 # parts of ccflags in the process of compiling but don't save those parts
52 # anywhere, so $self->{config}{ccflags} needs to be reset for each compile
53 # operation.
54
55 sub compile {
56   my ($self, %args) = @_;
57
58   $self->{config}{ccflags} = $Config{ccflags};
59   $self->{config}{ccflags} = $ENV{CFLAGS} if defined $ENV{CFLAGS};
60
61   return $self->SUPER::compile(%args);
62 }
63
64 sub _do_link {
65   my ($self, $type, %args) = @_;
66
67   my $objects = delete $args{objects};
68   $objects = [$objects] unless ref $objects;
69
70   if ($args{lddl}) {
71
72     # prelink will call Mksymlists, which creates the extension-specific
73     # linker options file and populates it with the boot symbol.
74
75     my @temp_files = $self->prelink(%args, dl_name => $args{module_name});
76
77     # We now add the rest of what we need to the linker options file.  We
78     # should replicate the functionality of C<ExtUtils::MM_VMS::dlsyms>,
79     # but there is as yet no infrastructure for handling object libraries,
80     # so for now we depend on object files being listed individually on the
81     # command line, which should work for simple cases.  We do bring in our
82     # own version of C<ExtUtils::Liblist::Kid::ext> so that any additional
83     # libraries (including PERLSHR) can be added to the options file.
84
85     my @optlibs = $self->_liblist_ext( $args{'libs'} );
86
87     my $optfile = 'sys$disk:[]' . $temp_files[0];
88     open my $opt_fh, '>>', $optfile
89         or die "_do_link: Unable to open $optfile: $!";
90     for my $lib (@optlibs) {print $opt_fh "$lib\n" if length $lib }
91     close $opt_fh;
92
93     $objects->[-1] .= ',';
94     push @$objects, $optfile . '/OPTIONS,';
95
96     # This one not needed for DEC C, but leave for completeness.
97     push @$objects, $self->perl_inc() . 'perlshr_attr.opt/OPTIONS';
98   }
99
100   return $self->SUPER::_do_link($type, %args, objects => $objects);
101 }
102
103 sub arg_nolink { return; }
104
105 sub arg_object_file {
106   my ($self, $file) = @_;
107   return "/obj=$file";
108 }
109
110 sub arg_exec_file {
111   my ($self, $file) = @_;
112   return ("/exe=$file");
113 }
114
115 sub arg_share_object_file {
116   my ($self, $file) = @_;
117   return ("$self->{config}{lddlflags}=$file");
118 }
119
120 # The following is reproduced almost verbatim from ExtUtils::Liblist::Kid::_vms_ext.
121 # We can't just call that because it's tied up with the MakeMaker object hierarchy.
122
123 sub _liblist_ext {
124   my($self, $potential_libs,$verbose,$give_libs) = @_;
125   $verbose ||= 0;
126
127   my(@crtls,$crtlstr);
128   @crtls = ( ($self->{'config'}{'ldflags'} =~ m-/Debug-i ? $self->{'config'}{'dbgprefix'} : '')
129               . 'PerlShr/Share' );
130   push(@crtls, grep { not /\(/ } split /\s+/, $self->{'config'}{'perllibs'});
131   push(@crtls, grep { not /\(/ } split /\s+/, $self->{'config'}{'libc'});
132   # In general, we pass through the basic libraries from %Config unchanged.
133   # The one exception is that if we're building in the Perl source tree, and
134   # a library spec could be resolved via a logical name, we go to some trouble
135   # to ensure that the copy in the local tree is used, rather than one to
136   # which a system-wide logical may point.
137   if ($self->perl_src) {
138     my($lib,$locspec,$type);
139     foreach $lib (@crtls) {
140       if (($locspec,$type) = $lib =~ m{^([\w\$-]+)(/\w+)?} and $locspec =~ /perl/i) {
141         if    (lc $type eq '/share')   { $locspec .= $self->{'config'}{'exe_ext'}; }
142         elsif (lc $type eq '/library') { $locspec .= $self->{'config'}{'lib_ext'}; }
143         else                           { $locspec .= $self->{'config'}{'obj_ext'}; }
144         $locspec = catfile($self->perl_src, $locspec);
145         $lib = "$locspec$type" if -e $locspec;
146       }
147     }
148   }
149   $crtlstr = @crtls ? join(' ',@crtls) : '';
150
151   unless ($potential_libs) {
152     warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose;
153     return ('', '', $crtlstr, '', ($give_libs ? [] : ()));
154   }
155
156   my(@dirs,@libs,$dir,$lib,%found,@fndlibs,$ldlib);
157   my $cwd = cwd();
158   my($so,$lib_ext,$obj_ext) = @{$self->{'config'}}{'so','lib_ext','obj_ext'};
159   # List of common Unix library names and their VMS equivalents
160   # (VMS equivalent of '' indicates that the library is automatically
161   # searched by the linker, and should be skipped here.)
162   my(@flibs, %libs_seen);
163   my %libmap = ( 'm' => '', 'f77' => '', 'F77' => '', 'V77' => '', 'c' => '',
164                  'malloc' => '', 'crypt' => '', 'resolv' => '', 'c_s' => '',
165                  'socket' => '', 'X11' => 'DECW$XLIBSHR',
166                  'Xt' => 'DECW$XTSHR', 'Xm' => 'DECW$XMLIBSHR',
167                  'Xmu' => 'DECW$XMULIBSHR');
168
169   warn "Potential libraries are '$potential_libs'\n" if $verbose;
170
171   # First, sort out directories and library names in the input
172   foreach $lib (split ' ',$potential_libs) {
173     push(@dirs,$1),   next if $lib =~ /^-L(.*)/;
174     push(@dirs,$lib), next if $lib =~ /[:>\]]$/;
175     push(@dirs,$lib), next if -d $lib;
176     push(@libs,$1),   next if $lib =~ /^-l(.*)/;
177     push(@libs,$lib);
178   }
179   push(@dirs,split(' ',$self->{'config'}{'libpth'}));
180
181   # Now make sure we've got VMS-syntax absolute directory specs
182   # (We don't, however, check whether someone's hidden a relative
183   # path in a logical name.)
184   foreach $dir (@dirs) {
185     unless (-d $dir) {
186       warn "Skipping nonexistent Directory $dir\n" if $verbose > 1;
187       $dir = '';
188       next;
189     }
190     warn "Resolving directory $dir\n" if $verbose;
191     if (!File::Spec->file_name_is_absolute($dir)) {
192         $dir = catdir($cwd,$dir);
193     }
194   }
195   @dirs = grep { length($_) } @dirs;
196   unshift(@dirs,''); # Check each $lib without additions first
197
198   LIB: foreach $lib (@libs) {
199     if (exists $libmap{$lib}) {
200       next unless length $libmap{$lib};
201       $lib = $libmap{$lib};
202     }
203
204     my(@variants,$variant,$cand);
205     my($ctype) = '';
206
207     # If we don't have a file type, consider it a possibly abbreviated name and
208     # check for common variants.  We try these first to grab libraries before
209     # a like-named executable image (e.g. -lperl resolves to perlshr.exe
210     # before perl.exe).
211     if ($lib !~ /\.[^:>\]]*$/) {
212       push(@variants,"${lib}shr","${lib}rtl","${lib}lib");
213       push(@variants,"lib$lib") if $lib !~ /[:>\]]/;
214     }
215     push(@variants,$lib);
216     warn "Looking for $lib\n" if $verbose;
217     foreach $variant (@variants) {
218       my($fullname, $name);
219
220       foreach $dir (@dirs) {
221         my($type);
222
223         $name = "$dir$variant";
224         warn "\tChecking $name\n" if $verbose > 2;
225         $fullname = VMS::Filespec::rmsexpand($name);
226         if (defined $fullname and -f $fullname) {
227           # It's got its own suffix, so we'll have to figure out the type
228           if    ($fullname =~ /(?:$so|exe)$/i)      { $type = 'SHR'; }
229           elsif ($fullname =~ /(?:$lib_ext|olb)$/i) { $type = 'OLB'; }
230           elsif ($fullname =~ /(?:$obj_ext|obj)$/i) {
231             warn "Note (probably harmless): "
232                 ."Plain object file $fullname found in library list\n";
233             $type = 'OBJ';
234           }
235           else {
236             warn "Note (probably harmless): "
237                 ."Unknown library type for $fullname; assuming shared\n";
238             $type = 'SHR';
239           }
240         }
241         elsif (-f ($fullname = VMS::Filespec::rmsexpand($name,$so))      or
242                -f ($fullname = VMS::Filespec::rmsexpand($name,'.exe')))     {
243           $type = 'SHR';
244           $name = $fullname unless $fullname =~ /exe;?\d*$/i;
245         }
246         elsif (not length($ctype) and  # If we've got a lib already,
247                                        # don't bother
248                ( -f ($fullname = VMS::Filespec::rmsexpand($name,$lib_ext)) or
249                  -f ($fullname = VMS::Filespec::rmsexpand($name,'.olb'))))  {
250           $type = 'OLB';
251           $name = $fullname unless $fullname =~ /olb;?\d*$/i;
252         }
253         elsif (not length($ctype) and  # If we've got a lib already,
254                                        # don't bother
255                ( -f ($fullname = VMS::Filespec::rmsexpand($name,$obj_ext)) or
256                  -f ($fullname = VMS::Filespec::rmsexpand($name,'.obj'))))  {
257           warn "Note (probably harmless): "
258                        ."Plain object file $fullname found in library list\n";
259           $type = 'OBJ';
260           $name = $fullname unless $fullname =~ /obj;?\d*$/i;
261         }
262         if (defined $type) {
263           $ctype = $type; $cand = $name;
264           last if $ctype eq 'SHR';
265         }
266       }
267       if ($ctype) {
268         push @{$found{$ctype}}, $cand;
269         warn "\tFound as $cand (really $fullname), type $ctype\n"
270           if $verbose > 1;
271         push @flibs, $name unless $libs_seen{$fullname}++;
272         next LIB;
273       }
274     }
275     warn "Note (probably harmless): "
276                  ."No library found for $lib\n";
277   }
278
279   push @fndlibs, @{$found{OBJ}}                      if exists $found{OBJ};
280   push @fndlibs, map { "$_/Library" } @{$found{OLB}} if exists $found{OLB};
281   push @fndlibs, map { "$_/Share"   } @{$found{SHR}} if exists $found{SHR};
282   $lib = join(' ',@fndlibs);
283
284   $ldlib = $crtlstr ? "$lib $crtlstr" : $lib;
285   warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose;
286   wantarray ? ($lib, '', $ldlib, '', ($give_libs ? \@flibs : ())) : $lib;
287 }
288
289 1;