add a Role-based Event handling system

3 files changed, 665 insertions, 0 deletions

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 <alien@rmail.be>
+
+=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 <alien@rmail.be>
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (c) 2015 Maarten Vanraes <alien@rmail.be>
+
+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 <alien@rmail.be>
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (c) 2015 Maarten Vanraes <alien@rmail.be>
+
+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;
+