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;
  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}}) {
        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 ($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 (defined $vp->[1] and $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.
  
  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_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) {
      my $specified = $self->get_specified_value ($element, $prop_name);
      if (defined $specified and $specified->[0] eq 'INHERIT') {
        my $parent_element = $element->manakai_parent_element;
        if (defined $parent_element) {
          $self->{computed_value}->{$eid}->{$prop_name}
              = $self->get_computed_value ($parent_element, $prop_name);
        } else {
          $self->{computed_value}->{$eid}->{$prop_name}
              = $prop_def->{initial};
        }
      } else {
        $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/01 07:07:28 $
1	wakaba	1.1	package Whatpm::CSS::Cascade;
2	wakaba	1.4	use strict;
3	wakaba	1.1
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			return $self;
14			} # new
15
16			## NOTE: This version does not support dynamic addition --- style
17			## sheets must be added before any other operation.
18			## NOTE: The $ss argument must be a value that can be interpreted as
19			## an array reference of CSSStyleSheet objects.
20			## NOTE: \|type\| and \|media\| attributes are not accounted by this
21			## method (and any others in the class); CSSStyleSheet objects must
22			## be filtered before they are passed to this method.
23			sub add_style_sheets ($$) {
24			my ($self, $ss) = @_;
25
26			push @{$self->{style_sheets}}, @$ss;
27			} # add_style_sheets
28
29			## TODO: non-CSS presentation hints
30			## TODO: style=""
31
32			sub ___associate_rules ($) {
33			my $self = shift;
34
35			my $selectors_to_elements;
36
37			for my $sheet (@{$self->{style_sheets}}) {
38			## TODO: @media
39			## TODO: @import
40			## TODO: style sheet sources
41
42			for my $rule (@{$sheet->css_rules}) {
43			next if $rule->type != 1; # STYLE_RULE
44
45	wakaba	1.2	my $elements_to_specificity = {};
46
47			for my $selector (@{$$rule->{_selectors}}) {
48			my $selector_str = Whatpm::CSS::SelectorsSerializer->serialize_test
49			([$selector]);
50			unless ($selectors_to_elements->{$selector_str}) {
51			$selectors_to_elements->{$selector_str}
52			= $self->{document}->___query_selector_all ([$selector]);
53			}
54			next unless @{$selectors_to_elements->{$selector_str}};
55
56			my $selector_specificity
57			= Whatpm::CSS::SelectorsParser->get_selector_specificity
58			($selector);
59			for (@{$selectors_to_elements->{$selector_str}}) {
60			my $current_specificity = $elements_to_specificity->{refaddr $_};
61			if ($selector_specificity->[0] > $current_specificity->[0] or
62			$selector_specificity->[1] > $current_specificity->[1] or
63			$selector_specificity->[2] > $current_specificity->[2] or
64			$selector_specificity->[3] > $current_specificity->[3]) {
65			$elements_to_specificity->{refaddr $_} = $selector_specificity;
66			}
67			}
68			}
69
70			my $sd = $rule->style;
71			for (keys %$elements_to_specificity) {
72			push @{$self->{element_to_sds}->{$_} \|\|= []},
73			[$sd, $elements_to_specificity->{$_}];
74	wakaba	1.1	}
75			}
76			}
77
78	wakaba	1.2	for my $eid (keys %{$self->{element_to_sds} or {}}) {
79			$self->{element_to_sds}->{$eid} = [sort {
80			$a->[1]->[0] <=> $b->[1]->[0] or
81			$a->[1]->[1] <=> $b->[1]->[1] or
82			$a->[1]->[2] <=> $b->[1]->[2] or
83			$a->[1]->[3] <=> $b->[1]->[3]
84			## NOTE: Perl \|sort\| is stable.
85			} @{$self->{element_to_sds}->{$eid} or []}];
86			}
87	wakaba	1.1	} # associate_rules
88
89			sub get_cascaded_value ($$$) {
90			my ($self, $element, $prop_name) = @_;
91			return undef unless $Whatpm::CSS::Parser::Prop->{$prop_name};
92
93			my $key = $Whatpm::CSS::Parser::Prop->{$prop_name}->{key};
94	wakaba	1.3	return undef unless defined $key; ## Shorthand property or some.
95	wakaba	1.1
96	wakaba	1.2	my $value;
97			for my $sds (reverse @{$self->{element_to_sds}->{refaddr $element} or []}) {
98			my $vp = ${$sds->[0]}->{$key};
99			if (defined $vp->[1] and $vp->[1] eq 'important') {
100			return $vp->[0];
101			} else {
102			$value = $vp->[0] unless defined $value;
103			}
104	wakaba	1.1	}
105
106	wakaba	1.2	return $value; # might be \|undef\|.
107	wakaba	1.1	} # get_cascaded_value
108
109	wakaba	1.3	sub get_specified_value ($$$) {
110			my ($self, $element, $prop_name) = @_;
111
112			## TODO: Remove {specified_value} caching, once we implement most
113			## of CSS 2.1 properties and confirm that it makes almost non sence
114			## because of its duplication with {computed_value} caching.
115
116			my $eid = refaddr $element;
117			unless (exists $self->{specified_value}->{$eid}->{$prop_name}) {
118			my $cascaded = $self->get_cascaded_value ($element, $prop_name);
119			$self->{specified_value}->{$eid}->{$prop_name} = $cascaded;
120
121			unless (defined $cascaded) {
122			my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
123			if (defined $prop_def) {
124			if ($prop_def->{inherited}) {
125			my $parent_element = $element->manakai_parent_element;
126			if (defined $parent_element) {
127			$self->{specified_value}->{$eid}->{$prop_name}
128			= $self->get_computed_value ($parent_element, $prop_name);
129			} else {
130			$self->{specified_value}->{$eid}->{$prop_name}
131			= $prop_def->{initial};
132			}
133			} else {
134			$self->{specified_value}->{$eid}->{$prop_name}
135			= $prop_def->{initial};
136			}
137			} else {
138			$self->{specified_value}->{$eid}->{$prop_name} = undef;
139			}
140			}
141			}
142
143			## NOTE: Always \|undef\| for shorthand properties.
144
145			return $self->{specified_value}->{$eid}->{$prop_name};
146			} # get_specified_value
147
148			sub get_computed_value ($$$) {
149			my ($self, $element, $prop_name) = @_;
150
151			my $eid = refaddr $element;
152			unless (exists $self->{computed_value}->{$eid}->{$prop_name}) {
153			my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
154			if (defined $prop_def) {
155	wakaba	1.4	my $specified = $self->get_specified_value ($element, $prop_name);
156			if (defined $specified and $specified->[0] eq 'INHERIT') {
157			my $parent_element = $element->manakai_parent_element;
158			if (defined $parent_element) {
159			$self->{computed_value}->{$eid}->{$prop_name}
160			= $self->get_computed_value ($parent_element, $prop_name);
161			} else {
162			$self->{computed_value}->{$eid}->{$prop_name}
163			= $prop_def->{initial};
164			}
165			} else {
166			$self->{computed_value}->{$eid}->{$prop_name}
167			= $prop_def->{compute}->($self, $element, $prop_name, $specified);
168			}
169	wakaba	1.3	} else {
170			$self->{computed_value}->{$eid}->{$prop_name} = undef;
171			}
172			}
173
174			## NOTE: Always \|undef\| for shorthand properties.
175
176			return $self->{computed_value}->{$eid}->{$prop_name};
177			} # get_computed_value
178	wakaba	1.1
179			1;
180	wakaba	1.4	## $Date: 2008/01/01 07:07:28 $