Add vmsish 'hushed' option to suppress error messages at exit

[p5sagit/p5-mst-13.2.git] / vms / ext / vmsish.pm

package vmsish;

=head1 NAME

vmsish - Perl pragma to control VMS-specific language features

=head1 SYNOPSIS

    use vmsish;

    use vmsish 'status';	# or '$?'
    use vmsish 'exit';
    use vmsish 'time';
    use vmsish 'hushed';

    use vmsish;
    no vmsish 'time';

=head1 DESCRIPTION

If no import list is supplied, all possible VMS-specific features are
assumed.  Currently, there are four VMS-specific features available:
'status' (a.k.a '$?'), 'exit', 'time' and 'messages' (a.k.a 'message').

=over 6

=item C<vmsish status>

This makes C<$?> and C<system> return the native VMS exit status
instead of emulating the POSIX exit status.

=item C<vmsish exit>

This makes C<exit 1> produce a successful exit (with status SS$_NORMAL),
instead of emulating UNIX exit(), which considers C<exit 1> to indicate
an error.  As with the CRTL's exit() function, C<exit 0> is also mapped
to an exit status of SS$_NORMAL, and any other argument to exit() is
used directly as Perl's exit status.

=item C<vmsish time>

This makes all times relative to the local time zone, instead of the
default of Universal Time (a.k.a Greenwich Mean Time, or GMT).

=item C<vmsish hushed>

This supresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR
if Perl terminates with an error status.

=back

See L<perlmod/Pragmatic Modules>.

=cut

if ($^O ne 'VMS') {
    require Carp;
    Carp::croak("This isn't VMS");
}

sub bits {
    my $bits = 0;
    my $sememe;
    foreach $sememe (@_) {
        $bits |= 0x10000000, next if $sememe eq 'hushed';
	$bits |= 0x20000000, next if $sememe eq 'status' || $sememe eq '$?';
	$bits |= 0x40000000, next if $sememe eq 'exit';
	$bits |= 0x80000000, next if $sememe eq 'time';
    }
    $bits;
}

sub import {
    shift;
    $^H |= bits(@_ ? @_ : qw(status exit time hushed));
}

sub unimport {
    shift;
    $^H &= ~ bits(@_ ? @_ : qw(status exit time hushed));
}

1;