common: decode utf8 path request

Support unicode input.

diff --git a/charset.plp b/charset.plp
index 4c01b78d0b6bb45717d7f7e7e35bce8f55d81bf5..fcd647da740540df7c085708b0ba751fca2ebf2c 100644 (file)
--- a/charset.plp
+++ b/charset.plp
@@ -24,7 +24,6 @@ my $glyphs = Shiar_Sheet::FormatChar->new;
 my @nibble = (0..9, 'A'..'F');
 my $nibsize = 1;
 
 my @nibble = (0..9, 'A'..'F');
 my $nibsize = 1;
 

-use Encode qw(decode resolve_alias);

 # generate character table(s)
 # (~16x faster than decoding in loop;
 #  substr strings is twice as fast as splitting to an array)
 # generate character table(s)
 # (~16x faster than decoding in loop;
 #  substr strings is twice as fast as splitting to an array)


@@ -71,7 +70,7 @@ my @request = map {
                        @nibble = (map { $_.0, $_.8 } 0 .. 7);
                        $nibsize = 8;
                }
                        @nibble = (map { $_.0, $_.8 } 0 .. 7);
                        $nibsize = 8;
                }

-               elsif ($row{set} = resolve_alias($input)) {
+               elsif ($row{set} = Encode::resolve_alias($input)) {

                        if ($row{set} eq 'Internal') {
                                $row{table} = ' ' x ($endpoint < 255 ? 640 : 8192);
                                $row{set} = 'Unicode BMP';
                        if ($row{set} eq 'Internal') {
                                $row{table} = ' ' x ($endpoint < 255 ? 640 : 8192);
                                $row{set} = 'Unicode BMP';


@@ -85,7 +84,7 @@ my @request = map {
                                        or printf "<p class=error>Table data could not be read: <em>%s</em>.</p>\n", $@ || $!;
                        }
                        else {
                                        or printf "<p class=error>Table data could not be read: <em>%s</em>.</p>\n", $@ || $!;
                        }
                        else {

-                               $row{table} = decode($row{set}, pack 'C*', $row{offset} .. $endpoint);
+                               $row{table} = Encode::decode($row{set}, pack 'C*', $row{offset} .. $endpoint);

                        }
                }
                else {
                        }
                }
                else {

diff --git a/common.inc.plp b/common.inc.plp
index 0a010d24170790cb592b18782c4787144129313f..81f91b5bc8dbd285777083dabdd232fdd17bcc4d 100644 (file)
--- a/common.inc.plp
+++ b/common.inc.plp
@@ -8,6 +8,7 @@ use open ':std' => ':utf8';
 
 use File::stat 'stat';
 use HTTP::Date;
 
 use File::stat 'stat';
 use HTTP::Date;

+use Encode qw( decode_utf8 );

 
 $PLP::ERROR = sub {
        my ($text, $html) = @_;
 
 $PLP::ERROR = sub {
        my ($text, $html) = @_;


@@ -23,7 +24,7 @@ BEGIN {
 # user request
 our $Dev = $ENV{HTTP_HOST} =~ /\bdev\./;
 our ($file) = $ENV{SCRIPT_FILENAME} =~ m{ ([^/]+) \.plp$ }x;
 # user request
 our $Dev = $ENV{HTTP_HOST} =~ /\bdev\./;
 our ($file) = $ENV{SCRIPT_FILENAME} =~ m{ ([^/]+) \.plp$ }x;

-our $Request = $ENV{PATH_INFO} =~ s{^/}{}r;
+our $Request = decode_utf8($ENV{PATH_INFO} =~ s{^/}{}r);

 
 our $style;
 our $showkeys = !exists $get{keys} ? undef :
 
 our $style;
 our $showkeys = !exists $get{keys} ? undef :

diff --git a/source.plp b/source.plp
index 38af1faa1bcd21245b287831c060c22252136b71..56193fb95853a7a47a5ab98e18203fdfa9d82ffc 100644 (file)
--- a/source.plp
+++ b/source.plp
@@ -67,7 +67,6 @@ else {
        }
        -r $source or die "Requested file not found\n";
 
        }
        -r $source or die "Requested file not found\n";
 

-       require Encode;

        if (eval { require Text::VimColor and Text::VimColor->VERSION(0.12) }) {
                delete $Text::VimColor::SYNTAX_TYPE{Underlined};
                my %TYPETAG = (
        if (eval { require Text::VimColor and Text::VimColor->VERSION(0.12) }) {
                delete $Text::VimColor::SYNTAX_TYPE{Underlined};
                my %TYPETAG = (


@@ -84,7 +83,7 @@ else {
                say '<pre>';
                foreach (@$parsed) {
                        my ($type, $contents) = @{$_};
                say '<pre>';
                foreach (@$parsed) {
                        my ($type, $contents) = @{$_};

-                       $contents = Encode::decode_utf8($contents);
+                       $contents = decode_utf8($contents);

                        my $tag = $type && ($TYPETAG{$type} || 'span');
                        my $arg = '';
                        print "<$tag$arg class=\"sy-\l$type\">" if $tag;
                        my $tag = $type && ($TYPETAG{$type} || 'span');
                        my $arg = '';
                        print "<$tag$arg class=\"sy-\l$type\">" if $tag;


@@ -109,7 +108,7 @@ else {
        }
        else {
                say '<pre>';
        }
        else {
                say '<pre>';

-               print EscapeHTML(Encode::decode_utf8(ReadFile($source)));
+               print EscapeHTML(decode_utf8(ReadFile($source)));

                say '</pre>';
        }
 
                say '</pre>';
        }