}
foreach my $event ($self->accept_events) {
if (exists $events->{$event}) {
- if (DEBUG_EVENTS) {
- my $name = join(' at ', $self, $self->location);
- print STDERR
- "Applying Event: $event on $name with value: "
- .(defined $events->{$event} ? $events->{$event} : '<undef>')."\n";
- }
+ $self->_dump_event($event, $events->{$event}) if DEBUG_EVENTS;
$self->$event($events->{$event});
}
}
}
+sub _dump_event {
+ my ( $self, $name, $value ) = @_;
+ my $vp_name = join(' at ', $self, $self->location);
+ print STDERR
+ "Applying Event: $name on $vp_name with value: "
+ . (defined $value ? $value : '<undef>') . "\n";
+}
+
sub accept_events { () }
sub force_events { () }
}
}
+after handle_events => sub {
+ my ($self, $events) = @_;
+ foreach my $event ($self->accept_events) {
+ unless (exists $events->{$event} ) {
+ # for <input type="image"... buttons
+ if ( exists $events->{"${event}.x"} && exists $events->{"${event}.y"} ) {
+ $self->$event($events->{$event});
+ }
+ }
+ }
+};
__PACKAGE__->meta->make_immutable;