File Coverage

blib/lib/Classic/Perl.pm
Criterion Covered Total %
statement 37 40 92.5
branch 27 40 67.5
condition 2 6 33.3
subroutine 5 5 100.0
pod 0 1 0.0
total 71 92 77.1


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 15     15   141 shift;
7 15         33 for(@_) {
8 12 100       73 die
9             "$_ is not a feature Classic::Perl knows about at "
10             . join(" line ", (caller)[1,2]) . ".\n"
11             unless exists$features{$_};
12 11 50       25 next if $] < 5.0089999;
13 11 100       28 $_ eq '$*' and &_enable_multiline;
14 11 50       20 next if $] < 5.0109999;
15 11 100       28 $_ eq 'split' and $^H{Classic_Perl__split} = 1;
16 11 50       24 next if $] < 5.0150029;
17 11 100       43 $_ eq '$[' and $^H{'Classic_Perl__$['} = 0;
18             }
19 14 100       235 return if @_;
20 7 50       22 return if $] < 5.0089999;
21 7         13 &_enable_multiline;
22 7 50       15 return if $] < 5.0109999;
23 7         20 $^H{Classic_Perl__split} = 1;
24 7 50       12 return if $] < 5.0150029;
25 7         22 $^H{'Classic_Perl__$['} = 0;
26 7         3989 return;
27             }
28             sub _enable_multiline {
29 9         22 $^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   35 *{"*"};
35             }
36             sub unimport {
37 4     4   1762 shift;
38 4         9 for(@_) {
39 1 50       21 die
40             "$_ is not a feature Classic::Perl knows about at "
41             . join(" line ", (caller)[1,2]) . ".\n"
42             unless exists $features{$_};
43 0         0 delete $^H{"Classic_Perl__$_"};
44             }
45 3 50       10 return if @_;
46 3 50       21 if($^H{'Classic_Perl__$['}) {
47 0         0 Array::Base->unimport;
48 0         0 String::Base->unimport;
49             }
50 3 50 33     35 if(exists $^H{'Classic_Perl__$*'} and $] > 5.0130069 and $INC{"re.pm"}) {
      33        
51 3         78 unimport re:: "/m";
52             }
53 3         25 delete @^H{map "Classic_Perl__$_", keys %features};
54 3         151 return;
55             }
56              
57             BEGIN {
58 5     5   82922 $VERSION='0.05';
59 5 50       30 if($]>5.0089999){
60 5         39 require XSLoader;
61 5         3903 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 162 my @features;
71 4 100       13 push @features, '$*' if $_[1] < 5.0089999;
72 4 100       11 push @features, 'split' if $_[1] < 5.0109999;
73 4 50       9 push @features, '$[' if $_[1] < 5.0150029;
74 4 50       14 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.05
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 at the top of an
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. To disable
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 or 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 statement, followed by the perl version. Only
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-12 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.