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',
                    unsupported_level => 'unsupported'}, shift;

  return $self;
} # new

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

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;

  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 ($t->{value} eq 'namespace') {
          $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;
                undef $namespace_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 ($t->{value} eq 'charset') {
          $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 support for new at-rule, insert code
        ## "undef $charset_allowed" and "undef $namespace_token" as
        ## appropriate.
        } else {
          $onerror->(type => 'not supported:at:'.$t->{value},
                     level => $self->{unsupported_level},
                     token => $t);
        }

        $t = $tt->get_next_token;
        $state = IGNORED_STATEMENT_STATE;
        redo S;
      } elsif (@$open_rules > 1 and $t->{type} == RBRACE_TOKEN) {
        pop @$open_rules;
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == EOF_TOKEN) {
        if (@$open_rules > 1) {
          $onerror->(type => 'syntax error:block not closed',
                     level => $self->{must_level},
                     token => $t);
        }

        last S;
      } else {
        undef $charset_allowed;
        undef $namespace_allowed;

        ($t, my $selectors) = $sp->_parse_selectors_with_tokenizer
            ($tt, LBRACE_TOKEN, $t);

        $t = $tt->get_next_token
            while $t->{type} != LBRACE_TOKEN and $t->{type} != EOF_TOKEN;

        if ($t->{type} == LBRACE_TOKEN) {
          $current_decls = Message::DOM::CSSStyleDeclaration->____new;
          my $rs = Message::DOM::CSSStyleRule->____new
              ($selectors, $current_decls);
          push @{$current_rules}, $rs if defined $selectors;

          $state = BEFORE_DECLARATION_STATE;
          $t = $tt->get_next_token;
          redo S;
        } else {
          $onerror->(type => 'syntax error:after selectors',
                     level => $self->{must_level},
                     token => $t);

          ## Stay in the state.
          $t = $tt->get_next_token;
          redo S;
        }
      }
    } elsif ($state == BEFORE_DECLARATION_STATE) {
      ## NOTE: DELIM? in declaration will be removed:
      ## <http://csswg.inkedblade.net/spec/css2.1?s=declaration%20delim#issue-2>.

      $t = $tt->get_next_token while $t->{type} == S_TOKEN;
      if ($t->{type} == IDENT_TOKEN) { # property
        ## TODO: If supported, ...

        $t = $tt->get_next_token;
        #
      } elsif ($t->{type} == RBRACE_TOKEN) {
        $t = $tt->get_next_token;
        $state = BEFORE_STATEMENT_STATE;
        redo S;
      } elsif ($t->{type} == EOF_TOKEN) {
        $onerror->(type => 'syntax error:ruleset not closed',
                   level => $self->{must_level},
                   token => $t);
        ## Reprocess.
        $state = BEFORE_STATEMENT_STATE;
        redo S;
      }

      #
      $state = IGNORED_DECLARATION_STATE;
      redo S;
    } elsif ($state == IGNORED_STATEMENT_STATE or
             $state == IGNORED_DECLARATION_STATE) {
      if (@$closing_tokens) { ## Something is yet in opening state.
        if ($t->{type} == EOF_TOKEN) {
          @$closing_tokens = ();
          ## Reprocess.
          $state = $state == IGNORED_STATEMENT_STATE
              ? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
          redo S;
        } elsif ($t->{type} == $closing_tokens->[-1]) {
          pop @$closing_tokens;
          if (@$closing_tokens == 0 and
              $t->{type} == RBRACE_TOKEN and
              $state == IGNORED_STATEMENT_STATE) {
            $t = $tt->get_next_token;
            $state = BEFORE_STATEMENT_STATE;
            redo S;
          } else {
            $t = $tt->get_next_token;
            ## Stay in the state.
            redo S;
          }
        } else {
          #
        }
      } else {
        if ($t->{type} == SEMICOLON_TOKEN) {
          $t = $tt->get_next_token;
          $state = $state == IGNORED_STATEMENT_STATE
              ? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
          redo S;
        } elsif ($state == IGNORED_DECLARATION_STATE and
                 $t->{type} == RBRACE_TOKEN) {
          $t = $tt->get_next_token;
          $state = BEFORE_STATEMENT_STATE;
          redo S;
        } elsif ($t->{type} == EOF_TOKEN) {
          ## Reprocess.
          $state = $state == IGNORED_STATEMENT_STATE
              ? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
          redo S;
        } else {
          #
        }
      }

      while (not {
        EOF_TOKEN, 1,
        RBRACE_TOKEN, 1,
        RBRACKET_TOKEN, 1,
        RPAREN_TOKEN, 1,
        SEMICOLON_TOKEN, 1,
      }->{$t->{type}}) {
        if ($t->{type} == LBRACE_TOKEN) {
          push @$closing_tokens, RBRACE_TOKEN;
        } elsif ($t->{type} == LBRACKET_TOKEN) {
          push @$closing_tokens, RBRACKET_TOKEN;
        } elsif ($t->{type} == LPAREN_TOKEN or $t->{type} == FUNCTION_TOKEN) {
          push @$closing_tokens, RPAREN_TOKEN;
        }

        $t = $tt->get_next_token;
      }

      #
      ## Stay in the state.
      redo S;
    } else {
      die "$0: parse_char_string: Unknown state: $state";
    }
  } # S

  my $ss = Message::DOM::CSSStyleSheet->____new
      (css_rules => $open_rules->[0],
       ## TODO: href
       ## TODO: owner_node
       ## TODO: media
       type => 'text/css', ## TODO: OK?
       _parser => $self);
  return $ss;
} # parse_char_string

1;
## $Date: 2007/12/23 11:19:23 $
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			unsupported_level => 'unsupported'}, shift;
9	wakaba	1.1
10			return $self;
11			} # new
12
13			sub BEFORE_STATEMENT_STATE () { 0 }
14			sub BEFORE_DECLARATION_STATE () { 1 }
15			sub IGNORED_STATEMENT_STATE () { 2 }
16			sub IGNORED_DECLARATION_STATE () { 3 }
17
18			sub parse_char_string ($$) {
19			my $self = $_[0];
20
21			my $s = $_[1];
22			pos ($s) = 0;
23	wakaba	1.2	my $line = 1;
24			my $column = 0;
25
26			my $_onerror = $self->{onerror};
27			my $onerror = sub {
28			$_onerror->(@_, line => $line, column => $column);
29			};
30	wakaba	1.1
31			my $tt = Whatpm::CSS::Tokenizer->new;
32	wakaba	1.2	$tt->{onerror} = $onerror;
33	wakaba	1.1	$tt->{get_char} = sub {
34			if (pos $s < length $s) {
35	wakaba	1.2	my $c = ord substr $s, pos ($s)++, 1;
36			if ($c == 0x000A) {
37			$line++;
38			$column = 0;
39			} elsif ($c == 0x000D) {
40			unless (substr ($s, pos ($s), 1) eq "\x0A") {
41			$line++;
42			$column = 0;
43			} else {
44			$column++;
45			}
46			} else {
47			$column++;
48			}
49			return $c;
50	wakaba	1.1	} else {
51			return -1;
52			}
53			}; # $tt->{get_char}
54			$tt->init;
55
56			my $sp = Whatpm::CSS::SelectorsParser->new;
57	wakaba	1.2	$sp->{onerror} = $onerror;
58	wakaba	1.1	$sp->{must_level} = $self->{must_level};
59	wakaba	1.2	$sp->{pseudo_element} = $self->{pseudo_element};
60			$sp->{pseudo_class} = $self->{pseudo_class};
61	wakaba	1.1
62	wakaba	1.4	my $nsmap = {};
63			$sp->{lookup_namespace_uri} = sub {
64			return $nsmap->{$_[0]}; # $_[0] is '' (default namespace) or prefix
65			}; # $sp->{lookup_namespace_uri}
66	wakaba	1.1
67			## TODO: Supported pseudo classes and elements...
68
69			require Message::DOM::CSSStyleSheet;
70			require Message::DOM::CSSRule;
71			require Message::DOM::CSSStyleDeclaration;
72
73			my $state = BEFORE_STATEMENT_STATE;
74			my $t = $tt->get_next_token;
75
76			my $open_rules = [[]];
77			my $current_rules = $open_rules->[-1];
78			my $current_decls;
79			my $closing_tokens = [];
80	wakaba	1.3	my $charset_allowed = 1;
81	wakaba	1.4	my $namespace_allowed = 1;
82	wakaba	1.1
83			S: {
84			if ($state == BEFORE_STATEMENT_STATE) {
85			$t = $tt->get_next_token
86			while $t->{type} == S_TOKEN or
87			$t->{type} == CDO_TOKEN or
88			$t->{type} == CDC_TOKEN;
89
90			if ($t->{type} == ATKEYWORD_TOKEN) {
91	wakaba	1.4	if ($t->{value} eq 'namespace') {
92			$t = $tt->get_next_token;
93			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
94
95			my $prefix;
96			if ($t->{type} == IDENT_TOKEN) {
97			$prefix = lc $t->{value};
98			## TODO: Unicode lowercase
99
100			$t = $tt->get_next_token;
101			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
102			}
103
104			if ($t->{type} == STRING_TOKEN or $t->{type} == URI_TOKEN) {
105			my $uri = $t->{value};
106
107			$t = $tt->get_next_token;
108			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
109
110			## ISSUE: On handling of empty namespace URI, Firefox 2 and
111			## Opera 9 work differently (See SuikaWiki:namespace).
112			## TODO: We need to check what we do once it is specced.
113
114			if ($t->{type} == SEMICOLON_TOKEN) {
115			if ($namespace_allowed) {
116			$nsmap->{defined $prefix ? $prefix : ''} = $uri;
117			push @$current_rules,
118			Message::DOM::CSSNamespaceRule->____new ($prefix, $uri);
119			undef $charset_allowed;
120			undef $namespace_allowed;
121			} else {
122			$onerror->(type => 'at:namespace:not allowed',
123			level => $self->{must_level},
124			token => $t);
125			}
126
127			$t = $tt->get_next_token;
128			## Stay in the state.
129			redo S;
130			} else {
131			#
132			}
133			} else {
134			#
135			}
136
137			$onerror->(type => 'syntax error:at:namespace',
138			level => $self->{must_level},
139			token => $t);
140			#
141			} elsif ($t->{value} eq 'charset') {
142	wakaba	1.3	$t = $tt->get_next_token;
143			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
144
145			if ($t->{type} == STRING_TOKEN) {
146			my $encoding = $t->{value};
147
148			$t = $tt->get_next_token;
149			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
150
151			if ($t->{type} == SEMICOLON_TOKEN) {
152			if ($charset_allowed) {
153			push @$current_rules,
154			Message::DOM::CSSCharsetRule->____new ($encoding);
155			undef $charset_allowed;
156			} else {
157			$onerror->(type => 'at:charset:not allowed',
158			level => $self->{must_level},
159			token => $t);
160			}
161
162			## TODO: Detect the conformance errors for @charset...
163
164			$t = $tt->get_next_token;
165			## Stay in the state.
166			redo S;
167			} else {
168			#
169			}
170			} else {
171			#
172			}
173
174			$onerror->(type => 'syntax error:at:charset',
175			level => $self->{must_level},
176			token => $t);
177	wakaba	1.4	#
178	wakaba	1.3	## NOTE: When adding support for new at-rule, insert code
179	wakaba	1.4	## "undef $charset_allowed" and "undef $namespace_token" as
180			## appropriate.
181	wakaba	1.3	} else {
182			$onerror->(type => 'not supported:at:'.$t->{value},
183			level => $self->{unsupported_level},
184			token => $t);
185			}
186	wakaba	1.1
187			$t = $tt->get_next_token;
188			$state = IGNORED_STATEMENT_STATE;
189			redo S;
190			} elsif (@$open_rules > 1 and $t->{type} == RBRACE_TOKEN) {
191			pop @$open_rules;
192			## Stay in the state.
193			$t = $tt->get_next_token;
194			redo S;
195			} elsif ($t->{type} == EOF_TOKEN) {
196			if (@$open_rules > 1) {
197	wakaba	1.2	$onerror->(type => 'syntax error:block not closed',
198			level => $self->{must_level},
199			token => $t);
200	wakaba	1.1	}
201
202			last S;
203			} else {
204	wakaba	1.3	undef $charset_allowed;
205	wakaba	1.4	undef $namespace_allowed;
206	wakaba	1.3
207	wakaba	1.1	($t, my $selectors) = $sp->_parse_selectors_with_tokenizer
208			($tt, LBRACE_TOKEN, $t);
209
210			$t = $tt->get_next_token
211			while $t->{type} != LBRACE_TOKEN and $t->{type} != EOF_TOKEN;
212
213			if ($t->{type} == LBRACE_TOKEN) {
214			$current_decls = Message::DOM::CSSStyleDeclaration->____new;
215			my $rs = Message::DOM::CSSStyleRule->____new
216			($selectors, $current_decls);
217			push @{$current_rules}, $rs if defined $selectors;
218
219			$state = BEFORE_DECLARATION_STATE;
220			$t = $tt->get_next_token;
221			redo S;
222			} else {
223	wakaba	1.2	$onerror->(type => 'syntax error:after selectors',
224			level => $self->{must_level},
225			token => $t);
226	wakaba	1.1
227			## Stay in the state.
228			$t = $tt->get_next_token;
229			redo S;
230			}
231			}
232			} elsif ($state == BEFORE_DECLARATION_STATE) {
233			## NOTE: DELIM? in declaration will be removed:
234			## <http://csswg.inkedblade.net/spec/css2.1?s=declaration%20delim#issue-2>.
235
236			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
237			if ($t->{type} == IDENT_TOKEN) { # property
238			## TODO: If supported, ...
239
240			$t = $tt->get_next_token;
241			#
242			} elsif ($t->{type} == RBRACE_TOKEN) {
243			$t = $tt->get_next_token;
244			$state = BEFORE_STATEMENT_STATE;
245			redo S;
246			} elsif ($t->{type} == EOF_TOKEN) {
247	wakaba	1.2	$onerror->(type => 'syntax error:ruleset not closed',
248			level => $self->{must_level},
249			token => $t);
250	wakaba	1.1	## Reprocess.
251			$state = BEFORE_STATEMENT_STATE;
252			redo S;
253			}
254
255			#
256			$state = IGNORED_DECLARATION_STATE;
257			redo S;
258			} elsif ($state == IGNORED_STATEMENT_STATE or
259			$state == IGNORED_DECLARATION_STATE) {
260			if (@$closing_tokens) { ## Something is yet in opening state.
261			if ($t->{type} == EOF_TOKEN) {
262			@$closing_tokens = ();
263			## Reprocess.
264			$state = $state == IGNORED_STATEMENT_STATE
265			? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
266			redo S;
267			} elsif ($t->{type} == $closing_tokens->[-1]) {
268			pop @$closing_tokens;
269			if (@$closing_tokens == 0 and
270			$t->{type} == RBRACE_TOKEN and
271			$state == IGNORED_STATEMENT_STATE) {
272			$t = $tt->get_next_token;
273			$state = BEFORE_STATEMENT_STATE;
274			redo S;
275			} else {
276			$t = $tt->get_next_token;
277			## Stay in the state.
278			redo S;
279			}
280			} else {
281			#
282			}
283			} else {
284			if ($t->{type} == SEMICOLON_TOKEN) {
285			$t = $tt->get_next_token;
286			$state = $state == IGNORED_STATEMENT_STATE
287			? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
288			redo S;
289			} elsif ($state == IGNORED_DECLARATION_STATE and
290			$t->{type} == RBRACE_TOKEN) {
291			$t = $tt->get_next_token;
292			$state = BEFORE_STATEMENT_STATE;
293			redo S;
294			} elsif ($t->{type} == EOF_TOKEN) {
295			## Reprocess.
296			$state = $state == IGNORED_STATEMENT_STATE
297			? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
298			redo S;
299			} else {
300			#
301			}
302			}
303
304			while (not {
305			EOF_TOKEN, 1,
306			RBRACE_TOKEN, 1,
307			RBRACKET_TOKEN, 1,
308			RPAREN_TOKEN, 1,
309			SEMICOLON_TOKEN, 1,
310			}->{$t->{type}}) {
311			if ($t->{type} == LBRACE_TOKEN) {
312			push @$closing_tokens, RBRACE_TOKEN;
313			} elsif ($t->{type} == LBRACKET_TOKEN) {
314			push @$closing_tokens, RBRACKET_TOKEN;
315			} elsif ($t->{type} == LPAREN_TOKEN or $t->{type} == FUNCTION_TOKEN) {
316			push @$closing_tokens, RPAREN_TOKEN;
317			}
318
319			$t = $tt->get_next_token;
320			}
321
322			#
323			## Stay in the state.
324			redo S;
325			} else {
326			die "$0: parse_char_string: Unknown state: $state";
327			}
328			} # S
329
330			my $ss = Message::DOM::CSSStyleSheet->____new
331			(css_rules => $open_rules->[0],
332			## TODO: href
333			## TODO: owner_node
334			## TODO: media
335			type => 'text/css', ## TODO: OK?
336			_parser => $self);
337			return $ss;
338			} # parse_char_string
339
340			1;
341	wakaba	1.4	## $Date: 2007/12/23 11:19:23 $