[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
[PATCH] Deliver skeleton legacy.pm for the "Unicode bug"
Deliver skeleton legacy.pm
I am creating this module based on my understanding of how it was agreed
here to enable and disable the new behaviors associated with the
problems of characters in the Unicode ordinal range 128-255.
"use legacy" is a general pragma that can be used for other purposes as
well. Another candidate is the treatment of octal constants above 255.
This is a skeleton that doesn't affect behaviors yet. It does
understand "uni8bit" as a legacy behavior, and sets or clears an
appropriate bit, so perl.h is delivered as well.
I'm delivering this separately from the code that actually uses the bit,
as I said a couple of months ago I would, so that the patches are
independent, mostly, and so the other ones can be removed without
affecting this one if problems arise.
The first patch to work with this is close to being ready.
From e8f8502dafe376db4f3b2895b4c1dd465baca0fc Mon Sep 17 00:00:00 2001
From: Karl <khw@karl.(none)>
Date: Mon, 19 Jan 2009 12:24:39 -0700
Subject: [PATCH] Deliver skeleton legacy.pm
---
MANIFEST | 1 +
lib/legacy.pm | 140 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
perl.h | 1 +
3 files changed, 142 insertions(+), 0 deletions(-)
create mode 100755 lib/legacy.pm
diff --git a/MANIFEST b/MANIFEST
index 585c129..13ce1f3 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2217,6 +2217,7 @@ lib/IPC/Open2.pm Open a two-ended pipe
lib/IPC/Open2.t See if IPC::Open2 works
lib/IPC/Open3.pm Open a three-ended pipe!
lib/IPC/Open3.t See if IPC::Open3 works
+lib/legacy.pm Pragma to preserve legacy behavior
lib/less.pm For "use less"
lib/less.t See if less support works
lib/lib_pm.PL For "use lib", produces lib/lib.pm
diff --git a/lib/legacy.pm b/lib/legacy.pm
new file mode 100755
index 0000000..b0b4464
--- /dev/null
+++ b/lib/legacy.pm
@@ -0,0 +1,140 @@
+package legacy;
+
+our $VERSION = '1.00';
+
+$unicode8bit::hint_bits = 0x00000800;
+
+my %legacy_bundle = (
+ "5.10" => [qw(unicode8bit)],
+ "5.11" => [qw(unicode8bit)],
+);
+
+my %legacy = ( 'unicode8bit' => '0' );
+
+=head1 NAME
+
+legacy - Perl pragma to preserve legacy behaviors or enable new non-default
+behaviors
+
+=head1 SYNOPSIS
+
+ use legacy ':5.10'; # Keeps semantics the same as in perl 5.10
+
+ no legacy;
+
+=cut
+
+ #no legacy qw(unicode8bit);
+
+=pod
+
+=head1 DESCRIPTION
+
+Some programs may rely on behaviors that for others are problematic or
+even wrong. A new version of Perl may change behaviors from past ones,
+and when it is viewed that the old way of doing things may be required
+to still be supported, that behavior will be added to the list recognized
+by this pragma to allow that.
+
+Additionally, a new behavior may be supported in a new version of Perl, but
+for whatever reason the default remains the old one. This pragma can enable
+the new behavior.
+
+Like other pragmas (C<use feature>, for example), C<use legacy qw(foo)> will
+only make the legacy behavior for "foo" available from that point to the end of
+the enclosing block.
+
+B<This pragma is, for the moment, a skeleton and does not actually affect any
+behaviors yet>
+
+=head2 B<use legacy>
+
+Preserve the old way of doing things when a new version of Perl is
+released that changes things
+
+=head2 B<no legacy>
+
+Turn on a new behavior in a version of Perl that understands
+it but has it turned off by default. For example, C<no legacy 'foo'> turns on
+behavior C<foo> in the lexical scope of the pragma. Simply C<no legacy>
+turns on all new behaviors known to the pragma.
+
+=head1 LEGACY BUNDLES
+
+It's possible to turn off all new behaviors past a given release by
+using a I<legacy bundle>, which is the name of the release prefixed with
+a colon, to distinguish it from an individual legacy behavior.
+
+Specifying sub-versions such as the C<0> in C<5.10.0> in legacy bundles has
+no effect: legacy bundles are guaranteed to be the same for all sub-versions.
+
+Legacy bundles are not allowed with C<no legacy>
+
+=cut
+
+sub import {
+ my $class = shift;
+ if (@_ == 0) {
+ croak("No legacy behaviors specified");
+ }
+ while (@_) {
+ my $name = shift(@_);
+ if (substr($name, 0, 1) eq ":") {
+ my $v = substr($name, 1);
+ if (!exists $legacy_bundle{$v}) {
+ $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
+ if (!exists $legacy_bundle{$v}) {
+ unknown_legacy_bundle(substr($name, 1));
+ }
+ }
+ unshift @_, @{$legacy_bundle{$v}};
+ next;
+ }
+ if (!exists $legacy{$name}) {
+ unknown_legacy($name);
+ }
+ $^H &= ~$unicode8bit::hint_bits; # The only thing it could be as of yet
+ }
+}
+
+
+sub unimport {
+ my $class = shift;
+
+ # A bare C<no legacy> should disable *all* legacy behaviors
+ if (!@_) {
+ unshift @_, keys(%legacy);
+ }
+
+ while (@_) {
+ my $name = shift;
+ if (substr($name, 0, 1) eq ":") {
+ croak(sprintf('Legacy bundles (%s) are not allowed in "no legacy"',
+ $name));
+ }
+ if (!exists($legacy{$name})) {
+ unknown_legacy($name);
+ }
+ else {
+ $^H |= $unicode8bit::hint_bits; # The only thing it could be as of yet
+ }
+ }
+}
+
+sub unknown_legacy {
+ my $legacy = shift;
+ croak(sprintf('Legacy "%s" is not supported by Perl %vd', $legacy, $^V));
+}
+
+sub unknown_legacy_bundle {
+ my $legacy = shift;
+ croak(sprintf('Legacy bundle "%s" is not supported by Perl %vd',
+ $legacy, $^V));
+}
+
+sub croak {
+ require Carp;
+ Carp::croak(@_);
+}
+
+1;
diff --git a/perl.h b/perl.h
index 45d0e1d..6ff445b 100644
--- a/perl.h
+++ b/perl.h
@@ -4643,6 +4643,7 @@ enum { /* pass one of these to get_vtbl */
#define HINT_BLOCK_SCOPE 0x00000100
#define HINT_STRICT_SUBS 0x00000200 /* strict pragma */
#define HINT_STRICT_VARS 0x00000400 /* strict pragma */
+#define HINT_UNI_8_BIT 0x00000800 /* unicode8bit pragma */
/* The HINT_NEW_* constants are used by the overload pragma */
#define HINT_NEW_INTEGER 0x00001000
--
1.5.4.3
- Follow-Ups from:
-
Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]