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