[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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.22'; 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 insure 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;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |