File Coverage

blib/lib/Classic/Perl.pm
Criterion Covered Total %
statement 31 32 96.8
branch 22 30 73.3
condition 2 6 33.3
subroutine 5 5 100.0
pod 0 1 0.0
total 60 74 81.0


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   152 shift;
7 14         31 for(@_) {
8             die
9             "$_ is not a feature Classic::Perl knows about at "
10             . join(" line ", (caller)[1,2]) . ".\n"
11 8 100       40 unless exists$features{$_};
12 7 50       20 next if $] < 5.0089999;
13 7 100       24 $_ eq '$*' and &_enable_multiline;
14 7 50       33 next if $] < 5.0109999;
15 7 100       26 $_ eq 'split' and $^H{Classic_Perl__split} = 1;
16             # next if $] < 5.0150029;
17             # $_ eq '$[' and $^H{'Classic_Perl__$['} = 0;
18             }
19 13 100       183 return if @_;
20 7 50       23 return if $] < 5.0089999;
21 7         17 &_enable_multiline;
22 7 50       17 return if $] < 5.0109999;
23 7         20 $^H{Classic_Perl__split} = 1;
24             # return if $] < 5.0150029;
25             # $^H{'Classic_Perl__$['} = 0;
26 7         2237 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   34 *{"*"};
  9         28  
35             }
36             sub unimport {
37 4     4   1781 shift;
38 4         13 for(@_) {
39             die
40             "$_ is not a feature Classic::Perl knows about at "
41             . join(" line ", (caller)[1,2]) . ".\n"
42 1 50       15 unless exists $features{$_};
43 0         0 delete $^H{"Classic_Perl__$_"};
44             }
45 3 50       10 return if @_;
46             # if($^H{'Classic_Perl__$['}) {
47             # Array::Base->unimport;
48             # String::Base->unimport;
49             # }
50 3 50 33     37 if(exists $^H{'Classic_Perl__$*'} and $] > 5.0130069 and $INC{"re.pm"}) {
      33        
51 3         90 unimport re:: "/m";
52             }
53 3         32 delete @^H{map "Classic_Perl__$_", keys %features};
54 3         181 return;
55             }
56              
57             BEGIN {
58 5     5   47163 $VERSION='0.07';
59 5 50       25 if($]>5.0089999){
60 5         29 require XSLoader;
61 5         2103 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 127 my @features;
71 4 100       17 push @features, '$*' if $_[1] < 5.0089999;
72 4 100       16 push @features, 'split' if $_[1] < 5.0109999;
73             # push @features, '$[' if $_[1] < 5.0150029;
74 4 100       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.07
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             =head1 COPYRIGHT
206              
207             Copyright (C) 2010-17 Father Chrysostomos
208              
209             use Classic'Perl;
210             split / /, 'org . cpan @ sprout';
211             print reverse "\n", @_;
212              
213             This program is free software; you may redistribute it, modify it or both
214             under the same terms as perl.
215              
216             =head1 SEE ALSO
217              
218             L, L,
219             L, L in perlfunc|perlfunc/split>,
220             L in perlvar|perlvar/$*>,
221             C in perlvar|perlvar/$[>
222              
223             L is an experimental module that backports new Perl features
224             to older versions.
225              
226             The L module enables various pragmata which are currently
227             popular.