Message/DOM/EventTargetNode.pm

package Message::DOM::Node;
use strict;
require Message::DOM::Node;
require Message::DOM::EventTarget;
push our @ISA, 'Message::DOM::EventTarget';

sub __dispatch_event ($$) {
  my $ev = $_[1];

  $ev->{target} = $_[0];
  $ev->{manakai_dispatched} = 1;

  my @target = ($_[0]);
  while (defined (my $p = $target[0]->parent_node)) {
    unshift @target, $p;
  }

  my $evns = $ev->{namespace_uri};
  $evns = '' unless defined $evns;
  my $evln = $ev->{local_name};
  local $Error::Depth = $Error::Depth + 1;

  {
    $ev->{event_phase} = 1; # CAPTURE_PHASE
    for my $ct (@target[0..$#target-1]) {
      $ev->{current_target} = $ct;
      ## ISSUE: {event_handler} mutation
      for (@{$ct->{event_handler}->{$evns}->{$evln}->[1] or []}) {
        $_->($ev);
      }
    }
  }

  {
    $ev->{event_phase} = 2; # AT_TARGET
    {
      my $ct = $target[-1];
      $ev->{current_target} = $ct;
      ## ISSUE: {event_handler} mutation
      for (@{$ct->{event_handler}->{$evns}->{$evln}->[0] or []}) {
        $_->($ev);
      } 
    }   
  }

  if ($ev->{bubbles}) {
    $ev->{event_phase} = 3; # BUBBLE_PHASE
    for my $ct (reverse @target[0..$#target-1]) {
      $ev->{current_phase} = $ct;
      ## ISSUE: {event_handler} mutation
      for (@{$ct->{event_handler}->{$evns}->{$evln}->[0] or []}) {
        $_->($ev);
      }
    }
  }

  ## TODO: stop_propagation
  
  ## ISSUE: Should we remove {current_target}?

  return not $ev->{default_prevented};
} # __dispatch_event

package Message::DOM::Document;
push our @ISA, 'Message::IF::DocumentEvent';

sub can_dispatch ($$$) {
  ## ISSUE: What should we do??
  return 1;
} # can_dispatch

sub create_event ($$) {
  ## ISSUE: Case-sensitivity in implementations?
  my $mc = {
    Event => ['Message::DOM::Event', 'Message::DOM::Event'],
    ## ISSUE: Events?
    CustomEvents => ['Message::DOM::Event',
                     'Message::DOM::Event::CustomEvent'],
    HTMLEvents => ['Message::DOM::Event', 'Message::DOM::Event'],
    ## TODO: MouseEvents
    ## TODO: MutationEvents
    ## TODO: UIEvents
  }->{$_[1]};
  
  unless (defined $mc) {
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'NOT_SUPPORTED_ERR',
        -subtype => 'EVENT_INTERFACE_NOT_SUPPORTED_ERR';
  }

  eval qq{ require $mc->[0]; 1 } or die $@;
  ## TODO: Should we provide an option to use Time::HiRes?
  return bless {time_stamp => time}, $mc->[1];

  ## ISSUE: What value should be set to attributes?
} # create_event

package Message::IF::DocumentEvent;

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	## TODO: stop_propagation
58
59	## ISSUE: Should we remove {current_target}?
60
61	return not $ev->{default_prevented};
62	} # __dispatch_event
63
64	package Message::DOM::Document;
65	push our @ISA, 'Message::IF::DocumentEvent';
66
67	sub can_dispatch ($$$) {
68	## ISSUE: What should we do??
69	return 1;
70	} # can_dispatch
71
72	sub create_event ($$) {
73	## ISSUE: Case-sensitivity in implementations?
74	my $mc = {
75	Event => ['Message::DOM::Event', 'Message::DOM::Event'],
76	## ISSUE: Events?
77	CustomEvents => ['Message::DOM::Event',
78	'Message::DOM::Event::CustomEvent'],
79	HTMLEvents => ['Message::DOM::Event', 'Message::DOM::Event'],
80	## TODO: MouseEvents
81	## TODO: MutationEvents
82	## TODO: UIEvents
83	}->{$_[1]};
84
85	unless (defined $mc) {
86	report Message::DOM::DOMException
87	-object => $_[0],
88	-type => 'NOT_SUPPORTED_ERR',
89	-subtype => 'EVENT_INTERFACE_NOT_SUPPORTED_ERR';
90	}
91
92	eval qq{ require $mc->[0]; 1 } or die $@;
93	## TODO: Should we provide an option to use Time::HiRes?
94	return bless {time_stamp => time}, $mc->[1];
95
96	## ISSUE: What value should be set to attributes?
97	} # create_event
98
99	package Message::IF::DocumentEvent;
100
101	1;