Message/DOM/CSSStyleDeclaration.pm

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

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';
    *{ $method_name } = sub {
      ## TODO: setter

      my $self = $_[0];
      my $value = $$self->{$prop_def->{key}};
      if ($value) {
        return $prop_def->{serialize}->($self, $prop_def->{css}, $value->[0]);
      } else {
        return "";
      }
      ## ISSUE: If one of shorthand component properties is !important?
    };
    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 (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} . ";\n"
        }
      }
    } else {
      my $value = $$self->{$_};
      my $s = $prop_def->{serialize}->($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;

  my $v = ${$_[0]}->{$prop_def->{key}};
  return $v ? $v->[1] : '';
} # 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';
    *{ $method_name } = sub {
      ## TODO: setter

      my $self = $_[0];
      if ($prop_def->{compute} or $prop_def->{compute_multiple}) {
        my $value = $$self->{cascade}->get_computed_value
            ($$self->{element}, $prop_def->{css});
        if ($value) {
          return $prop_def->{serialize}->($self, $prop_def->{css}, $value);
        } else {
          return '';
        }
      } elsif ($prop_def->{serialize_multiple}) {
        my $v = $prop_def->{serialize_multiple}->($self);
        if (defined $v->{$prop_def->{css}}) {
          return $v->{$prop_def->{css}};
        } 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";
      }
    };
    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} . ";\n"
        }
      }
    } else {
      my $prop_value = $$self->{cascade}->get_computed_value
          ($$self->{element}, $prop_def->{css});
      my $s = $prop_def->{serialize}->($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/01/14 11:18:49 $
1	package Message::DOM::CSSStyleDeclaration;
2	use strict;
3	our $VERSION=do{my @r=(q$Revision: 1.11 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	push our @ISA, 'Message::IF::CSSStyleDeclaration',
5	'Message::IF::CSS2Properties';
6
7	sub ____new ($) {
8	return bless \{}, $_[0];
9	} # ____new
10
11	sub AUTOLOAD {
12	my $method_name = our $AUTOLOAD;
13	$method_name =~ s/.*:://;
14	return if $method_name eq 'DESTROY';
15
16	require Whatpm::CSS::Parser;
17	my $prop_def = $Whatpm::CSS::Parser::Attr->{$method_name};
18
19	if ($prop_def) {
20	no strict 'refs';
21	*{ $method_name } = sub {
22	## TODO: setter
23
24	my $self = $_[0];
25	my $value = $$self->{$prop_def->{key}};
26	if ($value) {
27	return $prop_def->{serialize}->($self, $prop_def->{css}, $value->[0]);
28	} else {
29	return "";
30	}
31	## ISSUE: If one of shorthand component properties is !important?
32	};
33	goto &{ $AUTOLOAD };
34	} else {
35	require Carp;
36	Carp::croak (qq<Can't locate method "$AUTOLOAD">);
37	}
38	} # AUTOLOAD
39
40	use overload
41	'@{}' => sub {
42	tie my @list, ref $_[0], $_[0];
43	return \@list;
44	},
45	fallback => 1;
46
47	sub TIEARRAY ($$) { $_[1] }
48
49	## \|CSSStyleDeclaration\| attributes
50
51	sub css_text ($;$) {
52	## TODO: setter
53
54	## NOTE: Where and how white space characters are inserted are
55	## intentionally changed from those in browsers so that properties are
56	## more prettily printed.
57	## See <http://suika.fam.cx/gate/2005/sw/cssText> for what browsers do.
58	## TODO: Ordering issue.
59	require Whatpm::CSS::Parser;
60	my $self = $_[0];
61	my $r = '';
62	my %serialized;
63	for (grep {$$self->{$_}} keys %$$self) {
64	my $prop_def = $Whatpm::CSS::Parser::Key->{$_};
65	next unless $prop_def;
66
67	if ($prop_def->{serialize_multiple}) {
68	unless ($serialized{$prop_def->{serialize_multiple}}) {
69	$serialized{$prop_def->{serialize_multiple}} = 1;
70	my $v = $prop_def->{serialize_multiple}->($self);
71	for my $prop_name (sort {$a cmp $b} keys %$v) {
72	$r .= ' ' . $prop_name . ': ' . $v->{$prop_name} . ";\n"
73	}
74	}
75	} else {
76	my $value = $$self->{$_};
77	my $s = $prop_def->{serialize}->($self, $prop_def->{css}, $value->[0]);
78	if (length $s) {
79	$r .= ' ' . $prop_def->{css} . ': ' . $s;
80	$r .= ' ! ' . $value->[1] if length $value->[1];
81	$r .= ";\n";
82	}
83	}
84	}
85	return $r;
86	} # css_text
87
88	sub length ($) {
89	require Whatpm::CSS::Parser;
90	return scalar @{[grep {$_}
91	map { $Whatpm::CSS::Parser::Key->{$_} }
92	keys %${$_[0]}]->[$_[1]]};
93	} # length
94	*FETCHSIZE = \&length;
95
96	## TODO: STORESIZE
97
98	sub parent_rule ($) {
99	return ${$_[0]}->{parent_rule};
100	} # parent_rule
101
102	## \|CSSStyleDeclaration\| methods
103
104	sub get_property_priority ($$) {
105	my $prop_name = ''.$_[1];
106
107	require Whatpm::CSS::Parser;
108	my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
109	return '' unless defined $prop_def;
110
111	my $v = ${$_[0]}->{$prop_def->{key}};
112	return $v ? $v->[1] : '';
113	} # get_property_priority
114
115	sub item ($$) {
116	require Whatpm::CSS::Parser;
117	return '' if $_[1] < 0;
118	## TODO: ordering (should be same as that in \|css_text\|.
119	my $v = [map {$_->{key}}
120	grep {$_}
121	map { $Whatpm::CSS::Parser::Key->{$_} }
122	keys %${$_[0]}]->[$_[1]];
123	return defined $v ? $v : '';
124	} # item
125	*FETCH = \&item;
126
127	## TODO: STORE, DELETE
128
129	sub EXISTS ($$) {
130	return length $_[0]->item;
131	} # EXISTS
132
133	## TODO: Implement other methods and attributes
134
135	package Message::DOM::CSSComputedStyleDeclaration;
136	push our @ISA, 'Message::IF::CSSStyleDeclaration',
137	'Message::IF::CSS2Properties';
138
139	sub ____new ($$$) {
140	my $self = bless \{}, shift;
141	$$self->{cascade} = shift; # Whatpm::CSS::Cascade object.
142	$$self->{element} = shift; ## TODO: This link should be weaken?
143	return $self;
144	} # ____new
145
146	sub AUTOLOAD {
147	my $method_name = our $AUTOLOAD;
148	$method_name =~ s/.*:://;
149	return if $method_name eq 'DESTROY';
150
151	require Whatpm::CSS::Parser;
152	my $prop_def = $Whatpm::CSS::Parser::Attr->{$method_name};
153
154	if ($prop_def) {
155	no strict 'refs';
156	*{ $method_name } = sub {
157	## TODO: setter
158
159	my $self = $_[0];
160	if ($prop_def->{compute} or $prop_def->{compute_multiple}) {
161	my $value = $$self->{cascade}->get_computed_value
162	($$self->{element}, $prop_def->{css});
163	if ($value) {
164	return $prop_def->{serialize}->($self, $prop_def->{css}, $value);
165	} else {
166	return '';
167	}
168	} elsif ($prop_def->{serialize_multiple}) {
169	my $v = $prop_def->{serialize_multiple}->($self);
170	if (defined $v->{$prop_def->{css}}) {
171	return $v->{$prop_def->{css}};
172	} else {
173	return '';
174	}
175	} else {
176	## TODO: This should be an error of the implementation.
177	## However, currently some shorthand properties does not have
178	## serializer.
179	## TODO: Remove {serialize} from shorthand properties, since
180	## they have no effect.
181	warn "$0: No computed value function for $method_name";
182	#die "$0: No computed value function for $method_name";
183	}
184	};
185	goto &{ $AUTOLOAD };
186	} else {
187	require Carp;
188	Carp::croak (qq<Can't locate method "$AUTOLOAD">);
189	}
190	} # AUTOLOAD
191
192	use overload
193	'@{}' => sub {
194	tie my @list, ref $_[0], $_[0];
195	return \@list;
196	},
197	fallback => 1;
198
199	sub TIEARRAY ($$) { $_[1] }
200
201	## \|CSSStyleDeclaration\| attributes
202
203	sub css_text ($;$) {
204	## TODO: error if modified
205
206	my $self = shift;
207	require Whatpm::CSS::Parser;
208
209	## NOTE: Where and how white space characters are inserted are
210	## intentionally changed from those in browsers so that properties are
211	## more prettily printed.
212	## See <http://suika.fam.cx/gate/2005/sw/cssText> for what browsers do.
213	## TODO: ordering
214	## TODO: any spec?
215	my $r = '';
216	my %serialized;
217	for my $prop_def (sort {$a->{css} cmp $b->{css}}
218	grep {$_->{compute} or
219	$_->{compute_multiple} or
220	$_->{serialize_multiple}}
221	values %$Whatpm::CSS::Parser::Prop) {
222	if ($prop_def->{serialize_multiple}) {
223	unless ($serialized{$prop_def->{serialize_multiple}}) {
224	$serialized{$prop_def->{serialize_multiple}} = 1;
225	my $v = $prop_def->{serialize_multiple}->($self);
226	for my $prop_name (sort {$a cmp $b} keys %$v) {
227	$r .= ' ' . $prop_name . ': ' . $v->{$prop_name} . ";\n"
228	}
229	}
230	} else {
231	my $prop_value = $$self->{cascade}->get_computed_value
232	($$self->{element}, $prop_def->{css});
233	my $s = $prop_def->{serialize}->($self, $prop_def->{css}, $prop_value);
234	if (length $s) {
235	$r .= ' ' . $prop_def->{css} . ': ' . $s;
236	$r .= ";\n";
237	} else {
238	## NOTE: This should be an error of the implementation.
239	$r .= " /* $prop_def->{css}: ???; */\n";
240	}
241	}
242	}
243
244	## ISSUE: Should we include CSS properties that are not supported?
245
246	return $r;
247	} # css_text
248
249	## TODO: What should we enumerate is unclear.
250	sub length ($) {
251	require Whatpm::CSS::Parser;
252	return scalar @{[grep {$_}
253	values %$Whatpm::CSS::Parser::Key]};
254	} # length
255	*FETCHSIZE = \&length;
256
257	## TODO: STORESIZE
258
259	## \|CSSStyleDeclaration\| methods
260
261	sub get_property_priority ($$) { '' }
262
263	sub item ($$) {
264	require Whatpm::CSS::Parser;
265	return '' if $_[1] < 0;
266	## TODO: ordering (should be same as that in \|css_text\|.
267	my $v = [sort {$a cmp $b}
268	map {$_->{css}}
269	grep {$_}
270	values %$Whatpm::CSS::Parser::Key]->[$_[1]];
271	return defined $v ? $v : '';
272	} # item
273	*FETCH = \&item;
274
275	## TODO: STORE, DELETE
276
277	sub EXISTS ($$) {
278	return length $_[0]->item;
279	} # EXISTS
280
281	## TODO: members
282
283	package Message::IF::CSSStyleDeclaration;
284	package Message::IF::CSS2Properties;
285
286	1;
287	## $Date: 2008/01/14 11:18:49 $