The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

LEONT / ExtUtils-Builder-Compiler-0.026 / lib / ExtUtils / Builder / Compiler / VMS.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
—
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79

              
package ExtUtils::Builder::Compiler::VMS;
$ExtUtils::Builder::Compiler::VMS::VERSION = '0.026';
use strict;
use warnings;
use parent 'ExtUtils::Builder::Compiler';
use Carp ();
sub _init {
        my ($self, %args) = @_;
        $args{cc} //= ['CC/DECC'];
        $self->SUPER::_init(%args);
        return;
}
# The VMS compiler can only have one define and one include qualifier, so we need to juggle here
sub add_argument {
        my ($self, %opts) = @_;
        my @value;
        for my $elem (@{ delete $opts{value} }) {
                if ($elem =~ m{ / def [^=]+ =+ (\()? ( [^/\)]* ) (?(1) \) ) }xi) {
                        my @defines = $2 =~ m/ ( \w+ | "[^"]+" ) /gx;
                        push @{ $self->{defines} }, @defines;
                }
                elsif ($elem =~ m{ / inc [^=]+ =+ (\()?  ( [^/\)]* ) (?(1) \) ) }xi) {
                        $self->add_include_dir([$2]);
                }
                else {
                        push @value, $elem;
                }
        }
        $self->SUPER::add_argument(%opts, value => \@value);
        return;
}
sub compile_flags {
        my ($self, $from, $to) = @_;
        my @ret;
        my @include_dirs = map { $_->{value} } @{ $self->{include_dirs} };
        my @defines = map { defined $_->{value} ? $_->{value} ne '' ? qq/"$_->{key}=$_->{value}"/ : qq{"$_->{key}"} : Carp::croak("Can't undefine '$_->{key}'") } @{ $self->{defines} };
        push @ret, $self->new_argument(ranking => 30, value => [ '/include=' . join ',', @include_dirs ]) if @include_dirs;
        push @ret, $self->new_argument(ranking => 40, value => [ '/define=' . join ',', @defines ])     if @defines;
        push @ret, $self->new_argument(ranking => 75, value => [ "/obj=$to", $from ]);
        return @ret;
}
1;
#ABSTRACT: Class for compiling with a VMS compiler
__END__
=pod
=encoding UTF-8
=head1 NAME
ExtUtils::Builder::Compiler::VMS - Class for compiling with a VMS compiler
=head1 VERSION
version 0.026
=head1 AUTHOR
Leon Timmermans <fawaka@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Leon Timmermans.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut