Changeset 21418 for perl5

Timestamp:

07/20/08 20:38:43 (4 months ago)

Author:

fglock

Message:

[PCR] unicode fixes

Location:

perl5/Pugs-Compiler-Rule

Files:

• Changes (modified) (1 diff)
• lib/Pugs/Compiler/Rule.pm (modified) (1 diff)
• lib/Pugs/Emitter/Rule/Perl5.pm (modified) (1 diff)
• lib/Pugs/Emitter/Rule/Perl5/CharClass.pm (modified) (5 diffs)

perl5/Pugs-Compiler-Rule/Changes

@@ +1 @@
+0.31  2008-07-21
+- unicode fixes
+
 0.30  2008-07-20
 - fixed char class with spaces

perl5/Pugs-Compiler-Rule/lib/Pugs/Compiler/Rule.pm

@@ -5 +5 @@
 package Pugs::Compiler::Rule;
 
-our $VERSION = '0.30';
+our $VERSION = '0.31';
 
 use base 'Pugs::Compiler::Regex';

perl5/Pugs-Compiler-Rule/lib/Pugs/Emitter/Rule/Perl5.pm

@@ -296 +296 @@
 sub special_char {
     my ($char, $data) = $_[0] =~ /^.(.)(.*)/;
+    $_[1] = '' unless defined $_[1];
 
     return  "$_[1] perl5( '\\N{" . join( "}\\N{", split( /\s*;\s*/, $data ) ) . "}' )\n"

perl5/Pugs-Compiler-Rule/lib/Pugs/Emitter/Rule/Perl5/CharClass.pm

@@ -2 +2 @@
 
 use strict;
+use charnames ();
 use Data::Dumper;
 
@@ -12 +13 @@
         word  xdigit
     );
+}
+
+sub vianame {
+    my $c = shift;
+    my $s = charnames::vianame($c);
+    return $s if $s;
+    $s = charnames::vianame("LINE FEED (LF)") 
+        if $c eq "LINE FEED" || $c eq "LF";
+    return $s if $s;
+    $s = charnames::vianame("CARRIAGE RETURN (CR)") 
+        if $c eq "CARRIAGE RETURN" || $c eq "CR";
+    return $s if $s;
+    $s = charnames::vianame("FORM FEED (FF)")  
+        if $c eq "FORM FEED" || $c eq "FF";
+    return $s if $s;
+    $s = charnames::vianame("NEXT LINE (NEL)") 
+        if $c eq "NEXT LINE" || $c eq "NEL";
+    return $s if $s;
 }
 
@@ -33 +52 @@
         my ( $op, $cmd ) = /(.)(.*)/;
 
-        $cmd =~ s/\s//g
-            unless $cmd =~ /\\c\[/;
-
-        #if ( $last_cmd eq '-'
-        #    && substr($cmd,0,1) eq '+'
-        #    )
-        #{
-        #    $out .= '|';
-        #}
-        #$last_cmd = substr($cmd,0,1);
-
+        $cmd =~ s/ \\c\[ ([^];]+) \; ([^];]+) \] / 
+                "\\x{" . sprintf("%02X", vianame($1)) . "}"
+              . "\\x{" . sprintf("%02X", vianame($2)) . "}"
+            /xgme;
+        $cmd =~ s/ \\c\[ ([^]]+) \] / "\\x[" . sprintf("%02X", vianame($1)) . ']' /xgme;
+        $cmd =~ s/ \\C\[ ([^]]+) \] / "\\X[" . sprintf("%02X", vianame($1)) . ']' /xgme;
+        $cmd =~ s/ \\o\[ ([^]]+) \] / "\\x[" . sprintf("%02X", oct($1)) . ']' /xgme;
+        $cmd =~ s/ \\O\[ ([^]]+) \] / "\\X[" . sprintf("%02X", oct($1)) . ']' /xgme;
+        $cmd =~ s/\s//g;
+        
         $cmd =~ s/\.\./-/g;  # ranges
 
-        # TODO - \o \O
-
-        if    ( $cmd =~ /^ \[ \\ c \[ (.*) \] \] /x ) {
-            #$cmd = "(?:\\N{" . join( "}|\\N{", split( /\s*;\s*/, $1 ) ) . "})";
-            $cmd = "[\\N{" . join( "}\\N{", split( /\s*;\s*/, $1 ) ) . "}]";
-        }
-        elsif ( $cmd =~ /^ \[ \\ C \[ (.*) \] \] /x ) {
-            #$cmd = "(?!\\N{" . join( "}|\\N{", split( /\s*;\s*/, $1 ) ) . "})\\X";
-            $cmd = "[^\\N{" . join( "}\\N{", split( /\s*;\s*/, $1 ) ) . "}]";
-        }
-
-
-        elsif ( $cmd =~ /^ \[ \\ x \[ (.*) \] \] /x ) {
+        if ( $cmd =~ /^ \[ \\ x \[ (.*) \] \] /x ) {
             $cmd = "(?:\\x{$1})";
         }
@@ -65 +71 @@
             #$cmd = "[^\\x{$1}]";
         }
-
 
         elsif ( $cmd =~ /^ \s* \[ (.*) /x ) {
@@ -93 +98 @@
     $out = "(?:$out)\\X";
 
-    #print Dumper( @c ), ' == ', $out, "\n";
+    #print Dumper( \@c ), ' == ', $out, "\n";
 
     return $out;