Whatpm/CSS/Parser.pm

package Whatpm::CSS::Parser;
use strict;
use Whatpm::CSS::Tokenizer qw(:token);
require Whatpm::CSS::SelectorsParser;

sub new ($) {
  my $self = bless {onerror => sub { }, must_level => 'm',
                    message_level => 'w',
                    unsupported_level => 'unsupported'}, shift;
  # $self->{base_uri}
  # $self->{unitless_px} = 1/0

  return $self;
} # new

sub BEFORE_STATEMENT_STATE () { 0 }
sub BEFORE_DECLARATION_STATE () { 1 }
sub IGNORED_STATEMENT_STATE () { 2 }
sub IGNORED_DECLARATION_STATE () { 3 }

our $Prop; ## By CSS property name
our $Attr; ## By CSSOM attribute name
our $Key; ## By internal key

sub parse_char_string ($$) {
  my $self = $_[0];

  my $s = $_[1];
  pos ($s) = 0;
  my $line = 1;
  my $column = 0;

  my $_onerror = $self->{onerror};
  my $onerror = sub {
    $_onerror->(@_, line => $line, column => $column);
  };
  
  my $tt = Whatpm::CSS::Tokenizer->new;
  $tt->{onerror} = $onerror;
  $tt->{get_char} = sub {
    if (pos $s < length $s) {
      my $c = ord substr $s, pos ($s)++, 1;
      if ($c == 0x000A) {
        $line++;
        $column = 0;
      } elsif ($c == 0x000D) {
        unless (substr ($s, pos ($s), 1) eq "\x0A") {
          $line++;
          $column = 0;
        } else {
          $column++;
        }
      } else {
        $column++;
      }
      return $c;
    } else {
      return -1;
    }
  }; # $tt->{get_char}
  $tt->init;

  my $sp = Whatpm::CSS::SelectorsParser->new;
  $sp->{onerror} = $onerror;
  $sp->{must_level} = $self->{must_level};
  $sp->{pseudo_element} = $self->{pseudo_element};
  $sp->{pseudo_class} = $self->{pseudo_class};

  my $nsmap = {};
  $sp->{lookup_namespace_uri} = sub {
    return $nsmap->{$_[0]}; # $_[0] is '' (default namespace) or prefix
  }; # $sp->{lookup_namespace_uri}

  ## TODO: Supported pseudo classes and elements...

  require Message::DOM::CSSStyleSheet;
  require Message::DOM::CSSRule;
  require Message::DOM::CSSStyleDeclaration;

  $self->{base_uri} = $self->{href} unless defined $self->{base_uri};

  my $state = BEFORE_STATEMENT_STATE;
  my $t = $tt->get_next_token;

  my $open_rules = [[]];
  my $current_rules = $open_rules->[-1];
  my $current_decls;
  my $closing_tokens = [];
  my $charset_allowed = 1;
  my $namespace_allowed = 1;

  S: {
    if ($state == BEFORE_STATEMENT_STATE) {
      $t = $tt->get_next_token
          while $t->{type} == S_TOKEN or
              $t->{type} == CDO_TOKEN or
              $t->{type} == CDC_TOKEN;

      if ($t->{type} == ATKEYWORD_TOKEN) {
        if (lc $t->{value} eq 'namespace') { ## TODO: case folding
          $t = $tt->get_next_token;
          $t = $tt->get_next_token while $t->{type} == S_TOKEN;

          my $prefix;
          if ($t->{type} == IDENT_TOKEN) {
            $prefix = lc $t->{value};
            ## TODO: Unicode lowercase
            
            $t = $tt->get_next_token;
            $t = $tt->get_next_token while $t->{type} == S_TOKEN;
          }

          if ($t->{type} == STRING_TOKEN or $t->{type} == URI_TOKEN) {
            my $uri = $t->{value};
            
            $t = $tt->get_next_token;
            $t = $tt->get_next_token while $t->{type} == S_TOKEN;

            ## ISSUE: On handling of empty namespace URI, Firefox 2 and
            ## Opera 9 work differently (See SuikaWiki:namespace).
            ## TODO: We need to check what we do once it is specced.

            if ($t->{type} == SEMICOLON_TOKEN) {
              if ($namespace_allowed) {
                $nsmap->{defined $prefix ? $prefix : ''} = $uri;
                push @$current_rules,
                    Message::DOM::CSSNamespaceRule->____new ($prefix, $uri);
                undef $charset_allowed;
              } else {
                $onerror->(type => 'at:namespace:not allowed',
                           level => $self->{must_level},
                           token => $t);
              }
              
              $t = $tt->get_next_token;
              ## Stay in the state.
              redo S;
            } else {
              #
            }
          } else {
            #
          }

          $onerror->(type => 'syntax error:at:namespace',
                     level => $self->{must_level},
                     token => $t);
          #
        } elsif (lc $t->{value} eq 'charset') { ## TODO: case folding
          $t = $tt->get_next_token;
          $t = $tt->get_next_token while $t->{type} == S_TOKEN;

          if ($t->{type} == STRING_TOKEN) {
            my $encoding = $t->{value};
            
            $t = $tt->get_next_token;
            $t = $tt->get_next_token while $t->{type} == S_TOKEN;
            
            if ($t->{type} == SEMICOLON_TOKEN) {
              if ($charset_allowed) {
                push @$current_rules,
                    Message::DOM::CSSCharsetRule->____new ($encoding);
                undef $charset_allowed;
              } else {
                 $onerror->(type => 'at:charset:not allowed',
                            level => $self->{must_level},
                            token => $t);
              }

              ## TODO: Detect the conformance errors for @charset...
              
              $t = $tt->get_next_token;
              ## Stay in the state.
              redo S;
            } else {
              #
            }
          } else {
            #
          }

          $onerror->(type => 'syntax error:at:charset',
                     level => $self->{must_level},
                     token => $t);
          #
        ## NOTE: When adding
1	wakaba	1.1	package Whatpm::CSS::Parser;
2			use strict;
3			use Whatpm::CSS::Tokenizer qw(:token);
4			require Whatpm::CSS::SelectorsParser;
5
6			sub new ($) {
7	wakaba	1.3	my $self = bless {onerror => sub { }, must_level => 'm',
8	wakaba	1.5	message_level => 'w',
9	wakaba	1.3	unsupported_level => 'unsupported'}, shift;
10	wakaba	1.11	# $self->{base_uri}
11	wakaba	1.18	# $self->{unitless_px} = 1/0
12	wakaba	1.1
13			return $self;
14			} # new
15
16			sub BEFORE_STATEMENT_STATE () { 0 }
17			sub BEFORE_DECLARATION_STATE () { 1 }
18			sub IGNORED_STATEMENT_STATE () { 2 }
19			sub IGNORED_DECLARATION_STATE () { 3 }
20
21	wakaba	1.5	our $Prop; ## By CSS property name
22			our $Attr; ## By CSSOM attribute name
23			our $Key; ## By internal key
24
25	wakaba	1.1	sub parse_char_string ($$) {
26			my $self = $_[0];
27
28			my $s = $_[1];
29			pos ($s) = 0;
30	wakaba	1.2	my $line = 1;
31			my $column = 0;
32
33			my $_onerror = $self->{onerror};
34			my $onerror = sub {
35			$_onerror->(@_, line => $line, column => $column);
36			};
37	wakaba	1.1
38			my $tt = Whatpm::CSS::Tokenizer->new;
39	wakaba	1.2	$tt->{onerror} = $onerror;
40	wakaba	1.1	$tt->{get_char} = sub {
41			if (pos $s < length $s) {
42	wakaba	1.2	my $c = ord substr $s, pos ($s)++, 1;
43			if ($c == 0x000A) {
44			$line++;
45			$column = 0;
46			} elsif ($c == 0x000D) {
47			unless (substr ($s, pos ($s), 1) eq "\x0A") {
48			$line++;
49			$column = 0;
50			} else {
51			$column++;
52			}
53			} else {
54			$column++;
55			}
56			return $c;
57	wakaba	1.1	} else {
58			return -1;
59			}
60			}; # $tt->{get_char}
61			$tt->init;
62
63			my $sp = Whatpm::CSS::SelectorsParser->new;
64	wakaba	1.2	$sp->{onerror} = $onerror;
65	wakaba	1.1	$sp->{must_level} = $self->{must_level};
66	wakaba	1.2	$sp->{pseudo_element} = $self->{pseudo_element};
67			$sp->{pseudo_class} = $self->{pseudo_class};
68	wakaba	1.1
69	wakaba	1.4	my $nsmap = {};
70			$sp->{lookup_namespace_uri} = sub {
71			return $nsmap->{$_[0]}; # $_[0] is '' (default namespace) or prefix
72			}; # $sp->{lookup_namespace_uri}
73	wakaba	1.1
74			## TODO: Supported pseudo classes and elements...
75
76			require Message::DOM::CSSStyleSheet;
77			require Message::DOM::CSSRule;
78			require Message::DOM::CSSStyleDeclaration;
79
80	wakaba	1.11	$self->{base_uri} = $self->{href} unless defined $self->{base_uri};
81
82	wakaba	1.1	my $state = BEFORE_STATEMENT_STATE;
83			my $t = $tt->get_next_token;
84
85			my $open_rules = [[]];
86			my $current_rules = $open_rules->[-1];
87			my $current_decls;
88			my $closing_tokens = [];
89	wakaba	1.3	my $charset_allowed = 1;
90	wakaba	1.4	my $namespace_allowed = 1;
91	wakaba	1.1
92			S: {
93			if ($state == BEFORE_STATEMENT_STATE) {
94			$t = $tt->get_next_token
95			while $t->{type} == S_TOKEN or
96			$t->{type} == CDO_TOKEN or
97			$t->{type} == CDC_TOKEN;
98
99			if ($t->{type} == ATKEYWORD_TOKEN) {
100	wakaba	1.5	if (lc $t->{value} eq 'namespace') { ## TODO: case folding
101	wakaba	1.4	$t = $tt->get_next_token;
102			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
103
104			my $prefix;
105			if ($t->{type} == IDENT_TOKEN) {
106			$prefix = lc $t->{value};
107			## TODO: Unicode lowercase
108
109			$t = $tt->get_next_token;
110			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
111			}
112
113			if ($t->{type} == STRING_TOKEN or $t->{type} == URI_TOKEN) {
114			my $uri = $t->{value};
115
116			$t = $tt->get_next_token;
117			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
118
119			## ISSUE: On handling of empty namespace URI, Firefox 2 and
120			## Opera 9 work differently (See SuikaWiki:namespace).
121			## TODO: We need to check what we do once it is specced.
122
123			if ($t->{type} == SEMICOLON_TOKEN) {
124			if ($namespace_allowed) {
125			$nsmap->{defined $prefix ? $prefix : ''} = $uri;
126			push @$current_rules,
127			Message::DOM::CSSNamespaceRule->____new ($prefix, $uri);
128			undef $charset_allowed;
129			} else {
130			$onerror->(type => 'at:namespace:not allowed',
131			level => $self->{must_level},
132			token => $t);
133			}
134
135			$t = $tt->get_next_token;
136			## Stay in the state.
137			redo S;
138			} else {
139			#
140			}
141			} else {
142			#
143			}
144
145			$onerror->(type => 'syntax error:at:namespace',
146			level => $self->{must_level},
147			token => $t);
148			#
149	wakaba	1.5	} elsif (lc $t->{value} eq 'charset') { ## TODO: case folding
150	wakaba	1.3	$t = $tt->get_next_token;
151			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
152
153			if ($t->{type} == STRING_TOKEN) {
154			my $encoding = $t->{value};
155
156			$t = $tt->get_next_token;
157			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
158
159			if ($t->{type} == SEMICOLON_TOKEN) {
160			if ($charset_allowed) {
161			push @$current_rules,
162			Message::DOM::CSSCharsetRule->____new ($encoding);
163			undef $charset_allowed;
164			} else {
165			$onerror->(type => 'at:charset:not allowed',
166			level => $self->{must_level},
167			token => $t);
168			}
169
170			## TODO: Detect the conformance errors for @charset...
171
172			$t = $tt->get_next_token;
173			## Stay in the state.
174			redo S;
175			} else {
176			#
177			}
178			} else {
179			#
180			}
181
182			$onerror->(type => 'syntax error:at:charset',
183			level => $self->{must_level},
184			token => $t);
185	wakaba	1.4	#
186	wakaba	1.3	## NOTE: When adding