Classic-Perl
view release on metacpan or search on metacpan
0.04 25 September, 2011
• Fixed a crashing bug that occurred with ||= in 5.9 and higher.
In 5.9, it required a constant on the right to cause the
crash. In 5.15.3 ||= would always crash.
• Fixed the changes file; I somehow got one from a dif-
ferent branch in the 0.03 release, listing changes that
never happened.
0.03 18 September, 2011
New $[ feature for 5.15+ (Thanks to Zefram for the patch!)
0.02a 17 October, 2010
Make a test more resilient when certain OSes scramble line
numbers in string evals.
0.02 10 October, 2010
• $* in perl 5.9 and higher
• use Classic::::Perl 5.008 import syntax
• Fixed to work with perls built with -DDEBUGGING.
This reinstates features deleted in recent versions of perl.
The features we currently provide are:
• split to @_ in void and scalar context. This feature was removed in
perl 5.11. With this module, you can have it back.
• $* - This was removed in perl 5.9.
• $[ - This was removed in perl 5.15.3 and reinstated in 5.15.5. This
may be removed from Classic::Perl (and then reinstated if it is
again removed from Perl).
RECENT CHANGES
0.06
----
• Fixed the split feature to work in perl 5.26 and higher.
lib/Classic/Perl.pm view on Meta::CPAN
package Classic::Perl;
my %features = map +($_ => undef) =>=> qw< $[ split $* >;
sub import{
shift;
for(@_) {
die
"$_ is not a feature Classic::Perl knows about at "
. join(" line ", (caller)[1,2]) . ".\n"
unless exists$features{$_};
next if $] < 5.0089999;
$_ eq '$*' and &_enable_multiline;
next if $] < 5.0109999;
$_ eq 'split' and $^H{Classic_Perl__split} = 1;
# next if $] < 5.0150029;
# $_ eq '$[' and $^H{'Classic_Perl__$['} = 0;
}
return if @_;
return if $] < 5.0089999;
&_enable_multiline;
return if $] < 5.0109999;
$^H{Classic_Perl__split} = 1;
# return if $] < 5.0150029;
# $^H{'Classic_Perl__$['} = 0;
return;
}
sub _enable_multiline {
$^H{'Classic_Perl__$*'} = 0,
# It’s the autovivification of the ** glob that warns, so this is how we
# have to suppress it. It only warns if it is created for the sake of
# the $* variable, so ‘no warnings’ is not needed.
*{"*"};
}
sub unimport {
shift;
for(@_) {
die
"$_ is not a feature Classic::Perl knows about at "
. join(" line ", (caller)[1,2]) . ".\n"
unless exists $features{$_};
delete $^H{"Classic_Perl__$_"};
}
return if @_;
# if($^H{'Classic_Perl__$['}) {
# Array::Base->unimport;
# String::Base->unimport;
# }
if(exists $^H{'Classic_Perl__$*'} and $] > 5.0130069 and $INC{"re.pm"}) {
unimport re:: "/m";
}
delete @^H{map "Classic_Perl__$_", keys %features};
return;
}
lib/Classic/Perl.pm view on Meta::CPAN
}
package Classic::::Perl;
$INC{"Classic/Perl.pm"} = $INC{"Classic//Perl.pm"} = __FILE__;
sub VERSION {
my @features;
push @features, '$*' if $_[1] < 5.0089999;
push @features, 'split' if $_[1] < 5.0109999;
# push @features, '$[' if $_[1] < 5.0150029;
Classic::Perl->import(@features) if @features;
}
__THE__=>__END__
=head1 NAME
Classic::Perl - Selectively reinstate deleted Perl features
=head1 VERSION
lib/Classic/Perl.pm view on Meta::CPAN
split //, "smat";
print join " ", @_; # prints "s m a t"
no Classic::Perl;
@_ = ();
split //, "smat";
print join " ", @_;
# prints "s m a t" in perl 5.10.x; nothing in 5.12
use Classic::Perl '$[';
$[ = 1;
print qw(a b c d)[2]; # prints "b"
use Classic::Perl '$*';
$* = 1;
print "yes\n" if "foo\nbar" =~ /^bar/; # prints yes
=head1 DESCRIPTION
Classic::Perl restores some Perl features that have been deleted in the
latest versions. By 'classic' we mean as of perl 5.8.x.
lib/Classic/Perl.pm view on Meta::CPAN
{
use Classic::Perl;
# ... features on here ...
}
# ... features off here ...
To enable or disable a specific set of features, pass them as arguments to
C<use> or C<no>:
use Classic::Perl qw< $[ split $* >;
To enable features that still existed in a given version of perl, put
I<four> colons in your C<use> statement, followed by the perl version. Only
plain numbers (C<5.008>) are currently supported. Don't use v-strings
(C<v5.8.0>).
use Classic::::Perl 5.016; # does nothing (yet)
use Classic::::Perl 5.014; # enables $[, but not split or $*
use Classic::::Perl 5.010; # enables $[ and split, but not $*
use Classic::::Perl 5.008; # enables everything
This is not guaranteed to do anything reasonable if used with C<no>.
=head1 THE FEATURES THEMSELVES
=over
=item $[
This feature provides the C<$[> variable, which, when set to an integer
other than zero, offsets indices into arrays and strings. For example,
setting it to 1 (almost the only non-zero value actually used) means
that the first element in an array has index 1 rather than the usual 0.
The index offset is lexically scoped, as C<$[> has been as of Perl 5.10,
unlike its behaviour in Perl 5.0-5.8 (file-scoped) and Perl 1-4 (global).
This is deprecated in Perl, but has not yet been removed. If it is
removed, Classic::Perl will continue to provide it.
=item split
This features provides C<split> to C<@_> in void and scalar context.
This was removed from perl in 5.11.
=item $*
This feature provides the C<$*> variable, which, when set to an integer
other than zero, puts an implicit C</m> on every regular expression.
Unlike the C<$*> variable in perl 5.8 and earlier, this only works at
compile-time and is lexically
scoped (like C<$[> in 5.10-5.14). It only works with constant values.
C<$* = $val> does not work.
<$*> was removed in perl 5.9.
=back
=head1 BUGS
Please report any bugs you find via L<http://rt.cpan.org> or
L<bug-Classic-Perl@rt.cpan.org>.
=head1 ACKNOWLEDGEMENTS
Much of the structural code in the XS file was stolen from Vincent Pit's
C<autovivification> module and tweaked. The F<ptable.h> file was taken
straight from his module without modifications. (I have been subsequently
informed that he stole it from B::Hooks::OP::Check, which pilfered it from
autobox, which filched it from perl. :-)
Andrew Main (Zefram) added support for C<$[> in 5.16.
=head1 SINE QUIBUS NON
L<perl> 5 or higher
=head1 COPYRIGHT
Copyright (C) 2010-17 Father Chrysostomos
use Classic'Perl;
lib/Classic/Perl.pm view on Meta::CPAN
print reverse "\n", @_;
This program is free software; you may redistribute it, modify it or both
under the same terms as perl.
=head1 SEE ALSO
L<Array::Base>, L<String:Base>,
L<perl>, L<C<split> in perlfunc|perlfunc/split>,
L<C<$*> in perlvar|perlvar/$*>,
C<C<$[> in perlvar|perlvar/$[>
L<any::feature> is an experimental module that backports new Perl features
to older versions.
The L<Modern::Perl> module enables various pragmata which are currently
popular.
t/arybase.t view on Meta::CPAN
use warnings;
no warnings qw(deprecated void);
use Test::More tests => 24;
is(qw(a b c d e f)[4], "e");
is(substr("abcdef", 4, 1), "e");
use Classic::Perl qw($[);
is(qw(a b c d e f)[4], "e");
is(substr("abcdef", 4, 1), "e");
$[ = 2;
is(qw(a b c d e f)[4], "c");
is(substr("abcdef", 4, 1), "c");
{
local $[ = 3;
is(qw(a b c d e f)[4], "b");
is(substr("abcdef", 4, 1), "b");
}
is(qw(a b c d e f)[4], "c");
is(substr("abcdef", 4, 1), "c");
{
local $[ = 1;
is(qw(a b c d e f)[4], "d");
is(substr("abcdef", 4, 1), "d");
}
is(qw(a b c d e f)[4], "c");
is(substr("abcdef", 4, 1), "c");
{
local($[) = 1;
is(qw(a b c d e f)[4], "d");
is(substr("abcdef", 4, 1), "d");
}
is(qw(a b c d e f)[4], "c");
is(substr("abcdef", 4, 1), "c");
{
local $[ = 0;
is(qw(a b c d e f)[4], "e");
is(substr("abcdef", 4, 1), "e");
}
is(qw(a b c d e f)[4], "c");
is(substr("abcdef", 4, 1), "c");
$[ = 0;
is(qw(a b c d e f)[4], "e");
is(substr("abcdef", 4, 1), "e");
1;
Perl_load_module(aTHX_ 0, newSVpvs("Array::Base"), newSVnv(4/((NV)1000)),
newSViv(base), NULL);
Perl_load_module(aTHX_ 0, newSVpvs("String::Base"), NULL,
newSViv(base), NULL);
LEAVE;
}
STATIC OP *(*cp_arybase_old_ck_sassign)(pTHX_ OP *) = 0;
STATIC OP *(*cp_arybase_old_ck_aassign)(pTHX_ OP *) = 0;
#define arybase "Classic_Perl__$["
#define arybase_len (sizeof(arybase)-1)
STATIC bool cp_op_is_dollar_bracket(pTHX_ OP *o) {
#define cp_op_is_dollar_bracket(o) cp_op_is_dollar_bracket(aTHX_ (o))
OP *c;
return o->op_type == OP_RV2SV && (o->op_flags & OPf_KIDS)
&& (c = cUNOPx(o)->op_first)
&& c->op_type == OP_GV
&& strEQ(GvNAME(cGVOPx_gv(c)), "[");
}
STATIC void cp_neuter_dollar_bracket(pTHX_ OP *o) {
#define cp_neuter_dollar_bracket(o) cp_neuter_dollar_bracket(aTHX_ (o))
OP *oldc, *newc;
/*
* Must replace the core's $[ with something that can accept assignment
* of non-zero value and can be local()ised. Simplest thing is a
* different global variable.
*/
oldc = cUNOPx(o)->op_first;
newc = newGVOP(OP_GV, 0,
gv_fetchpvs("Classic::Perl::[", GV_ADDMULTI, SVt_PVGV));
cUNOPx(o)->op_first = newc;
op_free(oldc);
}
( run in 0.740 second using v1.01-cache-2.11-cpan-cc502c75498 )