1 files changed, 62 insertions, 12 deletions

diff --git a/vms/ext/vmsish.pm b/vms/ext/vmsish.pm
index c51863a4f3..89ec72c28c 100644
--- a/vms/ext/vmsish.pm
+++ b/vms/ext/vmsish.pm
@@ -11,7 +11,10 @@ vmsish - Perl pragma to control VMS-specific language features
     use vmsish 'status';	# or '$?'
     use vmsish 'exit';
     use vmsish 'time';
+
     use vmsish 'hushed';
+    no vmsish 'hushed';
+    vmsish::hushed($hush);
 
     use vmsish;
     no vmsish 'time';
@@ -44,13 +47,59 @@ 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.
+This suppresses printing of VMS status messages to SYS$OUTPUT and
+SYS$ERROR if Perl terminates with an error status.  and allows
+programs that are expecting "unix-style" Perl to avoid having to parse
+VMS error messages.  It does not supress any messages from Perl
+itself, just the messages generated by DCL after Perl exits.  The DCL
+symbol $STATUS will still have the termination status, but with a
+high-order bit set:
+
+EXAMPLE:
+    $ perl -e"exit 44;"                             Non-hushed error exit
+    %SYSTEM-F-ABORT, abort                          DCL message
+    $ show sym $STATUS
+      $STATUS == "%X0000002C"
+
+    $ perl -e"use vmsish qw(hushed); exit 44;"      Hushed error exit
+    $ show sym $STATUS
+      $STATUS == "%X1000002C"
+
+The 'hushed' flag has a global scope during compilation: the exit() or
+die() commands that are compiled after 'vmsish hushed' will be hushed
+when they are executed.  Doing a "no vmsish 'hushed'" turns off the
+hushed flag.
+
+The status of the hushed flag also affects output of VMS error
+messages from compilation errors.   Again, you still get the Perl
+error message (and the code in $STATUS)
+
+EXAMPLE:
+    use vmsish 'hushed';    # turn on hushed flag
+    use Carp;          # Carp compiled hushed
+    exit 44;           # will be hushed
+    croak('I die');    # will be hushed
+    no vmsish 'hushed';     # turn off hushed flag
+    exit 44;           # will not be hushed
+    croak('I die2'):   # WILL be hushed, croak was compiled hushed
+
+You can also control the 'hushed' flag at run-time, using the built-in
+routine vmsish::hushed().  Without argument, it returns the hushed status.
+Since vmsish::hushed is built-in, you do not need to "use vmsish" to call
+it.
+
+EXAMPLE:
+    if ($quiet_exit) {
+        vmsish::hushed(1);
+    } 
+    print "Sssshhhh...I'm hushed...\n" if vmsish::hushed();
+    exit 44;
+
+Note that an exit() or die() that is compiled 'hushed' because of "use
+vmsish" is not un-hushed by calling vmsish::hushed(0) at runtime.
+
+The messages from error exits from inside the Perl core are generally
+more serious, and are not supressed.
 
 =back
 
@@ -67,7 +116,6 @@ sub bits {
     my $bits = 0;
     my $sememe;
     foreach $sememe (@_) {
-        $bits |= 0x20000000, next if $sememe eq 'hushed';
         $bits |= 0x40000000, next if $sememe eq 'status' || $sememe eq '$?';
 	$bits |= 0x80000000, next if $sememe eq 'time';
     }
@@ -76,21 +124,23 @@ sub bits {
 
 sub import {
     shift;
-    $^H |= bits(@_ ? @_ : qw(status time hushed));
+    $^H |= bits(@_ ? @_ : qw(status time));
     my $sememe;
 
-    foreach $sememe (@_ ? @_ : qw(exit)) {
+    foreach $sememe (@_ ? @_ : qw(exit hushed)) {
         $^H{'vmsish_exit'}   = 1 if $sememe eq 'exit';
+        vmsish::hushed(1) if $sememe eq 'hushed';
     }
 }
 
 sub unimport {
     shift;
-    $^H &= ~ bits(@_ ? @_ : qw(status time hushed));
+    $^H &= ~ bits(@_ ? @_ : qw(status time));
     my $sememe;
 
-    foreach $sememe (@_ ? @_ : qw(exit)) {
+    foreach $sememe (@_ ? @_ : qw(exit hushed)) {
         $^H{'vmsish_exit'}   = 0 if $sememe eq 'exit';
+        vmsish::hushed(0) if $sememe eq 'hushed';
     }
 }