6 my %Opt; getopts("ChH:e:f:t:s:pPv", \%Opt);
13 my ($linebuf, $outbuf);
14 my $CPL = $Opt{p} ? 64 : 8;
16 my $linesperheading = $Opt{H};
21 $Opt{p} and do_perl($Opt{s});
29 $Opt{P} and print "#!$^X -w\nprint\n";
33 $linebuf .= Encode::decode($Opt{f}, $_);
35 my $chr = render_p(substr($linebuf, 0, 1));
36 substr($linebuf, 0, 1) = '';
37 length($outbuf) + length($chr) > $CPL and print_P();
41 $outbuf and print print_P(";");
44 my $chr = render_p(substr($string, 0, 1));
45 substr($string, 0, 1) = '';
46 length($outbuf) + length($chr) > $CPL and print_P();
50 $outbuf and print print_P(";");
55 my ($chr, $format) = @_;
57 $S2pstr{$chr} and return $S2pstr{$chr}; # \t\n...
58 $chr =~ /[\x20-\x7e]/ and return $chr; # ascii, printable;
59 my $fmt = ($chr =~ /[\x00-\x1f\x7F]/) ?
61 return sprintf $fmt, ord($chr);
67 print '"', encode($Opt{t}, $outbuf), '"';
68 my $tail = $Opt{P} ? $end ? "$end" : "," : '';
75 !$Opt{p} and exists $Opt{H} and print_H();
79 $linebuf .= Encode::decode($Opt{f}, $_);
80 while (length($linebuf) > $CPL){
81 my $chunk = substr($linebuf, 0, $CPL);
82 print_C($chunk, $linenum++);
83 substr($linebuf, 0, $CPL) = '';
84 $Opt{H} and $linenum % $Opt{H} == $CPL-1 and print_S();
87 $linebuf and print_C($linebuf);
90 my $chunk = substr($string, 0, $CPL);
91 print_C($chunk, $linenum++);
92 substr($string,0, $CPL) = '';
93 $Opt{H} and $linenum % $Opt{H} == $CPL-1 and print_S();
100 print "--------+------------------------------------------------";
102 print "-+-----------------";
107 print " Offset 0 1 2 3 4 5 6 7";
109 print " | 0 1 2 3 4 5 6 7";
116 my ($chunk, $linenum) = @_;
117 if (!$Opt{v} and $chunk eq $PrevChunk){
118 printf "%08x *\n", $linenum*8; return;
121 my $end = length($chunk) - 1;
125 my $chr = substr($chunk,$i,1);
127 my $fmt = $ord <= 0xffff ? " %04x" : " %05x";
128 push @ord, (sprintf $fmt, $ord);
129 $Opt{C} and push @chr, render_c($chr);
133 push @ord, (" " x 6);
136 my $line = sprintf "%08x %s", $linenum*8, join('', @ord);
137 $Opt{C} and $line .= sprintf " | %s", join('', @chr);
138 print encode($Opt{t}, $line), "\n";
142 my ($chr, $format) = @_;
143 our (%S2str, $IsFullWidth);
144 $chr =~ /[\p{IsControl}\s]/o and return $S2str{$chr} || " ";
145 $chr =~ $IsFullWidth and return $chr; # as is
152 my $name = basename($0);
153 $message and print STDERR "$name error: $message\n";
154 print STDERR <<"EOT";
156 $name -[options...] [files...]
157 $name -[options...] -s "string"
159 -h prints this message.
160 Inherited from hexdump;
161 -C Canonical unidump mode
162 -v prints the duplicate line as is. Without this option,
163 single "*" will be printed instead.
165 -p prints in perl literals that you can copy and paste directly
167 -P prints in perl executable format!
168 -u prints a bunch of "Uxxxx,". Handy when you want to pass your
169 characters in mailing lists.
171 -e io_encoding same as "-f io_encoding -t io_encoding"
172 -f from_encoding convert the source stream from this encoding
173 -t to_encoding print to STDOUT in this encoding
174 -s string "string" will be converted instead of STDIN.
175 -H nline prints separater for each nlines of output.
176 0 means only the table headding be printed.
199 qq(\x00) => q(\0), # NULL
200 qq(\x01) => q(^A), # START OF HEADING
201 qq(\x02) => q(^B), # START OF TEXT
202 qq(\x03) => q(^C), # END OF TEXT
203 qq(\x04) => q(^D), # END OF TRANSMISSION
204 qq(\x05) => q(^E), # ENQUIRY
205 qq(\x06) => q(^F), # ACKNOWLEDGE
206 qq(\x07) => q(\a), # BELL
207 qq(\x08) => q(^H), # BACKSPACE
208 qq(\x09) => q(\t), # HORIZONTAL TABULATION
209 qq(\x0A) => q(\n), # LINE FEED
210 qq(\x0B) => q(\v), # VERTICAL TABULATION
211 qq(\x0C) => q(^L), # FORM FEED
212 qq(\x0D) => q(\r), # CARRIAGE RETURN
213 qq(\x0E) => q(^N), # SHIFT OUT
214 qq(\x0F) => q(^O), # SHIFT IN
215 qq(\x10) => q(^P), # DATA LINK ESCAPE
216 qq(\x11) => q(^Q), # DEVICE CONTROL ONE
217 qq(\x12) => q(^R), # DEVICE CONTROL TWO
218 qq(\x13) => q(^S), # DEVICE CONTROL THREE
219 qq(\x14) => q(^T), # DEVICE CONTROL FOUR
220 qq(\x15) => q(^U), # NEGATIVE ACKNOWLEDGE
221 qq(\x16) => q(^V), # SYNCHRONOUS IDLE
222 qq(\x17) => q(^W), # END OF TRANSMISSION BLOCK
223 qq(\x18) => q(^X), # CANCEL
224 qq(\x19) => q(^Y), # END OF MEDIUM
225 qq(\x1A) => q(^Z), # SUBSTITUTE
226 qq(\x1B) => q(\e), # ESCAPE (\c[)
227 qq(\x1C) => "^\\", # FILE SEPARATOR
228 qq(\x1D) => "^\]", # GROUP SEPARATOR
229 qq(\x1E) => q(^^), # RECORD SEPARATOR
230 qq(\x1F) => q(^_), # UNIT SEPARATOR
233 # Generated out of lib/unicore/EastAsianWidth.txt