Message/DOM/CSSStyleSheet.pm

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

sub ____new ($;%) {
  my $class = shift;
  my $self = bless \{@_}, $class;
  for (@{$$self->{css_rules}}) {
    ${$_}->{parent_style_sheet} = $self;
    Scalar::Util::weaken (${$_}->{parent_style_sheet});
  }
  # $self->{_parser} : Whatpm::CSS::Parser
  # $self->{_nsmap} : $nsmap (see Whatpm::CSS::Parser)
  return $self;
} # ____new

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

  if ({
    ## Read-only attributes (trivial accessors)
    href => 1,
    owner_node => 1,
    owner_rule => 1,
    parent_style_sheet => 1,
    type => 1,
  }->{$method_name}) {
    no strict 'refs';
    eval qq{
      sub $method_name (\$) {
        return \${\$_[0]}->{$method_name}; 
      }
    };
    goto &{ $AUTOLOAD };
  } else {
    require Carp;
    Carp::croak (qq<Can't locate method "$AUTOLOAD">);
  }
} # AUTOLOAD

## |StyleSheet| attributes

## TODO: documentation
sub manakai_base_uri ($) {
  if (defined ${$_[0]}->{manakai_base_uri}) {
    return ${$_[0]}->{manakai_base_uri};
  } else {
    return ${$_[0]}->{href}; ## NOTE: Might be |undef|.
  }
} # manakai_base_uri

sub disabled ($;$) {
  if (@_ > 1) {
    if ($_[1]) {
      ${$_[0]}->{disabled} = 1;
    } else {
      delete ${$_[0]}->{disabled};
    }
  }
  return ${$_[0]}->{disabled};
} # disabled

sub href ($);

sub media ($;$) {
  if (@_ > 1) {
    local $Error::Depth = $Error::Depth + 1;
    ${+shift}->{media}->media_text (@_);
  }
  return ${$_[0]}->{media};
} # media

sub owner_node ($);

sub parent_style_sheet ($);

sub title ($;$) {
  if (@_ > 1) {
    if (defined $_[1]) {
      ${$_[0]}->{title} = ''.$_[1];
    } else {
      delete ${$_[0]}->{title};
    }
  }
  return ${$_[0]}->{title};
} # title

sub type ($);

## |CSSStyleSheet| attributes

sub css_rules ($) {
  require Message::DOM::CSSRuleList;
  return bless \\($_[0]), 'Message::DOM::CSSRuleList';
} # css_rules

## NOTE: This is a manakai extension.
sub css_text ($;$) {
  ## TODO: setter

  my $r = '';
  local $Error::Depth = $Error::Depth + 1;
  for my $rule (@{$_[0]->css_rules}) {
    $r .= $rule->css_text . "\n"; ## TODO: \x0D\x0A? \x0A?
  }
  return $r;
} # css_text

## TODO: documentation
sub manakai_input_encoding ($;$) {
  if (@_ > 1) {
    if (defined $_[1]) {
      ${$_[0]}->{input_encoding} = ''.$_[1];
    } else {
      delete ${$_[0]}->{input_encoding};
    }
  }
  return ${$_[0]}->{input_encoding};
} # manakai_input_encoding

sub owner_rule ($);

## |CSSStyleSheet| methods

sub delete_rule ($$) {
  if ($_[1] < 0 or $_[1] > @{${$_[0]}->{css_rules}}) {
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'INDEX_SIZE_ERR',
        -subtype => 'INDEX_OUT_OF_BOUND_ERR';
  } else {
    my $rule = ${$_[0]}->{css_rules}->[$_[1]];
    delete $rule->{parent_rule};
    delete ${$_[0]}->{css_rules}->[$_[1]];
  }
} # delete_rule

## TODO: insert_rule

## TODO: Documentation
sub manakai_is_default_namespace ($$) {
  my $uri = $_[1];
  for my $rule (@{$_[0]->css_rules}) {
    next if $rule->type == 2 or $rule->type == 3; # CHARSET_RULE or IMPORT_RULE
    return 0 if $rule->type != 7; # NAMESPACE_RULE

    ## TODO: Can we insert NAMESPACE_RULE after other kinds of rules
    ## by insert_rule?

    if ($uri eq $rule->namespace_uri) {
      return 1 if $rule->prefix eq '';
    }
  }

  return 0;
} # manakai_is_default_namespace

## TODO: Documentation
sub manakai_lookup_namespace_prefix ($$) {
  my $uri = $_[1];
  for my $rule (@{$_[0]->css_rules}) {
    next if $rule->type == 2 or $rule->type == 3; # CHARSET_RULE or IMPORT_RULE
    return undef if $rule->type != 7; # NAMESPACE_RULE

    ## TODO: Can we insert NAMESPACE_RULE after other kinds of rules
    ## by insert_rule?

    if ($uri eq $rule->namespace_uri) {
      my $prefix = $rule->prefix;
      return $prefix if $prefix ne '';
    }
  }

  return undef;
} # manakai_lookup_namespace_prefix

package Message::IF::StyleSheet;
package Message::IF::CSSStyleSheet;

1;
## $Date: 2008/01/14 05:53:45 $
1	wakaba	1.1	package Message::DOM::CSSStyleSheet;
2			use strict;
3	wakaba	1.8	our $VERSION=do{my @r=(q$Revision: 1.7 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4	wakaba	1.1	push our @ISA, 'Message::IF::CSSStyleSheet';
5	wakaba	1.2	require Message::DOM::DOMException;
6			require Scalar::Util;
7	wakaba	1.1
8	wakaba	1.3	sub ____new ($;%) {
9	wakaba	1.2	my $class = shift;
10			my $self = bless \{@_}, $class;
11			for (@{$$self->{css_rules}}) {
12			${$_}->{parent_style_sheet} = $self;
13			Scalar::Util::weaken (${$_}->{parent_style_sheet});
14			}
15	wakaba	1.7	# $self->{_parser} : Whatpm::CSS::Parser
16			# $self->{_nsmap} : $nsmap (see Whatpm::CSS::Parser)
17	wakaba	1.2	return $self;
18	wakaba	1.3	} # ____new
19	wakaba	1.1
20			sub AUTOLOAD {
21			my $method_name = our $AUTOLOAD;
22			$method_name =~ s/.*:://;
23			return if $method_name eq 'DESTROY';
24
25			if ({
26			## Read-only attributes (trivial accessors)
27			href => 1,
28			owner_node => 1,
29			owner_rule => 1,
30			parent_style_sheet => 1,
31			type => 1,
32			}->{$method_name}) {
33			no strict 'refs';
34			eval qq{
35			sub $method_name (\$) {
36			return \${\$_[0]}->{$method_name};
37			}
38			};
39			goto &{ $AUTOLOAD };
40			} else {
41			require Carp;
42			Carp::croak (qq<Can't locate method "$AUTOLOAD">);
43			}
44			} # AUTOLOAD
45
46			## \|StyleSheet\| attributes
47
48	wakaba	1.6	## TODO: documentation
49			sub manakai_base_uri ($) {
50			if (defined ${$_[0]}->{manakai_base_uri}) {
51			return ${$_[0]}->{manakai_base_uri};
52			} else {
53			return ${$_[0]}->{href}; ## NOTE: Might be \|undef\|.
54			}
55			} # manakai_base_uri
56
57	wakaba	1.1	sub disabled ($;$) {
58			if (@_ > 1) {
59			if ($_[1]) {
60			${$_[0]}->{disabled} = 1;
61			} else {
62			delete ${$_[0]}->{disabled};
63			}
64			}
65			return ${$_[0]}->{disabled};
66			} # disabled
67
68			sub href ($);
69
70	wakaba	1.2	sub media ($;$) {
71			if (@_ > 1) {
72			local $Error::Depth = $Error::Depth + 1;
73			${+shift}->{media}->media_text (@_);
74			}
75			return ${$_[0]}->{media};
76			} # media
77	wakaba	1.1
78			sub owner_node ($);
79
80			sub parent_style_sheet ($);
81
82			sub title ($;$) {
83			if (@_ > 1) {
84			if (defined $_[1]) {
85			${$_[0]}->{title} = ''.$_[1];
86			} else {
87			delete ${$_[0]}->{title};
88			}
89			}
90			return ${$_[0]}->{title};
91			} # title
92
93			sub type ($);
94
95			## \|CSSStyleSheet\| attributes
96
97			sub css_rules ($) {
98			require Message::DOM::CSSRuleList;
99			return bless \\($_[0]), 'Message::DOM::CSSRuleList';
100			} # css_rules
101
102	wakaba	1.3	## NOTE: This is a manakai extension.
103			sub css_text ($;$) {
104			## TODO: setter
105
106			my $r = '';
107			local $Error::Depth = $Error::Depth + 1;
108			for my $rule (@{$_[0]->css_rules}) {
109	wakaba	1.4	$r .= $rule->css_text . "\n"; ## TODO: \x0D\x0A? \x0A?
110	wakaba	1.3	}
111			return $r;
112			} # css_text
113
114	wakaba	1.8	## TODO: documentation
115			sub manakai_input_encoding ($;$) {
116			if (@_ > 1) {
117			if (defined $_[1]) {
118			${$_[0]}->{input_encoding} = ''.$_[1];
119			} else {
120			delete ${$_[0]}->{input_encoding};
121			}
122			}
123			return ${$_[0]}->{input_encoding};
124			} # manakai_input_encoding
125
126	wakaba	1.1	sub owner_rule ($);
127
128			## \|CSSStyleSheet\| methods
129
130	wakaba	1.2	sub delete_rule ($$) {
131			if ($_[1] < 0 or $_[1] > @{${$_[0]}->{css_rules}}) {
132			report Message::DOM::DOMException
133			-object => $_[0],
134			-type => 'INDEX_SIZE_ERR',
135			-subtype => 'INDEX_OUT_OF_BOUND_ERR';
136			} else {
137			my $rule = ${$_[0]}->{css_rules}->[$_[1]];
138			delete $rule->{parent_rule};
139			delete ${$_[0]}->{css_rules}->[$_[1]];
140			}
141			} # delete_rule
142	wakaba	1.1
143			## TODO: insert_rule
144
145	wakaba	1.5	## TODO: Documentation
146			sub manakai_is_default_namespace ($$) {
147			my $uri = $_[1];
148			for my $rule (@{$_[0]->css_rules}) {
149			next if $rule->type == 2 or $rule->type == 3; # CHARSET_RULE or IMPORT_RULE
150			return 0 if $rule->type != 7; # NAMESPACE_RULE
151
152			## TODO: Can we insert NAMESPACE_RULE after other kinds of rules
153			## by insert_rule?
154
155			if ($uri eq $rule->namespace_uri) {
156			return 1 if $rule->prefix eq '';
157			}
158			}
159
160			return 0;
161			} # manakai_is_default_namespace
162
163			## TODO: Documentation
164			sub manakai_lookup_namespace_prefix ($$) {
165			my $uri = $_[1];
166			for my $rule (@{$_[0]->css_rules}) {
167			next if $rule->type == 2 or $rule->type == 3; # CHARSET_RULE or IMPORT_RULE
168			return undef if $rule->type != 7; # NAMESPACE_RULE
169
170			## TODO: Can we insert NAMESPACE_RULE after other kinds of rules
171			## by insert_rule?
172
173			if ($uri eq $rule->namespace_uri) {
174			my $prefix = $rule->prefix;
175			return $prefix if $prefix ne '';
176			}
177			}
178
179			return undef;
180			} # manakai_lookup_namespace_prefix
181
182	wakaba	1.1	package Message::IF::StyleSheet;
183			package Message::IF::CSSStyleSheet;
184
185			1;
186	wakaba	1.8	## $Date: 2008/01/14 05:53:45 $