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'}, 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};

  ## TODO:
  #$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 = [];

  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) {
        ## TODO: supported...

        $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 {
        ($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 08:16:26 $
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			my $self = bless {onerror => sub { }, must_level => 'm'}, shift;
8
9			return $self;
10			} # new
11
12			sub BEFORE_STATEMENT_STATE () { 0 }
13			sub BEFORE_DECLARATION_STATE () { 1 }
14			sub IGNORED_STATEMENT_STATE () { 2 }
15			sub IGNORED_DECLARATION_STATE () { 3 }
16
17			sub parse_char_string ($$) {
18			my $self = $_[0];
19
20			my $s = $_[1];
21			pos ($s) = 0;
22	wakaba	1.2	my $line = 1;
23			my $column = 0;
24
25			my $_onerror = $self->{onerror};
26			my $onerror = sub {
27			$_onerror->(@_, line => $line, column => $column);
28			};
29	wakaba	1.1
30			my $tt = Whatpm::CSS::Tokenizer->new;
31	wakaba	1.2	$tt->{onerror} = $onerror;
32	wakaba	1.1	$tt->{get_char} = sub {
33			if (pos $s < length $s) {
34	wakaba	1.2	my $c = ord substr $s, pos ($s)++, 1;
35			if ($c == 0x000A) {
36			$line++;
37			$column = 0;
38			} elsif ($c == 0x000D) {
39			unless (substr ($s, pos ($s), 1) eq "\x0A") {
40			$line++;
41			$column = 0;
42			} else {
43			$column++;
44			}
45			} else {
46			$column++;
47			}
48			return $c;
49	wakaba	1.1	} else {
50			return -1;
51			}
52			}; # $tt->{get_char}
53			$tt->init;
54
55			my $sp = Whatpm::CSS::SelectorsParser->new;
56	wakaba	1.2	$sp->{onerror} = $onerror;
57	wakaba	1.1	$sp->{must_level} = $self->{must_level};
58	wakaba	1.2	$sp->{pseudo_element} = $self->{pseudo_element};
59			$sp->{pseudo_class} = $self->{pseudo_class};
60	wakaba	1.1
61			## TODO:
62			#$sp->{lookup_namespace_uri} = ...;
63
64			## TODO: Supported pseudo classes and elements...
65
66			require Message::DOM::CSSStyleSheet;
67			require Message::DOM::CSSRule;
68			require Message::DOM::CSSStyleDeclaration;
69
70			my $state = BEFORE_STATEMENT_STATE;
71			my $t = $tt->get_next_token;
72
73			my $open_rules = [[]];
74			my $current_rules = $open_rules->[-1];
75			my $current_decls;
76			my $closing_tokens = [];
77
78			S: {
79			if ($state == BEFORE_STATEMENT_STATE) {
80			$t = $tt->get_next_token
81			while $t->{type} == S_TOKEN or
82			$t->{type} == CDO_TOKEN or
83			$t->{type} == CDC_TOKEN;
84
85			if ($t->{type} == ATKEYWORD_TOKEN) {
86			## TODO: supported...
87
88			$t = $tt->get_next_token;
89			$state = IGNORED_STATEMENT_STATE;
90			redo S;
91			} elsif (@$open_rules > 1 and $t->{type} == RBRACE_TOKEN) {
92			pop @$open_rules;
93			## Stay in the state.
94			$t = $tt->get_next_token;
95			redo S;
96			} elsif ($t->{type} == EOF_TOKEN) {
97			if (@$open_rules > 1) {
98	wakaba	1.2	$onerror->(type => 'syntax error:block not closed',
99			level => $self->{must_level},
100			token => $t);
101	wakaba	1.1	}
102
103			last S;
104			} else {
105			($t, my $selectors) = $sp->_parse_selectors_with_tokenizer
106			($tt, LBRACE_TOKEN, $t);
107
108			$t = $tt->get_next_token
109			while $t->{type} != LBRACE_TOKEN and $t->{type} != EOF_TOKEN;
110
111			if ($t->{type} == LBRACE_TOKEN) {
112			$current_decls = Message::DOM::CSSStyleDeclaration->____new;
113			my $rs = Message::DOM::CSSStyleRule->____new
114			($selectors, $current_decls);
115			push @{$current_rules}, $rs if defined $selectors;
116
117			$state = BEFORE_DECLARATION_STATE;
118			$t = $tt->get_next_token;
119			redo S;
120			} else {
121	wakaba	1.2	$onerror->(type => 'syntax error:after selectors',
122			level => $self->{must_level},
123			token => $t);
124	wakaba	1.1
125			## Stay in the state.
126			$t = $tt->get_next_token;
127			redo S;
128			}
129			}
130			} elsif ($state == BEFORE_DECLARATION_STATE) {
131			## NOTE: DELIM? in declaration will be removed:
132			## <http://csswg.inkedblade.net/spec/css2.1?s=declaration%20delim#issue-2>.
133
134			$t = $tt->get_next_token while $t->{type} == S_TOKEN;
135			if ($t->{type} == IDENT_TOKEN) { # property
136			## TODO: If supported, ...
137
138			$t = $tt->get_next_token;
139			#
140			} elsif ($t->{type} == RBRACE_TOKEN) {
141			$t = $tt->get_next_token;
142			$state = BEFORE_STATEMENT_STATE;
143			redo S;
144			} elsif ($t->{type} == EOF_TOKEN) {
145	wakaba	1.2	$onerror->(type => 'syntax error:ruleset not closed',
146			level => $self->{must_level},
147			token => $t);
148	wakaba	1.1	## Reprocess.
149			$state = BEFORE_STATEMENT_STATE;
150			redo S;
151			}
152
153			#
154			$state = IGNORED_DECLARATION_STATE;
155			redo S;
156			} elsif ($state == IGNORED_STATEMENT_STATE or
157			$state == IGNORED_DECLARATION_STATE) {
158			if (@$closing_tokens) { ## Something is yet in opening state.
159			if ($t->{type} == EOF_TOKEN) {
160			@$closing_tokens = ();
161			## Reprocess.
162			$state = $state == IGNORED_STATEMENT_STATE
163			? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
164			redo S;
165			} elsif ($t->{type} == $closing_tokens->[-1]) {
166			pop @$closing_tokens;
167			if (@$closing_tokens == 0 and
168			$t->{type} == RBRACE_TOKEN and
169			$state == IGNORED_STATEMENT_STATE) {
170			$t = $tt->get_next_token;
171			$state = BEFORE_STATEMENT_STATE;
172			redo S;
173			} else {
174			$t = $tt->get_next_token;
175			## Stay in the state.
176			redo S;
177			}
178			} else {
179			#
180			}
181			} else {
182			if ($t->{type} == SEMICOLON_TOKEN) {
183			$t = $tt->get_next_token;
184			$state = $state == IGNORED_STATEMENT_STATE
185			? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
186			redo S;
187			} elsif ($state == IGNORED_DECLARATION_STATE and
188			$t->{type} == RBRACE_TOKEN) {
189			$t = $tt->get_next_token;
190			$state = BEFORE_STATEMENT_STATE;
191			redo S;
192			} elsif ($t->{type} == EOF_TOKEN) {
193			## Reprocess.
194			$state = $state == IGNORED_STATEMENT_STATE
195			? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
196			redo S;
197			} else {
198			#
199			}
200			}
201
202			while (not {
203			EOF_TOKEN, 1,
204			RBRACE_TOKEN, 1,
205			RBRACKET_TOKEN, 1,
206			RPAREN_TOKEN, 1,
207			SEMICOLON_TOKEN, 1,
208			}->{$t->{type}}) {
209			if ($t->{type} == LBRACE_TOKEN) {
210			push @$closing_tokens, RBRACE_TOKEN;
211			} elsif ($t->{type} == LBRACKET_TOKEN) {
212			push @$closing_tokens, RBRACKET_TOKEN;
213			} elsif ($t->{type} == LPAREN_TOKEN or $t->{type} == FUNCTION_TOKEN) {
214			push @$closing_tokens, RPAREN_TOKEN;
215			}
216
217			$t = $tt->get_next_token;
218			}
219
220			#
221			## Stay in the state.
222			redo S;
223			} else {
224			die "$0: parse_char_string: Unknown state: $state";
225			}
226			} # S
227
228			my $ss = Message::DOM::CSSStyleSheet->____new
229			(css_rules => $open_rules->[0],
230			## TODO: href
231			## TODO: owner_node
232			## TODO: media
233			type => 'text/css', ## TODO: OK?
234			_parser => $self);
235			return $ss;
236			} # parse_char_string
237
238			1;
239	wakaba	1.2	## $Date: 2007/12/23 08:16:26 $