From 19f0093bc6920331d926bde70aa1e16340c367ca Mon Sep 17 00:00:00 2001 From: Maarten Vanraes Date: Sat, 29 Aug 2015 15:18:26 +0200 Subject: add a Role-based Event handling system --- lib/ManaTools/Shared/GUI/Event.pm | 160 +++++++++++ lib/ManaTools/Shared/GUI/EventHandlerRole.pm | 396 +++++++++++++++++++++++++++ lib/ManaTools/Shared/GUI/EventRole.pm | 109 ++++++++ 3 files changed, 665 insertions(+) create mode 100644 lib/ManaTools/Shared/GUI/Event.pm create mode 100644 lib/ManaTools/Shared/GUI/EventHandlerRole.pm create mode 100644 lib/ManaTools/Shared/GUI/EventRole.pm (limited to 'lib/ManaTools/Shared/GUI') diff --git a/lib/ManaTools/Shared/GUI/Event.pm b/lib/ManaTools/Shared/GUI/Event.pm new file mode 100644 index 00000000..efed61c3 --- /dev/null +++ b/lib/ManaTools/Shared/GUI/Event.pm @@ -0,0 +1,160 @@ +# vim: set et ts=4 sw=4: +package ManaTools::Shared::GUI::Event; +#============================================================= -*-perl-*- + +=head1 NAME + +ManaTools::Shared::GUI::Event - Class to manage various events + +=head1 SYNOPSIS + +use ManaTools::Shared::GUI::Event; + +my $event = ManaTools::Shared::GUI::Event->new( + name => "Event1", + parentDialog => $dialog, + eventType => $yui::YEvent::YWidgetEvent, + widget => $widget, + backend => $backend, + event => sub { + my $self = shift; + my $yevent = shift; + my $backend = shift; + my $dialog = $self->parentDialog(); + my $ydialog = $dialog->dialog(); + ... + return 1; + } +); + + +=head1 DESCRIPTION + +This class wraps the most common dialog functionality + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command: + +perldoc ManaTools::Shared::GUI::Event + +=head1 AUTHOR + +Maarten Vanraes + +=head1 COPYRIGHT and LICENSE + +Copyright (C) 2015, Maarten Vanraes. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License version 2, as +published by the Free Software Foundation. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA + +=head1 FUNCTIONS + +=cut + +use Moose; +use diagnostics; +use utf8; + +with 'ManaTools::Shared::GUI::EventRole'; + +use yui; + +#============================================================= + +=head2 new + +=head3 INPUT + + hash ref containing + name: a name to identify it + parentDialog: the parent Dialog + eventType: a yui::YEventType + widget: an optional widget + item: an optional item + event: an optional CodeRef + backend: an optional backend to be used in the event handler + +=head3 DESCRIPTION + + new is inherited from Moose, to create an Event object + +=cut + +has 'widget' => ( + is => 'ro', + isa => 'Maybe[yui::YWidget]', + default => sub { + return undef; + } +); + +has 'item' => ( + is => 'ro', + isa => 'Maybe[yui::YItem]', + default => sub { + return undef; + } +); + +has 'event' => ( + is => 'rw', + isa => 'Maybe[CodeRef]', + lazy => 1, + default => sub { + return undef; + } +); + +has 'backend' => ( + is => 'rw', + isa => 'Maybe[Ref]', + lazy => 1, + default => sub { + return undef; + } +); + +#============================================================= + +sub processEvent { + my $self = shift; + my $yevent = shift; + return 1 if ($yevent->eventType != $self->eventType); + return 1 if ($yevent->eventType == $yui::YEvent::WidgetEvent && !$self->equalsWidget($yevent->widget)); + return 1 if ($yevent->eventType == $yui::YEvent::MenuEvent && !$self->equalsItem($yevent->item)); + my $event = $self->event(); + return $event->($self, $yevent, $self->backend()) if defined($event); + return 1; +} + +sub equalsWidget { + my $self = shift; + my $widget = shift; + return ($self->widget() == $widget); +} + +sub equalsItem { + my $self = shift; + my $item = shift; + return ($self->item() == $item); +} + +#============================================================= + +no Moose; +__PACKAGE__->meta->make_immutable; + +1; diff --git a/lib/ManaTools/Shared/GUI/EventHandlerRole.pm b/lib/ManaTools/Shared/GUI/EventHandlerRole.pm new file mode 100644 index 00000000..cf554ed3 --- /dev/null +++ b/lib/ManaTools/Shared/GUI/EventHandlerRole.pm @@ -0,0 +1,396 @@ +# vim: set et ts=4 sw=4: +package ManaTools::Shared::GUI::EventHandlerRole; + +#============================================================= -*-perl-*- + +=head1 NAME + + ManaTools::Shared::GUI::EventHandlerRole - a Properties Moose::Role + +=head1 SYNOPSIS + package Foo; + + with 'ManaTools::Shared::GUI::EventHandlerRole'; + + 1; + + ... + + my $f = Foo->new(...); + $f->addEvent($event); + ... + while(1) { + ... + last if (!$f->processEvents($yevent)); + } + ... + $f->clearEvents(); + + +=head1 DESCRIPTION + + This Role is to specify an EventHandler Role, specifically, to handle multiple sub-Events + +=head1 SUPPORT + + You can find documentation for this Role with the perldoc command: + + perldoc ManaTools::Shared::GUI::EventHandlerRole + + +=head1 AUTHOR + + Maarten Vanraes + +=head1 COPYRIGHT and LICENSE + +Copyright (c) 2015 Maarten Vanraes + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License version 2, as +published by the Free Software Foundation. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +=head1 METHODS + +=cut + +use Moose::Role; + +has 'events' => ( + is => 'ro', + isa => 'HashRef[ManaTools::Shared::GUI::EventRole]', + default => sub { + return {}; + } +); + +#============================================================= + +=head2 parentDialog + +=head3 INPUT + + $self: this object + +=head3 DESCRIPTION + + finds the parent Dialog + +=cut + +#============================================================= +sub parentDialog { + my $self = shift; + my $eventHandler = $self->eventHandler(); + while (defined($eventHandler) && !$eventHandler->isa('ManaTools::Shared::GUI::Dialog') && $eventHandler->does('ManaTools::Shared::GUI::EventRole')) { + $eventHandler = $eventHandler->eventHandler(); + } + return $eventHandler; +} + +#============================================================= + +=head2 addEvent + +=head3 INPUT + + $self: this object + $name: a name to identify the event + $event: an EventRole to be added + @args: extra optional arguments + +=head3 DESCRIPTION + + add an Event to the events list + +=cut + +#============================================================= +sub addEvent { + my $self = shift; + my $name = shift; + my $event = shift; + my $events = $self->events(); + die "event named '$name' already exists!" if defined($events->{$name}); + $events->{$name} = $event; +} + +#============================================================= + +=head2 delEvent + +=head3 INPUT + + $self: this object + $name: a name to identify the event + +=head3 DESCRIPTION + + del an event from the events list + +=cut + +#============================================================= +sub delEvent { + my $self = shift; + my $name = shift; + my $events = $self->events(); + delete $events->{$name} if (defined $events->{$name}); +} + +#============================================================= + +=head2 hasEvent + +=head3 INPUT + + $self: this object + $name: the event identified by $name + +=head3 DESCRIPTION + + 1 if the event exists, 0 otherwise + +=cut + +#============================================================= +sub hasEvent { + my $self = shift; + my $name = shift; + my $events = $self->events(); + return defined($events->{$name}); +} + +#============================================================= + +=head2 getEvent + +=head3 INPUT + + $self: this object + $name: the event identified by $name + +=head3 OUTPUT + + an ManaTools::Shared::GUI::EventRole + +=head3 DESCRIPTION + + returns an event, depending on the name + +=cut + +#============================================================= +sub getEvent { + my $self = shift; + my $name = shift; + my $events = $self->events(); + die "event named '$name' does not exist!" if !defined($events->{$name}); + return $events->{$name}; +} + +#============================================================= + +=head2 clearEvents + +=head3 INPUT + + $self: this object + +=head3 DESCRIPTION + + clears all events + +=cut + +#============================================================= +sub clearEvents { + my $self = shift; + my $events = $self->events(); + for my $name (keys %{$events}) { + $self->delEvent($name); + } +} + +#============================================================= + +=head2 findEvent + +=head3 INPUT + + $self: this object + $callback: CodeRef to be executed for each event + @args: extra arguments for the callback + +=head3 OUTPUT + + an event if it's found, or undef otherwise + +=head3 DESCRIPTION + + returns an Event from the list, according to a callback function, or undef + +=cut + +#============================================================= +sub findEvent { + my $self = shift; + my $callback = shift; + my @args = @_; + my $events = $self->events(); + # loop all the items + for my $event (values %{$events}) { + return $event if ($callback->($event, @args)); + } + return undef; +} + +#============================================================= + +=head2 addWidget + +=head3 INPUT + + $self: this object + $name: a name to identify the widget + $widget: a yui widget + $event: an optional CodeRef that will be executed when an Event triggers + $backend: an optional backend object that will be present in the event handler + +=head3 DESCRIPTION + + add a widget event handler to the events list + +=cut + +#============================================================= +sub addWidget { + my $self = shift; + my $name = shift; + my $widget = shift; + my $event = shift; + my $backend = shift; + return ManaTools::Shared::GUI::Event->new(name => $name, eventHandler => $self, eventType => $yui::YEvent::WidgetEvent, widget => $widget, event => $event, backend => $backend); +} + +#============================================================= + +=head2 delWidget + +=head3 INPUT + + $self: this object + $widget: a yui widget + +=head3 DESCRIPTION + + del a widget event handler from the events list + +=cut + +#============================================================= +sub delWidget { + my $self = shift; + my $widget = shift; + my $event = $self->findWidget($widget); + $self->delEvent($event) if (defined $event); +} + +#============================================================= + +=head2 widget + +=head3 INPUT + + $self: this object + $name: the widget identified by $name + +=head3 DESCRIPTION + + returns a yui::YWidget + +=cut + +#============================================================= +sub widget { + my $self = shift; + my $name = shift; + return undef if (!$self->hasEvent($name)); + my $event = $self->getEvent($name); + return undef if ($event->eventType() != $yui::YEvent::WidgetEvent); + return undef if (!$event->isa('ManaTools::Shared::GUI::Event')); + return $event->widget(); +} + +#============================================================= + +=head2 findWidget + +=head3 INPUT + + $self: this object + $widget: the yui::YWidget to be found + +=head3 DESCRIPTION + + returns a ManaTools::Shared::GUI::Dialog::Event that has the widget + +=cut + +#============================================================= +sub findWidget { + my $self = shift; + my $widget = shift; + return $self->findEvent(sub { + my $event = shift; + my $widget = shift; + return 0 if ($event->eventType() != $yui::YEvent::WidgetEvent); + return 0 if (!$event->isa('ManaTools::Shared::GUI::Event')); + return $event->equalsWidget($widget); + }, $widget); +} + +#============================================================= + +=head2 processEvents + +=head3 INPUT + + $self: this object + $yevent: the yui::YEvent + +=head3 OUTPUT + + 0 if the loop should end, 1 otherwise + +=head3 DESCRIPTION + + returns an Event from the list, according to a callback function, or undef + +=cut + +#============================================================= +sub processEvents { + my $self = shift; + my $yevent = shift; + my $events = $self->events(); + # loop all the items + for my $event (values %{$events}) { + return 0 if(!$event->processEvent($yevent)); + } + return 1; +} + +#============================================================= + +1; + diff --git a/lib/ManaTools/Shared/GUI/EventRole.pm b/lib/ManaTools/Shared/GUI/EventRole.pm new file mode 100644 index 00000000..c0dc639b --- /dev/null +++ b/lib/ManaTools/Shared/GUI/EventRole.pm @@ -0,0 +1,109 @@ +# vim: set et ts=4 sw=4: +package ManaTools::Shared::GUI::EventRole; + +#============================================================= -*-perl-*- + +=head1 NAME + + ManaTools::Shared::GUI::EventRole - a Properties Moose::Role + +=head1 SYNOPSIS + package Foo; + + with 'ManaTools::Shared::GUI::EventRole'; + + sub processEvent { + my $self = shift; + my $yevent = shift; + my $eventHandler = shift; + ... + ## return 0 if you want to exit the eventloop + return 1; + } + + 1; + + ... + + my $dialog = ManaTools::Shared::GUI::Dialog->new(...); + Foo->new(name => 'Foo #1', eventHandler => $dialog, eventType => $yui::YEvent::WidgetEvent, ...); + Foo->new(name => 'Foo #2', eventHandler => $dialog, eventType => $yui::YEvent::WidgetEvent, ...); + return $dialog->call(); + + +=head1 DESCRIPTION + + This Role is to specify an EventRole, specifically, the need to provide a proper processEvent function + +=head1 SUPPORT + + You can find documentation for this Role with the perldoc command: + + perldoc ManaTools::Shared::GUI::EventRole + + +=head1 AUTHOR + + Maarten Vanraes + +=head1 COPYRIGHT and LICENSE + +Copyright (c) 2015 Maarten Vanraes + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License version 2, as +published by the Free Software Foundation. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +=head1 METHODS + +=cut + +use Moose::Role; + +requires 'processEvent'; + +has 'eventHandler' => ( + is => 'ro', + isa => 'ManaTools::Shared::GUI::EventHandlerRole', + required => 1, +); + +has 'name' => ( + is => 'ro', + isa => 'Str', + required => 1, +); + +has 'eventType' => ( + is => 'ro', + isa => 'Int', + required => 1, +); + +sub BUILD { + my $self = shift; + my $name = $self->name(); + my $eventHandler = $self->eventHandler(); + # add yourself to the dialog's event handlers + $eventHandler->addEvent($name, $self); +} + +sub DEMOLISH { + my $self = shift; + my $name = $self->name(); + my $eventHandler = $self->eventHandler(); + # remove yourself from the event handler + $eventHandler->delEvent($name) if defined($eventHandler); +} + +1; + -- cgit v1.2.1