Message/DOM/CSSStyleDeclaration.pm

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