| 1 |
#! perl-000 |
| 2 |
|
| 3 |
open STDOUT, ">$ARGV[0]~" |
| 4 |
or die "$ARGV[0]~: $!"; |
| 5 |
|
| 6 |
our ($WARN, $H, %H); |
| 7 |
|
| 8 |
use utf8; |
| 9 |
use strict qw(subs vars); |
| 10 |
|
| 11 |
BEGIN { |
| 12 |
if ($] >= 5.010) { |
| 13 |
require feature; |
| 14 |
feature->import (qw(say state switch)); |
| 15 |
} |
| 16 |
if ($] >= 5.012) { |
| 17 |
feature->import (qw(unicode_strings)); |
| 18 |
} |
| 19 |
if ($] >= 5.016) { |
| 20 |
feature->import (qw(current_sub fc evalbytes)); |
| 21 |
feature->unimport (qw(array_base)); |
| 22 |
} |
| 23 |
} |
| 24 |
|
| 25 |
no warnings; |
| 26 |
use warnings qw(FATAL closed threads internal debugging pack malloc portable prototype |
| 27 |
inplace io pipe unpack deprecated glob digit printf |
| 28 |
layer reserved taint closure semicolon); |
| 29 |
no warnings qw(exec newline unopened); |
| 30 |
|
| 31 |
BEGIN { |
| 32 |
$H = $^H; |
| 33 |
$WARN = ${^WARNING_BITS}; |
| 34 |
%H = %^H; |
| 35 |
} |
| 36 |
|
| 37 |
while (<DATA>) { |
| 38 |
if (/^IMPORT/) { |
| 39 |
print " # use warnings\n"; |
| 40 |
printf " \${^WARNING_BITS} ^= \${^WARNING_BITS} ^ \"%s\";\n", |
| 41 |
join "", map "\\x$_", unpack "(H2)*", $WARN; |
| 42 |
print " # use strict, use utf8; use feature;\n"; |
| 43 |
printf " \$^H |= 0x%x;\n", $H; |
| 44 |
|
| 45 |
if (my @features = grep /^feature_/, keys %H) { |
| 46 |
print " \@^H{qw(@features)} = (1) x ", (scalar @features), ";\n"; |
| 47 |
} |
| 48 |
} else { |
| 49 |
print; |
| 50 |
} |
| 51 |
} |
| 52 |
|
| 53 |
close STDOUT; |
| 54 |
rename "$ARGV[0]~", $ARGV[0]; |
| 55 |
|
| 56 |
__DATA__ |
| 57 |
package common::sense; |
| 58 |
|
| 59 |
our $VERSION = '3.7'; |
| 60 |
|
| 61 |
# overload should be included |
| 62 |
|
| 63 |
sub import { |
| 64 |
local $^W; # work around perl 5.16 spewing out warnings for next statement |
| 65 |
IMPORT |
| 66 |
} |
| 67 |
|
| 68 |
1 |
