[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/ExtUtils/CBuilder/Platform/ -> VMS.pm (source)

   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;


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1