1*0Sstevel@tonic-gatepackage vmsish; 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateour $VERSION = '1.01'; 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gate=head1 NAME 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gatevmsish - Perl pragma to control VMS-specific language features 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gate=head1 SYNOPSIS 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gate use vmsish; 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gate use vmsish 'status'; # or '$?' 14*0Sstevel@tonic-gate use vmsish 'exit'; 15*0Sstevel@tonic-gate use vmsish 'time'; 16*0Sstevel@tonic-gate 17*0Sstevel@tonic-gate use vmsish 'hushed'; 18*0Sstevel@tonic-gate no vmsish 'hushed'; 19*0Sstevel@tonic-gate vmsish::hushed($hush); 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gate use vmsish; 22*0Sstevel@tonic-gate no vmsish 'time'; 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gate=head1 DESCRIPTION 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gateIf no import list is supplied, all possible VMS-specific features are 27*0Sstevel@tonic-gateassumed. Currently, there are four VMS-specific features available: 28*0Sstevel@tonic-gate'status' (a.k.a '$?'), 'exit', 'time' and 'hushed'. 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gateIf you're not running VMS, this module does nothing. 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gate=over 6 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gate=item C<vmsish status> 35*0Sstevel@tonic-gate 36*0Sstevel@tonic-gateThis makes C<$?> and C<system> return the native VMS exit status 37*0Sstevel@tonic-gateinstead of emulating the POSIX exit status. 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gate=item C<vmsish exit> 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gateThis makes C<exit 1> produce a successful exit (with status SS$_NORMAL), 42*0Sstevel@tonic-gateinstead of emulating UNIX exit(), which considers C<exit 1> to indicate 43*0Sstevel@tonic-gatean error. As with the CRTL's exit() function, C<exit 0> is also mapped 44*0Sstevel@tonic-gateto an exit status of SS$_NORMAL, and any other argument to exit() is 45*0Sstevel@tonic-gateused directly as Perl's exit status. 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gate=item C<vmsish time> 48*0Sstevel@tonic-gate 49*0Sstevel@tonic-gateThis makes all times relative to the local time zone, instead of the 50*0Sstevel@tonic-gatedefault of Universal Time (a.k.a Greenwich Mean Time, or GMT). 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gate=item C<vmsish hushed> 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gateThis suppresses printing of VMS status messages to SYS$OUTPUT and 55*0Sstevel@tonic-gateSYS$ERROR if Perl terminates with an error status. and allows 56*0Sstevel@tonic-gateprograms that are expecting "unix-style" Perl to avoid having to parse 57*0Sstevel@tonic-gateVMS error messages. It does not supress any messages from Perl 58*0Sstevel@tonic-gateitself, just the messages generated by DCL after Perl exits. The DCL 59*0Sstevel@tonic-gatesymbol $STATUS will still have the termination status, but with a 60*0Sstevel@tonic-gatehigh-order bit set: 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gateEXAMPLE: 63*0Sstevel@tonic-gate $ perl -e"exit 44;" Non-hushed error exit 64*0Sstevel@tonic-gate %SYSTEM-F-ABORT, abort DCL message 65*0Sstevel@tonic-gate $ show sym $STATUS 66*0Sstevel@tonic-gate $STATUS == "%X0000002C" 67*0Sstevel@tonic-gate 68*0Sstevel@tonic-gate $ perl -e"use vmsish qw(hushed); exit 44;" Hushed error exit 69*0Sstevel@tonic-gate $ show sym $STATUS 70*0Sstevel@tonic-gate $STATUS == "%X1000002C" 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gateThe 'hushed' flag has a global scope during compilation: the exit() or 73*0Sstevel@tonic-gatedie() commands that are compiled after 'vmsish hushed' will be hushed 74*0Sstevel@tonic-gatewhen they are executed. Doing a "no vmsish 'hushed'" turns off the 75*0Sstevel@tonic-gatehushed flag. 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gateThe status of the hushed flag also affects output of VMS error 78*0Sstevel@tonic-gatemessages from compilation errors. Again, you still get the Perl 79*0Sstevel@tonic-gateerror message (and the code in $STATUS) 80*0Sstevel@tonic-gate 81*0Sstevel@tonic-gateEXAMPLE: 82*0Sstevel@tonic-gate use vmsish 'hushed'; # turn on hushed flag 83*0Sstevel@tonic-gate use Carp; # Carp compiled hushed 84*0Sstevel@tonic-gate exit 44; # will be hushed 85*0Sstevel@tonic-gate croak('I die'); # will be hushed 86*0Sstevel@tonic-gate no vmsish 'hushed'; # turn off hushed flag 87*0Sstevel@tonic-gate exit 44; # will not be hushed 88*0Sstevel@tonic-gate croak('I die2'): # WILL be hushed, croak was compiled hushed 89*0Sstevel@tonic-gate 90*0Sstevel@tonic-gateYou can also control the 'hushed' flag at run-time, using the built-in 91*0Sstevel@tonic-gateroutine vmsish::hushed(). Without argument, it returns the hushed status. 92*0Sstevel@tonic-gateSince vmsish::hushed is built-in, you do not need to "use vmsish" to call 93*0Sstevel@tonic-gateit. 94*0Sstevel@tonic-gate 95*0Sstevel@tonic-gateEXAMPLE: 96*0Sstevel@tonic-gate if ($quiet_exit) { 97*0Sstevel@tonic-gate vmsish::hushed(1); 98*0Sstevel@tonic-gate } 99*0Sstevel@tonic-gate print "Sssshhhh...I'm hushed...\n" if vmsish::hushed(); 100*0Sstevel@tonic-gate exit 44; 101*0Sstevel@tonic-gate 102*0Sstevel@tonic-gateNote that an exit() or die() that is compiled 'hushed' because of "use 103*0Sstevel@tonic-gatevmsish" is not un-hushed by calling vmsish::hushed(0) at runtime. 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gateThe messages from error exits from inside the Perl core are generally 106*0Sstevel@tonic-gatemore serious, and are not supressed. 107*0Sstevel@tonic-gate 108*0Sstevel@tonic-gate=back 109*0Sstevel@tonic-gate 110*0Sstevel@tonic-gateSee L<perlmod/Pragmatic Modules>. 111*0Sstevel@tonic-gate 112*0Sstevel@tonic-gate=cut 113*0Sstevel@tonic-gate 114*0Sstevel@tonic-gatemy $IsVMS = $^O eq 'VMS'; 115*0Sstevel@tonic-gate 116*0Sstevel@tonic-gatesub bits { 117*0Sstevel@tonic-gate my $bits = 0; 118*0Sstevel@tonic-gate my $sememe; 119*0Sstevel@tonic-gate foreach $sememe (@_) { 120*0Sstevel@tonic-gate # Those hints are defined in vms/vmsish.h : 121*0Sstevel@tonic-gate # HINT_M_VMSISH_STATUS and HINT_M_VMSISH_TIME 122*0Sstevel@tonic-gate $bits |= 0x40000000, next if $sememe eq 'status' || $sememe eq '$?'; 123*0Sstevel@tonic-gate $bits |= 0x80000000, next if $sememe eq 'time'; 124*0Sstevel@tonic-gate } 125*0Sstevel@tonic-gate $bits; 126*0Sstevel@tonic-gate} 127*0Sstevel@tonic-gate 128*0Sstevel@tonic-gatesub import { 129*0Sstevel@tonic-gate return unless $IsVMS; 130*0Sstevel@tonic-gate 131*0Sstevel@tonic-gate shift; 132*0Sstevel@tonic-gate $^H |= bits(@_ ? @_ : qw(status time)); 133*0Sstevel@tonic-gate my $sememe; 134*0Sstevel@tonic-gate 135*0Sstevel@tonic-gate foreach $sememe (@_ ? @_ : qw(exit hushed)) { 136*0Sstevel@tonic-gate $^H{'vmsish_exit'} = 1 if $sememe eq 'exit'; 137*0Sstevel@tonic-gate vmsish::hushed(1) if $sememe eq 'hushed'; 138*0Sstevel@tonic-gate } 139*0Sstevel@tonic-gate} 140*0Sstevel@tonic-gate 141*0Sstevel@tonic-gatesub unimport { 142*0Sstevel@tonic-gate return unless $IsVMS; 143*0Sstevel@tonic-gate 144*0Sstevel@tonic-gate shift; 145*0Sstevel@tonic-gate $^H &= ~ bits(@_ ? @_ : qw(status time)); 146*0Sstevel@tonic-gate my $sememe; 147*0Sstevel@tonic-gate 148*0Sstevel@tonic-gate foreach $sememe (@_ ? @_ : qw(exit hushed)) { 149*0Sstevel@tonic-gate $^H{'vmsish_exit'} = 0 if $sememe eq 'exit'; 150*0Sstevel@tonic-gate vmsish::hushed(0) if $sememe eq 'hushed'; 151*0Sstevel@tonic-gate } 152*0Sstevel@tonic-gate} 153*0Sstevel@tonic-gate 154*0Sstevel@tonic-gate1; 155