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