cpan/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm

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