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	wakaba	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;