diff options
author | Karl Williamson <khw@cpan.org> | 2015-03-14 21:50:27 -0600 |
---|---|---|
committer | Karl Williamson <khw@cpan.org> | 2015-03-19 10:20:39 -0600 |
commit | 4b6af431de82c30fc8df0d5d024cf77f6512e8b9 (patch) | |
tree | bcda9fc9b5f1bafebd609e5a6ee5cfb0866cf938 /lib/DB.pm | |
parent | 8b371338c1359c38e4de8ec65a0b9b884f05e450 (diff) | |
download | perl-4b6af431de82c30fc8df0d5d024cf77f6512e8b9.tar.gz |
Create single fcn for dup'd /lib code
Several /lib .pm's have the same code which is complicated enough to
warrant being placed in a shared function. This commit creates a .pm
to be used by these .pm's.
This implements the perhaps archaic 'Meta' notation wherein characters
above 0x7f are displayed as M- plus the ASCII-range character derived by
looking at only the lower 7 bits of the upper range one. There are
problems with this, in that a literal control character can be in the
string, whereas it is trying to get rid of control characters. But I
left it to work as-is, just centralizing the code.
On EBCDIC platforms this notation makes no sense because the bit
patterns are all mixed up about having the upper bit set. So this
commit fixes things on these platforms, so these are changed to
\x{...}. No literal control characters are emitted.
Another potential problem is that characters above 0xFF are passed
through, unchanged. But again, I let the existing behavior stand.
Diffstat (limited to 'lib/DB.pm')
-rw-r--r-- | lib/DB.pm | 6 |
1 files changed, 3 insertions, 3 deletions
@@ -41,7 +41,7 @@ BEGIN { $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 @@ -244,8 +244,8 @@ sub backtrace { 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) . ')' : ''; |