| … | |
… | |
| 3 | open STDOUT, ">$ARGV[0]~" |
3 | open STDOUT, ">$ARGV[0]~" |
| 4 | or die "$ARGV[0]~: $!"; |
4 | or die "$ARGV[0]~: $!"; |
| 5 | |
5 | |
| 6 | our $WARN; |
6 | our $WARN; |
| 7 | our $H; |
7 | our $H; |
|
|
8 | our %H; |
| 8 | |
9 | |
| 9 | BEGIN { |
10 | BEGIN { |
| 10 | $H = $^H; |
11 | $H = $^H; |
| 11 | $WARN = ${^WARNING_BITS}; |
12 | $WARN = ${^WARNING_BITS}; |
| 12 | } |
13 | } |
| 13 | |
14 | |
| 14 | use utf8; |
15 | use utf8; |
| 15 | use strict qw(subs vars); |
16 | use strict qw(subs vars); |
|
|
17 | |
|
|
18 | BEGIN { |
|
|
19 | if ($] >= 5.010) { |
|
|
20 | require feature; |
|
|
21 | feature->import (qw(say state switch)); |
|
|
22 | } |
|
|
23 | if ($] >= 5.012) { |
|
|
24 | feature->import (qw(unicode_strings)); |
|
|
25 | } |
|
|
26 | if ($] >= 5.016) { |
|
|
27 | feature->import (qw(current_sub fc evalbytes)); |
|
|
28 | feature->unimport (qw(array_base)); |
|
|
29 | } |
|
|
30 | } |
| 16 | |
31 | |
| 17 | no warnings; |
32 | no warnings; |
| 18 | use warnings qw(FATAL closed threads internal debugging pack malloc portable prototype |
33 | use warnings qw(FATAL closed threads internal debugging pack malloc portable prototype |
| 19 | inplace io pipe unpack deprecated glob digit printf |
34 | inplace io pipe unpack deprecated glob digit printf |
| 20 | layer reserved taint closure semicolon); |
35 | layer reserved taint closure semicolon); |
| 21 | no warnings qw(exec newline unopened); |
36 | no warnings qw(exec newline unopened); |
| 22 | |
37 | |
| 23 | BEGIN { |
38 | BEGIN { |
| 24 | $H = $^H & ~$H; |
39 | $H = $^H & ~$H; |
| 25 | $WARN = ${^WARNING_BITS} & ~$WARN; |
40 | $WARN = ${^WARNING_BITS} & ~$WARN; |
|
|
41 | %H = %^H; |
| 26 | } |
42 | } |
| 27 | |
43 | |
| 28 | while (<DATA>) { |
44 | while (<DATA>) { |
| 29 | if (/^IMPORT/) { |
45 | if (/^IMPORT/) { |
| 30 | print " # use warnings\n"; |
46 | print " # use warnings\n"; |
| 31 | printf " \${^WARNING_BITS} ^= \${^WARNING_BITS} ^ \"%s\";\n", |
47 | printf " \${^WARNING_BITS} ^= \${^WARNING_BITS} ^ \"%s\";\n", |
| 32 | join "", map "\\x$_", unpack "(H2)*", $WARN; |
48 | join "", map "\\x$_", unpack "(H2)*", $WARN; |
| 33 | print " # use strict, use utf8;\n"; |
49 | print " # use strict, use utf8; use feature;\n"; |
| 34 | printf " \$^H |= 0x%x;\n", $H; |
50 | printf " \$^H |= 0x%x;\n", $H; |
|
|
51 | |
|
|
52 | if (my @features = grep /^feature_/, keys %H) { |
|
|
53 | print " \@^H{qw(@features)} = (1) x ", (scalar @features), ";\n"; |
|
|
54 | } |
| 35 | } else { |
55 | } else { |
| 36 | print; |
56 | print; |
| 37 | } |
57 | } |
| 38 | } |
58 | } |
| 39 | |
59 | |
| … | |
… | |
| 46 | |
66 | |
| 47 | common::sense - save a tree AND a kitten, use common::sense! |
67 | common::sense - save a tree AND a kitten, use common::sense! |
| 48 | |
68 | |
| 49 | =head1 SYNOPSIS |
69 | =head1 SYNOPSIS |
| 50 | |
70 | |
| 51 | use common::sense; |
71 | use common::sense; |
| 52 | |
72 | |
| 53 | # supposed to be the same, with much lower memory usage, as: |
73 | # Supposed to be mostly the same, with much lower memory usage, as: |
| 54 | # |
74 | |
| 55 | # use utf8; |
75 | # use utf8; |
| 56 | # use strict qw(vars subs); |
76 | # use strict qw(vars subs); |
| 57 | # use feature qw(say state switch); |
77 | # use feature qw(say state switch); |
|
|
78 | # use feature qw(unicode_strings unicode_eval current_sub fc evalbytes); |
|
|
79 | # no feature qw(array_base); |
| 58 | # no warnings; |
80 | # no warnings; |
| 59 | # use warnings qw(FATAL closed threads internal debugging pack |
81 | # use warnings qw(FATAL closed threads internal debugging pack |
| 60 | # portable prototype inplace io pipe unpack malloc |
82 | # portable prototype inplace io pipe unpack malloc |
| 61 | # deprecated glob digit printf layer |
83 | # deprecated glob digit printf layer |
| 62 | # reserved taint closure semicolon); |
84 | # reserved taint closure semicolon); |
| 63 | # no warnings qw(exec newline unopened); |
85 | # no warnings qw(exec newline unopened); |
| 64 | |
|
|
| 65 | |
86 | |
| 66 | =head1 DESCRIPTION |
87 | =head1 DESCRIPTION |
| 67 | |
88 | |
| 68 | “Nothing is more fairly distributed than common sense: no one thinks |
89 | “Nothing is more fairly distributed than common sense: no one thinks |
| 69 | he needs more of it than he already has.” |
90 | he needs more of it than he already has.” |
| … | |
… | |
| 160 | for (@{ $var->[0] }) { ... |
181 | for (@{ $var->[0] }) { ... |
| 161 | |
182 | |
| 162 | If that isn't hypocrisy! And all that from a mere program! |
183 | If that isn't hypocrisy! And all that from a mere program! |
| 163 | |
184 | |
| 164 | |
185 | |
| 165 | =item use feature qw(say state given) |
186 | =item use feature qw(say state given ...) |
| 166 | |
187 | |
| 167 | We found it annoying that we always have to enable extra features. If |
188 | We found it annoying that we always have to enable extra features. If |
| 168 | something breaks because it didn't anticipate future changes, so be |
189 | something breaks because it didn't anticipate future changes, so be |
| 169 | it. 5.10 broke almost all our XS modules and nobody cared either (or at |
190 | it. 5.10 broke almost all our XS modules and nobody cared either (or at |
| 170 | least I know of nobody who really complained about gratuitous changes - |
191 | least I know of nobody who really complained about gratuitous changes - |
| … | |
… | |
| 180 | older versions of perl - common::sense of course works there as well. |
201 | older versions of perl - common::sense of course works there as well. |
| 181 | There is also an important other mode where having additional features by |
202 | There is also an important other mode where having additional features by |
| 182 | default is useful: commandline hacks and internal use scripts: See "much |
203 | default is useful: commandline hacks and internal use scripts: See "much |
| 183 | reduced typing", below. |
204 | reduced typing", below. |
| 184 | |
205 | |
|
|
206 | There is one notable exception: C<unicode_eval> is not enabled by |
|
|
207 | default. In our opinion, C<use feature> had one main effect - newer perl |
|
|
208 | versions don't value backwards compatibility and the ability to write |
|
|
209 | modules for multiple perl versions much, after all, you can use feature. |
|
|
210 | |
|
|
211 | C<unicode_eval> doesn't add a new feature, it breaks an existing function. |
| 185 | |
212 | |
| 186 | =item no warnings, but a lot of new errors |
213 | =item no warnings, but a lot of new errors |
| 187 | |
214 | |
| 188 | Ah, the dreaded warnings. Even worse, the horribly dreaded C<-w> |
215 | Ah, the dreaded warnings. Even worse, the horribly dreaded C<-w> |
| 189 | switch: Even though we don't care if other people use warnings (and |
216 | switch: Even though we don't care if other people use warnings (and |
| … | |
… | |
| 274 | our $VERSION = '3.5'; |
301 | our $VERSION = '3.5'; |
| 275 | |
302 | |
| 276 | # overload should be included |
303 | # overload should be included |
| 277 | |
304 | |
| 278 | sub import { |
305 | sub import { |
| 279 | local $^W; # work around perl 5.16 spewing out warnings for next line |
306 | local $^W; # work around perl 5.16 spewing out warnings for next statement |
| 280 | IMPORT |
307 | IMPORT |
| 281 | # use feature |
|
|
| 282 | $^H{feature_switch} = |
|
|
| 283 | $^H{feature_say} = |
|
|
| 284 | $^H{feature_state} = 1; |
|
|
| 285 | } |
308 | } |
| 286 | |
309 | |
| 287 | 1; |
310 | 1; |
| 288 | |
311 | |
| 289 | =back |
312 | =back |
