Whatpm/CSS/Cascade.pm

package Whatpm::CSS::Cascade;

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};

  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


1;
## $Date: 2007/12/31 13:47:49 $
1	wakaba	1.1	package Whatpm::CSS::Cascade;
2
3			require Whatpm::CSS::Parser; ## NOTE: For property definitions.
4			require Whatpm::CSS::SelectorsSerializer;
5			use Scalar::Util qw/refaddr/;
6
7			## Cascading and value computations
8
9			sub new ($$) {
10			my $self = bless {style_sheets => []}, shift;
11			$self->{document} = shift;
12			return $self;
13			} # new
14
15			## NOTE: This version does not support dynamic addition --- style
16			## sheets must be added before any other operation.
17			## NOTE: The $ss argument must be a value that can be interpreted as
18			## an array reference of CSSStyleSheet objects.
19			## NOTE: \|type\| and \|media\| attributes are not accounted by this
20			## method (and any others in the class); CSSStyleSheet objects must
21			## be filtered before they are passed to this method.
22			sub add_style_sheets ($$) {
23			my ($self, $ss) = @_;
24
25			push @{$self->{style_sheets}}, @$ss;
26			} # add_style_sheets
27
28			## TODO: non-CSS presentation hints
29			## TODO: style=""
30
31			sub ___associate_rules ($) {
32			my $self = shift;
33
34			my $selectors_to_elements;
35
36			for my $sheet (@{$self->{style_sheets}}) {
37			## TODO: @media
38			## TODO: @import
39			## TODO: style sheet sources
40
41			for my $rule (@{$sheet->css_rules}) {
42			next if $rule->type != 1; # STYLE_RULE
43
44	wakaba	1.2	my $elements_to_specificity = {};
45
46			for my $selector (@{$$rule->{_selectors}}) {
47			my $selector_str = Whatpm::CSS::SelectorsSerializer->serialize_test
48			([$selector]);
49			unless ($selectors_to_elements->{$selector_str}) {
50			$selectors_to_elements->{$selector_str}
51			= $self->{document}->___query_selector_all ([$selector]);
52			}
53			next unless @{$selectors_to_elements->{$selector_str}};
54
55			my $selector_specificity
56			= Whatpm::CSS::SelectorsParser->get_selector_specificity
57			($selector);
58			for (@{$selectors_to_elements->{$selector_str}}) {
59			my $current_specificity = $elements_to_specificity->{refaddr $_};
60			if ($selector_specificity->[0] > $current_specificity->[0] or
61			$selector_specificity->[1] > $current_specificity->[1] or
62			$selector_specificity->[2] > $current_specificity->[2] or
63			$selector_specificity->[3] > $current_specificity->[3]) {
64			$elements_to_specificity->{refaddr $_} = $selector_specificity;
65			}
66			}
67			}
68
69			my $sd = $rule->style;
70			for (keys %$elements_to_specificity) {
71			push @{$self->{element_to_sds}->{$_} \|\|= []},
72			[$sd, $elements_to_specificity->{$_}];
73	wakaba	1.1	}
74			}
75			}
76
77	wakaba	1.2	for my $eid (keys %{$self->{element_to_sds} or {}}) {
78			$self->{element_to_sds}->{$eid} = [sort {
79			$a->[1]->[0] <=> $b->[1]->[0] or
80			$a->[1]->[1] <=> $b->[1]->[1] or
81			$a->[1]->[2] <=> $b->[1]->[2] or
82			$a->[1]->[3] <=> $b->[1]->[3]
83			## NOTE: Perl \|sort\| is stable.
84			} @{$self->{element_to_sds}->{$eid} or []}];
85			}
86	wakaba	1.1	} # associate_rules
87
88			sub get_cascaded_value ($$$) {
89			my ($self, $element, $prop_name) = @_;
90			return undef unless $Whatpm::CSS::Parser::Prop->{$prop_name};
91
92			my $key = $Whatpm::CSS::Parser::Prop->{$prop_name}->{key};
93
94	wakaba	1.2	my $value;
95			for my $sds (reverse @{$self->{element_to_sds}->{refaddr $element} or []}) {
96			my $vp = ${$sds->[0]}->{$key};
97			if (defined $vp->[1] and $vp->[1] eq 'important') {
98			return $vp->[0];
99			} else {
100			$value = $vp->[0] unless defined $value;
101			}
102	wakaba	1.1	}
103
104	wakaba	1.2	return $value; # might be \|undef\|.
105	wakaba	1.1	} # get_cascaded_value
106
107
108			1;
109	wakaba	1.2	## $Date: 2007/12/31 13:47:49 $