my $string = shift;
$Opt{P} and print "#!$^X -w\nprint\n";
unless ($string){
- while(<>){
- use utf8;
- $linebuf .= Encode::decode($Opt{f}, $_);
- while($linebuf){
- my $chr = render_p(substr($linebuf, 0, 1, ''));
- length($outbuf) + length($chr) > $CPL and print_P();
- $outbuf .= $chr;
- }
- }
- $outbuf and print print_P(";");
+ while(<>){
+ use utf8;
+ $linebuf .= Encode::decode($Opt{f}, $_);
+ while($linebuf){
+ my $chr = render_p(substr($linebuf, 0, 1, ''));
+ length($outbuf) + length($chr) > $CPL and print_P();
+ $outbuf .= $chr;
+ }
+ }
+ $outbuf and print print_P(";");
}else{
- while($string){
- my $chr = render_p(substr($string, 0, 1, ''));
- length($outbuf) + length($chr) > $CPL and print_P();
- $outbuf .= $chr;
- }
+ while($string){
+ my $chr = render_p(substr($string, 0, 1, ''));
+ length($outbuf) + length($chr) > $CPL and print_P();
+ $outbuf .= $chr;
+ }
}
$outbuf and print print_P(";");
exit;
$S2pstr{$chr} and return $S2pstr{$chr}; # \t\n...
$chr =~ /[\x20-\x7e]/ and return $chr; # ascii, printable;
my $fmt = ($chr =~ /[\x00-\x1f\x7F]/) ?
- q(\x%x) : q(\x{%x});
+ q(\x%x) : q(\x{%x});
return sprintf $fmt, ord($chr);
}
my $string = shift;
!$Opt{p} and exists $Opt{H} and print_H();
unless ($string){
- while(<>){
- use utf8;
- $linebuf .= Encode::decode($Opt{f}, $_);
- while (length($linebuf) > $CPL){
- my $chunk = substr($linebuf, 0, $CPL, '');
- print_C($chunk, $linenum++);
- $Opt{H} and $linenum % $Opt{H} == $CPL-1 and print_S();
- }
- }
- $linebuf and print_C($linebuf);
+ while(<>){
+ use utf8;
+ $linebuf .= Encode::decode($Opt{f}, $_);
+ while (length($linebuf) > $CPL){
+ my $chunk = substr($linebuf, 0, $CPL, '');
+ print_C($chunk, $linenum++);
+ $Opt{H} and $linenum % $Opt{H} == $CPL-1 and print_S();
+ }
+ }
+ $linebuf and print_C($linebuf);
}else{
- while ($string){
- my $chunk = substr($string, 0, $CPL, '');
- print_C($chunk, $linenum++);
- $Opt{H} and $linenum % $Opt{H} == $CPL-1 and print_S();
- }
+ while ($string){
+ my $chunk = substr($string, 0, $CPL, '');
+ print_C($chunk, $linenum++);
+ $Opt{H} and $linenum % $Opt{H} == $CPL-1 and print_S();
+ }
}
exit;
}
sub print_S{
print "--------+------------------------------------------------";
if ($Opt{C}){
- print "-+-----------------";
+ print "-+-----------------";
}
print "\n";
}
sub print_H{
print " Offset 0 1 2 3 4 5 6 7";
if ($Opt{C}){
- print " | 0 1 2 3 4 5 6 7";
+ print " | 0 1 2 3 4 5 6 7";
}
print "\n";
print_S;
sub print_C{
my ($chunk, $linenum) = @_;
if (!$Opt{v} and $chunk eq $PrevChunk){
- printf "%08x *\n", $linenum*8; return;
+ printf "%08x *\n", $linenum*8; return;
}
$PrevChunk = $chunk;
my $end = length($chunk) - 1;
my (@ord, @chr);
for my $i (0..$end){
- use utf8;
- my $chr = substr($chunk,$i,1);
- my $ord = ord($chr);
- my $fmt = $ord <= 0xffff ? " %04x" : " %05x";
- push @ord, (sprintf $fmt, $ord);
- $Opt{C} and push @chr, render_c($chr);
+ use utf8;
+ my $chr = substr($chunk,$i,1);
+ my $ord = ord($chr);
+ my $fmt = $ord <= 0xffff ? " %04x" : " %05x";
+ push @ord, (sprintf $fmt, $ord);
+ $Opt{C} and push @chr, render_c($chr);
}
if (++$end < 7){
- for my $i ($end..7){
- push @ord, (" " x 6);
- }
+ for my $i ($end..7){
+ push @ord, (" " x 6);
+ }
}
my $line = sprintf "%08x %s", $linenum*8, join('', @ord);
$Opt{C} and $line .= sprintf " | %s", join('', @chr);
BEGIN{
our %S2pstr= (
- "\\" => '\\\\',
- "\0" => '\0',
- "\t" => '\t',
- "\n" => '\n',
- "\r" => '\r',
- "\v" => '\v',
- "\a" => '\a',
- "\e" => '\e',
- "\"" => qq(\\\"),
- "\'" => qq(\\\'),
- '$' => '\$',
- "@" => '\@',
- "%" => '\%',
- );
+ "\\" => '\\\\',
+ "\0" => '\0',
+ "\t" => '\t',
+ "\n" => '\n',
+ "\r" => '\r',
+ "\v" => '\v',
+ "\a" => '\a',
+ "\e" => '\e',
+ "\"" => qq(\\\"),
+ "\'" => qq(\\\'),
+ '$' => '\$',
+ "@" => '\@',
+ "%" => '\%',
+ );
our %S2str = (
- qq(\x00) => q(\0), # NULL
- qq(\x01) => q(^A), # START OF HEADING
- qq(\x02) => q(^B), # START OF TEXT
- qq(\x03) => q(^C), # END OF TEXT
- qq(\x04) => q(^D), # END OF TRANSMISSION
- qq(\x05) => q(^E), # ENQUIRY
- qq(\x06) => q(^F), # ACKNOWLEDGE
- qq(\x07) => q(\a), # BELL
- qq(\x08) => q(^H), # BACKSPACE
- qq(\x09) => q(\t), # HORIZONTAL TABULATION
- qq(\x0A) => q(\n), # LINE FEED
- qq(\x0B) => q(\v), # VERTICAL TABULATION
- qq(\x0C) => q(^L), # FORM FEED
- qq(\x0D) => q(\r), # CARRIAGE RETURN
- qq(\x0E) => q(^N), # SHIFT OUT
- qq(\x0F) => q(^O), # SHIFT IN
- qq(\x10) => q(^P), # DATA LINK ESCAPE
- qq(\x11) => q(^Q), # DEVICE CONTROL ONE
- qq(\x12) => q(^R), # DEVICE CONTROL TWO
- qq(\x13) => q(^S), # DEVICE CONTROL THREE
- qq(\x14) => q(^T), # DEVICE CONTROL FOUR
- qq(\x15) => q(^U), # NEGATIVE ACKNOWLEDGE
- qq(\x16) => q(^V), # SYNCHRONOUS IDLE
- qq(\x17) => q(^W), # END OF TRANSMISSION BLOCK
- qq(\x18) => q(^X), # CANCEL
- qq(\x19) => q(^Y), # END OF MEDIUM
- qq(\x1A) => q(^Z), # SUBSTITUTE
- qq(\x1B) => q(\e), # ESCAPE (\c[)
- qq(\x1C) => "^\\", # FILE SEPARATOR
- qq(\x1D) => "^\]", # GROUP SEPARATOR
- qq(\x1E) => q(^^), # RECORD SEPARATOR
- qq(\x1F) => q(^_), # UNIT SEPARATOR
- );
+ qq(\x00) => q(\0), # NULL
+ qq(\x01) => q(^A), # START OF HEADING
+ qq(\x02) => q(^B), # START OF TEXT
+ qq(\x03) => q(^C), # END OF TEXT
+ qq(\x04) => q(^D), # END OF TRANSMISSION
+ qq(\x05) => q(^E), # ENQUIRY
+ qq(\x06) => q(^F), # ACKNOWLEDGE
+ qq(\x07) => q(\a), # BELL
+ qq(\x08) => q(^H), # BACKSPACE
+ qq(\x09) => q(\t), # HORIZONTAL TABULATION
+ qq(\x0A) => q(\n), # LINE FEED
+ qq(\x0B) => q(\v), # VERTICAL TABULATION
+ qq(\x0C) => q(^L), # FORM FEED
+ qq(\x0D) => q(\r), # CARRIAGE RETURN
+ qq(\x0E) => q(^N), # SHIFT OUT
+ qq(\x0F) => q(^O), # SHIFT IN
+ qq(\x10) => q(^P), # DATA LINK ESCAPE
+ qq(\x11) => q(^Q), # DEVICE CONTROL ONE
+ qq(\x12) => q(^R), # DEVICE CONTROL TWO
+ qq(\x13) => q(^S), # DEVICE CONTROL THREE
+ qq(\x14) => q(^T), # DEVICE CONTROL FOUR
+ qq(\x15) => q(^U), # NEGATIVE ACKNOWLEDGE
+ qq(\x16) => q(^V), # SYNCHRONOUS IDLE
+ qq(\x17) => q(^W), # END OF TRANSMISSION BLOCK
+ qq(\x18) => q(^X), # CANCEL
+ qq(\x19) => q(^Y), # END OF MEDIUM
+ qq(\x1A) => q(^Z), # SUBSTITUTE
+ qq(\x1B) => q(\e), # ESCAPE (\c[)
+ qq(\x1C) => "^\\", # FILE SEPARATOR
+ qq(\x1D) => "^\]", # GROUP SEPARATOR
+ qq(\x1E) => q(^^), # RECORD SEPARATOR
+ qq(\x1F) => q(^_), # UNIT SEPARATOR
+ );
#
# Generated out of lib/unicore/EastAsianWidth.txt
# will it work ?
#
our $IsFullWidth =
- qr/^[
- \x{1100}-\x{1159}
- \x{115F}-\x{115F}
- \x{2329}-\x{232A}
- \x{2E80}-\x{2E99}
- \x{2E9B}-\x{2EF3}
- \x{2F00}-\x{2FD5}
- \x{2FF0}-\x{2FFB}
- \x{3000}-\x{303E}
- \x{3041}-\x{3096}
- \x{3099}-\x{30FF}
- \x{3105}-\x{312C}
- \x{3131}-\x{318E}
- \x{3190}-\x{31B7}
- \x{31F0}-\x{321C}
- \x{3220}-\x{3243}
- \x{3251}-\x{327B}
- \x{327F}-\x{32CB}
- \x{32D0}-\x{32FE}
- \x{3300}-\x{3376}
- \x{337B}-\x{33DD}
- \x{3400}-\x{4DB5}
- \x{4E00}-\x{9FA5}
- \x{33E0}-\x{33FE}
- \x{A000}-\x{A48C}
- \x{AC00}-\x{D7A3}
- \x{A490}-\x{A4C6}
- \x{F900}-\x{FA2D}
- \x{FA30}-\x{FA6A}
- \x{FE30}-\x{FE46}
- \x{FE49}-\x{FE52}
- \x{FE54}-\x{FE66}
- \x{FE68}-\x{FE6B}
- \x{FF01}-\x{FF60}
- \x{FFE0}-\x{FFE6}
- \x{20000}-\x{2A6D6}
- ]$/xo;
+ qr/^[
+ \x{1100}-\x{1159}
+ \x{115F}-\x{115F}
+ \x{2329}-\x{232A}
+ \x{2E80}-\x{2E99}
+ \x{2E9B}-\x{2EF3}
+ \x{2F00}-\x{2FD5}
+ \x{2FF0}-\x{2FFB}
+ \x{3000}-\x{303E}
+ \x{3041}-\x{3096}
+ \x{3099}-\x{30FF}
+ \x{3105}-\x{312C}
+ \x{3131}-\x{318E}
+ \x{3190}-\x{31B7}
+ \x{31F0}-\x{321C}
+ \x{3220}-\x{3243}
+ \x{3251}-\x{327B}
+ \x{327F}-\x{32CB}
+ \x{32D0}-\x{32FE}
+ \x{3300}-\x{3376}
+ \x{337B}-\x{33DD}
+ \x{3400}-\x{4DB5}
+ \x{4E00}-\x{9FA5}
+ \x{33E0}-\x{33FE}
+ \x{A000}-\x{A48C}
+ \x{AC00}-\x{D7A3}
+ \x{A490}-\x{A4C6}
+ \x{F900}-\x{FA2D}
+ \x{FA30}-\x{FA6A}
+ \x{FE30}-\x{FE46}
+ \x{FE49}-\x{FE52}
+ \x{FE54}-\x{FE66}
+ \x{FE68}-\x{FE6B}
+ \x{FF01}-\x{FF60}
+ \x{FFE0}-\x{FFE6}
+ \x{20000}-\x{2A6D6}
+ ]$/xo;
}
__END__
projects / p5sagit/p5-mst-13.2.git / blobdiff