/[suikacvs]/webroot/regexp/lib/Regexp/Parser/JavaScript.pm
Suika

Diff of /webroot/regexp/lib/Regexp/Parser/JavaScript.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wakaba, Mon Dec 8 12:21:26 2008 UTC revision 1.3 by wakaba, Sun Mar 8 14:30:51 2009 UTC
# Line 1  Line 1 
1  package Regexp::Parser::JavaScript;  package Regexp::Parser::JavaScript;
2    our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
3  use strict;  use strict;
4  use warnings;  use warnings;
5    
# Line 6  use Regexp::Parser::Perl58; Line 7  use Regexp::Parser::Perl58;
7  use Regexp::Parser qw(:original :RPe);  use Regexp::Parser qw(:original :RPe);
8  push our @ISA, 'Regexp::Parser::Perl58';  push our @ISA, 'Regexp::Parser::Perl58';
9    
10    use constant RPJSe_OCTESC => 80130, 'Octal escape is obsolete';
11    
12    my $IdentifierStart = qr/[
13                              ## UnicodeLetter
14                              \p{Lu}\p{Ll}\p{Lt}\p{Lm}\p{Lo}\p{Nl}
15    
16                              $ _
17                             ]/x;
18    
19  sub init ($) {  sub init ($) {
20    my $self = shift;    my $self = shift;
21    $self->SUPER::init;    $self->SUPER::init;
22    
23      $self->{enum_to_level}->{[RPe_BADESC]->[0]} = 'm';
24      $self->{enum_to_level}->{[RPe_BGROUP]->[0]} = 'm';
25      $self->{enum_to_level}->{[RPJSe_OCTESC]->[0]} = 'm';
26      $self->{enum_to_level}->{[RPe_FRANGE]->[0]} = 'm';
27    
28    $self->del_handler (qw/    $self->del_handler (qw/
29                           \a \e \A \C \G \N \P \p \X \Z \z                           \a \e \A \C \G \N \P \p \X \Z \z
30                           (?# (?$ (?@ (?< (?> (?{ (?? (?p (?(                           (?# (?$ (?@ (?< (?> (?{ (?? (?p (?(
# Line 43  sub init ($) { Line 58  sub init ($) {
58    
59        return $S->$c($cc) if $S->can($c);        return $S->$c($cc) if $S->can($c);
60    
61          my $family = $cc ? 'anyof_char' : 'exact';
62    
63        if ($n =~ /\d/) {        if ($n =~ /\d/) {
64          ## See <http://suika.fam.cx/%7Ewakaba/wiki/sw/n/%E5%85%AB%E9%80%B2%E3%82%A8%E3%82%B9%E3%82%B1%E3%83%BC%E3%83%97>.          ## See <http://suika.fam.cx/%7Ewakaba/wiki/sw/n/%E5%85%AB%E9%80%B2%E3%82%A8%E3%82%B9%E3%82%B1%E3%83%BC%E3%83%97>.
65    
# Line 60  sub init ($) { Line 77  sub init ($) {
77            }            }
78          }          }
79          if ($n =~ /^[89]/) {          if ($n =~ /^[89]/) {
80            ## TODO: warning            $S->warn(RPe_BGROUP);
81            return $S->object(exact => chr 0x30 + $n,            return $S->object($family => chr 0x30 + $n,
82                              sprintf("\\x%02x", 0x30 + $n));                              sprintf("\\x%02x", 0x30 + $n));
83          }          }
84    
85          ## TODO: warning          if ($n eq '0') {
86          return $S->object(exact => chr oct $n, sprintf("\\%03s", $n));            #
87            } elsif ($n =~ /^0/ or $cc) {
88              $S->warn(RPJSe_OCTESC);
89            } elsif ($n > $S->{maxpar}) {
90              $S->warn(RPe_BGROUP);
91            }
92            return $S->object($family => chr oct $n, sprintf("\\%03s", $n));
93        }        }
94    
95        $S->warn(RPe_BADESC, $c = $n, "") if $n =~ /[a-zA-Z]/;        $S->warn(RPe_BADESC, $c = $n, "") if $n =~ /$IdentifierStart/o;
96    
97        return $S->object(exact => $n, $c);        return $S->object($family => $n, $c);
98      }      }
99    
100      $S->error(RPe_ESLASH);      $S->error(RPe_ESLASH);
# Line 80  sub init ($) { Line 103  sub init ($) {
103    # control character    # control character
104    $self->add_handler('\c' => sub {    $self->add_handler('\c' => sub {
105      my ($S, $cc) = @_;      my ($S, $cc) = @_;
106      ${&Rx} =~ m{ \G (.?) }xgc;      ## See <http://suika.fam.cx/%7Ewakaba/wiki/sw/n/%5Cc>.
107  ## TODO: error unless [A-Za-z]      if (${&Rx} =~ m{ \G ([A-Za-z]) }xgc) {
108      my $c = $1;        my $c = $1;
109      return $S->force_object(anyof_char => chr(64 ^ ord $c), "\\c$c") if $cc;        $c =~ tr/a-z/A-Z/;
110      return $S->object(exact => chr(64 ^ ord $c), "\\c$c");        return $S->force_object(anyof_char => chr(64 ^ ord $c), "\\c$c") if $cc;
111          return $S->object(exact => chr(64 ^ ord $c), "\\c$c");
112        } else {
113          my $c = 'c';
114          $S->warn(RPe_BADESC, $c, "");
115          return $S->object(($cc ? 'anyof_char' : 'exact') => $c, $c);
116        }
117    });    });
118    
119    # hex character    # hex character
# Line 96  sub init ($) { Line 125  sub init ($) {
125        $num = hex $1;        $num = hex $1;
126      } else {      } else {
127        $num = ord 'x';        $num = ord 'x';
128          $S->warn(RPe_BADESC, 'x', "");
129      }      }
130    
131      my $rep = sprintf("\\x%02X", $num);      my $rep = sprintf("\\x%02X", $num);
# Line 112  sub init ($) { Line 142  sub init ($) {
142        $num = hex $1;        $num = hex $1;
143      } else {      } else {
144        $num = ord 'u';        $num = ord 'u';
145          $S->warn(RPe_BADESC, 'u', "");
146      }      }
147            
148      my $rep = sprintf("\\u%04X", $num);      my $rep = sprintf("\\u%04X", $num);
# Line 206  sub init ($) { Line 237  sub init ($) {
237  } # init  } # init
238    
239  1;  1;
240    
241    __END__
242    
243    =head1 LICENSE
244    
245    Copyright 2008-2009 Wakaba <w@suika.fam.cx>.
246    
247    This library is free software; you can redistribute it and/or modify
248    it under the same terms as Perl itself.
249    
250    =cut
251    
252    # $Date$
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24