Message/DOM/CSSStyleDeclaration.pm

package Message::DOM::CSSStyleDeclaration;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.13 $=~/\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';
    if ($prop_def->{serialize}) {
      *{ $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 '';
        }
      };
    } 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 = $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;

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