Optimize reversing an array in-place
[p5sagit/p5-mst-13.2.git] / lib / legacy.pm
CommitLineData
66060160 1package legacy;
2
3our $VERSION = '1.00';
4
5$unicode8bit::hint_bits = 0x00000800;
6
7my %legacy_bundle = (
8 "5.10" => [qw(unicode8bit)],
9 "5.11" => [qw(unicode8bit)],
10);
11
12my %legacy = ( 'unicode8bit' => '0' );
13
14=head1 NAME
15
16legacy - Perl pragma to preserve legacy behaviors or enable new non-default
17behaviors
18
19=head1 SYNOPSIS
20
21 use legacy ':5.10'; # Keeps semantics the same as in perl 5.10
22
23 no legacy;
24
25=cut
26
27 #no legacy qw(unicode8bit);
28
29=pod
30
31=head1 DESCRIPTION
32
33Some programs may rely on behaviors that for others are problematic or
34even wrong. A new version of Perl may change behaviors from past ones,
35and when it is viewed that the old way of doing things may be required
36to still be supported, that behavior will be added to the list recognized
37by this pragma to allow that.
38
39Additionally, a new behavior may be supported in a new version of Perl, but
40for whatever reason the default remains the old one. This pragma can enable
41the new behavior.
42
43Like other pragmas (C<use feature>, for example), C<use legacy qw(foo)> will
44only make the legacy behavior for "foo" available from that point to the end of
45the enclosing block.
46
47B<This pragma is, for the moment, a skeleton and does not actually affect any
48behaviors yet>
49
50=head2 B<use legacy>
51
52Preserve the old way of doing things when a new version of Perl is
53released that changes things
54
55=head2 B<no legacy>
56
57Turn on a new behavior in a version of Perl that understands
58it but has it turned off by default. For example, C<no legacy 'foo'> turns on
59behavior C<foo> in the lexical scope of the pragma. Simply C<no legacy>
60turns on all new behaviors known to the pragma.
61
62=head1 LEGACY BUNDLES
63
64It's possible to turn off all new behaviors past a given release by
65using a I<legacy bundle>, which is the name of the release prefixed with
66a colon, to distinguish it from an individual legacy behavior.
67
68Specifying sub-versions such as the C<0> in C<5.10.0> in legacy bundles has
69no effect: legacy bundles are guaranteed to be the same for all sub-versions.
70
71Legacy bundles are not allowed with C<no legacy>
72
73=cut
74
75sub import {
76 my $class = shift;
77 if (@_ == 0) {
78 croak("No legacy behaviors specified");
79 }
80 while (@_) {
81 my $name = shift(@_);
82 if (substr($name, 0, 1) eq ":") {
83 my $v = substr($name, 1);
84 if (!exists $legacy_bundle{$v}) {
85 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
86 if (!exists $legacy_bundle{$v}) {
87 unknown_legacy_bundle(substr($name, 1));
88 }
89 }
90 unshift @_, @{$legacy_bundle{$v}};
91 next;
92 }
93 if (!exists $legacy{$name}) {
94 unknown_legacy($name);
95 }
96 $^H &= ~$unicode8bit::hint_bits; # The only thing it could be as of yet
97 }
98}
99
100
101sub unimport {
102 my $class = shift;
103
104 # A bare C<no legacy> should disable *all* legacy behaviors
105 if (!@_) {
106 unshift @_, keys(%legacy);
107 }
108
109 while (@_) {
110 my $name = shift;
111 if (substr($name, 0, 1) eq ":") {
112 croak(sprintf('Legacy bundles (%s) are not allowed in "no legacy"',
113 $name));
114 }
115 if (!exists($legacy{$name})) {
116 unknown_legacy($name);
117 }
118 else {
119 $^H |= $unicode8bit::hint_bits; # The only thing it could be as of yet
120 }
121 }
122}
123
124sub unknown_legacy {
125 my $legacy = shift;
126 croak(sprintf('Legacy "%s" is not supported by Perl %vd', $legacy, $^V));
127}
128
129sub unknown_legacy_bundle {
130 my $legacy = shift;
131 croak(sprintf('Legacy bundle "%s" is not supported by Perl %vd',
132 $legacy, $^V));
133}
134
135sub croak {
136 require Carp;
137 Carp::croak(@_);
138}
139
1401;