HTML::DOM::Event - A Perl class for HTML DOM Event objects

  use HTML::DOM::Event ':all'; # get constants

  use HTML::DOM;
  $doc=new HTML::DOM;

  $event = $doc->createEvent;
  $event->initEvent(
      'click', # type
       1,      # whether it propagates up the hierarchy
       0,      # whether it can be cancelled
  );
  # OR:
  $event->init(
      type => 'click',
      propagates_up => 1,
      cancellable => 0,
  );

  $doc->body->dispatchEvent($event); # fake event (run the handlers)
  $doc->body->trigger_event($event); # real event

package HTML::DOM::Event;

our $VERSION = '0.048';


use strict;
use warnings;

# Look, TMTOWTDI:
sub	CAPTURING_PHASE  (){             1,}
sub	AT_TARGET             (){ 2,}
	sub BUBBLING_PHASE             (){       3,}	

use HTML::DOM::Exception 'NOT_SUPPORTED_ERR';
use Exporter 5.57 'import';

our @EXPORT_OK = qw'
	CAPTURING_PHASE            
	AT_TARGET        
	BUBBLING_PHASE              
';
our %EXPORT_TAGS = (all => \@EXPORT_OK);

sub new {
	bless {time => time}, $_[0];
}

sub create_event {
	my $class = class_for($_[0]);
	defined $class or die new HTML::DOM::Exception NOT_SUPPORTED_ERR,
		"The event category '$_[0]' is not supported";
	(my $path =$class) =~ s/::/\//g;
	require "$path.pm";
	$class->new
}

# ----------- ATTRIBUTE METHODS ------------- #
# (all read-only)

sub type          { $_[0]{name      } }
sub target        { $_[0]{target    }||() }
sub currentTarget { $_[0]{cur_target}||() }
sub eventPhase    { $_[0]{phase     } }
sub bubbles       { $_[0]{froth     } }
sub cancelable    { $_[0]{cancelable} }
sub timeStamp     { $_[0]{time      } }
sub cancelled     { $_[0]{cancelled } } # non-DOM
sub propagation_stopped { $_[0]{stopped} } # same hear


# ----------- METHOD METHODS ------------- #

sub stopPropagation { $_[0]{stopped  } = !0; return }
sub preventDefault  { $_[0]{cancelled} = !0 if $_[0]->cancelable; return }
#  similar:
sub _set_eventPhase    { $_[0]{phase     } = $_[1] }
sub _set_target        { $_[0]{target    } = $_[1] }
sub _set_currentTarget { $_[0]{cur_target} = $_[1] }

sub initEvent {
	shift->init(
		type => shift,
		propagates_up => shift,
		cancellable => shift,
	);
	return;
}

sub init {
	my($event, %args) = @_;
	return if defined $event->eventPhase;
	@$event{qw/name froth cancelable target/}
		= @args{qw/ type propagates_up cancellable target /};
	$event;
}

# ----------- OTHER STUFF ------------- #

# ~~~ Should I document these?
# ~~~ If I do make these public, I probably ought to rename them to make
#     some distinction between the arg types; the arg to class_for is a DOM
#     event module name, and the arg to defaults is an event type.

my %class_for = (
	'' => __PACKAGE__,
	UIEvents => 'HTML::DOM::Event::UI',
	HTMLEvents => __PACKAGE__,
	MouseEvents => 'HTML::DOM::Event::Mouse',
	MutationEvents => "HTML::DOM::Event::Mutation",
);

sub class_for {
	$class_for{$_[0]};
}

# ~~~ The DOM 2 spec lists mouseover and -out as cancellable. Firefox has
#     the cancelable property set to true, but preventDefault does nothing.
#     The DOM 3 spec also lists mousemove as cancellable. None of this
#     makes any sense.
my %defaults = (
	domfocusin  => [ UIEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	domfocusout => [ UIEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	domactivate => [ UIEvents =>
		propagates_up => 1,
		cancellable => 1,
		detail => 1,
	],
	click       => [ MouseEvents =>
		propagates_up => 1,
		cancellable => 1,
		detail => 1,
		screen_x => 0,
		screen_y => 0,
		client_x => 0,
		client_y => 0,
		ctrl => 0,
		alt => 0,
		shift => 0,
		meta => 0,
		button => 1,
	],
	mousedown   => [ MouseEvents =>
		propagates_up => 1,
		cancellable => 1,
		detail => 1,
		screen_x => 0,
		screen_y => 0,
		client_x => 0,
		client_y => 0,
		ctrl => 0,
		alt => 0,
		shift => 0,
		meta => 0,
		button => 1,
	],
	mouseup     => [ MouseEvents =>
		propagates_up => 1,
		cancellable => 1,
		detail => 1,
		screen_x => 0,
		screen_y => 0,
		client_x => 0,
		client_y => 0,
		ctrl => 0,
		alt => 0,
		shift => 0,
		meta => 0,
		button => 1,
	],
	mouseover   => [ MouseEvents =>
		propagates_up => 1,
		cancellable => 1,
		screen_x => 0,
		screen_y => 0,
		client_x => 0,
		client_y => 0,
		ctrl => 0,
		alt => 0,
		shift => 0,
		meta => 0,
	],
	mousemove   => [ MouseEvents =>
		propagates_up => 1,
		cancellable => 0,
		screen_x => 0,
		screen_y => 0,
		client_x => 0,
		client_y => 0,
		ctrl => 0,
		alt => 0,
		shift => 0,
		meta => 0,
	],
	mouseout    => [ MouseEvents =>
		propagates_up => 1,
		cancellable => 1,
		screen_x => 0,
		screen_y => 0,
		client_x => 0,
		client_y => 0,
		ctrl => 0,
		alt => 0,
		shift => 0,
		meta => 0,
	],
	domsubtreemodified  => [ MutationEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	domnodeinserted  => [ MutationEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	domnoderemoved  => [ MutationEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	domnoderemovedfromdocument  => [ MutationEvents =>
		propagates_up => 0,
		cancellable => 0,
	],
	domnodeinsertedintodocument  => [ MutationEvents =>
		propagates_up => 0,
		cancellable => 0,
	],
	domattrmodified  => [ MutationEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	domcharacterdatamodified  => [ MutationEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	load => [ HTMLEvents =>
		propagates_up => 0,
		cancellable => 0,
	],
	unload => [ HTMLEvents =>
		propagates_up => 0,
		cancellable => 0,
	],
	focus => [ HTMLEvents =>
		propagates_up => 0,
		cancellable => 0,
	],
	blur => [ HTMLEvents =>
		propagates_up => 0,
		cancellable => 0,
	],
	abort => [ HTMLEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	error => [ HTMLEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	select => [ HTMLEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	change => [ HTMLEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	# submit uses the defaults
	reset => [ HTMLEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	resize => [ HTMLEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
	scroll => [ HTMLEvents =>
		propagates_up => 1,
		cancellable => 0,
	],
);

sub defaults {
	my $evnt_name = lc $_[0];
	return exists $defaults{$evnt_name}
		? @{$defaults{$evnt_name}}
		: (''=>propagates_up=>1,cancellable=>1);
}

# ($event_category, @args) = HTML'DOM'Event'defaults foo;

1;
__END__