1 |
wakaba |
1.1 |
package Message::DOM::Node; |
2 |
|
|
use strict; |
3 |
|
|
require Message::DOM::Node; |
4 |
|
|
require Message::DOM::EventTarget; |
5 |
|
|
push our @ISA, 'Message::DOM::EventTarget'; |
6 |
|
|
|
7 |
|
|
sub __dispatch_event ($$) { |
8 |
|
|
my $ev = $_[1]; |
9 |
|
|
|
10 |
|
|
$ev->{target} = $_[0]; |
11 |
|
|
$ev->{manakai_dispatched} = 1; |
12 |
|
|
|
13 |
|
|
my @target = ($_[0]); |
14 |
|
|
while (defined (my $p = $target[0]->parent_node)) { |
15 |
|
|
unshift @target, $p; |
16 |
|
|
} |
17 |
|
|
|
18 |
|
|
my $evns = $ev->{namespace_uri}; |
19 |
|
|
$evns = '' unless defined $evns; |
20 |
|
|
my $evln = $ev->{local_name}; |
21 |
|
|
local $Error::Depth = $Error::Depth + 1; |
22 |
|
|
|
23 |
|
|
{ |
24 |
|
|
$ev->{event_phase} = 1; # CAPTURE_PHASE |
25 |
|
|
for my $ct (@target[0..$#target-1]) { |
26 |
|
|
$ev->{current_target} = $ct; |
27 |
|
|
## ISSUE: {event_handler} mutation |
28 |
|
|
for (@{$ct->{event_handler}->{$evns}->{$evln}->[1] or []}) { |
29 |
|
|
$_->($ev); |
30 |
|
|
} |
31 |
|
|
} |
32 |
|
|
} |
33 |
|
|
|
34 |
|
|
{ |
35 |
|
|
$ev->{event_phase} = 2; # AT_TARGET |
36 |
|
|
{ |
37 |
|
|
my $ct = $target[-1]; |
38 |
|
|
$ev->{current_target} = $ct; |
39 |
|
|
## ISSUE: {event_handler} mutation |
40 |
|
|
for (@{$ct->{event_handler}->{$evns}->{$evln}->[0] or []}) { |
41 |
|
|
$_->($ev); |
42 |
|
|
} |
43 |
|
|
} |
44 |
|
|
} |
45 |
|
|
|
46 |
|
|
if ($ev->{bubbles}) { |
47 |
|
|
$ev->{event_phase} = 3; # BUBBLE_PHASE |
48 |
|
|
for my $ct (reverse @target[0..$#target-1]) { |
49 |
|
|
$ev->{current_phase} = $ct; |
50 |
|
|
## ISSUE: {event_handler} mutation |
51 |
|
|
for (@{$ct->{event_handler}->{$evns}->{$evln}->[0] or []}) { |
52 |
|
|
$_->($ev); |
53 |
|
|
} |
54 |
|
|
} |
55 |
|
|
} |
56 |
|
|
|
57 |
|
|
## ISSUE: Should we remove {current_target}? |
58 |
|
|
|
59 |
|
|
return not $ev->{default_prevented}; |
60 |
|
|
} # __dispatch_event |
61 |
|
|
|
62 |
|
|
package Message::DOM::Document; |
63 |
|
|
push our @ISA, 'Message::IF::DocumentEvent'; |
64 |
|
|
|
65 |
|
|
sub can_dispatch ($$$) { |
66 |
|
|
## ISSUE: What should we do?? |
67 |
|
|
return 1; |
68 |
|
|
} # can_dispatch |
69 |
|
|
|
70 |
|
|
sub create_event ($$) { |
71 |
|
|
## ISSUE: Case-sensitivity in implementations? |
72 |
|
|
my $mc = { |
73 |
|
|
Event => ['Message::DOM::Event', 'Message::DOM::Event'], |
74 |
|
|
## ISSUE: Events? |
75 |
|
|
CustomEvents => ['Message::DOM::Event', |
76 |
|
|
'Message::DOM::Event::CustomEvent'], |
77 |
|
|
HTMLEvents => ['Message::DOM::Event', 'Message::DOM::Event'], |
78 |
|
|
## TODO: MouseEvents |
79 |
|
|
## TODO: MutationEvents |
80 |
|
|
## TODO: UIEvents |
81 |
|
|
}->{$_[1]}; |
82 |
|
|
|
83 |
|
|
unless (defined $mc) { |
84 |
|
|
report Message::DOM::DOMException |
85 |
|
|
-object => $_[0], |
86 |
|
|
-type => 'NOT_SUPPORTED_ERR', |
87 |
|
|
-subtype => 'EVENT_INTERFACE_NOT_SUPPORTED_ERR'; |
88 |
|
|
} |
89 |
|
|
|
90 |
|
|
eval qq{ require $mc->[0]; 1 } or die $@; |
91 |
|
|
## TODO: Should we provide an option to use Time::HiRes? |
92 |
|
|
return bless {time_stamp => time}, $mc->[1]; |
93 |
|
|
|
94 |
|
|
## ISSUE: What value should be set to attributes? |
95 |
|
|
} # create_event |
96 |
|
|
|
97 |
|
|
package Message::IF::DocumentEvent; |
98 |
|
|
|
99 |
|
|
1; |