Message/DOM/EventTarget.pm

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

sub add_event_listener ($$$;$) {
  push @{$_[0]->{event_listener}->{''}->{''.$_[1]}->[$_[3] ? 1 : 0] or []},
      $_[2];
} # add_event_listener

sub add_event_listener_ns ($$$$;$) {
  push @{$_[0]->{event_listener}->{
    defined $_[1] ? $_[1] : ''
  }->{''.$_[2]}->[$_[4] ? 1 : 0] or []}, $_[3];
} # add_event_listener_ns

require Message::DOM::EventException;
use Char::Class::XML qw/InXMLNCNameStartChar11 InXMLNCNameChar11/;

sub dispatch_event ($$) {
  unless (UNIVERSAL::isa ($_[1], 'Message::DOM::Event')) {
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'NOT_SUPPORTED_ERR',
        -subtype => 'EXTERNAL_EVENT_ERR';
  }

  if ($_[1]->{manakai_dispatched}) {
    report Message::DOM::EventException
        -object => $_[0],
        -type => 'DISPATCH_REQUEST_ERR';
  }

  my $type = $_[1]->{type};
  if (not defined $type or $type eq '') {
    report Message::DOM::EventException
        -object => $_[0],
        -type => 'UNSPECIFIED_EVENT_TYPE_ERR';
  } elsif ($type =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*\z/) {
    report Message::DOM::DOMException
        -object => $_[0],
        -type => 'INVALID_CHARACTER_ERR',
        -subtype => 'MALFORMED_EVENT_TYPE_ERR';
  }

  local $Error::Depth = $Error::Depth + 1;
  return $_[0]->__dispatch_event ($_[1]);
} # dispatch_event

sub __dispatch_event {
  ## NOTE: MUST be implemented by subclass.
  die "Not implemented";
} # __dispatch_event

## TODO: multiple registration... then, remove them
## TODO: <http://www.w3.org/2006/webapi/track/issues/77>

sub remove_event_listener ($$$;$) {
  my $list = $_[0]->{event_listener}->{''}->{''.$_[1]}->[$_[3] ? 1 : 0] || [];
  for my $i (0..$#$list) {
    if ($list->[$i] eq $_[2]) {
      splice @$list, $i, 1, ();
      last;
    }
  }
} # remove_event_listener

sub remove_event_listener_ns ($$$$;$) {
  my $list = $_[0]->{event_listener}->{
    defined $_[1] ? $_[1] : ''
  }->{''.$_[2]}->[$_[4] ? 1 : 0] || [];
  for my $i (0..$#$list) {
    if ($list->[$i] eq $_[3]) {
      splice @$list, $i, 1, ();
      last;
    }
  }
} # remove_event_listener_ns

package Message::IF::EventTarget;

1;
1	package Message::DOM::EventTarget;
2	use strict;
3	push our @ISA, 'Message::IF::EventTarget';
4
5	sub add_event_listener ($$$;$) {
6	push @{$_[0]->{event_listener}->{''}->{''.$_[1]}->[$_[3] ? 1 : 0] or []},
7	$_[2];
8	} # add_event_listener
9
10	sub add_event_listener_ns ($$$$;$) {
11	push @{$_[0]->{event_listener}->{
12	defined $_[1] ? $_[1] : ''
13	}->{''.$_[2]}->[$_[4] ? 1 : 0] or []}, $_[3];
14	} # add_event_listener_ns
15
16	require Message::DOM::EventException;
17	use Char::Class::XML qw/InXMLNCNameStartChar11 InXMLNCNameChar11/;
18
19	sub dispatch_event ($$) {
20	unless (UNIVERSAL::isa ($_[1], 'Message::DOM::Event')) {
21	report Message::DOM::DOMException
22	-object => $_[0],
23	-type => 'NOT_SUPPORTED_ERR',
24	-subtype => 'EXTERNAL_EVENT_ERR';
25	}
26
27	if ($_[1]->{manakai_dispatched}) {
28	report Message::DOM::EventException
29	-object => $_[0],
30	-type => 'DISPATCH_REQUEST_ERR';
31	}
32
33	my $type = $_[1]->{type};
34	if (not defined $type or $type eq '') {
35	report Message::DOM::EventException
36	-object => $_[0],
37	-type => 'UNSPECIFIED_EVENT_TYPE_ERR';
38	} elsif ($type =~ /\A\p{InXMLNCNameStartChar11}\p{InXMLNCNameChar11}*\z/) {
39	report Message::DOM::DOMException
40	-object => $_[0],
41	-type => 'INVALID_CHARACTER_ERR',
42	-subtype => 'MALFORMED_EVENT_TYPE_ERR';
43	}
44
45	local $Error::Depth = $Error::Depth + 1;
46	return $_[0]->__dispatch_event ($_[1]);
47	} # dispatch_event
48
49	sub __dispatch_event {
50	## NOTE: MUST be implemented by subclass.
51	die "Not implemented";
52	} # __dispatch_event
53
54	## TODO: multiple registration... then, remove them
55	## TODO: <http://www.w3.org/2006/webapi/track/issues/77>
56
57	sub remove_event_listener ($$$;$) {
58	my $list = $_[0]->{event_listener}->{''}->{''.$_[1]}->[$_[3] ? 1 : 0] \|\| [];
59	for my $i (0..$#$list) {
60	if ($list->[$i] eq $_[2]) {
61	splice @$list, $i, 1, ();
62	last;
63	}
64	}
65	} # remove_event_listener
66
67	sub remove_event_listener_ns ($$$$;$) {
68	my $list = $_[0]->{event_listener}->{
69	defined $_[1] ? $_[1] : ''
70	}->{''.$_[2]}->[$_[4] ? 1 : 0] \|\| [];
71	for my $i (0..$#$list) {
72	if ($list->[$i] eq $_[3]) {
73	splice @$list, $i, 1, ();
74	last;
75	}
76	}
77	} # remove_event_listener_ns
78
79	package Message::IF::EventTarget;
80
81	1;