view release on metacpan or  search on metacpan

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;
}

BEGIN {
 $VERSION='0.07';
 if($]>5.0089999){
  require XSLoader;
  XSLoader::load(__PACKAGE__, $VERSION);
 }
}

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

Version 0.07

=head1 SYNOPSIS

  use Classic::Perl;
  # or
  use Classic::Perl 'split';

  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