Whatpm/CSS/SelectorsSerializer.pm

package Whatpm::CSS::SelectorsSerializer;
use strict;

use Whatpm::CSS::SelectorsParser qw(:selector :combinator :match);

sub serialize_test ($$$) {
  my (undef, $selectors, $ns) = @_;
  $ns ||= {};
  my $i = 0;
  my $ident = sub {
    my $s = shift;
    $s =~ s{([^A-Za-z_0-9\x80-\x{D7FF}\x{E000}-\x{10FFFF}-])}{
      my $v = ord $1;
      sprintf '\\%06X',$v > 0x10FFFF ? 0xFFFFFF : $v;
    }ge;
    $s =~ s/^([0-9])/\\00003$1/g;
    $s =~ s/^-([^A-Za-z_])/\\00002D$1/g;
    return $s;
  }; # $str
  my $str = sub {
    my $s = shift;
    $s =~ s{([^\x20\x21\x23-\x5B\x5D-\x{D7FF}\x{E000}-\x{10FFFF}])}{
      my $v = ord $1;
      sprintf '\\%06X',$v > 0x10FFFF ? 0xFFFFFF : $v;
    }ge;
    return '"'.$s.'"';
  }; # $str
  my $r = join ",\n", map {
    join "", map {
      if (ref $_) {
        my $ss = [];
        $ss->[LOCAL_NAME_SELECTOR] = [LOCAL_NAME_SELECTOR, undef];
        for my $s (@$_) {
          if ($s->[0] == NAMESPACE_SELECTOR or
              $s->[0] == LOCAL_NAME_SELECTOR) {
            $ss->[$s->[0]] = $s;
          } else {
            push @{$ss->[$s->[0]] ||= []}, $s;
          }
        }
        
        my $v = '';
        if (not defined $ss->[NAMESPACE_SELECTOR]) {
          $v .= '*|';
        } elsif (defined $ss->[NAMESPACE_SELECTOR]->[1]) {
          unless (defined $ns->{$ss->[NAMESPACE_SELECTOR]->[1]}) {
            $ns->{$ss->[NAMESPACE_SELECTOR]->[1]} = 'n' . ++$i;
          }
          $v .= $ns->{$ss->[NAMESPACE_SELECTOR]->[1]} . '|';
        } else {
          $v .= '|';
        }

        if (defined $ss->[LOCAL_NAME_SELECTOR]->[1]) {
          $v .= $ident->($ss->[LOCAL_NAME_SELECTOR]->[1]);
        } else {
          $v .= '*';
        }

        $v .= join '', sort {$a cmp $b} map {
          '[' .
          (defined $_->[1] ?
            $_->[1] eq '' ? '' : ($ns->{$_->[1]} ||= 'n'.++$i) : '*') .
          '|' .
          $ident->($_->[2]) .
          ($_->[3] != EXISTS_MATCH ?
            {EQUALS_MATCH, '=',
             INCLUDES_MATCH, '~=',
             DASH_MATCH, '|=',
             PREFIX_MATCH, '^=',
             SUFFIX_MATCH, '$=',
             SUBSTRING_MATCH, '*='}->{$_->[3]} .
            $str->($_->[4])
          : '') .
          ']';
        } @{$ss->[ATTRIBUTE_SELECTOR] || []};

        $v .= join '', sort {$a cmp $b} map {
          '.' . $ident->($_->[1]);
        } @{$ss->[CLASS_SELECTOR] || []};

        $v .= join '', sort {$a cmp $b} map {
          '#' . $ident->($_->[1]);
        } @{$ss->[ID_SELECTOR] || []};

        $v .= join '', sort {$a cmp $b} map {
          my $v = $_;
          if ($v->[1] eq 'lang') {
            ':lang(' . $ident->($v->[2]) . ')';
          } elsif ($v->[1] eq 'not') {
            my $v = Whatpm::CSS::SelectorsSerializer->serialize_test
                ([[DESCENDANT_COMBINATOR, [@{$v}[2..$#{$v}]]]], $ns);
            $v =~ s/^    \*\|\*(?!$)/    /;
            ":not(\n    " . $v . "    )";
          } elsif ({'nth-child' => 1,
                    'nth-last-child' => 1,
                    'nth-of-type' => 1,
                    'nth-last-of-type' => 1}->{$v->[1]}) {
            ':' . $ident->($v->[1]) . '(' .
            ($v->[2] . 'n' . ($v->[3] < 0 ? $v->[3] : '+' . $v->[3])) . ')';
          } else {
            ':' . $ident->($v->[1]);
          }
        } @{$ss->[PSEUDO_CLASS_SELECTOR] || []};

        $v .= join '', sort {$a cmp $b} map {
          '::' . $ident->($_->[1]);
        } @{$ss->[PSEUDO_ELEMENT_SELECTOR] || []};

        $v . "\n";
      } else {
        "  " . {
          DESCENDANT_COMBINATOR, ' ',
          CHILD_COMBINATOR, '>',
          ADJACENT_SIBLING_COMBINATOR, '+',
          GENERAL_SIBLING_COMBINATOR, '~',
        }->{$_} . " ";
      }
    } @$_;
  } @$selectors;  

  return wantarray ? ($r, join '', map {
    '@namespace ' . $ns->{$_} . ' ' . $str->($_) . ";\n";
  } sort {$a cmp $b} keys %$ns) : $r;
} # serialize_test

1;
1	wakaba	1.1	package Whatpm::CSS::SelectorsSerializer;
2			use strict;
3
4			use Whatpm::CSS::SelectorsParser qw(:selector :combinator :match);
5
6			sub serialize_test ($$$) {
7			my (undef, $selectors, $ns) = @_;
8			$ns \|\|= {};
9			my $i = 0;
10			my $ident = sub {
11			my $s = shift;
12			$s =~ s{([^A-Za-z_0-9\x80-\x{D7FF}\x{E000}-\x{10FFFF}-])}{
13			my $v = ord $1;
14			sprintf '\\%06X',$v > 0x10FFFF ? 0xFFFFFF : $v;
15			}ge;
16			$s =~ s/^([0-9])/\\00003$1/g;
17			$s =~ s/^-([^A-Za-z_])/\\00002D$1/g;
18			return $s;
19			}; # $str
20			my $str = sub {
21			my $s = shift;
22			$s =~ s{([^\x20\x21\x23-\x5B\x5D-\x{D7FF}\x{E000}-\x{10FFFF}])}{
23			my $v = ord $1;
24			sprintf '\\%06X',$v > 0x10FFFF ? 0xFFFFFF : $v;
25			}ge;
26			return '"'.$s.'"';
27			}; # $str
28			my $r = join ",\n", map {
29			join "", map {
30			if (ref $_) {
31			my $ss = [];
32			$ss->[LOCAL_NAME_SELECTOR] = [LOCAL_NAME_SELECTOR, undef];
33			for my $s (@$_) {
34			if ($s->[0] == NAMESPACE_SELECTOR or
35			$s->[0] == LOCAL_NAME_SELECTOR) {
36			$ss->[$s->[0]] = $s;
37			} else {
38			push @{$ss->[$s->[0]] \|\|= []}, $s;
39			}
40			}
41
42			my $v = '';
43			if (not defined $ss->[NAMESPACE_SELECTOR]) {
44			$v .= '*\|';
45			} elsif (defined $ss->[NAMESPACE_SELECTOR]->[1]) {
46			unless (defined $ns->{$ss->[NAMESPACE_SELECTOR]->[1]}) {
47			$ns->{$ss->[NAMESPACE_SELECTOR]->[1]} = 'n' . ++$i;
48			}
49			$v .= $ns->{$ss->[NAMESPACE_SELECTOR]->[1]} . '\|';
50			} else {
51			$v .= '\|';
52			}
53
54			if (defined $ss->[LOCAL_NAME_SELECTOR]->[1]) {
55			$v .= $ident->($ss->[LOCAL_NAME_SELECTOR]->[1]);
56			} else {
57			$v .= '*';
58			}
59
60			$v .= join '', sort {$a cmp $b} map {
61			'[' .
62			(defined $_->[1] ?
63			$_->[1] eq '' ? '' : ($ns->{$_->[1]} \|\|= 'n'.++$i) : '*') .
64			'\|' .
65			$ident->($_->[2]) .
66			($_->[3] != EXISTS_MATCH ?
67			{EQUALS_MATCH, '=',
68			INCLUDES_MATCH, '~=',
69			DASH_MATCH, '\|=',
70			PREFIX_MATCH, '^=',
71			SUFFIX_MATCH, '$=',
72			SUBSTRING_MATCH, '*='}->{$_->[3]} .
73			$str->($_->[4])
74			: '') .
75			']';
76			} @{$ss->[ATTRIBUTE_SELECTOR] \|\| []};
77
78			$v .= join '', sort {$a cmp $b} map {
79			'.' . $ident->($_->[1]);
80			} @{$ss->[CLASS_SELECTOR] \|\| []};
81
82			$v .= join '', sort {$a cmp $b} map {
83			'#' . $ident->($_->[1]);
84			} @{$ss->[ID_SELECTOR] \|\| []};
85
86			$v .= join '', sort {$a cmp $b} map {
87			my $v = $_;
88			if ($v->[1] eq 'lang') {
89			':lang(' . $ident->($v->[2]) . ')';
90			} elsif ($v->[1] eq 'not') {
91			my $v = Whatpm::CSS::SelectorsSerializer->serialize_test
92			([[DESCENDANT_COMBINATOR, [@{$v}[2..$#{$v}]]]], $ns);
93			$v =~ s/^ \\\|\(?!$)/ /;
94			":not(\n " . $v . " )";
95			} elsif ({'nth-child' => 1,
96			'nth-last-child' => 1,
97			'nth-of-type' => 1,
98			'nth-last-of-type' => 1}->{$v->[1]}) {
99			':' . $ident->($v->[1]) . '(' .
100			($v->[2] . 'n' . ($v->[3] < 0 ? $v->[3] : '+' . $v->[3])) . ')';
101			} else {
102			':' . $ident->($v->[1]);
103			}
104			} @{$ss->[PSEUDO_CLASS_SELECTOR] \|\| []};
105
106			$v .= join '', sort {$a cmp $b} map {
107			'::' . $ident->($_->[1]);
108			} @{$ss->[PSEUDO_ELEMENT_SELECTOR] \|\| []};
109
110			$v . "\n";
111			} else {
112			" " . {
113			DESCENDANT_COMBINATOR, ' ',
114			CHILD_COMBINATOR, '>',
115			ADJACENT_SIBLING_COMBINATOR, '+',
116			GENERAL_SIBLING_COMBINATOR, '~',
117			}->{$_} . " ";
118			}
119			} @$_;
120			} @$selectors;
121
122			return wantarray ? ($r, join '', map {
123			'@namespace ' . $ns->{$_} . ' ' . $str->($_) . ";\n";
124			} sort {$a cmp $b} keys %$ns) : $r;
125			} # serialize_test
126
127			1;