Whatpm/CSS/Cascade.pm

package Whatpm::CSS::Cascade;
use strict;

require Whatpm::CSS::Parser; ## NOTE: For property definitions.
require Whatpm::CSS::SelectorsSerializer;
use Scalar::Util qw/refaddr/;

## Cascading and value computations

sub new ($$) {
  my $self = bless {style_sheets => []}, shift;
  $self->{document} = shift;

  ## Device dependent font size parameters
  my @scale = (3/5, 3/4, 8/9, 1, 6/5, 3/2, 2/1, 3/1); ## From css3-fonts
  $self->{font_size}->[$_] = 16 * $scale[$_] for 0..$#scale;
  ## TODO: Provide better default
  $self->{get_smaller_font_size} = sub ($$) {
    #my ($self, $original_px) = @_;
    return $_[1] / 1.1;
  };
  ## TODO: Provide better default
  $self->{get_larger_font_size} = sub ($$) {
    #my ($self, $original_px) = @_;
    return $_[1] * 1.1;
  };
  ## $self->{has_invert}: Should be same as
  ##     $parser->{prop_value}->{'outline-color'}->{invert}.

  return $self;
} # new

## NOTE: This version does not support dynamic addition --- style
## sheets must be added before any other operation.
## NOTE: The $ss argument must be a value that can be interpreted as
## an array reference of CSSStyleSheet objects.
## NOTE: |type| and |media| attributes are not accounted by this
## method (and any others in the class); CSSStyleSheet objects must
## be filtered before they are passed to this method.
sub add_style_sheets ($$) {
  my ($self, $ss) = @_;

  push @{$self->{style_sheets}}, @$ss;
} # add_style_sheets

## TODO: non-CSS presentation hints
## TODO: style=""

sub ___associate_rules ($) {
  my $self = shift;

  my $selectors_to_elements;

  for my $sheet (@{$self->{style_sheets}}) {
    ## TODO: @media
    ## TODO: @import
    ## TODO: style sheet sources

    for my $rule (@{$sheet->css_rules}) {
      next if $rule->type != 1; # STYLE_RULE

      my $elements_to_specificity = {};

      for my $selector (@{$$rule->{_selectors}}) {
        ## TODO: Data::Dumper is faster?
        my $selector_str = Whatpm::CSS::SelectorsSerializer->serialize_test
            ([$selector]);
        unless ($selectors_to_elements->{$selector_str}) {
          $selectors_to_elements->{$selector_str}
              = $self->{document}->___query_selector_all ([$selector]);
        }
        next unless @{$selectors_to_elements->{$selector_str}};

        my $selector_specificity
            = Whatpm::CSS::SelectorsParser->get_selector_specificity
                ($selector);
        for (@{$selectors_to_elements->{$selector_str}}) {
          my $current_specificity = $elements_to_specificity->{refaddr $_};
          if (not defined $current_specificity or ## "*"-only case.
              $selector_specificity->[0] > $current_specificity->[0] or
              $selector_specificity->[1] > $current_specificity->[1] or
              $selector_specificity->[2] > $current_specificity->[2] or
              $selector_specificity->[3] > $current_specificity->[3]) {
            $elements_to_specificity->{refaddr $_} = $selector_specificity;
          }
        }
      }

      my $sd = $rule->style;
      for (keys %$elements_to_specificity) {
        push @{$self->{element_to_sds}->{$_} ||= []},
            [$sd, $elements_to_specificity->{$_}];
      }
    }
  }

  for my $eid (keys %{$self->{element_to_sds} or {}}) {
    $self->{element_to_sds}->{$eid} = [sort {
      $a->[1]->[0] <=> $b->[1]->[0] or
      $a->[1]->[1] <=> $b->[1]->[1] or
      $a->[1]->[2] <=> $b->[1]->[2] or 
      $a->[1]->[3] <=> $b->[1]->[3]
      ## NOTE: Perl |sort| is stable.
    } @{$self->{element_to_sds}->{$eid} or []}];
  }
} # associate_rules

sub get_cascaded_value ($$$) {
  my ($self, $element, $prop_name) = @_;
  return undef unless $Whatpm::CSS::Parser::Prop->{$prop_name};

  my $key = $Whatpm::CSS::Parser::Prop->{$prop_name}->{key};
  return undef unless defined $key; ## Shorthand property or some.

  my $value;
  for my $sds (reverse @{$self->{element_to_sds}->{refaddr $element} or []}) {
    my $vp = ${$sds->[0]}->{$key};
    if ($vp->[1] eq 'important') {
      return $vp->[0];
    } else {
      $value = $vp->[0] unless defined $value;
    }
  }

  return $value; # might be |undef|.
} # get_cascaded_value

sub get_specified_value ($$$) {
  my ($self, $element, $prop_name) = @_;

  ## TODO: Remove {specified_value} caching, once we implement most
  ## of CSS 2.1 properties and confirm that it makes almost non sence
  ## because of its duplication with {computed_value} caching.

  ## NOTE: |top| computation refers |bottom| and vice versa.
  ## |left| does |right| and vice versa.

  my $eid = refaddr $element;
  unless (exists $self->{specified_value}->{$eid}->{$prop_name}) {
    my $cascaded = $self->get_cascaded_value ($element, $prop_name);
    $self->{specified_value}->{$eid}->{$prop_name} = $cascaded;
    
    unless (defined $cascaded) {
      my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
      if (defined $prop_def) {
        if ($prop_def->{inherited}) {
          my $parent_element = $element->manakai_parent_element;
          if (defined $parent_element) {
            $self->{specified_value}->{$eid}->{$prop_name}
                = $self->get_computed_value ($parent_element, $prop_name);
          } else {
            $self->{specified_value}->{$eid}->{$prop_name}
                = $prop_def->{initial};
          }
        } else {
          $self->{specified_value}->{$eid}->{$prop_name}
              = $prop_def->{initial};
        }
      } else {
        $self->{specified_value}->{$eid}->{$prop_name} = undef;
      }
    }
  }

  ## NOTE: Always |undef| for shorthand properties.

  return $self->{specified_value}->{$eid}->{$prop_name};
} # get_specified_value

sub get_specified_value_no_inherit ($$$) {
  my ($self, $element, $prop_name) = @_;

  my $specified = $self->get_specified_value ($element, $prop_name);
  if (defined $specified and $specified->[0] eq 'INHERIT') {
    ## ISSUE: CSS 2.1 does not say to resolve computed value of the parent.
    ## However, it is necessary for some cases (see
    ## <http://suika.fam.cx/gate/2005/sw/inherit>).  In addition,
    ## the initial value is not a computed value for some properties.
    my $parent_element = $element->manakai_parent_element;
    if (defined $parent_element) {
      $specified = $self->get_computed_value ($parent_element, $prop_name);
    } else {
      my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
      $specified = $prop_def->{initial};
    }
    ## NOTE: Because of this handling, {compute} codes must be
    ## idempotent.
  }
  return $specified;
} # get_specified_value_no_inherit

sub get_computed_value ($$$) {
  my ($self, $element, $prop_name) = @_;

  my $eid = refaddr $element;
  unless (exists $self->{computed_value}->{$eid}->{$prop_name}) {
    my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
    if (defined $prop_def) {
      if ($prop_def->{compute_multiple}) {
        $prop_def->{compute_multiple}->($self, $element, $eid, $prop_name);
      } else {
        my $specified = $self->get_specified_value_no_inherit
            ($element, $prop_name);
        $self->{computed_value}->{$eid}->{$prop_name}
            = $prop_def->{compute}->($self, $element, $prop_name, $specified);
      }
    } else {
      $self->{computed_value}->{$eid}->{$prop_name} = undef;
    }
  }

  ## NOTE: Always |undef| for shorthand properties.

  return $self->{computed_value}->{$eid}->{$prop_name};
} # get_computed_value

1;
## $Date: 2008/01/14 11:21:22 $
1	package Whatpm::CSS::Cascade;
2	use strict;
3
4	require Whatpm::CSS::Parser; ## NOTE: For property definitions.
5	require Whatpm::CSS::SelectorsSerializer;
6	use Scalar::Util qw/refaddr/;
7
8	## Cascading and value computations
9
10	sub new ($$) {
11	my $self = bless {style_sheets => []}, shift;
12	$self->{document} = shift;
13
14	## Device dependent font size parameters
15	my @scale = (3/5, 3/4, 8/9, 1, 6/5, 3/2, 2/1, 3/1); ## From css3-fonts
16	$self->{font_size}->[$_] = 16 * $scale[$_] for 0..$#scale;
17	## TODO: Provide better default
18	$self->{get_smaller_font_size} = sub ($$) {
19	#my ($self, $original_px) = @_;
20	return $_[1] / 1.1;
21	};
22	## TODO: Provide better default
23	$self->{get_larger_font_size} = sub ($$) {
24	#my ($self, $original_px) = @_;
25	return $_[1] * 1.1;
26	};
27	## $self->{has_invert}: Should be same as
28	## $parser->{prop_value}->{'outline-color'}->{invert}.
29
30	return $self;
31	} # new
32
33	## NOTE: This version does not support dynamic addition --- style
34	## sheets must be added before any other operation.
35	## NOTE: The $ss argument must be a value that can be interpreted as
36	## an array reference of CSSStyleSheet objects.
37	## NOTE: \|type\| and \|media\| attributes are not accounted by this
38	## method (and any others in the class); CSSStyleSheet objects must
39	## be filtered before they are passed to this method.
40	sub add_style_sheets ($$) {
41	my ($self, $ss) = @_;
42
43	push @{$self->{style_sheets}}, @$ss;
44	} # add_style_sheets
45
46	## TODO: non-CSS presentation hints
47	## TODO: style=""
48
49	sub ___associate_rules ($) {
50	my $self = shift;
51
52	my $selectors_to_elements;
53
54	for my $sheet (@{$self->{style_sheets}}) {
55	## TODO: @media
56	## TODO: @import
57	## TODO: style sheet sources
58
59	for my $rule (@{$sheet->css_rules}) {
60	next if $rule->type != 1; # STYLE_RULE
61
62	my $elements_to_specificity = {};
63
64	for my $selector (@{$$rule->{_selectors}}) {
65	## TODO: Data::Dumper is faster?
66	my $selector_str = Whatpm::CSS::SelectorsSerializer->serialize_test
67	([$selector]);
68	unless ($selectors_to_elements->{$selector_str}) {
69	$selectors_to_elements->{$selector_str}
70	= $self->{document}->___query_selector_all ([$selector]);
71	}
72	next unless @{$selectors_to_elements->{$selector_str}};
73
74	my $selector_specificity
75	= Whatpm::CSS::SelectorsParser->get_selector_specificity
76	($selector);
77	for (@{$selectors_to_elements->{$selector_str}}) {
78	my $current_specificity = $elements_to_specificity->{refaddr $_};
79	if (not defined $current_specificity or ## "*"-only case.
80	$selector_specificity->[0] > $current_specificity->[0] or
81	$selector_specificity->[1] > $current_specificity->[1] or
82	$selector_specificity->[2] > $current_specificity->[2] or
83	$selector_specificity->[3] > $current_specificity->[3]) {
84	$elements_to_specificity->{refaddr $_} = $selector_specificity;
85	}
86	}
87	}
88
89	my $sd = $rule->style;
90	for (keys %$elements_to_specificity) {
91	push @{$self->{element_to_sds}->{$_} \|\|= []},
92	[$sd, $elements_to_specificity->{$_}];
93	}
94	}
95	}
96
97	for my $eid (keys %{$self->{element_to_sds} or {}}) {
98	$self->{element_to_sds}->{$eid} = [sort {
99	$a->[1]->[0] <=> $b->[1]->[0] or
100	$a->[1]->[1] <=> $b->[1]->[1] or
101	$a->[1]->[2] <=> $b->[1]->[2] or
102	$a->[1]->[3] <=> $b->[1]->[3]
103	## NOTE: Perl \|sort\| is stable.
104	} @{$self->{element_to_sds}->{$eid} or []}];
105	}
106	} # associate_rules
107
108	sub get_cascaded_value ($$$) {
109	my ($self, $element, $prop_name) = @_;
110	return undef unless $Whatpm::CSS::Parser::Prop->{$prop_name};
111
112	my $key = $Whatpm::CSS::Parser::Prop->{$prop_name}->{key};
113	return undef unless defined $key; ## Shorthand property or some.
114
115	my $value;
116	for my $sds (reverse @{$self->{element_to_sds}->{refaddr $element} or []}) {
117	my $vp = ${$sds->[0]}->{$key};
118	if ($vp->[1] eq 'important') {
119	return $vp->[0];
120	} else {
121	$value = $vp->[0] unless defined $value;
122	}
123	}
124
125	return $value; # might be \|undef\|.
126	} # get_cascaded_value
127
128	sub get_specified_value ($$$) {
129	my ($self, $element, $prop_name) = @_;
130
131	## TODO: Remove {specified_value} caching, once we implement most
132	## of CSS 2.1 properties and confirm that it makes almost non sence
133	## because of its duplication with {computed_value} caching.
134
135	## NOTE: \|top\| computation refers \|bottom\| and vice versa.
136	## \|left\| does \|right\| and vice versa.
137
138	my $eid = refaddr $element;
139	unless (exists $self->{specified_value}->{$eid}->{$prop_name}) {
140	my $cascaded = $self->get_cascaded_value ($element, $prop_name);
141	$self->{specified_value}->{$eid}->{$prop_name} = $cascaded;
142
143	unless (defined $cascaded) {
144	my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
145	if (defined $prop_def) {
146	if ($prop_def->{inherited}) {
147	my $parent_element = $element->manakai_parent_element;
148	if (defined $parent_element) {
149	$self->{specified_value}->{$eid}->{$prop_name}
150	= $self->get_computed_value ($parent_element, $prop_name);
151	} else {
152	$self->{specified_value}->{$eid}->{$prop_name}
153	= $prop_def->{initial};
154	}
155	} else {
156	$self->{specified_value}->{$eid}->{$prop_name}
157	= $prop_def->{initial};
158	}
159	} else {
160	$self->{specified_value}->{$eid}->{$prop_name} = undef;
161	}
162	}
163	}
164
165	## NOTE: Always \|undef\| for shorthand properties.
166
167	return $self->{specified_value}->{$eid}->{$prop_name};
168	} # get_specified_value
169
170	sub get_specified_value_no_inherit ($$$) {
171	my ($self, $element, $prop_name) = @_;
172
173	my $specified = $self->get_specified_value ($element, $prop_name);
174	if (defined $specified and $specified->[0] eq 'INHERIT') {
175	## ISSUE: CSS 2.1 does not say to resolve computed value of the parent.
176	## However, it is necessary for some cases (see
177	## <http://suika.fam.cx/gate/2005/sw/inherit>). In addition,
178	## the initial value is not a computed value for some properties.
179	my $parent_element = $element->manakai_parent_element;
180	if (defined $parent_element) {
181	$specified = $self->get_computed_value ($parent_element, $prop_name);
182	} else {
183	my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
184	$specified = $prop_def->{initial};
185	}
186	## NOTE: Because of this handling, {compute} codes must be
187	## idempotent.
188	}
189	return $specified;
190	} # get_specified_value_no_inherit
191
192	sub get_computed_value ($$$) {
193	my ($self, $element, $prop_name) = @_;
194
195	my $eid = refaddr $element;
196	unless (exists $self->{computed_value}->{$eid}->{$prop_name}) {
197	my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
198	if (defined $prop_def) {
199	if ($prop_def->{compute_multiple}) {
200	$prop_def->{compute_multiple}->($self, $element, $eid, $prop_name);
201	} else {
202	my $specified = $self->get_specified_value_no_inherit
203	($element, $prop_name);
204	$self->{computed_value}->{$eid}->{$prop_name}
205	= $prop_def->{compute}->($self, $element, $prop_name, $specified);
206	}
207	} else {
208	$self->{computed_value}->{$eid}->{$prop_name} = undef;
209	}
210	}
211
212	## NOTE: Always \|undef\| for shorthand properties.
213
214	return $self->{computed_value}->{$eid}->{$prop_name};
215	} # get_computed_value
216
217	1;
218	## $Date: 2008/01/14 11:21:22 $