lib/Module/Build/Platform/VMS.pm

   1 package Module::Build::Platform::VMS;
   2
   3 use strict;
   4 use Module::Build::Base;
   5
   6 use vars qw(@ISA);
   7 @ISA = qw(Module::Build::Base);
   8
   9
  10
  11 =head1 NAME
  12
  13 Module::Build::Platform::VMS - Builder class for VMS platforms
  14
  15 =head1 DESCRIPTION
  16
  17 This module inherits from C<Module::Build::Base> and alters a few
  18 minor details of its functionality.  Please see L<Module::Build> for
  19 the general docs.
  20
  21 =head2 Overridden Methods
  22
  23 =over 4
  24
  25 =item new
  26
  27 Change $self->{build_script} to 'Build.com' so @Build works.
  28
  29 =cut
  30
  31 sub new {
  32     my $class = shift;
  33     my $self = $class->SUPER::new(@_);
  34
  35     $self->{properties}{build_script} = 'Build.com';
  36
  37     return $self;
  38 }
  39
  40
  41 =item cull_args
  42
  43 '@Build foo' on VMS will not preserve the case of 'foo'.  Rather than forcing
  44 people to write '@Build "foo"' we'll dispatch case-insensitively.
  45
  46 =cut
  47
  48 sub cull_args {
  49     my $self = shift;
  50     my($action, $args) = $self->SUPER::cull_args(@_);
  51     my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions;
  52
  53     die "Ambiguous action '$action'.  Could be one of @possible_actions"
  54         if @possible_actions > 1;
  55
  56     return ($possible_actions[0], $args);
  57 }
  58
  59
  60 =item manpage_separator
  61
  62 Use '__' instead of '::'.
  63
  64 =cut
  65
  66 sub manpage_separator {
  67     return '__';
  68 }
  69
  70
  71 =item prefixify
  72
  73 Prefixify taking into account VMS' filepath syntax.
  74
  75 =cut
  76
  77 # Translated from ExtUtils::MM_VMS::prefixify()
  78 sub _prefixify {
  79     my($self, $path, $sprefix, $type) = @_;
  80     my $rprefix = $self->prefix;
  81
  82     $self->log_verbose("  prefixify $path from $sprefix to $rprefix\n");
  83
  84     # Translate $(PERLPREFIX) to a real path.
  85     $rprefix = $self->eliminate_macros($rprefix);
  86     $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
  87     $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
  88
  89     $self->log_verbose("  rprefix translated to $rprefix\n".
  90                        "  sprefix translated to $sprefix\n");
  91
  92     if( length $path == 0 ) {
  93         $self->log_verbose("  no path to prefixify.\n")
  94     }
  95     elsif( !File::Spec->file_name_is_absolute($path) ) {
  96         $self->log_verbose("    path is relative, not prefixifying.\n");
  97     }
  98     elsif( $sprefix eq $rprefix ) {
  99         $self->log_verbose("  no new prefix.\n");
 100     }
 101     else {
 102         my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
 103         my $vms_prefix = $self->config->{vms_prefix};
 104         if( $path_vol eq $vms_prefix.':' ) {
 105             $self->log_verbose("  $vms_prefix: seen\n");
 106
 107             $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
 108             $path = $self->_catprefix($rprefix, $path_dirs);
 109         }
 110         else {
 111             $self->log_verbose("    cannot prefixify.\n");
 112             return $self->prefix_relpaths($self->installdirs, $type);
 113         }
 114     }
 115
 116     $self->log_verbose("    now $path\n");
 117
 118     return $path;
 119 }
 120
 121
 122 =back
 123
 124 =head1 AUTHOR
 125
 126 Michael G Schwern <schwern@pobox.com>, Ken Williams <ken@cpan.org>
 127
 128 =head1 SEE ALSO
 129
 130 perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
 131
 132 =cut
 133
 134 1;
 135 __END__