Commit | Line | Data |
ff0cee69 |
1 | package vmsish; |
2 | |
3 | =head1 NAME |
4 | |
5 | vmsish - Perl pragma to control VMS-specific language features |
6 | |
7 | =head1 SYNOPSIS |
8 | |
9 | use vmsish; |
10 | |
11 | use vmsish 'status'; # or '$?' |
12 | use vmsish 'exit'; |
13 | use vmsish 'time'; |
925fd5a3 |
14 | use vmsish 'hushed'; |
ff0cee69 |
15 | |
16 | use vmsish; |
17 | no vmsish 'time'; |
18 | |
19 | =head1 DESCRIPTION |
20 | |
21 | If no import list is supplied, all possible VMS-specific features are |
925fd5a3 |
22 | assumed. Currently, there are four VMS-specific features available: |
ee8c7f54 |
23 | 'status' (a.k.a '$?'), 'exit', 'time' and 'hushed'. |
ff0cee69 |
24 | |
25 | =over 6 |
26 | |
27 | =item C<vmsish status> |
28 | |
29 | This makes C<$?> and C<system> return the native VMS exit status |
30 | instead of emulating the POSIX exit status. |
31 | |
32 | =item C<vmsish exit> |
33 | |
34 | This makes C<exit 1> produce a successful exit (with status SS$_NORMAL), |
35 | instead of emulating UNIX exit(), which considers C<exit 1> to indicate |
36 | an error. As with the CRTL's exit() function, C<exit 0> is also mapped |
37 | to an exit status of SS$_NORMAL, and any other argument to exit() is |
38 | used directly as Perl's exit status. |
39 | |
40 | =item C<vmsish time> |
41 | |
42 | This makes all times relative to the local time zone, instead of the |
43 | default of Universal Time (a.k.a Greenwich Mean Time, or GMT). |
44 | |
925fd5a3 |
45 | =item C<vmsish hushed> |
46 | |
ee8c7f54 |
47 | This suppresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR |
48 | if Perl terminates with an error status. This primarily effects error |
49 | exits from things like Perl compiler errors or "standard Perl" runtime errors, |
50 | where text error messages are also generated by Perl. |
51 | |
52 | The error exits from inside the core are generally more serious, and are |
53 | not supressed. |
925fd5a3 |
54 | |
ff0cee69 |
55 | =back |
56 | |
57 | See L<perlmod/Pragmatic Modules>. |
58 | |
59 | =cut |
60 | |
61 | if ($^O ne 'VMS') { |
62 | require Carp; |
63 | Carp::croak("This isn't VMS"); |
64 | } |
65 | |
66 | sub bits { |
67 | my $bits = 0; |
68 | my $sememe; |
69 | foreach $sememe (@_) { |
744a34f9 |
70 | $bits |= 0x20000000, next if $sememe eq 'hushed'; |
71 | $bits |= 0x40000000, next if $sememe eq 'status' || $sememe eq '$?'; |
a12fb911 |
72 | $bits |= 0x80000000, next if $sememe eq 'time'; |
ff0cee69 |
73 | } |
74 | $bits; |
75 | } |
76 | |
77 | sub import { |
78 | shift; |
744a34f9 |
79 | $^H |= bits(@_ ? @_ : qw(status time hushed)); |
80 | my $sememe; |
81 | |
82 | foreach $sememe (@_ ? @_ : qw(exit)) { |
83 | $^H{'vmsish_exit'} = 1 if $sememe eq 'exit'; |
84 | } |
ff0cee69 |
85 | } |
86 | |
87 | sub unimport { |
88 | shift; |
744a34f9 |
89 | $^H &= ~ bits(@_ ? @_ : qw(status time hushed)); |
90 | my $sememe; |
91 | |
92 | foreach $sememe (@_ ? @_ : qw(exit)) { |
93 | $^H{'vmsish_exit'} = 0 if $sememe eq 'exit'; |
94 | } |
ff0cee69 |
95 | } |
96 | |
97 | 1; |