Commit | Line | Data |
6b09c160 |
1 | package ExtUtils::CBuilder::Platform::VMS; |
2 | |
3 | use strict; |
4 | use ExtUtils::CBuilder::Base; |
5 | |
6 | use vars qw($VERSION @ISA); |
345dbb93 |
7 | $VERSION = '0.12'; |
6b09c160 |
8 | @ISA = qw(ExtUtils::CBuilder::Base); |
9 | |
4629f7b1 |
10 | sub need_prelink { 0 } |
6b09c160 |
11 | |
ea2e6518 |
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[^=]+(?:=)+(?:\()?([^\/\)]*)} {}i) { |
21 | $config_defines = $1; |
22 | } |
23 | |
24 | return unless (scalar keys %args) || $config_defines; |
25 | |
26 | return ('/define=(' |
27 | . (defined $config_defines ? "$config_defines," : '') |
28 | . join(',', |
29 | map "\"$_" . ( length($args{$_}) ? "=$args{$_}" : '') . "\"", |
30 | keys %args) |
31 | . ')'); |
32 | } |
33 | |
6b09c160 |
34 | sub arg_include_dirs { |
2bd31f1a |
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); |
6b09c160 |
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 | |
2bd31f1a |
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 | |
6b09c160 |
102 | 1; |