git.maemo.org Git - dh-make-perl/blob - dev/arm/libextutils-cbuilder-perl/libextutils-cbuilder-perl-0.23/debian/libextutils-cbuilder-perl/usr/share/perl5/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.23';
   8 @ISA = qw(ExtUtils::CBuilder::Base);
   9
  10 sub need_prelink { 0 }
  11
  12 sub arg_defines {
  13   my ($self, %args) = @_;
  14
  15   s/"/""/g foreach values %args;
  16
  17   my @config_defines;
  18
  19   # VMS can only have one define qualifier; add the one from config, if any.
  20   if ($self->{config}{ccflags} =~ s{/  def[^=]+  =+  \(?  ([^\/\)]*)  } {}ix) {
  21     push @config_defines, $1;
  22   }
  23
  24   return '' unless keys(%args) || @config_defines;
  25
  26   return ('/define=('
  27           . join(',',
  28                  @config_defines,
  29                  map "\"$_" . ( length($args{$_}) ? "=$args{$_}" : '') . "\"",
  30                      keys %args)
  31           . ')');
  32 }
  33
  34 sub arg_include_dirs {
  35   my ($self, @dirs) = @_;
  36
  37   # VMS can only have one include list, add the one from config.
  38   if ($self->{config}{ccflags} =~ s{/inc[^=]+(?:=)+(?:\()?([^\/\)]*)} {}i) {
  39     unshift @dirs, $1;
  40   }
  41   return unless @dirs;
  42
  43   return ('/include=(' . join(',', @dirs) . ')');
  44 }
  45
  46 sub _do_link {
  47   my ($self, $type, %args) = @_;
  48
  49   my $objects = delete $args{objects};
  50   $objects = [$objects] unless ref $objects;
  51
  52   # VMS has two option files, the external symbol, and to pull in PerlShr
  53   if ($args{lddl}) {
  54     my @temp_files =
  55       $self->prelink(%args, dl_name => $args{module_name});
  56
  57     $objects->[-1] .= ',';
  58
  59     # If creating a loadable library, the link option file is needed.
  60     push @$objects, 'sys$disk:[]' . $temp_files[0] . '/opt,';
  61
  62     # VMS always needs the option file for the Perl shared image.
  63     push @$objects, $self->perl_inc() . 'PerlShr.Opt/opt';
  64   }
  65
  66   return $self->SUPER::_do_link($type, %args, objects => $objects);
  67 }
  68
  69 sub arg_nolink { return; }
  70
  71 sub arg_object_file {
  72   my ($self, $file) = @_;
  73   return "/obj=$file";
  74 }
  75
  76 sub arg_exec_file {
  77   my ($self, $file) = @_;
  78   return ("/exe=$file");
  79 }
  80
  81 sub arg_share_object_file {
  82   my ($self, $file) = @_;
  83   return ("$self->{config}{lddlflags}=$file");
  84 }
  85
  86
  87 sub lib_file {
  88   my ($self, $dl_file) = @_;
  89   $dl_file =~ s/\.[^.]+$//;
  90   $dl_file =~ tr/"//d;
  91   $dl_file = $dl_file .= '.' . $self->{config}{dlext};
  92
  93   # Need to create with the same name as DynaLoader will load with.
  94   if (defined &DynaLoader::mod2fname) {
  95     my ($dev,$dir,$file) = File::Spec->splitpath($dl_file);
  96     $file = DynaLoader::mod2fname([$file]);
  97     $dl_file = File::Spec->catpath($dev,$dir,$file);
  98   }
  99   return $dl_file;
 100 }
 101
 102 1;