[catagits/Gitalist.git] / local-lib5 / lib / perl5 / Module / Build / Platform / VMS.pm

package Module::Build::Platform::VMS;

use strict;
use vars qw($VERSION);
$VERSION = '0.35';
$VERSION = eval $VERSION;
use Module::Build::Base;

use vars qw(@ISA);
@ISA = qw(Module::Build::Base);


=head1 NAME

Module::Build::Platform::VMS - Builder class for VMS platforms

=head1 DESCRIPTION

This module inherits from C<Module::Build::Base> and alters a few
minor details of its functionality.  Please see L<Module::Build> for
the general docs.

=head2 Overridden Methods

=over 4

=item _set_defaults

Change $self->{build_script} to 'Build.com' so @Build works.

=cut

sub _set_defaults {
    my $self = shift;
    $self->SUPER::_set_defaults(@_);

    $self->{properties}{build_script} = 'Build.com';
}


=item cull_args

'@Build foo' on VMS will not preserve the case of 'foo'.  Rather than forcing
people to write '@Build "foo"' we'll dispatch case-insensitively.

=cut

sub cull_args {
    my $self = shift;
    my($action, $args) = $self->SUPER::cull_args(@_);
    my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions;

    die "Ambiguous action '$action'.  Could be one of @possible_actions"
        if @possible_actions > 1;

    return ($possible_actions[0], $args);
}


=item manpage_separator

Use '__' instead of '::'.

=cut

sub manpage_separator {
    return '__';
}


=item prefixify

Prefixify taking into account VMS' filepath syntax.

=cut

# Translated from ExtUtils::MM_VMS::prefixify()
sub _prefixify {
    my($self, $path, $sprefix, $type) = @_;
    my $rprefix = $self->prefix;

    $self->log_verbose("  prefixify $path from $sprefix to $rprefix\n");

    # Translate $(PERLPREFIX) to a real path.
    $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
    $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;

    $self->log_verbose("  rprefix translated to $rprefix\n".
                       "  sprefix translated to $sprefix\n");

    if( length $path == 0 ) {
        $self->log_verbose("  no path to prefixify.\n")
    }
    elsif( !File::Spec->file_name_is_absolute($path) ) {
        $self->log_verbose("    path is relative, not prefixifying.\n");
    }
    elsif( $sprefix eq $rprefix ) {
        $self->log_verbose("  no new prefix.\n");
    }
    else {
        my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
	my $vms_prefix = $self->config('vms_prefix');
        if( $path_vol eq $vms_prefix.':' ) {
            $self->log_verbose("  $vms_prefix: seen\n");

            $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
            $path = $self->_catprefix($rprefix, $path_dirs);
        }
        else {
            $self->log_verbose("    cannot prefixify.\n");
	    return $self->prefix_relpaths($self->installdirs, $type);
        }
    }

    $self->log_verbose("    now $path\n");

    return $path;
}

=item _quote_args

Command-line arguments (but not the command itself) must be quoted
to ensure case preservation.

=cut

sub _quote_args {
  # Returns a string that can become [part of] a command line with
  # proper quoting so that the subprocess sees this same list of args,
  # or if we get a single arg that is an array reference, quote the
  # elements of it and return the reference.
  my ($self, @args) = @_;
  my $got_arrayref = (scalar(@args) == 1 
                      && UNIVERSAL::isa($args[0], 'ARRAY')) 
                   ? 1 
                   : 0;

  # Do not quote qualifiers that begin with '/'.
  map { if (!/^\//) { 
          $_ =~ s/\"/""/g;     # escape C<"> by doubling
          $_ = q(").$_.q(");
        }
  }
    ($got_arrayref ? @{$args[0]} 
                   : @args
    );

  return $got_arrayref ? $args[0] 
                       : join(' ', @args);
}

=item have_forkpipe

There is no native fork(), so some constructs depending on it are not
available.

=cut

sub have_forkpipe { 0 }

=item _backticks

Override to ensure that we quote the arguments but not the command.

=cut

sub _backticks {
  # The command must not be quoted but the arguments to it must be.
  my ($self, @cmd) = @_;
  my $cmd = shift @cmd;
  my $args = $self->_quote_args(@cmd);
  return `$cmd $args`;
}

=item do_system

Override to ensure that we quote the arguments but not the command.

=cut

sub do_system {
  # The command must not be quoted but the arguments to it must be.
  my ($self, @cmd) = @_;
  $self->log_info("@cmd\n");
  my $cmd = shift @cmd;
  my $args = $self->_quote_args(@cmd);
  return !system("$cmd $args");
}

=item oneliner

Override to ensure that we do not quote the command.

=cut

sub oneliner {
    my $self = shift;
    my $oneliner = $self->SUPER::oneliner(@_);

    $oneliner =~ s/^\"\S+\"//;

    return "MCR $^X $oneliner";
}

=item _infer_xs_spec

Inherit the standard version but tweak the library file name to be 
something Dynaloader can find.

=cut

sub _infer_xs_spec {
  my $self = shift;
  my $file = shift;

  my $spec = $self->SUPER::_infer_xs_spec($file);

  # Need to create with the same name as DynaLoader will load with.
  if (defined &DynaLoader::mod2fname) {
    my $file = $$spec{module_name} . '.' . $self->{config}->get('dlext');
    $file =~ tr/:/_/;
    $file = DynaLoader::mod2fname([$file]);
    $$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__
Commit	Line	Data
3fea05b9	1	package Module::Build::Platform::VMS;
	2
	3	use strict;
	4	use vars qw($VERSION);
	5	$VERSION = '0.35';
	6	$VERSION = eval $VERSION;
	7	use Module::Build::Base;
	8
	9	use vars qw(@ISA);
	10	@ISA = qw(Module::Build::Base);
	11
	12
	13
	14	=head1 NAME
	15
	16	Module::Build::Platform::VMS - Builder class for VMS platforms
	17
	18	=head1 DESCRIPTION
	19
	20	This module inherits from C<Module::Build::Base> and alters a few
	21	minor details of its functionality. Please see L<Module::Build> for
	22	the general docs.
	23
	24	=head2 Overridden Methods
	25
	26	=over 4
	27
	28	=item _set_defaults
	29
	30	Change $self->{build_script} to 'Build.com' so @Build works.
	31
	32	=cut
	33
	34	sub _set_defaults {
	35	my $self = shift;
	36	$self->SUPER::_set_defaults(@_);
	37
	38	$self->{properties}{build_script} = 'Build.com';
	39	}
	40
	41
	42	=item cull_args
	43
	44	'@Build foo' on VMS will not preserve the case of 'foo'. Rather than forcing
	45	people to write '@Build "foo"' we'll dispatch case-insensitively.
	46
	47	=cut
	48
	49	sub cull_args {
	50	my $self = shift;
	51	my($action, $args) = $self->SUPER::cull_args(@_);
	52	my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions;
	53
	54	die "Ambiguous action '$action'. Could be one of @possible_actions"
	55	if @possible_actions > 1;
	56
	57	return ($possible_actions[0], $args);
	58	}
	59
	60
	61	=item manpage_separator
	62
	63	Use '__' instead of '::'.
	64
65	=cut
66
67	sub manpage_separator {
68	return '__';
69	}
70
71
72	=item prefixify
73
74	Prefixify taking into account VMS' filepath syntax.
75
76	=cut
77
78	# Translated from ExtUtils::MM_VMS::prefixify()
79	sub _prefixify {
80	my($self, $path, $sprefix, $type) = @_;
81	my $rprefix = $self->prefix;
82
83	$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");
84
85	# Translate $(PERLPREFIX) to a real path.
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	=item _quote_args
122
123	Command-line arguments (but not the command itself) must be quoted
124	to ensure case preservation.
125
126	=cut
127
128	sub _quote_args {
129	# Returns a string that can become [part of] a command line with
130	# proper quoting so that the subprocess sees this same list of args,
131	# or if we get a single arg that is an array reference, quote the
132	# elements of it and return the reference.
133	my ($self, @args) = @_;
134	my $got_arrayref = (scalar(@args) == 1
135	&& UNIVERSAL::isa($args[0], 'ARRAY'))
136	? 1
137	: 0;
138
139	# Do not quote qualifiers that begin with '/'.
140	map { if (!/^\//) {
141	$_ =~ s/\"/""/g; # escape C<"> by doubling
142	$_ = q(").$_.q(");
143	}
144	}
145	($got_arrayref ? @{$args[0]}
146	: @args
147	);
148
149	return $got_arrayref ? $args[0]
150	: join(' ', @args);
151	}
152
153	=item have_forkpipe
154
155	There is no native fork(), so some constructs depending on it are not
156	available.
157
158	=cut
159
160	sub have_forkpipe { 0 }
161
162	=item _backticks
163
164	Override to ensure that we quote the arguments but not the command.
165
166	=cut
167
168	sub _backticks {
169	# The command must not be quoted but the arguments to it must be.
170	my ($self, @cmd) = @_;
171	my $cmd = shift @cmd;
172	my $args = $self->_quote_args(@cmd);
173	return `$cmd $args`;
174	}
175
176	=item do_system
177
178	Override to ensure that we quote the arguments but not the command.
179
180	=cut
181
182	sub do_system {
183	# The command must not be quoted but the arguments to it must be.
184	my ($self, @cmd) = @_;
185	$self->log_info("@cmd\n");
186	my $cmd = shift @cmd;
187	my $args = $self->_quote_args(@cmd);
188	return !system("$cmd $args");
189	}
190
191	=item oneliner
192
193	Override to ensure that we do not quote the command.
194
195	=cut
196
197	sub oneliner {
198	my $self = shift;
199	my $oneliner = $self->SUPER::oneliner(@_);
200
201	$oneliner =~ s/^\"\S+\"//;
202
203	return "MCR $^X $oneliner";
204	}
205
206	=item _infer_xs_spec
207
208	Inherit the standard version but tweak the library file name to be
209	something Dynaloader can find.
210
211	=cut
212
213	sub _infer_xs_spec {
214	my $self = shift;
215	my $file = shift;
216
217	my $spec = $self->SUPER::_infer_xs_spec($file);
218
219	# Need to create with the same name as DynaLoader will load with.
220	if (defined &DynaLoader::mod2fname) {
221	my $file = $$spec{module_name} . '.' . $self->{config}->get('dlext');
222	$file =~ tr/:/_/;
223	$file = DynaLoader::mod2fname([$file]);
224	$$spec{lib_file} = File::Spec->catfile($$spec{archdir}, $file);
225	}
226
227	return $spec;
228	}
229
230	=item rscan_dir
231
232	Inherit the standard version but remove dots at end of name.
233	If the extended character set is in effect, do not remove dots from filenames
234	with Unix path delimiters.
235
236	=cut
237
238	sub rscan_dir {
239	my ($self, $dir, $pattern) = @_;
240
241	my $result = $self->SUPER::rscan_dir( $dir, $pattern );
242
243	for my $file (@$result) {
244	if (!_efs() && ($file =~ m#/#)) {
245	$file =~ s/\.$//;
246	}
247	}
248	return $result;
249	}
250
251	=item dist_dir
252
253	Inherit the standard version but replace embedded dots with underscores because
254	a dot is the directory delimiter on VMS.
255
256	=cut
257
258	sub dist_dir {
259	my $self = shift;
260
261	my $dist_dir = $self->SUPER::dist_dir;
262	$dist_dir =~ s/\./_/g unless _efs();
263	return $dist_dir;
264	}
265
266	=item man3page_name
267
268	Inherit the standard version but chop the extra manpage delimiter off the front if
269	there is one. The VMS version of splitdir('[.foo]') returns '', 'foo'.
270
271	=cut
272
273	sub man3page_name {
274	my $self = shift;
275
276	my $mpname = $self->SUPER::man3page_name( shift );
277	my $sep = $self->manpage_separator;
278	$mpname =~ s/^$sep//;
279	return $mpname;
280	}
281
282	=item expand_test_dir
283
284	Inherit the standard version but relativize the paths as the native glob() doesn't
285	do that for us.
286
287	=cut
288
289	sub expand_test_dir {
290	my ($self, $dir) = @_;
291
292	my @reldirs = $self->SUPER::expand_test_dir( $dir );
293
294	for my $eachdir (@reldirs) {
295	my ($v,$d,$f) = File::Spec->splitpath( $eachdir );
296	my $reldir = File::Spec->abs2rel( File::Spec->catpath( $v, $d, '' ) );
297	$eachdir = File::Spec->catfile( $reldir, $f );
298	}
299	return @reldirs;
300	}
301
302	=item _detildefy
303
304	The home-grown glob() does not currently handle tildes, so provide limited support
305	here. Expect only UNIX format file specifications for now.
306
307	=cut
308
309	sub _detildefy {
310	my ($self, $arg) = @_;
311
312	# Apparently double ~ are not translated.
313	return $arg if ($arg =~ /^~~/);
314
315	# Apparently ~ followed by whitespace are not translated.
316	return $arg if ($arg =~ /^~ /);
317
318	if ($arg =~ /^~/) {
319	my $spec = $arg;
320
321	# Remove the tilde
322	$spec =~ s/^~//;
323
324	# Remove any slash following the tilde if present.
325	$spec =~ s#^/##;
326
327	# break up the paths for the merge
328	my $home = VMS::Filespec::unixify($ENV{HOME});
329
330	# In the default VMS mode, the trailing slash is present.
331	# In Unix report mode it is not. The parsing logic assumes that
332	# it is present.
333	$home .= '/' unless $home =~ m#/$#;
334
335	# Trivial case of just ~ by it self
336	if ($spec eq '') {
337	$home =~ s#/$##;
338	return $home;
339	}
340
341	my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
342	if ($hdir eq '') {
343	# Someone has tampered with $ENV{HOME}
344	# So hfile is probably the directory since this should be
345	# a path.
346	$hdir = $hfile;
347	}
348
349	my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec);
350
351	my @hdirs = File::Spec::Unix->splitdir($hdir);
352	my @dirs = File::Spec::Unix->splitdir($dir);
353
354	my $newdirs;
355
356	# Two cases of tilde handling
357	if ($arg =~ m#^~/#) {
358
359	# Simple case, just merge together
360	$newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);
361
362	} else {
363
364	# Complex case, need to add an updir - No delimiters
365	my @backup = File::Spec::Unix->splitdir(File::Spec::Unix->updir);
366
367	$newdirs = File::Spec::Unix->catdir(@hdirs, @backup, @dirs);
368
369	}
370
371	# Now put the two cases back together
372	$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
373
374	}
375	return $arg;
376
377	}
378
379	=item find_perl_interpreter
380
381	On VMS, $^X returns the fully qualified absolute path including version
382	number. It's logically impossible to improve on it for getting the perl
383	we're currently running, and attempting to manipulate it is usually
384	lossy.
385
386	=cut
387
388	sub find_perl_interpreter {
389	return VMS::Filespec::vmsify($^X);
390	}
391
392	=item localize_file_path
393
394	Convert the file path to the local syntax
395
396	=cut
397
398	sub localize_file_path {
399	my ($self, $path) = @_;
400	$path = VMS::Filespec::vmsify($path);
401	$path =~ s/\.\z//;
402	return $path;
403	}
404
405	=item localize_dir_path
406
407	Convert the directory path to the local syntax
408
409	=cut
410
411	sub localize_dir_path {
412	my ($self, $path) = @_;
413	return VMS::Filespec::vmspath($path);
414	}
415
416	=item ACTION_clean
417
418	The home-grown glob() expands a bit too aggressively when given a bare name,
419	so default in a zero-length extension.
420
421	=cut
422
423	sub ACTION_clean {
424	my ($self) = @_;
425	foreach my $item (map glob(VMS::Filespec::rmsexpand($_, '.;0')), $self->cleanup) {
426	$self->delete_filetree($item);
427	}
428	}
429
430
431	# Need to look up the feature settings. The preferred way is to use the
432	# VMS::Feature module, but that may not be available to dual life modules.
433
434	my $use_feature;
435	BEGIN {
436	if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
437	$use_feature = 1;
438	}
439	}
440
441	# Need to look up the UNIX report mode. This may become a dynamic mode
442	# in the future.
443	sub _unix_rpt {
444	my $unix_rpt;
445	if ($use_feature) {
446	$unix_rpt = VMS::Feature::current("filename_unix_report");
447	} else {
448	my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} \|\| '';
449	$unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
450	}
451	return $unix_rpt;
452	}
453
454	# Need to look up the EFS character set mode. This may become a dynamic
455	# mode in the future.
456	sub _efs {
457	my $efs;
458	if ($use_feature) {
459	$efs = VMS::Feature::current("efs_charset");
460	} else {
461	my $env_efs = $ENV{'DECC$EFS_CHARSET'} \|\| '';
462	$efs = $env_efs =~ /^[ET1]/i;
463	}
464	return $efs;
465	}
466
467	=back
468
469	=head1 AUTHOR
470
471	Michael G Schwern <schwern@pobox.com>
472	Ken Williams <kwilliams@cpan.org>
473	Craig A. Berry <craigberry@mac.com>
474
475	=head1 SEE ALSO
476
477	perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
478
479	=cut
480
481	1;
482	__END__