This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Math::BigInt 1.40.
[perl5.git] / vms / ext / vmsish.pm
index dfb565b..c51863a 100644 (file)
@@ -11,6 +11,7 @@ vmsish - Perl pragma to control VMS-specific language features
     use vmsish 'status';       # or '$?'
     use vmsish 'exit';
     use vmsish 'time';
+    use vmsish 'hushed';
 
     use vmsish;
     no vmsish 'time';
@@ -18,8 +19,8 @@ vmsish - Perl pragma to control VMS-specific language features
 =head1 DESCRIPTION
 
 If no import list is supplied, all possible VMS-specific features are
-assumed.  Currently, there are three VMS-specific features available:
-'status' (a.k.a '$?'), 'exit', and 'time'.
+assumed.  Currently, there are four VMS-specific features available:
+'status' (a.k.a '$?'), 'exit', 'time' and 'hushed'.
 
 =over 6
 
@@ -41,6 +42,16 @@ used directly as Perl's exit status.
 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 suppresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR
+if Perl terminates with an error status.  This primarily effects error
+exits from things like Perl compiler errors or "standard Perl" runtime errors,
+where text error messages are also generated by Perl.
+
+The error exits from inside the core are generally more serious, and are
+not supressed.
+
 =back
 
 See L<perlmod/Pragmatic Modules>.
@@ -56,8 +67,8 @@ sub bits {
     my $bits = 0;
     my $sememe;
     foreach $sememe (@_) {
-       $bits |= 0x20000000, next if $sememe eq 'status' || $sememe eq '$?';
-       $bits |= 0x40000000, next if $sememe eq 'exit';
+        $bits |= 0x20000000, next if $sememe eq 'hushed';
+        $bits |= 0x40000000, next if $sememe eq 'status' || $sememe eq '$?';
        $bits |= 0x80000000, next if $sememe eq 'time';
     }
     $bits;
@@ -65,12 +76,22 @@ sub bits {
 
 sub import {
     shift;
-    $^H |= bits(@_ ? @_ : qw(status exit time));
+    $^H |= bits(@_ ? @_ : qw(status time hushed));
+    my $sememe;
+
+    foreach $sememe (@_ ? @_ : qw(exit)) {
+        $^H{'vmsish_exit'}   = 1 if $sememe eq 'exit';
+    }
 }
 
 sub unimport {
     shift;
-    $^H &= ~ bits(@_ ? @_ : qw(status exit time));
+    $^H &= ~ bits(@_ ? @_ : qw(status time hushed));
+    my $sememe;
+
+    foreach $sememe (@_ ? @_ : qw(exit)) {
+        $^H{'vmsish_exit'}   = 0 if $sememe eq 'exit';
+    }
 }
 
 1;