lib/less.t See if less support works
lib/locale.pm For "use locale"
lib/locale.t See if locale support works
+lib/meta_notation.pm Helper for certain /lib .pm's
+lib/meta_notation.t See if meta_notation.t works
lib/Net/hostent.pm By-name interface to Perl's builtin gethost*
lib/Net/hostent.t See if Net::hostent works
lib/Net/netent.pm By-name interface to Perl's builtin getnet*
lib/FindBin.{pm,t}
lib/Getopt/Std.{pm,t}
lib/Internals.t
+ lib/meta_notation.{pm,t}
lib/Net/hostent.{pm,t}
lib/Net/netent.{pm,t}
lib/Net/protoent.{pm,t}
$DB::subname = ''; # currently executing sub (fully qualified name)
$DB::lineno = ''; # current line number
- $DB::VERSION = $DB::VERSION = '1.07';
+ $DB::VERSION = $DB::VERSION = '1.08';
# initialize private globals to avoid warnings
for (@a) {
s/'/\\'/g;
s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
- s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
- s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+ require 'meta_notation.pm';
+ $_ = _meta_notation($_) if /[[:^print:]]/a;
}
$w = $w ? '@ = ' : '$ = ';
$a = $h ? '(' . join(', ', @a) . ')' : '';
--- /dev/null
+use strict;
+use warnings;
+
+# A tiny private library routine which is a helper to several Perl core
+# modules, to allow a paradigm to be implemented in a single place. The name,
+# contents, or even the existence of this file may be changed at any time and
+# are NOT to be used by anthing outside the Perl core.
+
+sub _meta_notation ($) {
+
+ # Returns a copy of the input string with the nonprintable characters
+ # below 0x100 changed into printables. Any ASCII printables or above 0xFF
+ # are unchanged. (XXX Probably above-Latin1 characters should be
+ # converted to \X{...})
+ #
+ # \0 .. \x1F (which are "\c@" .. "\c_") are changed into ^@, ^A, ^B, ...
+ # ^Z, ^[, ^\, ^], ^^, ^_
+ # \c? is changed into ^?.
+ #
+ # The above accounts for all the ASCII-range nonprintables.
+ #
+ # On ASCII platforms, the upper-Latin1-range characters are converted to
+ # Meta notation, so that \xC1 becomes 'M-A', \xE2 becomes 'M-b', etc.
+ # This is how it always has worked, so is continued that way for backwards
+ # compatibility. XXX Wrong, but the way it has always worked is that \x80
+ # .. \x9F are converted to M- followed by a literal control char. This
+ # probably has escaped attention due to the limited domains this code has
+ # been applied to. ext/SDBM_File/dbu.c does this right.
+ #
+ # On EBCDIC platforms, the upper-Latin1-range characters are converted
+ # into '\x{...}' Meta notation doesn't make sense on EBCDIC platforms
+ # because the ASCII-range printables are a mixture of upper bit set or
+ # not. [A-Za-Z0-9] all have the upper bit set. The underscore likely
+ # doesn't; and other punctuation may or may not. There's no simple
+ # pattern.
+
+ my $string = shift;
+
+ $string =~ s/([\0-\037])/
+ sprintf("^%c",utf8::unicode_to_native(ord($1)^64))/xeg;
+ $string =~ s/\c?/^?/g;
+ if (ord("A") == 65) {
+ $string =~ s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+ }
+ else {
+ no warnings 'experimental::regex_sets';
+ # Leave alone things above \xff
+ $string =~ s/( (?[ [\x00-\xFF] & [:^print:]])) /
+ sprintf("\\x{%X}", ord($1))/xaeg;
+ }
+
+ return $string;
+}
+1
--- /dev/null
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+use strict;
+use warnings;
+
+eval "require 'meta_notation.pm'";
+if ($@) {
+ fail("Could not find 'meta_notation.pm'");
+}
+else {
+
+ is(_meta_notation("\007\010\011\c?Z\x{103}"), "^G^H^I^?Z\x{103}");
+
+ if ($::IS_ASCII || $::IS_ASCII) {
+ is(_meta_notation("\x{c1}\x{e2}"), 'M-AM-b');
+ is(_meta_notation("\x{df}"), 'M-_');
+ }
+ else { # EBCDIC platform
+ # In the first iteration we are looking for a non-ASCII control; in
+ # the second, a regular non-ASCII character. SPACE marks the end of
+ # most controls. We test each to see that they are properly converted
+ # to \x{...}
+ foreach my $start (0x20, ord " ") {
+ for (my $i = $start; $i < 256; $i++) {
+ my $char = chr $i;
+ next if $char =~ /[[:ascii:]]/;
+ is(_meta_notation($char), sprintf("\\x{%X}", $i));
+ last;
+ }
+ }
+ }
+}
+
+done_testing();
# Debugger for Perl 5.00x; perl5db.pl patch level:
use vars qw($VERSION $header);
-$VERSION = '1.47';
+$VERSION = '1.48';
$header = "perl5db.pl version $VERSION";
s/(.*)/'$1'/s
unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
- # Turn high-bit characters into meta-whatever.
- s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
-
- # Turn control characters into ^-whatever.
- s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+ # Turn high-bit characters into meta-whatever, and controls into like
+ # '^D'.
+ require 'meta_notation.pm';
+ $_ = _meta_notation($_) if /[[:^print:]]/a;
return $_;
}
use Carp;
-$VERSION = 1.07;
+$VERSION = 1.08;
$Verbose ||= 0;
sub import {
s/([\'\\])/\\$1/g;
s/([^\0]*)/'$1'/
unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
- s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
- s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+ require 'meta_notation.pm';
+ $_ = _meta_notation($_) if /[[:^print:]]/a;
push(@a, $_);
}
$w = $w ? '@ = ' : '$ = ';