view release on metacpan or  search on metacpan

inc/inc_Module-Build/Module/Build/Platform/VMS.pm  view on Meta::CPAN

    $$spec{lib_file} = File::Spec->catfile($$spec{archdir}, $file);
  }

  return $spec;
}

=item rscan_dir

Inherit the standard version but remove dots at end of name.
If the extended character set is in effect, do not remove dots from filenames
with Unix path delimiters.

=cut

sub rscan_dir {
  my ($self, $dir, $pattern) = @_;

  my $result = $self->SUPER::rscan_dir( $dir, $pattern );

  for my $file (@$result) {
      if (!_efs() && ($file =~ m#/#)) {
          $file =~ s/\.$//;
      }
  }
  return $result;
}

=item dist_dir

Inherit the standard version but replace embedded dots with underscores because
a dot is the directory delimiter on VMS.

=cut

sub dist_dir {
  my $self = shift;

  my $dist_dir = $self->SUPER::dist_dir;
  $dist_dir =~ s/\./_/g unless _efs();
  return $dist_dir;
}

=item man3page_name

Inherit the standard version but chop the extra manpage delimiter off the front if
there is one.  The VMS version of splitdir('[.foo]') returns '', 'foo'.

=cut

sub man3page_name {
  my $self = shift;

  my $mpname = $self->SUPER::man3page_name( shift );
  my $sep = $self->manpage_separator;
  $mpname =~ s/^$sep//;
  return $mpname;
}

=item expand_test_dir

Inherit the standard version but relativize the paths as the native glob() doesn't
do that for us.

=cut

sub expand_test_dir {
  my ($self, $dir) = @_;

  my @reldirs = $self->SUPER::expand_test_dir( $dir );

  for my $eachdir (@reldirs) {
    my ($v,$d,$f) = File::Spec->splitpath( $eachdir );
    my $reldir = File::Spec->abs2rel( File::Spec->catpath( $v, $d, '' ) );
    $eachdir = File::Spec->catfile( $reldir, $f );
  }
  return @reldirs;
}

=item _detildefy

The home-grown glob() does not currently handle tildes, so provide limited support
here.  Expect only UNIX format file specifications for now.

=cut

sub _detildefy {
    my ($self, $arg) = @_;

    # Apparently double ~ are not translated.
    return $arg if ($arg =~ /^~~/);

    # Apparently ~ followed by whitespace are not translated.
    return $arg if ($arg =~ /^~ /);

    if ($arg =~ /^~/) {
        my $spec = $arg;

        # Remove the tilde
        $spec =~ s/^~//;

        # Remove any slash following the tilde if present.
        $spec =~ s#^/##;

        # break up the paths for the merge
        my $home = VMS::Filespec::unixify($ENV{HOME});

        # In the default VMS mode, the trailing slash is present.
        # In Unix report mode it is not.  The parsing logic assumes that
        # it is present.
        $home .= '/' unless $home =~ m#/$#;

        # Trivial case of just ~ by it self
        if ($spec eq '') {
            $home =~ s#/$##;
            return $home;
        }

        my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
        if ($hdir eq '') {
             # Someone has tampered with $ENV{HOME}
             # So hfile is probably the directory since this should be
             # a path.
             $hdir = $hfile;
        }

        my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec);

        my @hdirs = File::Spec::Unix->splitdir($hdir);
        my @dirs = File::Spec::Unix->splitdir($dir);

        my $newdirs;

        # Two cases of tilde handling
        if ($arg =~ m#^~/#) {

            # Simple case, just merge together
            $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);

        } else {

            # Complex case, need to add an updir - No delimiters
            my @backup = File::Spec::Unix->splitdir(File::Spec::Unix->updir);

            $newdirs = File::Spec::Unix->catdir(@hdirs, @backup, @dirs);

        }

        # Now put the two cases back together
        $arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);

    }
    return $arg;

}

=item find_perl_interpreter

On VMS, $^X returns the fully qualified absolute path including version
number.  It's logically impossible to improve on it for getting the perl
we're currently running, and attempting to manipulate it is usually
lossy.

=cut

sub find_perl_interpreter {
    return VMS::Filespec::vmsify($^X);
}

=item localize_file_path

Convert the file path to the local syntax

=cut

sub localize_file_path {
  my ($self, $path) = @_;
  $path = VMS::Filespec::vmsify($path);
  $path =~ s/\.\z//;
  return $path;
}

=item localize_dir_path

Convert the directory path to the local syntax

=cut

sub localize_dir_path {
  my ($self, $path) = @_;
  return VMS::Filespec::vmspath($path);
}

=item ACTION_clean

The home-grown glob() expands a bit too aggressively when given a bare name,
so default in a zero-length extension.

=cut

sub ACTION_clean {
  my ($self) = @_;
  foreach my $item (map glob(VMS::Filespec::rmsexpand($_, '.;0')), $self->cleanup) {
    $self->delete_filetree($item);
  }
}


# Need to look up the feature settings.  The preferred way is to use the
# VMS::Feature module, but that may not be available to dual life modules.

my $use_feature;
BEGIN {
    if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
        $use_feature = 1;
    }
}

# Need to look up the UNIX report mode.  This may become a dynamic mode
# in the future.
sub _unix_rpt {
    my $unix_rpt;
    if ($use_feature) {
        $unix_rpt = VMS::Feature::current("filename_unix_report");
    } else {
        my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
        $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
    }
    return $unix_rpt;
}

# Need to look up the EFS character set mode.  This may become a dynamic
# mode in the future.
sub _efs {
    my $efs;
    if ($use_feature) {
        $efs = VMS::Feature::current("efs_charset");
    } else {
        my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
        $efs = $env_efs =~ /^[ET1]/i;
    }
    return $efs;
}

=back

=head1 AUTHOR

Michael G Schwern <schwern@pobox.com>
Ken Williams <kwilliams@cpan.org>
Craig A. Berry <craigberry@mac.com>

=head1 SEE ALSO

perl(1), Module::Build(3), ExtUtils::MakeMaker(3)

=cut

1;
__END__