Whatpm/CSS/SelectorsParser.pm

package Whatpm::CSS::SelectorsParser;
use strict;

require Exporter;
push our @ISA, 'Exporter';

use Whatpm::CSS::Tokenizer qw(:token);

sub new ($) {
  my $self = bless {onerror => sub { }, lookup_namespace_uri => sub {
    return undef;
  }}, shift;
  return $self;
} # new

sub BEFORE_TYPE_SELECTOR_STATE () { 1 }
sub AFTER_NAME_STATE () { 2 }
sub BEFORE_LOCAL_NAME_STATE () { 3 }
sub BEFORE_SIMPLE_SELECTOR_STATE () { 4 }
sub BEFORE_CLASS_NAME_STATE () { 5 }
sub AFTER_COLON_STATE () { 6 }
sub AFTER_DOUBLE_COLON_STATE () { 7 }
sub AFTER_LBRACKET_STATE () { 8 }
sub AFTER_ATTR_NAME_STATE () { 9 }
sub BEFORE_ATTR_LOCAL_NAME_STATE () { 10 }
sub BEFORE_MATCH_STATE () { 11 }
sub BEFORE_VALUE_STATE () { 12 }
sub AFTER_VALUE_STATE () { 13 }
sub BEFORE_COMBINATOR_STATE () { 14 }
sub COMBINATOR_STATE () { 15 }
sub BEFORE_LANG_TAG_STATE () { 16 }
sub AFTER_LANG_TAG_STATE () { 17 }
sub BEFORE_AN_STATE () { 18 }
sub AFTER_AN_STATE () { 19 }
sub BEFORE_B_STATE () { 20 }
sub AFTER_B_STATE () { 21 }
sub AFTER_NEGATION_SIMPLE_SELECTOR_STATE () { 22 }

sub NAMESPACE_SELECTOR () { 1 }
sub LOCAL_NAME_SELECTOR () { 2 }
sub ID_SELECTOR () { 3 }
sub CLASS_SELECTOR () { 4 }
sub PSEUDO_CLASS_SELECTOR () { 5 }
sub PSEUDO_ELEMENT_SELECTOR () { 6 }
sub ATTRIBUTE_SELECTOR () { 7 }

sub DESCENDANT_COMBINATOR () { S_TOKEN }
sub CHILD_COMBINATOR () { GREATER_TOKEN }
sub ADJACENT_SIBLING_COMBINATOR () { PLUS_TOKEN }
sub GENERAL_SIBLING_COMBINATOR () { TILDE_TOKEN }

sub EXISTS_MATCH () { 0 }
sub EQUALS_MATCH () { MATCH_TOKEN }
sub INCLUDES_MATCH () { INCLUDES_TOKEN }
sub DASH_MATCH () { DASHMATCH_TOKEN }
sub PREFIX_MATCH () { PREFIXMATCH_TOKEN }
sub SUFFIX_MATCH () { SUFFIXMATCH_TOKEN }
sub SUBSTRING_MATCH () { SUBSTRINGMATCH_TOKEN }

our @EXPORT_OK = qw(NAMESPACE_SELECTOR LOCAL_NAME_SELECTOR ID_SELECTOR
    CLASS_SELECTOR PSEUDO_CLASS_SELECTOR PSEUDO_ELEMENT_SELECTOR
    ATTRIBUTE_SELECTOR
    DESCENDANT_COMBINATOR CHILD_COMBINATOR
    ADJACENT_SIBLING_COMBINATOR GENERAL_SIBLING_COMBINATOR
    EXISTS_MATCH EQUALS_MATCH INCLUDES_MATCH DASH_MATCH PREFIX_MATCH
    SUFFIX_MATCH SUBSTRING_MATCH);

our %EXPORT_TAGS = (
  selector => [qw(NAMESPACE_SELECTOR LOCAL_NAME_SELECTOR ID_SELECTOR
      CLASS_SELECTOR PSEUDO_CLASS_SELECTOR PSEUDO_ELEMENT_SELECTOR
      ATTRIBUTE_SELECTOR)],
  combinator => [qw(DESCENDANT_COMBINATOR CHILD_COMBINATOR
      ADJACENT_SIBLING_COMBINATOR GENERAL_SIBLING_COMBINATOR)],
  match => [qw(EXISTS_MATCH EQUALS_MATCH INCLUDES_MATCH DASH_MATCH
      PREFIX_MATCH SUFFIX_MATCH SUBSTRING_MATCH)],
);

sub parse_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 $default_namespace = $self->{lookup_namespace_uri}->('');

  ## ISSUE: The Selectors spec only poorly defines how tokens are mapped
  ## to each component of selectors.  In addition, it does not well define
  ## where spaces and comments are able to be inserted.

  my $selectors = [];
  my $selector = [DESCENDANT_COMBINATOR];
  my $sss = [];
  my $simple_selector;
  my $has_pseudo_element;
  my $in_negation;

  my $state = BEFORE_TYPE_SELECTOR_STATE;
  my $t = $tt->get_next_token;
  my $name;
  S: {
    if ($state == BEFORE_TYPE_SELECTOR_STATE) {
      $in_negation = 2 if $in_negation;

      if ($t->{type} == IDENT_TOKEN) { ## element type or namespace prefix
        $name = $t->{value};
        $state = AFTER_NAME_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == STAR_TOKEN) { ## universal selector or prefix
        undef $name;
        $state = AFTER_NAME_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == VBAR_TOKEN) { ## null namespace
        undef $name;
        push @$sss, [NAMESPACE_SELECTOR, undef];

        $state = BEFORE_LOCAL_NAME_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } elsif ({
                DOT_TOKEN, 1,
                COLON_TOKEN, 1,
                HASH_TOKEN, 1,
                LBRACKET_TOKEN, 1,
                RPAREN_TOKEN, 1, # :not(a ->> ) <<-
               }->{$t->{type}}) {
        $in_negation = 1 if $in_negation;
        push @$sss, [NAMESPACE_SELECTOR, $default_namespace]
            if defined $default_namespace;

        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        # Reprocess.
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == BEFORE_SIMPLE_SELECTOR_STATE) {
      if ($in_negation and $in_negation++ == 2) {
        $state = AFTER_NEGATION_SIMPLE_SELECTOR_STATE;
        ## Reprocess.
        redo S;
      }

      if ($t->{type} == DOT_TOKEN) { ## class selector
        if ($has_pseudo_element) {
          ## TODO: error
          return undef;
        }
        $state = BEFORE_CLASS_NAME_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == HASH_TOKEN) { ## ID selector
        if ($has_pseudo_element) {
          ## TODO: error
          return undef;
        }
        push @$sss, [ID_SELECTOR, $t->{value}];
        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == COLON_TOKEN) { ## pseudo-class or pseudo-element
        if ($has_pseudo_element) {
          ## TODO: error
          return undef;
        }
        $state = AFTER_COLON_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == LBRACKET_TOKEN) { ## attribute selector
        if ($has_pseudo_element) {
          ## TODO: error
          return undef;
        }
        $state = AFTER_LBRACKET_STATE;
        $t = $tt->get_next_token;
        redo S;
      } else {
        $state = BEFORE_COMBINATOR_STATE;
        ## Reprocess.
        redo S;
      }
    } elsif ($state == AFTER_NAME_STATE) {
      if ($t->{type} == VBAR_TOKEN) {
        $state = BEFORE_LOCAL_NAME_STATE;
        $t = $tt->get_next_token;
        redo S;
      } else { ## Type or universal selector w/o namespace prefix
        push @$sss, [NAMESPACE_SELECTOR, $default_namespace]
            if defined $default_namespace;
        push @$sss, [LOCAL_NAME_SELECTOR, $name] if defined $name;

        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        ## reprocess.
        redo S;
      }
    } elsif ($state == BEFORE_LOCAL_NAME_STATE) {
      if ($t->{type} == IDENT_TOKEN) {
        if (defined $name) { ## Prefix is neither empty nor "*"
          my $uri = $self->{lookup_namespace_uri}->($name);
          unless (defined $uri) {
            ## TODO: error
            return undef;
          }
          push @$sss, [NAMESPACE_SELECTOR, $uri];
        }
        push @$sss, [LOCAL_NAME_SELECTOR, $t->{value}];

        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == STAR_TOKEN) {
        if (defined $name) { ## Prefix is neither empty nor "*"
          my $uri = $self->{lookup_namespace_uri}->($name);
          unless (defined $uri) {
            ## TODO: error
            return undef;
          }
          push @$sss, [NAMESPACE_SELECTOR, $uri];
        }
        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } else { ## "|" not followed by type or universal selector
        ## TODO: error
        return undef;
      }
    } elsif ($state == BEFORE_CLASS_NAME_STATE) {
      if ($t->{type} == IDENT_TOKEN) {
        push @$sss, [CLASS_SELECTOR, $t->{value}];

        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == BEFORE_COMBINATOR_STATE) {
      push @$selector, $sss;
      $sss = [];

      if ($t->{type} == S_TOKEN) {
        $state = COMBINATOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ({
                GREATER_TOKEN, 1,
                PLUS_TOKEN, 1,
                TILDE_TOKEN, 1,
                COMMA_TOKEN, 1,
                EOF_TOKEN, 1,
               }->{$t->{type}}) {
        $state = COMBINATOR_STATE;
        ## Reprocess.
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == COMBINATOR_STATE) {
      if ($state == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } elsif ({
                GREATER_TOKEN, 1,
                PLUS_TOKEN, 1,
                TILDE_TOKEN, 1,
               }->{$t->{type}}) {
        push @$selector, $t->{type};

        $state = BEFORE_TYPE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == EOF_TOKEN) {
        push @$selectors, $selector;
        return $selectors;
      } elsif ($t->{type} == COMMA_TOKEN) {
        push @$selectors, $selector;
        $selector = [DESCENDANT_COMBINATOR];
        undef $has_pseudo_element;

        $state = BEFORE_TYPE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } else {
        push @$selector, S_TOKEN;

        $state = BEFORE_TYPE_SELECTOR_STATE;
        ## Reprocess.
        redo S;
      }
    } elsif ($state == AFTER_COLON_STATE) {
      if ($t->{type} == IDENT_TOKEN) {
        my $class = $t->{value};
        $class =~ tr/A-Z/a-z/; ## TODO: ASCII case-insensitivity ok?
        if ($self->{pseudo_class}->{$class} and 
            {
              active => 1,
              checked => 1,
              disabled => 1,
              empty => 1,
              enabled => 1,
              'first-child' => 1,
              'first-of-type' => 1,
              focus => 1,
              hover => 1,
              indeterminate => 1, ## NOTE: Reserved in Selectors Level 3
              'last-child' => 1,
              'last-of-type' => 1,
              link => 1,
              'only-child' => 1,
              'only-of-type' => 1,
              root => 1,
              target => 1,
              visited => 1,
            }->{$class}) {
          push @$sss, [PSEUDO_CLASS_SELECTOR, $class];
        } elsif ($self->{pseudo_element}->{$class} and
                 {'first-letter' => 1, 'first-line' => 1,
                  before => 1, after => 1}->{$class}) {
          push @$sss, [PSEUDO_ELEMENT_SELECTOR, $class];
          $has_pseudo_element = 1;
        } else {
          ## TODO: error
          return undef;
        }

        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == FUNCTION_TOKEN) {
        my $class = $t->{value};
        $class =~ tr/A-Z/a-z/; ## TODO: Is ASCII case-insensitivity OK?
        
        if ($class eq 'lang' and $self->{pseudo_class}->{$class}) {
          $state = BEFORE_LANG_TAG_STATE;
          $t = $tt->get_next_token;
          redo S;
        } elsif ($class eq 'not' and $self->{pseudo_class}->{$class} and
                 not $in_negation) {
          $in_negation = 1;

          push @$sss, '';
          $state = BEFORE_TYPE_SELECTOR_STATE;
          $t = $tt->get_next_token;
          redo S;
        } elsif ({
                  'nth-child' => 1,
                  'nth-last-child' => 1,
                  'nth-of-type' => 1,
                  'nth-last-of-type' => 1,
                 }->{$class} and $self->{pseudo_class}->{$class}) {
          $name = $class;

          $state = BEFORE_AN_STATE;
          $t = $tt->get_next_token;
          ## TODO: syntax of value in the spec is vague; need to reverse
          ## engineer what Opera 9.5 does.
          redo S;
        } else {
          ## TODO: error
          return undef;
        }
      } elsif ($t->{type} == COLON_TOKEN and
               not $in_negation) { ## Pseudo-element
        $state = AFTER_DOUBLE_COLON_STATE;
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == AFTER_LBRACKET_STATE) { ## Attribute selector
      $simple_selector = [ATTRIBUTE_SELECTOR];
      if ($t->{type} == IDENT_TOKEN) {
        $name = $t->{value};

        $state = AFTER_ATTR_NAME_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == VBAR_TOKEN) {
        $simple_selector->[1] = ''; # null namespace
        
        $state = BEFORE_ATTR_LOCAL_NAME_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == STAR_TOKEN) {
        $name = undef;

        $state = AFTER_ATTR_NAME_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == AFTER_ATTR_NAME_STATE) {
      if ($t->{type} == VBAR_TOKEN) {
        if (defined $name) {
          my $uri = $self->{lookup_namespace_uri}->($name);
          unless (defined $uri) {
            ## TODO: error
            return undef;
          }
          $simple_selector->[1] = $uri;
        }

        $state = BEFORE_ATTR_LOCAL_NAME_STATE;
        $t = $tt->get_next_token;
        redo S;
      } else {
        unless (defined $name) { ## [*]
          ## TODO: error
          return undef;
        }
        $simple_selector->[1] = ''; # null namespace
        $simple_selector->[2] = $name;

        $state = BEFORE_MATCH_STATE;
        ## Reprocess.
        redo S;
      }
    } elsif ($state == BEFORE_ATTR_LOCAL_NAME_STATE) {
      if ($t->{type} == IDENT_TOKEN) {
        $simple_selector->[2] = $t->{value};
        
        $state = BEFORE_MATCH_STATE;
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == BEFORE_MATCH_STATE) {
      if ({
           MATCH_TOKEN, 1,
           INCLUDES_TOKEN, 1,
           DASHMATCH_TOKEN, 1,
           PREFIXMATCH_TOKEN, 1,
           SUFFIXMATCH_TOKEN, 1,
           SUBSTRINGMATCH_TOKEN, 1,
          }->{$t->{type}}) {
        $simple_selector->[3] = $t->{type};

        $state = BEFORE_VALUE_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == RBRACKET_TOKEN) {
        push @$sss, $simple_selector;
        
        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == BEFORE_VALUE_STATE) {
      if ($t->{type} == IDENT_TOKEN or $t->{type} == STRING_TOKEN) {
        $simple_selector->[4] = $t->{value};
        push @$sss, $simple_selector;

        $state = AFTER_VALUE_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == AFTER_VALUE_STATE) {
      if ($t->{type} == RBRACKET_TOKEN) {
        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == AFTER_DOUBLE_COLON_STATE) {
      if ($t->{type} == IDENT_TOKEN) {
        my $pe = $t->{value};
        $pe =~ tr/A-Z/a-z/; ## TODO: Is ASCII case-insensitive OK?
        if ($self->{pseudo_element}->{$pe} and 
            {'first-letter' => 1, 'first-line' => 1,
             after => 1, before => 1}->{$pe}) {
          push @$sss, [PSEUDO_ELEMENT_SELECTOR, $pe];
          $has_pseudo_element = 1;

          $state = BEFORE_SIMPLE_SELECTOR_STATE;
          $t = $tt->get_next_token;
          redo S;
        } else {
          ## TODO: error
          return undef;
        }
      } else {
        ## TODO: error
        return undef
      }
    } elsif ($state == BEFORE_LANG_TAG_STATE) {
      if ($t->{type} == IDENT_TOKEN) {
        push @$sss, [PSEUDO_CLASS_SELECTOR, 'lang', $t->{value}];
        
        $state = AFTER_LANG_TAG_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == AFTER_LANG_TAG_STATE) {
      if ($t->{type} == RPAREN_TOKEN) {
        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == BEFORE_AN_STATE) {
      if ($t->{type} == DIMENSION_TOKEN) {
        if (int $t->{number} == $t->{number}) {
          my $n = $t->{value};
          $n =~ tr/A-Z/a-z/; ## TODO: ascii ?
          if ($n eq 'n') {
            $simple_selector = [PSEUDO_CLASS_SELECTOR, $name,
                                0+$t->{number}, 0];
            
            $state = AFTER_AN_STATE;
            $t = $tt->get_next_token;
            redo S;
          } elsif ($n =~ /\An-([0-9]+)\z/) {
            push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 0+$t->{number}, 0-$1];

            $state = AFTER_B_STATE;
            $t = $tt->get_next_token;
            redo S;
          } else {
            ## TODO: error
            return undef;
          }
        } else {
          ## TODO: error
          return undef;
        }
      } elsif ($t->{type} == NUMBER_TOKEN) {
        if (int $t->{number} == $t->{number}) {
          push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 0, 0+$t->{number}];

          $state = AFTER_B_STATE;
          $t = $tt->get_next_token;
          redo S;
        } else { ## ISSUE: Is :nth-child(0.0) disallowed?
          ## TODO: error
          return undef;
        }
      } elsif ($t->{type} == IDENT_TOKEN) {
        my $value = $t->{value};
        $value =~ tr/A-Z/a-z/; ## TODO: ASCII case-insensitive?
        if ($value eq 'odd') {
          push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 2, 1];

          $state = AFTER_B_STATE;
          $t = $tt->get_next_token;
          redo S;
        } elsif ($value eq 'even') {
          push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 2, 0];

          $state = AFTER_B_STATE;
          $t = $tt->get_next_token;
          redo S;
        } elsif ($value eq 'n' or $value eq '-n') {
          ## ISSUE: :nth-child(-n) is not explicitly allowed, but appears
          ## in an example in the spec.
          $simple_selector = [PSEUDO_CLASS_SELECTOR, $name,
                              $value eq 'n' ? 1 : -1, 0];

          $state = AFTER_AN_STATE;
          $t = $tt->get_next_token;
          redo S;
        } elsif ($value =~ /\A(-?)n-([0-9]+)\z/) {
          push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 0+($1.'1'), -$2];

          $state = AFTER_B_STATE;
          $t = $tt->get_next_token;
          redo S;
        } else {
          ## TODO: error
          return undef;
        }
      } elsif ($t->{type} == MINUS_TOKEN) {
        ## ISSUE: Is :nth-child(- 1) allowed?
        ## ISSUE: Is :nth-child(n-/**/6) or (-n-/**/6) allowed?
        $t = $tt->get_next_token;
        if ($t->{type} == DIMENSION_TOKEN || $t->{type} == IDENT_TOKEN) {
          my $num = $t->{type} == IDENT_TOKEN ? 1 : $t->{number};
          ## NOTE: :nth-child(-/**/n)
          if (int $num == $num) {
            my $n = $t->{value};
            $n =~ tr/A-Z/a-z/; ## TODO: ASCII?
            if ($n eq 'n') {
              $simple_selector = [PSEUDO_CLASS_SELECTOR, $name, -$num, 0];
              
              $state = AFTER_AN_STATE;
              $t = $tt->get_next_token;
              redo S;
            } elsif ($n =~ /\An-([0-9]+)\z/) {
              $simple_selector = [PSEUDO_CLASS_SELECTOR, $name,
                                  -$num, -$1];

              $state = AFTER_AN_STATE;
              $t = $tt->get_next_token;
              redo S;
            } else {
              ## TODO: error
              return undef;
            }
          } else {
            ## TODO: error
            return undef;
          }
        } elsif ($t->{type} == NUMBER_TOKEN) {
          if (int $t->{number} == $t->{number}) {
            push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 0, -$t->{number}];

            $state = AFTER_B_STATE;
            $t = $tt->get_next_token;
            redo S;
          } else {
            ## TODO: error
            return undef;
          }
        } else {
          ## TODO: error
          return undef;
        }
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == AFTER_AN_STATE) {
      ## ISSUE: :nth-child(1n +2) is allowed.
      ## :nth-child(1n /**/ +2) and :nth-child(1n -2) are allowed?
      if ($t->{type} == PLUS_TOKEN) {
        $simple_selector->[3] = +1;

        $state = BEFORE_B_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == MINUS_TOKEN) {
        $simple_selector->[3] = -1;

        $state = BEFORE_B_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == RPAREN_TOKEN) {
        push @$sss, $simple_selector;

        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == BEFORE_B_STATE) {
      ## ISSUE: Is S allowed?
      if ($t->{type} == NUMBER_TOKEN) {
        if (int $t->{number} == $t->{number}) {
          $simple_selector->[3] *= $t->{number};
          push @$sss, $simple_selector;
          
          $state = AFTER_B_STATE;
          $t = $tt->get_next_token;
          redo S;
        } else {
          ## TODO: error
          return undef;
        }
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == AFTER_B_STATE) {
      if ($t->{type} == RPAREN_TOKEN) {
        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } elsif ($state == AFTER_NEGATION_SIMPLE_SELECTOR_STATE) {
      if ($t->{type} == RPAREN_TOKEN) {
        undef $in_negation;
        my $simple_selector = [];
        unshift @$simple_selector, pop @$sss while ref $sss->[-1];
        pop @$sss; # dummy
        unshift @$simple_selector, 'not';
        unshift @$simple_selector, PSEUDO_CLASS_SELECTOR;
        push @$sss, $simple_selector;
        
        $state = BEFORE_SIMPLE_SELECTOR_STATE;
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == S_TOKEN) {
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } else {
        ## TODO: error
        return undef;
      }
    } else {
      die "$0: Selectors Parser: $state: Unknown state";
    }
  } # S
} # parse_string

1;
1	wakaba	1.1	package Whatpm::CSS::SelectorsParser;
2			use strict;
3
4			require Exporter;
5			push our @ISA, 'Exporter';
6
7			use Whatpm::CSS::Tokenizer qw(:token);
8
9			sub new ($) {
10			my $self = bless {onerror => sub { }, lookup_namespace_uri => sub {
11			return undef;
12			}}, shift;
13			return $self;
14			} # new
15
16			sub BEFORE_TYPE_SELECTOR_STATE () { 1 }
17			sub AFTER_NAME_STATE () { 2 }
18			sub BEFORE_LOCAL_NAME_STATE () { 3 }
19			sub BEFORE_SIMPLE_SELECTOR_STATE () { 4 }
20			sub BEFORE_CLASS_NAME_STATE () { 5 }
21			sub AFTER_COLON_STATE () { 6 }
22			sub AFTER_DOUBLE_COLON_STATE () { 7 }
23			sub AFTER_LBRACKET_STATE () { 8 }
24			sub AFTER_ATTR_NAME_STATE () { 9 }
25			sub BEFORE_ATTR_LOCAL_NAME_STATE () { 10 }
26			sub BEFORE_MATCH_STATE () { 11 }
27			sub BEFORE_VALUE_STATE () { 12 }
28			sub AFTER_VALUE_STATE () { 13 }
29			sub BEFORE_COMBINATOR_STATE () { 14 }
30			sub COMBINATOR_STATE () { 15 }
31			sub BEFORE_LANG_TAG_STATE () { 16 }
32			sub AFTER_LANG_TAG_STATE () { 17 }
33			sub BEFORE_AN_STATE () { 18 }
34			sub AFTER_AN_STATE () { 19 }
35			sub BEFORE_B_STATE () { 20 }
36			sub AFTER_B_STATE () { 21 }
37			sub AFTER_NEGATION_SIMPLE_SELECTOR_STATE () { 22 }
38
39			sub NAMESPACE_SELECTOR () { 1 }
40			sub LOCAL_NAME_SELECTOR () { 2 }
41			sub ID_SELECTOR () { 3 }
42			sub CLASS_SELECTOR () { 4 }
43			sub PSEUDO_CLASS_SELECTOR () { 5 }
44			sub PSEUDO_ELEMENT_SELECTOR () { 6 }
45			sub ATTRIBUTE_SELECTOR () { 7 }
46
47			sub DESCENDANT_COMBINATOR () { S_TOKEN }
48			sub CHILD_COMBINATOR () { GREATER_TOKEN }
49			sub ADJACENT_SIBLING_COMBINATOR () { PLUS_TOKEN }
50			sub GENERAL_SIBLING_COMBINATOR () { TILDE_TOKEN }
51
52			sub EXISTS_MATCH () { 0 }
53			sub EQUALS_MATCH () { MATCH_TOKEN }
54			sub INCLUDES_MATCH () { INCLUDES_TOKEN }
55			sub DASH_MATCH () { DASHMATCH_TOKEN }
56			sub PREFIX_MATCH () { PREFIXMATCH_TOKEN }
57			sub SUFFIX_MATCH () { SUFFIXMATCH_TOKEN }
58			sub SUBSTRING_MATCH () { SUBSTRINGMATCH_TOKEN }
59
60			our @EXPORT_OK = qw(NAMESPACE_SELECTOR LOCAL_NAME_SELECTOR ID_SELECTOR
61			CLASS_SELECTOR PSEUDO_CLASS_SELECTOR PSEUDO_ELEMENT_SELECTOR
62			ATTRIBUTE_SELECTOR
63			DESCENDANT_COMBINATOR CHILD_COMBINATOR
64			ADJACENT_SIBLING_COMBINATOR GENERAL_SIBLING_COMBINATOR
65			EXISTS_MATCH EQUALS_MATCH INCLUDES_MATCH DASH_MATCH PREFIX_MATCH
66			SUFFIX_MATCH SUBSTRING_MATCH);
67
68			our %EXPORT_TAGS = (
69			selector => [qw(NAMESPACE_SELECTOR LOCAL_NAME_SELECTOR ID_SELECTOR
70			CLASS_SELECTOR PSEUDO_CLASS_SELECTOR PSEUDO_ELEMENT_SELECTOR
71			ATTRIBUTE_SELECTOR)],
72			combinator => [qw(DESCENDANT_COMBINATOR CHILD_COMBINATOR
73			ADJACENT_SIBLING_COMBINATOR GENERAL_SIBLING_COMBINATOR)],
74			match => [qw(EXISTS_MATCH EQUALS_MATCH INCLUDES_MATCH DASH_MATCH
75			PREFIX_MATCH SUFFIX_MATCH SUBSTRING_MATCH)],
76			);
77
78			sub parse_string ($$) {
79			my $self = $_[0];
80
81			my $s = $_[1];
82			pos ($s) = 0;
83
84			my $tt = Whatpm::CSS::Tokenizer->new;
85			$tt->{onerror} = $self->{onerror};
86			$tt->{get_char} = sub {
87			if (pos $s < length $s) {
88			return ord substr $s, pos ($s)++, 1;
89			} else {
90			return -1;
91			}
92			}; # $tt->{get_char}
93			$tt->init;
94
95	wakaba	1.2	my $default_namespace = $self->{lookup_namespace_uri}->('');
96	wakaba	1.1
97			## ISSUE: The Selectors spec only poorly defines how tokens are mapped
98			## to each component of selectors. In addition, it does not well define
99			## where spaces and comments are able to be inserted.
100
101			my $selectors = [];
102			my $selector = [DESCENDANT_COMBINATOR];
103			my $sss = [];
104			my $simple_selector;
105			my $has_pseudo_element;
106			my $in_negation;
107
108			my $state = BEFORE_TYPE_SELECTOR_STATE;
109			my $t = $tt->get_next_token;
110			my $name;
111			S: {
112			if ($state == BEFORE_TYPE_SELECTOR_STATE) {
113			$in_negation = 2 if $in_negation;
114
115			if ($t->{type} == IDENT_TOKEN) { ## element type or namespace prefix
116			$name = $t->{value};
117			$state = AFTER_NAME_STATE;
118			$t = $tt->get_next_token;
119			redo S;
120			} elsif ($t->{type} == STAR_TOKEN) { ## universal selector or prefix
121			undef $name;
122			$state = AFTER_NAME_STATE;
123			$t = $tt->get_next_token;
124			redo S;
125			} elsif ($t->{type} == VBAR_TOKEN) { ## null namespace
126			undef $name;
127			push @$sss, [NAMESPACE_SELECTOR, undef];
128
129			$state = BEFORE_LOCAL_NAME_STATE;
130			$t = $tt->get_next_token;
131			redo S;
132			} elsif ($t->{type} == S_TOKEN) {
133			## Stay in the state.
134			$t = $tt->get_next_token;
135			redo S;
136			} elsif ({
137			DOT_TOKEN, 1,
138			COLON_TOKEN, 1,
139			HASH_TOKEN, 1,
140			LBRACKET_TOKEN, 1,
141			RPAREN_TOKEN, 1, # :not(a ->> ) <<-
142			}->{$t->{type}}) {
143			$in_negation = 1 if $in_negation;
144			push @$sss, [NAMESPACE_SELECTOR, $default_namespace]
145			if defined $default_namespace;
146
147			$state = BEFORE_SIMPLE_SELECTOR_STATE;
148			# Reprocess.
149			redo S;
150			} else {
151			## TODO: error
152			return undef;
153			}
154			} elsif ($state == BEFORE_SIMPLE_SELECTOR_STATE) {
155			if ($in_negation and $in_negation++ == 2) {
156			$state = AFTER_NEGATION_SIMPLE_SELECTOR_STATE;
157			## Reprocess.
158			redo S;
159			}
160
161			if ($t->{type} == DOT_TOKEN) { ## class selector
162			if ($has_pseudo_element) {
163			## TODO: error
164			return undef;
165			}
166			$state = BEFORE_CLASS_NAME_STATE;
167			$t = $tt->get_next_token;
168			redo S;
169			} elsif ($t->{type} == HASH_TOKEN) { ## ID selector
170			if ($has_pseudo_element) {
171			## TODO: error
172			return undef;
173			}
174			push @$sss, [ID_SELECTOR, $t->{value}];
175			$state = BEFORE_SIMPLE_SELECTOR_STATE;
176			$t = $tt->get_next_token;
177			redo S;
178			} elsif ($t->{type} == COLON_TOKEN) { ## pseudo-class or pseudo-element
179			if ($has_pseudo_element) {
180			## TODO: error
181			return undef;
182			}
183			$state = AFTER_COLON_STATE;
184			$t = $tt->get_next_token;
185			redo S;
186			} elsif ($t->{type} == LBRACKET_TOKEN) { ## attribute selector
187			if ($has_pseudo_element) {
188			## TODO: error
189			return undef;
190			}
191			$state = AFTER_LBRACKET_STATE;
192			$t = $tt->get_next_token;
193			redo S;
194			} else {
195			$state = BEFORE_COMBINATOR_STATE;
196			## Reprocess.
197			redo S;
198			}
199			} elsif ($state == AFTER_NAME_STATE) {
200			if ($t->{type} == VBAR_TOKEN) {
201			$state = BEFORE_LOCAL_NAME_STATE;
202			$t = $tt->get_next_token;
203			redo S;
204			} else { ## Type or universal selector w/o namespace prefix
205			push @$sss, [NAMESPACE_SELECTOR, $default_namespace]
206			if defined $default_namespace;
207			push @$sss, [LOCAL_NAME_SELECTOR, $name] if defined $name;
208
209			$state = BEFORE_SIMPLE_SELECTOR_STATE;
210			## reprocess.
211			redo S;
212			}
213			} elsif ($state == BEFORE_LOCAL_NAME_STATE) {
214			if ($t->{type} == IDENT_TOKEN) {
215			if (defined $name) { ## Prefix is neither empty nor "*"
216			my $uri = $self->{lookup_namespace_uri}->($name);
217			unless (defined $uri) {
218			## TODO: error
219			return undef;
220			}
221			push @$sss, [NAMESPACE_SELECTOR, $uri];
222			}
223			push @$sss, [LOCAL_NAME_SELECTOR, $t->{value}];
224
225			$state = BEFORE_SIMPLE_SELECTOR_STATE;
226			$t = $tt->get_next_token;
227			redo S;
228			} elsif ($t->{type} == STAR_TOKEN) {
229			if (defined $name) { ## Prefix is neither empty nor "*"
230			my $uri = $self->{lookup_namespace_uri}->($name);
231			unless (defined $uri) {
232			## TODO: error
233			return undef;
234			}
235			push @$sss, [NAMESPACE_SELECTOR, $uri];
236			}
237			$state = BEFORE_SIMPLE_SELECTOR_STATE;
238			$t = $tt->get_next_token;
239			redo S;
240			} else { ## "\|" not followed by type or universal selector
241			## TODO: error
242			return undef;
243			}
244			} elsif ($state == BEFORE_CLASS_NAME_STATE) {
245			if ($t->{type} == IDENT_TOKEN) {
246			push @$sss, [CLASS_SELECTOR, $t->{value}];
247
248			$state = BEFORE_SIMPLE_SELECTOR_STATE;
249			$t = $tt->get_next_token;
250			redo S;
251			} else {
252			## TODO: error
253			return undef;
254			}
255			} elsif ($state == BEFORE_COMBINATOR_STATE) {
256			push @$selector, $sss;
257			$sss = [];
258
259			if ($t->{type} == S_TOKEN) {
260			$state = COMBINATOR_STATE;
261			$t = $tt->get_next_token;
262			redo S;
263			} elsif ({
264			GREATER_TOKEN, 1,
265			PLUS_TOKEN, 1,
266			TILDE_TOKEN, 1,
267			COMMA_TOKEN, 1,
268			EOF_TOKEN, 1,
269			}->{$t->{type}}) {
270			$state = COMBINATOR_STATE;
271			## Reprocess.
272			redo S;
273			} else {
274			## TODO: error
275			return undef;
276			}
277			} elsif ($state == COMBINATOR_STATE) {
278			if ($state == S_TOKEN) {
279			## Stay in the state.
280			$t = $tt->get_next_token;
281			redo S;
282			} elsif ({
283			GREATER_TOKEN, 1,
284			PLUS_TOKEN, 1,
285			TILDE_TOKEN, 1,
286			}->{$t->{type}}) {
287			push @$selector, $t->{type};
288
289			$state = BEFORE_TYPE_SELECTOR_STATE;
290			$t = $tt->get_next_token;
291			redo S;
292			} elsif ($t->{type} == EOF_TOKEN) {
293			push @$selectors, $selector;
294			return $selectors;
295			} elsif ($t->{type} == COMMA_TOKEN) {
296			push @$selectors, $selector;
297			$selector = [DESCENDANT_COMBINATOR];
298			undef $has_pseudo_element;
299
300			$state = BEFORE_TYPE_SELECTOR_STATE;
301			$t = $tt->get_next_token;
302			redo S;
303			} else {
304			push @$selector, S_TOKEN;
305
306			$state = BEFORE_TYPE_SELECTOR_STATE;
307			## Reprocess.
308			redo S;
309			}
310			} elsif ($state == AFTER_COLON_STATE) {
311			if ($t->{type} == IDENT_TOKEN) {
312			my $class = $t->{value};
313			$class =~ tr/A-Z/a-z/; ## TODO: ASCII case-insensitivity ok?
314			if ($self->{pseudo_class}->{$class} and
315			{
316			active => 1,
317			checked => 1,
318			disabled => 1,
319			empty => 1,
320			enabled => 1,
321			'first-child' => 1,
322			'first-of-type' => 1,
323			focus => 1,
324			hover => 1,
325			indeterminate => 1, ## NOTE: Reserved in Selectors Level 3
326			'last-child' => 1,
327			'last-of-type' => 1,
328			link => 1,
329			'only-child' => 1,
330			'only-of-type' => 1,
331			root => 1,
332			target => 1,
333			visited => 1,
334			}->{$class}) {
335			push @$sss, [PSEUDO_CLASS_SELECTOR, $class];
336			} elsif ($self->{pseudo_element}->{$class} and
337			{'first-letter' => 1, 'first-line' => 1,
338			before => 1, after => 1}->{$class}) {
339			push @$sss, [PSEUDO_ELEMENT_SELECTOR, $class];
340			$has_pseudo_element = 1;
341			} else {
342			## TODO: error
343			return undef;
344			}
345
346			$state = BEFORE_SIMPLE_SELECTOR_STATE;
347			$t = $tt->get_next_token;
348			redo S;
349			} elsif ($t->{type} == FUNCTION_TOKEN) {
350			my $class = $t->{value};
351			$class =~ tr/A-Z/a-z/; ## TODO: Is ASCII case-insensitivity OK?
352
353			if ($class eq 'lang' and $self->{pseudo_class}->{$class}) {
354			$state = BEFORE_LANG_TAG_STATE;
355			$t = $tt->get_next_token;
356			redo S;
357			} elsif ($class eq 'not' and $self->{pseudo_class}->{$class} and
358			not $in_negation) {
359			$in_negation = 1;
360
361			push @$sss, '';
362			$state = BEFORE_TYPE_SELECTOR_STATE;
363			$t = $tt->get_next_token;
364			redo S;
365			} elsif ({
366			'nth-child' => 1,
367			'nth-last-child' => 1,
368			'nth-of-type' => 1,
369			'nth-last-of-type' => 1,
370			}->{$class} and $self->{pseudo_class}->{$class}) {
371			$name = $class;
372
373			$state = BEFORE_AN_STATE;
374			$t = $tt->get_next_token;
375			## TODO: syntax of value in the spec is vague; need to reverse
376			## engineer what Opera 9.5 does.
377			redo S;
378			} else {
379			## TODO: error
380			return undef;
381			}
382			} elsif ($t->{type} == COLON_TOKEN and
383			not $in_negation) { ## Pseudo-element
384			$state = AFTER_DOUBLE_COLON_STATE;
385			$t = $tt->get_next_token;
386			redo S;
387			} else {
388			## TODO: error
389			return undef;
390			}
391			} elsif ($state == AFTER_LBRACKET_STATE) { ## Attribute selector
392			$simple_selector = [ATTRIBUTE_SELECTOR];
393			if ($t->{type} == IDENT_TOKEN) {
394			$name = $t->{value};
395
396			$state = AFTER_ATTR_NAME_STATE;
397			$t = $tt->get_next_token;
398			redo S;
399			} elsif ($t->{type} == VBAR_TOKEN) {
400			$simple_selector->[1] = ''; # null namespace
401
402			$state = BEFORE_ATTR_LOCAL_NAME_STATE;
403			$t = $tt->get_next_token;
404			redo S;
405			} elsif ($t->{type} == STAR_TOKEN) {
406			$name = undef;
407
408			$state = AFTER_ATTR_NAME_STATE;
409			$t = $tt->get_next_token;
410			redo S;
411			} elsif ($t->{type} == S_TOKEN) {
412			## Stay in the state.
413			$t = $tt->get_next_token;
414			redo S;
415			} else {
416			## TODO: error
417			return undef;
418			}
419			} elsif ($state == AFTER_ATTR_NAME_STATE) {
420			if ($t->{type} == VBAR_TOKEN) {
421			if (defined $name) {
422			my $uri = $self->{lookup_namespace_uri}->($name);
423			unless (defined $uri) {
424			## TODO: error
425			return undef;
426			}
427			$simple_selector->[1] = $uri;
428			}
429
430			$state = BEFORE_ATTR_LOCAL_NAME_STATE;
431			$t = $tt->get_next_token;
432			redo S;
433			} else {
434			unless (defined $name) { ## [*]
435			## TODO: error
436			return undef;
437			}
438			$simple_selector->[1] = ''; # null namespace
439			$simple_selector->[2] = $name;
440
441			$state = BEFORE_MATCH_STATE;
442			## Reprocess.
443			redo S;
444			}
445			} elsif ($state == BEFORE_ATTR_LOCAL_NAME_STATE) {
446			if ($t->{type} == IDENT_TOKEN) {
447			$simple_selector->[2] = $t->{value};
448
449			$state = BEFORE_MATCH_STATE;
450			$t = $tt->get_next_token;
451			redo S;
452			} else {
453			## TODO: error
454			return undef;
455			}
456			} elsif ($state == BEFORE_MATCH_STATE) {
457			if ({
458			MATCH_TOKEN, 1,
459			INCLUDES_TOKEN, 1,
460			DASHMATCH_TOKEN, 1,
461			PREFIXMATCH_TOKEN, 1,
462			SUFFIXMATCH_TOKEN, 1,
463			SUBSTRINGMATCH_TOKEN, 1,
464			}->{$t->{type}}) {
465			$simple_selector->[3] = $t->{type};
466
467			$state = BEFORE_VALUE_STATE;
468			$t = $tt->get_next_token;
469			redo S;
470			} elsif ($t->{type} == RBRACKET_TOKEN) {
471			push @$sss, $simple_selector;
472
473			$state = BEFORE_SIMPLE_SELECTOR_STATE;
474			$t = $tt->get_next_token;
475			redo S;
476			} elsif ($t->{type} == S_TOKEN) {
477			## Stay in the state.
478			$t = $tt->get_next_token;
479			redo S;
480			} else {
481			## TODO: error
482			return undef;
483			}
484			} elsif ($state == BEFORE_VALUE_STATE) {
485			if ($t->{type} == IDENT_TOKEN or $t->{type} == STRING_TOKEN) {
486			$simple_selector->[4] = $t->{value};
487			push @$sss, $simple_selector;
488
489			$state = AFTER_VALUE_STATE;
490			$t = $tt->get_next_token;
491			redo S;
492			} elsif ($t->{type} == S_TOKEN) {
493			## Stay in the state.
494			$t = $tt->get_next_token;
495			redo S;
496			} else {
497			## TODO: error
498			return undef;
499			}
500			} elsif ($state == AFTER_VALUE_STATE) {
501			if ($t->{type} == RBRACKET_TOKEN) {
502			$state = BEFORE_SIMPLE_SELECTOR_STATE;
503			$t = $tt->get_next_token;
504			redo S;
505			} else {
506			## TODO: error
507			return undef;
508			}
509			} elsif ($state == AFTER_DOUBLE_COLON_STATE) {
510			if ($t->{type} == IDENT_TOKEN) {
511			my $pe = $t->{value};
512			$pe =~ tr/A-Z/a-z/; ## TODO: Is ASCII case-insensitive OK?
513			if ($self->{pseudo_element}->{$pe} and
514			{'first-letter' => 1, 'first-line' => 1,
515			after => 1, before => 1}->{$pe}) {
516			push @$sss, [PSEUDO_ELEMENT_SELECTOR, $pe];
517			$has_pseudo_element = 1;
518
519			$state = BEFORE_SIMPLE_SELECTOR_STATE;
520			$t = $tt->get_next_token;
521			redo S;
522			} else {
523			## TODO: error
524			return undef;
525			}
526			} else {
527			## TODO: error
528			return undef
529			}
530			} elsif ($state == BEFORE_LANG_TAG_STATE) {
531			if ($t->{type} == IDENT_TOKEN) {
532			push @$sss, [PSEUDO_CLASS_SELECTOR, 'lang', $t->{value}];
533
534			$state = AFTER_LANG_TAG_STATE;
535			$t = $tt->get_next_token;
536			redo S;
537			} elsif ($t->{type} == S_TOKEN) {
538			## Stay in the state.
539			$t = $tt->get_next_token;
540			redo S;
541			} else {
542			## TODO: error
543			return undef;
544			}
545			} elsif ($state == AFTER_LANG_TAG_STATE) {
546			if ($t->{type} == RPAREN_TOKEN) {
547			$state = BEFORE_SIMPLE_SELECTOR_STATE;
548			$t = $tt->get_next_token;
549			redo S;
550			} elsif ($t->{type} == S_TOKEN) {
551			## Stay in the state.
552			$t = $tt->get_next_token;
553			redo S;
554			} else {
555			## TODO: error
556			return undef;
557			}
558			} elsif ($state == BEFORE_AN_STATE) {
559			if ($t->{type} == DIMENSION_TOKEN) {
560			if (int $t->{number} == $t->{number}) {
561			my $n = $t->{value};
562			$n =~ tr/A-Z/a-z/; ## TODO: ascii ?
563			if ($n eq 'n') {
564			$simple_selector = [PSEUDO_CLASS_SELECTOR, $name,
565			0+$t->{number}, 0];
566
567			$state = AFTER_AN_STATE;
568			$t = $tt->get_next_token;
569			redo S;
570			} elsif ($n =~ /\An-([0-9]+)\z/) {
571			push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 0+$t->{number}, 0-$1];
572
573			$state = AFTER_B_STATE;
574			$t = $tt->get_next_token;
575			redo S;
576			} else {
577			## TODO: error
578			return undef;
579			}
580			} else {
581			## TODO: error
582			return undef;
583			}
584			} elsif ($t->{type} == NUMBER_TOKEN) {
585			if (int $t->{number} == $t->{number}) {
586			push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 0, 0+$t->{number}];
587
588			$state = AFTER_B_STATE;
589			$t = $tt->get_next_token;
590			redo S;
591			} else { ## ISSUE: Is :nth-child(0.0) disallowed?
592			## TODO: error
593			return undef;
594			}
595			} elsif ($t->{type} == IDENT_TOKEN) {
596			my $value = $t->{value};
597			$value =~ tr/A-Z/a-z/; ## TODO: ASCII case-insensitive?
598			if ($value eq 'odd') {
599			push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 2, 1];
600
601			$state = AFTER_B_STATE;
602			$t = $tt->get_next_token;
603			redo S;
604			} elsif ($value eq 'even') {
605			push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 2, 0];
606
607			$state = AFTER_B_STATE;
608			$t = $tt->get_next_token;
609			redo S;
610			} elsif ($value eq 'n' or $value eq '-n') {
611			## ISSUE: :nth-child(-n) is not explicitly allowed, but appears
612			## in an example in the spec.
613			$simple_selector = [PSEUDO_CLASS_SELECTOR, $name,
614			$value eq 'n' ? 1 : -1, 0];
615
616			$state = AFTER_AN_STATE;
617			$t = $tt->get_next_token;
618			redo S;
619			} elsif ($value =~ /\A(-?)n-([0-9]+)\z/) {
620			push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 0+($1.'1'), -$2];
621
622			$state = AFTER_B_STATE;
623			$t = $tt->get_next_token;
624			redo S;
625			} else {
626			## TODO: error
627			return undef;
628			}
629			} elsif ($t->{type} == MINUS_TOKEN) {
630			## ISSUE: Is :nth-child(- 1) allowed?
631			## ISSUE: Is :nth-child(n-//6) or (-n-//6) allowed?
632			$t = $tt->get_next_token;
633			if ($t->{type} == DIMENSION_TOKEN \|\| $t->{type} == IDENT_TOKEN) {
634			my $num = $t->{type} == IDENT_TOKEN ? 1 : $t->{number};
635			## NOTE: :nth-child(-/**/n)
636			if (int $num == $num) {
637			my $n = $t->{value};
638			$n =~ tr/A-Z/a-z/; ## TODO: ASCII?
639			if ($n eq 'n') {
640			$simple_selector = [PSEUDO_CLASS_SELECTOR, $name, -$num, 0];
641
642			$state = AFTER_AN_STATE;
643			$t = $tt->get_next_token;
644			redo S;
645			} elsif ($n =~ /\An-([0-9]+)\z/) {
646			$simple_selector = [PSEUDO_CLASS_SELECTOR, $name,
647			-$num, -$1];
648
649			$state = AFTER_AN_STATE;
650			$t = $tt->get_next_token;
651			redo S;
652			} else {
653			## TODO: error
654			return undef;
655			}
656			} else {
657			## TODO: error
658			return undef;
659			}
660			} elsif ($t->{type} == NUMBER_TOKEN) {
661			if (int $t->{number} == $t->{number}) {
662			push @$sss, [PSEUDO_CLASS_SELECTOR, $name, 0, -$t->{number}];
663
664			$state = AFTER_B_STATE;
665			$t = $tt->get_next_token;
666			redo S;
667			} else {
668			## TODO: error
669			return undef;
670			}
671			} else {
672			## TODO: error
673			return undef;
674			}
675			} elsif ($t->{type} == S_TOKEN) {
676			## Stay in the state.
677			$t = $tt->get_next_token;
678			redo S;
679			} else {
680			## TODO: error
681			return undef;
682			}
683			} elsif ($state == AFTER_AN_STATE) {
684			## ISSUE: :nth-child(1n +2) is allowed.
685			## :nth-child(1n /**/ +2) and :nth-child(1n -2) are allowed?
686			if ($t->{type} == PLUS_TOKEN) {
687			$simple_selector->[3] = +1;
688
689			$state = BEFORE_B_STATE;
690			$t = $tt->get_next_token;
691			redo S;
692			} elsif ($t->{type} == MINUS_TOKEN) {
693			$simple_selector->[3] = -1;
694
695			$state = BEFORE_B_STATE;
696			$t = $tt->get_next_token;
697			redo S;
698			} elsif ($t->{type} == RPAREN_TOKEN) {
699			push @$sss, $simple_selector;
700
701			$state = BEFORE_SIMPLE_SELECTOR_STATE;
702			$t = $tt->get_next_token;
703			redo S;
704			} elsif ($t->{type} == S_TOKEN) {
705			## Stay in the state.
706			$t = $tt->get_next_token;
707			redo S;
708			} else {
709			## TODO: error
710			return undef;
711			}
712			} elsif ($state == BEFORE_B_STATE) {
713			## ISSUE: Is S allowed?
714			if ($t->{type} == NUMBER_TOKEN) {
715			if (int $t->{number} == $t->{number}) {
716			$simple_selector->[3] *= $t->{number};
717			push @$sss, $simple_selector;
718
719			$state = AFTER_B_STATE;
720			$t = $tt->get_next_token;
721			redo S;
722			} else {
723			## TODO: error
724			return undef;
725			}
726			} else {
727			## TODO: error
728			return undef;
729			}
730			} elsif ($state == AFTER_B_STATE) {
731			if ($t->{type} == RPAREN_TOKEN) {
732			$state = BEFORE_SIMPLE_SELECTOR_STATE;
733			$t = $tt->get_next_token;
734			redo S;
735			} elsif ($t->{type} == S_TOKEN) {
736			## Stay in the state.
737			$t = $tt->get_next_token;
738			redo S;
739			} else {
740			## TODO: error
741			return undef;
742			}
743			} elsif ($state == AFTER_NEGATION_SIMPLE_SELECTOR_STATE) {
744			if ($t->{type} == RPAREN_TOKEN) {
745			undef $in_negation;
746			my $simple_selector = [];
747			unshift @$simple_selector, pop @$sss while ref $sss->[-1];
748			pop @$sss; # dummy
749			unshift @$simple_selector, 'not';
750			unshift @$simple_selector, PSEUDO_CLASS_SELECTOR;
751			push @$sss, $simple_selector;
752
753			$state = BEFORE_SIMPLE_SELECTOR_STATE;
754			$t = $tt->get_next_token;
755			redo S;
756			} elsif ($t->{type} == S_TOKEN) {
757			## Stay in the state.
758			$t = $tt->get_next_token;
759			redo S;
760			} else {
761			## TODO: error
762			return undef;
763			}
764			} else {
765			die "$0: Selectors Parser: $state: Unknown state";
766			}
767			} # S
768			} # parse_string
769
770			1;