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 $tt = Whatpm::CSS::Tokenizer->new;
  $tt->{onerror} = $self->{onerror};
  $tt->{get_char} = sub {
    if (pos $s < length $s) {
      return ord substr $s, pos ($s)++, 1;
    } else {
      return -1;
    }
  }; # $tt->{get_char}
  $tt->init;

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

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