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