Message/DOM/CSSStyleDeclaration.pm

package Message::DOM::CSSStyleDeclaration;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.15 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
push our @ISA, 'Message::IF::CSSStyleDeclaration',
    'Message::IF::CSS2Properties';

my $serialize_value = sub ($$$) {
  my ($self, $prop_name, $value) = @_;
  if ($value->[0] eq 'NUMBER' or $value->[0] eq 'WEIGHT') {
    ## TODO: What we currently do for 'font-weight' is different from
    ## any browser for lighter/bolder cases.  We need to fix this, but
    ## how?
    return $value->[1]; ## TODO: big or small number cases?
  } elsif ($value->[0] eq 'DIMENSION') {
    return $value->[1] . $value->[2]; ## NOTE: This is what browsers do.
  } elsif ($value->[0] eq 'PERCENTAGE') {
    return $value->[1] . '%';
  } elsif ($value->[0] eq 'KEYWORD' or $value->[0] eq 'PAGE') {
    return $value->[1];
  } elsif ($value->[0] eq 'URI') {
    ## NOTE: This is what browsers do.
    return 'url('.$value->[1].')';
  } elsif ($value->[0] eq 'RGBA') {
    if ($value->[4] == 1) {
      return 'rgb('.$value->[1].', '.$value->[2].', '.$value->[3].')';
    } elsif ($value->[4] == 0) {
      ## TODO: check what browsers do...
      return 'transparent';
    } else {
      return 'rgba('.$value->[1].', '.$value->[2].', '.$value->[3].', '
          .$value->[4].')';
    }
  } elsif ($value->[0] eq 'INHERIT') {
    return 'inherit';
  } elsif ($value->[0] eq 'DECORATION') {
    my @v = ();
    push @v, 'underline' if $value->[1];
    push @v, 'overline' if $value->[2];
    push @v, 'line-through' if $value->[3];
    push @v, 'blink' if $value->[4];
    return 'none' unless @v;
    return join ' ', @v;
  } elsif ($value->[0] eq 'QUOTES') {
    return join ' ', map {'"'.$_.'"'} map {$_->[0], $_->[1]} @{$value->[1]};
    ## NOTE: The result string might not be a <'quotes'> if it contains
    ## e.g. '"'.  In addition, it might not be a <'quotes'> if 
    ## @{$value->[1]} is empty (which is unlikely as long as the implementation
    ## is not broken).
  } elsif ($value->[0] eq 'CONTENT') {
    return join ' ', map {
      $_->[0] eq 'KEYWORD' ? $_->[1] :
      $_->[0] eq 'STRING' ? '"' . $_->[1] . '"' :
      $_->[0] eq 'URI' ? 'url(' . $_->[1] . ')' :
      $_->[0] eq 'ATTR' ? 'attr(' . $_->[2] . ')' : ## TODO: prefix
      $_->[0] eq 'COUNTER' ? 'counter(' . $_->[1] . ', ' . $_->[3] . ')' :
      $_->[0] eq 'COUNTERS' ? 'counters(' . $_->[1] . ', "' . $_->[2] . '", ' . $_->[3] . ')' :
      ''
    } @{$value}[1..$#$value];
  } elsif ($value->[0] eq 'RECT') {
    ## NOTE: Four components are DIMENSIONs.
    return 'rect(' . $value->[1]->[1].$value->[1]->[2] . ', '
          . $value->[2]->[1].$value->[2]->[2] . ', '
          . $value->[3]->[1].$value->[3]->[2] . ', '
          . $value->[4]->[1].$value->[4]->[2] . ')';
  } elsif ($value->[0] eq 'SETCOUNTER' or $value->[0] eq 'ADDCOUNTER') {
    return join ' ', map {$_->[0], $_->[1]} @$value[1..$#$value];
  } elsif ($value->[0] eq 'FONT') {
    return join ', ', map {
      if ($_->[0] eq 'STRING') {
        '"'.$_->[1].'"'; ## NOTE: This is what Firefox does.
      } elsif ($_->[0] eq 'KEYWORD') {
        $_->[1]; ## NOTE: This is what Firefox does.
      } else {
        ## NOTE: This should be an error.
        '""';
      }
    } @$value[1..$#$value];
  } elsif ($value->[0] eq 'CURSOR') {
    return join ', ', map {
      if ($_->[0] eq 'URI') {
        'url('.$_->[1].')'; ## NOTE: This is what Firefox does.
      } elsif ($_->[0] eq 'KEYWORD') {
        $_->[1];
      } else {
        ## NOTE: This should be an error.
        '""';
      }
    } @$value[1..$#$value];
  } elsif ($value->[0] eq 'MARKS') {
    if ($value->[1]) {
      if ($value->[2]) {
        return 'crop cross';
      } else {
        return 'crop';
      }
    } elsif ($value->[2]) {
      return 'cross';
    } else {
      return 'none';
    }
  } elsif ($value->[0] eq 'SIZE') {
    my $s1 = $value->[1]->[1] . $value->[1]->[2]; ## NOTE: They should be 
    my $s2 = $value->[2]->[1] . $value->[2]->[2]; ## 'DIMENSION's.
    if ($s1 eq $s2) {
      return $s1;
    } else {
      return $s1 . ' ' . $s2;
    }
  } else {
    return '';
  }
}; # $serialize_value

sub ____new ($) {
  return bless \{}, $_[0];
} # ____new

sub AUTOLOAD {
  my $method_name = our $AUTOLOAD;
  $method_name =~ s/.*:://;
  return if $method_name eq 'DESTROY';

  require Whatpm::CSS::Parser;
  my $prop_def = $Whatpm::CSS::Parser::Attr->{$method_name};

  if ($prop_def) {
    no strict 'refs';
    if (defined $prop_def->{key}) {
      *{ $method_name } = sub {
        ## TODO: setter
  
        my $self = $_[0];
        my $value = $$self->{$prop_def->{key}};
        if ($value) {
          return $serialize_value->($self, $prop_def->{css}, $value->[0]);
        } else {
          return '';
        }
      };
    } elsif ($prop_def->{serialize_shorthand} or
             $prop_def->{serialize_multiple}) {
      *{ $method_name } = sub {
        ## TODO: setter
  
        my $self = $_[0];
        my $v = ($prop_def->{serialize_shorthand} or
                 $prop_def->{serialize_multiple})->($self);
        if (defined $v->{$prop_def->{css}}) {
          return $v->{$prop_def->{css}}->[0];
        } else {
          return '';
        }
        ## ISSUE: If one of shorthand component properties is !important?
      };
    } else {
      die qq<Implementation error: Can't load serializer for "$AUTOLOAD">;
    }
    goto &{ $AUTOLOAD };
  } else {
    require Carp;
    Carp::croak (qq<Can't locate method "$AUTOLOAD">);
  }
} # AUTOLOAD

use overload
    '@{}' => sub {
      tie my @list, ref $_[0], $_[0];
      return \@list;
    },
    fallback => 1;

sub TIEARRAY ($$) { $_[1] }

## |CSSStyleDeclaration| attributes

sub css_text ($;$) {
  ## TODO: setter

  ## NOTE: Where and how white space characters are inserted are 
  ## intentionally changed from those in browsers so that properties are
  ## more prettily printed.
  ## See <http://suika.fam.cx/gate/2005/sw/cssText> for what browsers do.
  ## TODO: Ordering issue.
  require Whatpm::CSS::Parser;
  my $self = $_[0];
  my $r = '';
  my %serialized;
  for (sort {$a cmp $b} grep {$$self->{$_}} keys %$$self) {
    my $prop_def = $Whatpm::CSS::Parser::Key->{$_};
    next unless $prop_def;

    if ($prop_def->{serialize_multiple}) {
      unless ($serialized{$prop_def->{serialize_multiple}}) {
        $serialized{$prop_def->{serialize_multiple}} = 1;
        my $v = $prop_def->{serialize_multiple}->($self);
        for my $prop_name (sort {$a cmp $b} keys %$v) {
          $r .= '  ' . $prop_name . ': ' . $v->{$prop_name}->[0];
          $r .= ' ! ' . $v->{$prop_name}->[1] if length $v->{$prop_name}->[1];
          $r .= ";\n";
        }
      }
    } else {
      my $value = $$self->{$_};
      my $s = $serialize_value->($self, $prop_def->{css}, $value->[0]);
      if (length $s) {
        $r .= '  ' . $prop_def->{css} . ': ' . $s;
        $r .= ' ! ' . $value->[1] if length $value->[1];
        $r .= ";\n";
      }
    }
  }
  return $r;
} # css_text

sub length ($) {
  require Whatpm::CSS::Parser;
  return scalar @{[grep {$_}
                   map { $Whatpm::CSS::Parser::Key->{$_} }
                   keys %${$_[0]}]->[$_[1]]};
} # length
*FETCHSIZE = \&length;

## TODO: STORESIZE

sub parent_rule ($) {
  return ${$_[0]}->{parent_rule};
} # parent_rule

## |CSSStyleDeclaration| methods

sub get_property_priority ($$) {
  my $prop_name = ''.$_[1];

  require Whatpm::CSS::Parser;
  my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
  return '' unless defined $prop_def;

  if (defined $prop_def->{key}) {
    my $v = ${$_[0]}->{$prop_def->{key}};
    return $v ? $v->[1] : '';
  } elsif ($prop_def->{serialize_shorthand} or
           $prop_def->{serialize_multiple}) {
    my $v = ($prop_def->{serialize_shorthand} or
             $prop_def->{serialize_multiple})->($_[0]);
    if (defined $v->{$prop_def->{css}}) {
      return $v->{$prop_def->{css}}->[1];
    } else {
      return '';
    }
  } else {
    die "Implementation error: No serializer for property '$prop_name'";
  }
} # get_property_priority

sub item ($$) {
  require Whatpm::CSS::Parser;
  return '' if $_[1] < 0;
  ## TODO: ordering (should be same as that in |css_text|.
  my $v = [map {$_->{key}}
           grep {$_}
           map { $Whatpm::CSS::Parser::Key->{$_} }
           keys %${$_[0]}]->[$_[1]];
  return defined $v ? $v : '';
} # item
*FETCH = \&item;

## TODO: STORE, DELETE

sub EXISTS ($$) {
  return length $_[0]->item;
} # EXISTS

## TODO: Implement other methods and attributes

package Message::DOM::CSSComputedStyleDeclaration;
push our @ISA, 'Message::IF::CSSStyleDeclaration',
    'Message::IF::CSS2Properties';

sub ____new ($$$) {
  my $self = bless \{}, shift;
  $$self->{cascade} = shift; # Whatpm::CSS::Cascade object.
  $$self->{element} = shift; ## TODO: This link should be weaken?
  return $self;
} # ____new

sub AUTOLOAD {
  my $method_name = our $AUTOLOAD;
  $method_name =~ s/.*:://;
  return if $method_name eq 'DESTROY';

  require Whatpm::CSS::Parser;
  my $prop_def = $Whatpm::CSS::Parser::Attr->{$method_name};

  if ($prop_def) {
    no strict 'refs';
    if ($prop_def->{compute} or $prop_def->{compute_multiple}) {
      *{ $method_name } = sub {
        ## TODO: setter
  
        my $self = $_[0];
        my $value = $$self->{cascade}->get_computed_value
            ($$self->{element}, $prop_def->{css});
        if ($value) {
          return $serialize_value->($self, $prop_def->{css}, $value);
        } else {
          return '';
        }
      };
    } elsif ($prop_def->{serialize_shorthand} or
             $prop_def->{serialize_multiple}) {
      *{ $method_name } = sub {
        ## TODO: setter
        my $self = shift;

        my $v = ($prop_def->{serialize_shorthand} or
                 $prop_def->{serialize_multiple})->($self);
        if (defined $v->{$prop_def->{css}}) {
          return $v->{$prop_def->{css}}->[0];
        } else {
          return '';
        }
      };
    } else {
      ## TODO: This should be an error of the implementation.
      ## However, currently some shorthand properties does not have
      ## serializer.
      ## TODO: Remove {serialize} from shorthand properties, since
      ## they have no effect.
      warn "$0: No computed value function for $method_name";
      #die "$0: No computed value function for $method_name";
      *{ $method_name } = sub { };
    }
    goto &{ $AUTOLOAD };
  } else {
    require Carp;
    Carp::croak (qq<Can't locate method "$AUTOLOAD">);
  }
} # AUTOLOAD

use overload
    '@{}' => sub {
      tie my @list, ref $_[0], $_[0];
      return \@list;
    },
    fallback => 1;

sub TIEARRAY ($$) { $_[1] }

## |CSSStyleDeclaration| attributes

sub css_text ($;$) {
  ## TODO: error if modified

  my $self = shift;
  require Whatpm::CSS::Parser;

  ## NOTE: Where and how white space characters are inserted are 
  ## intentionally changed from those in browsers so that properties are
  ## more prettily printed.
  ## See <http://suika.fam.cx/gate/2005/sw/cssText> for what browsers do.
  ## TODO: ordering
  ## TODO: any spec?
  my $r = '';
  my %serialized;
  for my $prop_def (sort {$a->{css} cmp $b->{css}}
                    grep {$_->{compute} or
                          $_->{compute_multiple} or
                          $_->{serialize_multiple}}
                    values %$Whatpm::CSS::Parser::Prop) {
    if ($prop_def->{serialize_multiple}) {
      unless ($serialized{$prop_def->{serialize_multiple}}) {
        $serialized{$prop_def->{serialize_multiple}} = 1;
        my $v = $prop_def->{serialize_multiple}->($self);
        for my $prop_name (sort {$a cmp $b} keys %$v) {
          $r .= '  ' . $prop_name . ': ' . $v->{$prop_name}->[0];
          $r .= ' ! ' . $v->{$prop_name}->[1] if length $v->{$prop_name}->[1];
          $r .= ";\n";
        }
      }
    } else {
      my $prop_value = $$self->{cascade}->get_computed_value
          ($$self->{element}, $prop_def->{css});
      my $s = $serialize_value->($self, $prop_def->{css}, $prop_value);
      if (length $s) {
        $r .= '  ' . $prop_def->{css} . ': ' . $s;
        $r .= ";\n";
      } else {
        ## NOTE: This should be an error of the implementation.
        $r .= "  /* $prop_def->{css}: ???; */\n";
      }
    }
  }

  ## ISSUE: Should we include CSS properties that are not supported?

  return $r;
} # css_text

## TODO: What should we enumerate is unclear.
sub length ($) {
  require Whatpm::CSS::Parser;
  return scalar @{[grep {$_}
                   values %$Whatpm::CSS::Parser::Key]};
} # length
*FETCHSIZE = \&length;

## TODO: STORESIZE

## |CSSStyleDeclaration| methods

sub get_property_priority ($$) { '' }

sub item ($$) {
  require Whatpm::CSS::Parser;
  return '' if $_[1] < 0;
  ## TODO: ordering (should be same as that in |css_text|.
  my $v = [sort {$a cmp $b}
           map {$_->{css}}
           grep {$_}
           values %$Whatpm::CSS::Parser::Key]->[$_[1]];
  return defined $v ? $v : '';
} # item
*FETCH = \&item;

## TODO: STORE, DELETE

sub EXISTS ($$) {
  return length $_[0]->item;
} # EXISTS

## TODO: members

package Message::IF::CSSStyleDeclaration;
package Message::IF::CSS2Properties;

1;
## $Date: 2008/02/02 13:58:02 $
1	wakaba	1.1	package Message::DOM::CSSStyleDeclaration;
2			use strict;
3	wakaba	1.16	our $VERSION=do{my @r=(q$Revision: 1.15 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	wakaba	1.11	push our @ISA, 'Message::IF::CSSStyleDeclaration',
5			'Message::IF::CSS2Properties';
6	wakaba	1.1
7	wakaba	1.15	my $serialize_value = sub ($$$) {
8			my ($self, $prop_name, $value) = @_;
9			if ($value->[0] eq 'NUMBER' or $value->[0] eq 'WEIGHT') {
10			## TODO: What we currently do for 'font-weight' is different from
11			## any browser for lighter/bolder cases. We need to fix this, but
12			## how?
13			return $value->[1]; ## TODO: big or small number cases?
14			} elsif ($value->[0] eq 'DIMENSION') {
15			return $value->[1] . $value->[2]; ## NOTE: This is what browsers do.
16			} elsif ($value->[0] eq 'PERCENTAGE') {
17			return $value->[1] . '%';
18	wakaba	1.16	} elsif ($value->[0] eq 'KEYWORD' or $value->[0] eq 'PAGE') {
19	wakaba	1.15	return $value->[1];
20			} elsif ($value->[0] eq 'URI') {
21			## NOTE: This is what browsers do.
22			return 'url('.$value->[1].')';
23			} elsif ($value->[0] eq 'RGBA') {
24			if ($value->[4] == 1) {
25			return 'rgb('.$value->[1].', '.$value->[2].', '.$value->[3].')';
26			} elsif ($value->[4] == 0) {
27			## TODO: check what browsers do...
28			return 'transparent';
29			} else {
30			return 'rgba('.$value->[1].', '.$value->[2].', '.$value->[3].', '
31			.$value->[4].')';
32			}
33			} elsif ($value->[0] eq 'INHERIT') {
34			return 'inherit';
35			} elsif ($value->[0] eq 'DECORATION') {
36			my @v = ();
37			push @v, 'underline' if $value->[1];
38			push @v, 'overline' if $value->[2];
39			push @v, 'line-through' if $value->[3];
40			push @v, 'blink' if $value->[4];
41			return 'none' unless @v;
42			return join ' ', @v;
43			} elsif ($value->[0] eq 'QUOTES') {
44			return join ' ', map {'"'.$_.'"'} map {$_->[0], $_->[1]} @{$value->[1]};
45			## NOTE: The result string might not be a <'quotes'> if it contains
46			## e.g. '"'. In addition, it might not be a <'quotes'> if
47			## @{$value->[1]} is empty (which is unlikely as long as the implementation
48			## is not broken).
49			} elsif ($value->[0] eq 'CONTENT') {
50			return join ' ', map {
51			$_->[0] eq 'KEYWORD' ? $_->[1] :
52			$_->[0] eq 'STRING' ? '"' . $_->[1] . '"' :
53			$_->[0] eq 'URI' ? 'url(' . $_->[1] . ')' :
54			$_->[0] eq 'ATTR' ? 'attr(' . $_->[2] . ')' : ## TODO: prefix
55			$_->[0] eq 'COUNTER' ? 'counter(' . $_->[1] . ', ' . $_->[3] . ')' :
56			$_->[0] eq 'COUNTERS' ? 'counters(' . $_->[1] . ', "' . $_->[2] . '", ' . $_->[3] . ')' :
57			''
58			} @{$value}[1..$#$value];
59			} elsif ($value->[0] eq 'RECT') {
60			## NOTE: Four components are DIMENSIONs.
61			return 'rect(' . $value->[1]->[1].$value->[1]->[2] . ', '
62			. $value->[2]->[1].$value->[2]->[2] . ', '
63			. $value->[3]->[1].$value->[3]->[2] . ', '
64			. $value->[4]->[1].$value->[4]->[2] . ')';
65			} elsif ($value->[0] eq 'SETCOUNTER' or $value->[0] eq 'ADDCOUNTER') {
66			return join ' ', map {$_->[0], $_->[1]} @$value[1..$#$value];
67			} elsif ($value->[0] eq 'FONT') {
68			return join ', ', map {
69			if ($_->[0] eq 'STRING') {
70			'"'.$_->[1].'"'; ## NOTE: This is what Firefox does.
71			} elsif ($_->[0] eq 'KEYWORD') {
72			$_->[1]; ## NOTE: This is what Firefox does.
73			} else {
74			## NOTE: This should be an error.
75			'""';
76			}
77			} @$value[1..$#$value];
78			} elsif ($value->[0] eq 'CURSOR') {
79			return join ', ', map {
80			if ($_->[0] eq 'URI') {
81			'url('.$_->[1].')'; ## NOTE: This is what Firefox does.
82			} elsif ($_->[0] eq 'KEYWORD') {
83			$_->[1];
84			} else {
85			## NOTE: This should be an error.
86			'""';
87			}
88			} @$value[1..$#$value];
89	wakaba	1.16	} elsif ($value->[0] eq 'MARKS') {
90			if ($value->[1]) {
91			if ($value->[2]) {
92			return 'crop cross';
93			} else {
94			return 'crop';
95			}
96			} elsif ($value->[2]) {
97			return 'cross';
98			} else {
99			return 'none';
100			}
101			} elsif ($value->[0] eq 'SIZE') {
102			my $s1 = $value->[1]->[1] . $value->[1]->[2]; ## NOTE: They should be
103			my $s2 = $value->[2]->[1] . $value->[2]->[2]; ## 'DIMENSION's.
104			if ($s1 eq $s2) {
105			return $s1;
106			} else {
107			return $s1 . ' ' . $s2;
108			}
109	wakaba	1.15	} else {
110			return '';
111			}
112			}; # $serialize_value
113
114	wakaba	1.1	sub ____new ($) {
115			return bless \{}, $_[0];
116			} # ____new
117
118	wakaba	1.3	sub AUTOLOAD {
119			my $method_name = our $AUTOLOAD;
120			$method_name =~ s/.*:://;
121			return if $method_name eq 'DESTROY';
122
123			require Whatpm::CSS::Parser;
124			my $prop_def = $Whatpm::CSS::Parser::Attr->{$method_name};
125
126			if ($prop_def) {
127			no strict 'refs';
128	wakaba	1.15	if (defined $prop_def->{key}) {
129	wakaba	1.13	*{ $method_name } = sub {
130			## TODO: setter
131
132			my $self = $_[0];
133			my $value = $$self->{$prop_def->{key}};
134			if ($value) {
135	wakaba	1.15	return $serialize_value->($self, $prop_def->{css}, $value->[0]);
136	wakaba	1.13	} else {
137			return '';
138			}
139			};
140			} elsif ($prop_def->{serialize_shorthand} or
141			$prop_def->{serialize_multiple}) {
142			*{ $method_name } = sub {
143			## TODO: setter
144
145			my $self = $_[0];
146			my $v = ($prop_def->{serialize_shorthand} or
147			$prop_def->{serialize_multiple})->($self);
148			if (defined $v->{$prop_def->{css}}) {
149			return $v->{$prop_def->{css}}->[0];
150			} else {
151			return '';
152			}
153			## ISSUE: If one of shorthand component properties is !important?
154			};
155			} else {
156			die qq<Implementation error: Can't load serializer for "$AUTOLOAD">;
157			}
158	wakaba	1.3	goto &{ $AUTOLOAD };
159			} else {
160			require Carp;
161			Carp::croak (qq<Can't locate method "$AUTOLOAD">);
162			}
163			} # AUTOLOAD
164
165	wakaba	1.11	use overload
166			'@{}' => sub {
167			tie my @list, ref $_[0], $_[0];
168			return \@list;
169			},
170			fallback => 1;
171
172			sub TIEARRAY ($$) { $_[1] }
173
174	wakaba	1.1	## \|CSSStyleDeclaration\| attributes
175
176	wakaba	1.2	sub css_text ($;$) {
177	wakaba	1.3	## TODO: setter
178
179	wakaba	1.9	## NOTE: Where and how white space characters are inserted are
180			## intentionally changed from those in browsers so that properties are
181			## more prettily printed.
182			## See <http://suika.fam.cx/gate/2005/sw/cssText> for what browsers do.
183			## TODO: Ordering issue.
184	wakaba	1.3	require Whatpm::CSS::Parser;
185			my $self = $_[0];
186			my $r = '';
187	wakaba	1.7	my %serialized;
188	wakaba	1.13	for (sort {$a cmp $b} grep {$$self->{$_}} keys %$$self) {
189	wakaba	1.3	my $prop_def = $Whatpm::CSS::Parser::Key->{$_};
190			next unless $prop_def;
191	wakaba	1.7
192			if ($prop_def->{serialize_multiple}) {
193			unless ($serialized{$prop_def->{serialize_multiple}}) {
194			$serialized{$prop_def->{serialize_multiple}} = 1;
195			my $v = $prop_def->{serialize_multiple}->($self);
196			for my $prop_name (sort {$a cmp $b} keys %$v) {
197	wakaba	1.14	$r .= ' ' . $prop_name . ': ' . $v->{$prop_name}->[0];
198			$r .= ' ! ' . $v->{$prop_name}->[1] if length $v->{$prop_name}->[1];
199			$r .= ";\n";
200	wakaba	1.7	}
201			}
202			} else {
203			my $value = $$self->{$_};
204	wakaba	1.15	my $s = $serialize_value->($self, $prop_def->{css}, $value->[0]);
205	wakaba	1.10	if (length $s) {
206	wakaba	1.7	$r .= ' ' . $prop_def->{css} . ': ' . $s;
207	wakaba	1.10	$r .= ' ! ' . $value->[1] if length $value->[1];
208	wakaba	1.7	$r .= ";\n";
209			}
210	wakaba	1.3	}
211			}
212			return $r;
213	wakaba	1.2	} # css_text
214
215	wakaba	1.11	sub length ($) {
216			require Whatpm::CSS::Parser;
217			return scalar @{[grep {$_}
218			map { $Whatpm::CSS::Parser::Key->{$_} }
219			keys %${$_[0]}]->[$_[1]]};
220			} # length
221			*FETCHSIZE = \&length;
222
223			## TODO: STORESIZE
224
225	wakaba	1.1	sub parent_rule ($) {
226			return ${$_[0]}->{parent_rule};
227			} # parent_rule
228
229	wakaba	1.7	## \|CSSStyleDeclaration\| methods
230
231			sub get_property_priority ($$) {
232			my $prop_name = ''.$_[1];
233
234			require Whatpm::CSS::Parser;
235			my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
236			return '' unless defined $prop_def;
237
238	wakaba	1.15	if (defined $prop_def->{key}) {
239	wakaba	1.14	my $v = ${$_[0]}->{$prop_def->{key}};
240			return $v ? $v->[1] : '';
241			} elsif ($prop_def->{serialize_shorthand} or
242			$prop_def->{serialize_multiple}) {
243			my $v = ($prop_def->{serialize_shorthand} or
244			$prop_def->{serialize_multiple})->($_[0]);
245			if (defined $v->{$prop_def->{css}}) {
246			return $v->{$prop_def->{css}}->[1];
247			} else {
248			return '';
249			}
250			} else {
251			die "Implementation error: No serializer for property '$prop_name'";
252			}
253	wakaba	1.7	} # get_property_priority
254
255	wakaba	1.11	sub item ($$) {
256			require Whatpm::CSS::Parser;
257			return '' if $_[1] < 0;
258			## TODO: ordering (should be same as that in \|css_text\|.
259			my $v = [map {$_->{key}}
260			grep {$_}
261			map { $Whatpm::CSS::Parser::Key->{$_} }
262			keys %${$_[0]}]->[$_[1]];
263			return defined $v ? $v : '';
264			} # item
265			*FETCH = \&item;
266
267			## TODO: STORE, DELETE
268
269			sub EXISTS ($$) {
270			return length $_[0]->item;
271			} # EXISTS
272
273	wakaba	1.1	## TODO: Implement other methods and attributes
274
275	wakaba	1.4	package Message::DOM::CSSComputedStyleDeclaration;
276	wakaba	1.11	push our @ISA, 'Message::IF::CSSStyleDeclaration',
277			'Message::IF::CSS2Properties';
278	wakaba	1.4
279			sub ____new ($$$) {
280			my $self = bless \{}, shift;
281			$$self->{cascade} = shift; # Whatpm::CSS::Cascade object.
282			$$self->{element} = shift; ## TODO: This link should be weaken?
283			return $self;
284			} # ____new
285
286	wakaba	1.7	sub AUTOLOAD {
287			my $method_name = our $AUTOLOAD;
288			$method_name =~ s/.*:://;
289			return if $method_name eq 'DESTROY';
290
291			require Whatpm::CSS::Parser;
292			my $prop_def = $Whatpm::CSS::Parser::Attr->{$method_name};
293
294			if ($prop_def) {
295			no strict 'refs';
296	wakaba	1.13	if ($prop_def->{compute} or $prop_def->{compute_multiple}) {
297			*{ $method_name } = sub {
298			## TODO: setter
299
300			my $self = $_[0];
301	wakaba	1.12	my $value = $$self->{cascade}->get_computed_value
302			($$self->{element}, $prop_def->{css});
303			if ($value) {
304	wakaba	1.15	return $serialize_value->($self, $prop_def->{css}, $value);
305	wakaba	1.12	} else {
306			return '';
307			}
308	wakaba	1.13	};
309			} elsif ($prop_def->{serialize_shorthand} or
310			$prop_def->{serialize_multiple}) {
311			*{ $method_name } = sub {
312			## TODO: setter
313			my $self = shift;
314
315			my $v = ($prop_def->{serialize_shorthand} or
316			$prop_def->{serialize_multiple})->($self);
317	wakaba	1.12	if (defined $v->{$prop_def->{css}}) {
318	wakaba	1.13	return $v->{$prop_def->{css}}->[0];
319	wakaba	1.12	} else {
320			return '';
321			}
322	wakaba	1.13	};
323			} else {
324			## TODO: This should be an error of the implementation.
325			## However, currently some shorthand properties does not have
326			## serializer.
327			## TODO: Remove {serialize} from shorthand properties, since
328			## they have no effect.
329			warn "$0: No computed value function for $method_name";
330			#die "$0: No computed value function for $method_name";
331			*{ $method_name } = sub { };
332			}
333	wakaba	1.7	goto &{ $AUTOLOAD };
334			} else {
335			require Carp;
336			Carp::croak (qq<Can't locate method "$AUTOLOAD">);
337			}
338			} # AUTOLOAD
339
340	wakaba	1.11	use overload
341			'@{}' => sub {
342			tie my @list, ref $_[0], $_[0];
343			return \@list;
344			},
345			fallback => 1;
346
347			sub TIEARRAY ($$) { $_[1] }
348
349			## \|CSSStyleDeclaration\| attributes
350
351	wakaba	1.4	sub css_text ($;$) {
352			## TODO: error if modified
353
354			my $self = shift;
355			require Whatpm::CSS::Parser;
356
357	wakaba	1.9	## NOTE: Where and how white space characters are inserted are
358			## intentionally changed from those in browsers so that properties are
359			## more prettily printed.
360			## See <http://suika.fam.cx/gate/2005/sw/cssText> for what browsers do.
361	wakaba	1.4	## TODO: ordering
362			## TODO: any spec?
363			my $r = '';
364	wakaba	1.7	my %serialized;
365	wakaba	1.6	for my $prop_def (sort {$a->{css} cmp $b->{css}}
366	wakaba	1.7	grep {$_->{compute} or
367			$_->{compute_multiple} or
368			$_->{serialize_multiple}}
369	wakaba	1.6	values %$Whatpm::CSS::Parser::Prop) {
370	wakaba	1.7	if ($prop_def->{serialize_multiple}) {
371			unless ($serialized{$prop_def->{serialize_multiple}}) {
372			$serialized{$prop_def->{serialize_multiple}} = 1;
373			my $v = $prop_def->{serialize_multiple}->($self);
374			for my $prop_name (sort {$a cmp $b} keys %$v) {
375	wakaba	1.14	$r .= ' ' . $prop_name . ': ' . $v->{$prop_name}->[0];
376			$r .= ' ! ' . $v->{$prop_name}->[1] if length $v->{$prop_name}->[1];
377			$r .= ";\n";
378	wakaba	1.7	}
379			}
380	wakaba	1.5	} else {
381	wakaba	1.7	my $prop_value = $$self->{cascade}->get_computed_value
382			($$self->{element}, $prop_def->{css});
383	wakaba	1.15	my $s = $serialize_value->($self, $prop_def->{css}, $prop_value);
384	wakaba	1.10	if (length $s) {
385	wakaba	1.7	$r .= ' ' . $prop_def->{css} . ': ' . $s;
386			$r .= ";\n";
387			} else {
388			## NOTE: This should be an error of the implementation.
389			$r .= " /* $prop_def->{css}: ???; */\n";
390			}
391	wakaba	1.4	}
392			}
393	wakaba	1.6
394			## ISSUE: Should we include CSS properties that are not supported?
395
396	wakaba	1.4	return $r;
397			} # css_text
398
399	wakaba	1.11	## TODO: What should we enumerate is unclear.
400			sub length ($) {
401			require Whatpm::CSS::Parser;
402			return scalar @{[grep {$_}
403			values %$Whatpm::CSS::Parser::Key]};
404			} # length
405			*FETCHSIZE = \&length;
406
407			## TODO: STORESIZE
408
409	wakaba	1.7	## \|CSSStyleDeclaration\| methods
410
411	wakaba	1.10	sub get_property_priority ($$) { '' }
412	wakaba	1.7
413	wakaba	1.11	sub item ($$) {
414			require Whatpm::CSS::Parser;
415			return '' if $_[1] < 0;
416			## TODO: ordering (should be same as that in \|css_text\|.
417			my $v = [sort {$a cmp $b}
418			map {$_->{css}}
419			grep {$_}
420			values %$Whatpm::CSS::Parser::Key]->[$_[1]];
421			return defined $v ? $v : '';
422			} # item
423			*FETCH = \&item;
424
425			## TODO: STORE, DELETE
426
427			sub EXISTS ($$) {
428			return length $_[0]->item;
429			} # EXISTS
430
431	wakaba	1.4	## TODO: members
432
433	wakaba	1.1	package Message::IF::CSSStyleDeclaration;
434	wakaba	1.11	package Message::IF::CSS2Properties;
435	wakaba	1.1
436			1;
437	wakaba	1.16	## $Date: 2008/02/02 13:58:02 $