| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Classic::Perl; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | my %features = map +($_ => undef)  =>=>  qw< $[ split $* >; | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | sub import{ | 
| 6 | 14 |  |  | 14 |  | 117 | shift; | 
| 7 | 14 |  |  |  |  | 27 | for(@_) { | 
| 8 |  |  |  |  |  |  | die | 
| 9 |  |  |  |  |  |  | "$_ is not a feature Classic::Perl knows about at " | 
| 10 |  |  |  |  |  |  | . join(" line ", (caller)[1,2]) . ".\n" | 
| 11 | 8 | 100 |  |  |  | 41 | unless exists$features{$_}; | 
| 12 | 7 | 50 |  |  |  | 14 | next if $] < 5.0089999; | 
| 13 | 7 | 100 |  |  |  | 16 | $_ eq '$*' and &_enable_multiline; | 
| 14 | 7 | 50 |  |  |  | 23 | next if $] < 5.0109999; | 
| 15 | 7 | 100 |  |  |  | 21 | $_ eq 'split' and $^H{Classic_Perl__split} = 1; | 
| 16 |  |  |  |  |  |  | #  next if $] < 5.0150029; | 
| 17 |  |  |  |  |  |  | #  $_ eq '$[' and $^H{'Classic_Perl__$['} = 0; | 
| 18 |  |  |  |  |  |  | } | 
| 19 | 13 | 100 |  |  |  | 177 | return if @_; | 
| 20 | 7 | 50 |  |  |  | 21 | return if $] < 5.0089999; | 
| 21 | 7 |  |  |  |  | 11 | &_enable_multiline; | 
| 22 | 7 | 50 |  |  |  | 14 | return if $] < 5.0109999; | 
| 23 | 7 |  |  |  |  | 16 | $^H{Classic_Perl__split} = 1; | 
| 24 |  |  |  |  |  |  | # return if $] < 5.0150029; | 
| 25 |  |  |  |  |  |  | # $^H{'Classic_Perl__$['} = 0; | 
| 26 | 7 |  |  |  |  | 2239 | return; | 
| 27 |  |  |  |  |  |  | } | 
| 28 |  |  |  |  |  |  | sub _enable_multiline { | 
| 29 |  |  |  |  |  |  | $^H{'Classic_Perl__$*'} = 0, | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | # It’s the autovivification of the ** glob that warns, so this is how we | 
| 32 |  |  |  |  |  |  | # have to suppress it. It only warns if it is created for the sake of | 
| 33 |  |  |  |  |  |  | # the $* variable, so ‘no warnings’ is not needed. | 
| 34 | 9 |  |  | 9 |  | 26 | *{"*"}; | 
|  | 9 |  |  |  |  | 23 |  | 
| 35 |  |  |  |  |  |  | } | 
| 36 |  |  |  |  |  |  | sub unimport { | 
| 37 | 4 |  |  | 4 |  | 1685 | shift; | 
| 38 | 4 |  |  |  |  | 10 | for(@_) { | 
| 39 |  |  |  |  |  |  | die | 
| 40 |  |  |  |  |  |  | "$_ is not a feature Classic::Perl knows about at " | 
| 41 |  |  |  |  |  |  | . join(" line ", (caller)[1,2]) . ".\n" | 
| 42 | 1 | 50 |  |  |  | 21 | unless exists $features{$_}; | 
| 43 | 0 |  |  |  |  | 0 | delete $^H{"Classic_Perl__$_"}; | 
| 44 |  |  |  |  |  |  | } | 
| 45 | 3 | 50 |  |  |  | 6 | return if @_; | 
| 46 |  |  |  |  |  |  | # if($^H{'Classic_Perl__$['}) { | 
| 47 |  |  |  |  |  |  | #  Array::Base->unimport; | 
| 48 |  |  |  |  |  |  | #  String::Base->unimport; | 
| 49 |  |  |  |  |  |  | # } | 
| 50 | 3 | 50 | 33 |  |  | 28 | if(exists $^H{'Classic_Perl__$*'} and $] > 5.0130069 and $INC{"re.pm"}) { | 
|  |  |  | 33 |  |  |  |  | 
| 51 | 3 |  |  |  |  | 70 | unimport re:: "/m"; | 
| 52 |  |  |  |  |  |  | } | 
| 53 | 3 |  |  |  |  | 27 | delete @^H{map "Classic_Perl__$_", keys %features}; | 
| 54 | 3 |  |  |  |  | 136 | return; | 
| 55 |  |  |  |  |  |  | } | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | BEGIN { | 
| 58 | 5 |  |  | 5 |  | 42706 | $VERSION='0.06'; | 
| 59 | 5 | 50 |  |  |  | 25 | if($]>5.0089999){ | 
| 60 | 5 |  |  |  |  | 25 | require XSLoader; | 
| 61 | 5 |  |  |  |  | 2227 | XSLoader::load(__PACKAGE__, $VERSION); | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | package Classic::::Perl; | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | $INC{"Classic/Perl.pm"} = $INC{"Classic//Perl.pm"} = __FILE__; | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | sub VERSION { | 
| 70 | 4 |  |  | 4 | 0 | 108 | my @features; | 
| 71 | 4 | 100 |  |  |  | 10 | push @features, '$*'    if $_[1] < 5.0089999; | 
| 72 | 4 | 100 |  |  |  | 6 | push @features, 'split' if $_[1] < 5.0109999; | 
| 73 |  |  |  |  |  |  | # push @features, '$['    if $_[1] < 5.0150029; | 
| 74 | 4 | 100 |  |  |  | 10 | Classic::Perl->import(@features) if @features; | 
| 75 |  |  |  |  |  |  | } | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | __THE__=>__END__ | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | =head1 NAME | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | Classic::Perl - Selectively reinstate deleted Perl features | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | =head1 VERSION | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | Version 0.06 | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  | use Classic::Perl; | 
| 90 |  |  |  |  |  |  | # or | 
| 91 |  |  |  |  |  |  | use Classic::Perl 'split'; | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | split //, "smat"; | 
| 94 |  |  |  |  |  |  | print join " ", @_; # prints "s m a t" | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | no Classic::Perl; | 
| 97 |  |  |  |  |  |  | @_ = (); | 
| 98 |  |  |  |  |  |  | split //, "smat"; | 
| 99 |  |  |  |  |  |  | print join " ", @_; | 
| 100 |  |  |  |  |  |  | # prints "s m a t" in perl 5.10.x; nothing in 5.12 | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | use Classic::Perl '$['; | 
| 103 |  |  |  |  |  |  | $[ = 1; | 
| 104 |  |  |  |  |  |  | print qw(a b c d)[2]; # prints "b" | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | use Classic::Perl '$*'; | 
| 107 |  |  |  |  |  |  | $* = 1; | 
| 108 |  |  |  |  |  |  | print "yes\n" if "foo\nbar" =~ /^bar/; # prints yes | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 111 |  |  |  |  |  |  |  | 
| 112 |  |  |  |  |  |  | Classic::Perl restores some Perl features that have been deleted in the | 
| 113 |  |  |  |  |  |  | latest versions. By 'classic' we mean as of perl 5.8.x. | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | The whole idea is that you can put C | 
| 116 |  |  |  |  |  |  | old script or module (or a new one, if you like the features that are out | 
| 117 |  |  |  |  |  |  | of vogue) and have it continue to work. | 
| 118 |  |  |  |  |  |  |  | 
| 119 |  |  |  |  |  |  | In versions of perl prior to 5.10, this module simply does nothing. | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | =head1 ENABLING FEATURES | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | To enable all features, simply use C | 
| 124 |  |  |  |  |  |  | whatever Classic::Perl enabled, write C. These are | 
| 125 |  |  |  |  |  |  | lexically-scoped, so: | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | { | 
| 128 |  |  |  |  |  |  | use Classic::Perl; | 
| 129 |  |  |  |  |  |  | # ... features on here ... | 
| 130 |  |  |  |  |  |  | } | 
| 131 |  |  |  |  |  |  | # ... features off here ... | 
| 132 |  |  |  |  |  |  |  | 
| 133 |  |  |  |  |  |  | To enable or disable a specific set of features, pass them as arguments to | 
| 134 |  |  |  |  |  |  | C | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | use Classic::Perl qw< $[ split $* >; | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | To enable features that still existed in a given version of perl, put | 
| 139 |  |  |  |  |  |  | I colons in your C | 
| 140 |  |  |  |  |  |  | plain numbers (C<5.008>) are currently supported. Don't use v-strings | 
| 141 |  |  |  |  |  |  | (C). | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | use Classic::::Perl 5.016; # does nothing (yet) | 
| 144 |  |  |  |  |  |  | use Classic::::Perl 5.014; # enables $[, but not split or $* | 
| 145 |  |  |  |  |  |  | use Classic::::Perl 5.010; # enables $[ and split, but not $* | 
| 146 |  |  |  |  |  |  | use Classic::::Perl 5.008; # enables everything | 
| 147 |  |  |  |  |  |  |  | 
| 148 |  |  |  |  |  |  | This is not guaranteed to do anything reasonable if used with C. | 
| 149 |  |  |  |  |  |  |  | 
| 150 |  |  |  |  |  |  | =head1 THE FEATURES THEMSELVES | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | =over | 
| 153 |  |  |  |  |  |  |  | 
| 154 |  |  |  |  |  |  | =item $[ | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | This feature provides the C<$[> variable, which, when set to an integer | 
| 157 |  |  |  |  |  |  | other than zero, offsets indices into arrays and strings.  For example, | 
| 158 |  |  |  |  |  |  | setting it to 1 (almost the only non-zero value actually used) means | 
| 159 |  |  |  |  |  |  | that the first element in an array has index 1 rather than the usual 0. | 
| 160 |  |  |  |  |  |  | The index offset is lexically scoped, as C<$[> has been as of Perl 5.10, | 
| 161 |  |  |  |  |  |  | unlike its behaviour in Perl 5.0-5.8 (file-scoped) and Perl 1-4 (global). | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | This is deprecated in Perl, but has not yet been removed.  If it is | 
| 164 |  |  |  |  |  |  | removed, Classic::Perl will continue to provide it. | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | =item split | 
| 167 |  |  |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | This features provides C to C<@_> in void and scalar context. | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  | This was removed from perl in 5.11. | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | =item $* | 
| 173 |  |  |  |  |  |  |  | 
| 174 |  |  |  |  |  |  | This feature provides the C<$*> variable, which, when set to an integer | 
| 175 |  |  |  |  |  |  | other than zero, puts an implicit C on every regular expression. | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | Unlike the C<$*> variable in perl 5.8 and earlier, this only works at | 
| 178 |  |  |  |  |  |  | compile-time and is lexically | 
| 179 |  |  |  |  |  |  | scoped (like C<$[> in 5.10-5.14). It only works with constant values. | 
| 180 |  |  |  |  |  |  | C<$* = $val> does not work. | 
| 181 |  |  |  |  |  |  |  | 
| 182 |  |  |  |  |  |  | <$*> was removed in perl 5.9. | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | =back | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | =head1 BUGS | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | Please report any bugs you find via L or | 
| 189 |  |  |  |  |  |  | L. | 
| 190 |  |  |  |  |  |  |  | 
| 191 |  |  |  |  |  |  | =head1 ACKNOWLEDGEMENTS | 
| 192 |  |  |  |  |  |  |  | 
| 193 |  |  |  |  |  |  | Much of the structural code in the XS file was stolen from Vincent Pit's | 
| 194 |  |  |  |  |  |  | C module and tweaked. The F file was taken | 
| 195 |  |  |  |  |  |  | straight from his module without modifications. (I have been subsequently | 
| 196 |  |  |  |  |  |  | informed that he stole it from B::Hooks::OP::Check, which pilfered it from | 
| 197 |  |  |  |  |  |  | autobox, which filched it from perl. :-) | 
| 198 |  |  |  |  |  |  |  | 
| 199 |  |  |  |  |  |  | Andrew Main (Zefram) added support for C<$[> in 5.16. | 
| 200 |  |  |  |  |  |  |  | 
| 201 |  |  |  |  |  |  | =head1 SINE QUIBUS NON | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  | L 5 or higher | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | In Perl 5.16 and higher, L and L are required. | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | =head1 COPYRIGHT | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | Copyright (C) 2010-16 Father Chrysostomos | 
| 210 |  |  |  |  |  |  |  | 
| 211 |  |  |  |  |  |  | use Classic'Perl; | 
| 212 |  |  |  |  |  |  | split / /, 'org . cpan @ sprout'; | 
| 213 |  |  |  |  |  |  | print reverse "\n", @_; | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | This program is free software; you may redistribute it, modify it or both | 
| 216 |  |  |  |  |  |  | under the same terms as perl. | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | L, L, | 
| 221 |  |  |  |  |  |  | L, L in perlfunc|perlfunc/split>, | 
| 222 |  |  |  |  |  |  | L in perlvar|perlvar/$*>, | 
| 223 |  |  |  |  |  |  | C in perlvar|perlvar/$[> | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | L is an experimental module that backports new Perl features | 
| 226 |  |  |  |  |  |  | to older versions. | 
| 227 |  |  |  |  |  |  |  | 
| 228 |  |  |  |  |  |  | The L module enables various pragmata which are currently | 
| 229 |  |  |  |  |  |  | popular. |