my %unctrl = # portable to EBCDIC
(
- "\c@" => '\c@', # unused
- "\cA" => '\cA',
- "\cB" => '\cB',
- "\cC" => '\cC',
- "\cD" => '\cD',
- "\cE" => '\cE',
- "\cF" => '\cF',
- "\cG" => '\cG',
- "\cH" => '\cH',
- "\cI" => '\cI',
- "\cJ" => '\cJ',
- "\cK" => '\cK',
- "\cL" => '\cL',
- "\cM" => '\cM',
- "\cN" => '\cN',
- "\cO" => '\cO',
- "\cP" => '\cP',
- "\cQ" => '\cQ',
- "\cR" => '\cR',
- "\cS" => '\cS',
- "\cT" => '\cT',
- "\cU" => '\cU',
- "\cV" => '\cV',
- "\cW" => '\cW',
- "\cX" => '\cX',
- "\cY" => '\cY',
- "\cZ" => '\cZ',
- "\c[" => '\c[', # unused
- "\c\\" => '\c\\', # unused
- "\c]" => '\c]', # unused
- "\c_" => '\c_', # unused
+ "\c@" => '@', # unused
+ "\cA" => 'A',
+ "\cB" => 'B',
+ "\cC" => 'C',
+ "\cD" => 'D',
+ "\cE" => 'E',
+ "\cF" => 'F',
+ "\cG" => 'G',
+ "\cH" => 'H',
+ "\cI" => 'I',
+ "\cJ" => 'J',
+ "\cK" => 'K',
+ "\cL" => 'L',
+ "\cM" => 'M',
+ "\cN" => 'N',
+ "\cO" => 'O',
+ "\cP" => 'P',
+ "\cQ" => 'Q',
+ "\cR" => 'R',
+ "\cS" => 'S',
+ "\cT" => 'T',
+ "\cU" => 'U',
+ "\cV" => 'V',
+ "\cW" => 'W',
+ "\cX" => 'X',
+ "\cY" => 'Y',
+ "\cZ" => 'Z',
+ "\c[" => '[', # unused
+ "\c\\" => '\\', # unused
+ "\c]" => ']', # unused
+ "\c_" => '_', # unused
);
# Return just the name, without the prefix. It may be returned as a quoted
my $name = $self->gv_name($gv, 1);
$name = $self->maybe_qualify($prefix,$name);
if ($name =~ /^(?:\S|(?!\d)[\ca-\cz]?(?:\w|::)*|\d+)\z/) {
- if ($name =~ s/^([\ca-\cz])/$unctrl{$1}/e) {
- $name =~ s/\\c/^/g;
- }
+ $name =~ s/^([\ca-\cz])/'^' . $unctrl{$1}/e;
$name =~ /^(\^..|{)/ and $name = "{$name}";
return $name, 0; # not quoted
}
$str =~ s/\e/\\e/g;
$str =~ s/\f/\\f/g;
$str =~ s/\r/\\r/g;
- $str =~ s/([\cA-\cZ])/$unctrl{$1}/ge;
+ $str =~ s/([\cA-\cZ])/'\\c' . $unctrl{$1}/ge;
$str =~ s/([[:^print:]])/sprintf("\\%03o", ord($1))/age;
return $str;
}
} elsif ($n == ord "\r") {
return '\\r';
} elsif ($n >= ord("\cA") and $n <= ord("\cZ")) {
- return unctrl{chr $n};
+ return '\\c' . unctrl{chr $n};
} else {
# return '\x' . sprintf("%02x", $n);
return '\\' . sprintf("%03o", $n);