File Coverage

blib/lib/Weasel/WidgetHandlers.pm

Criterion	Covered	Total	%
statement	28	57	49.1
branch	2	16	12.5
condition	1	8	12.5
subroutine	6	9	66.6
pod	2	2	100.0
total	39	92	42.3

=head1 NAME

Weasel::WidgetHandlers - Mapping elements to widget handlers

=head1 VERSION

version 0.32

=head1 SYNOPSIS

  use Weasel::WidgetHandlers qw( register_widget_handler );

  register_widget_handler(
    'Weasel::Widgets::HTML::Radio', # Perl class handler
    'HTML',                         # Widget group
    tag_name => 'input',
    attributes => {
       type => 'radio',
    });

  register_widget_handler(
    'Weasel::Widgets::Dojo::FilteringSelect',
    'Dojo',
    tag_name => 'span',
    classes => ['dijitFilteringSelect'],
    attributes => {
       role => 'presentation',
       ...
    });

=cut

=head1 DESCRIPTION

Widget handlers map HTML elements to Perl class instances based on the
HTML tag and its attributes.  The Perl class can be used to encapsulate
interaction with the HTML element and its children, abstracting HTML DOM
interactions into functional behaviours.

A widget may itself be composed of one or more child-widget. Eg, a form
could be composed of several input fields and a button, all mapped to
widgets to handle the interactions with the specific element type.

Classes can be developed and handlers registered for widgets which
perform the same behaviours as basic HTML widgets, like the C<select>
tag; eg., a Dojo Toolkit, Vue or React widgets could be mapped to
specific classes which encapsulate the DOM interactions required to make
these widgets transparent to the Perl code which is interacting with them.
An example of a widget mimicing to be a C<select> tag is
L<Weasel::Widgets::Dojo::Select>.

=cut

=head1 DEPENDENCIES


=cut

package Weasel::WidgetHandlers 0.32;

use strict;
use warnings;

use base 'Exporter';

use Module::Runtime qw(use_module);
use List::Util qw(max);

our @EXPORT_OK = qw| register_widget_handler best_match_handler_class |;

=head1 SUBROUTINES/METHODS

=over

=item register_widget_handler($handler_class_name, $group_name, %conditions)

Registers C<$handler_class_name> to be the instantiated widget returned
for an element matching C<%conditions> into C<$group_name>.

C<Weasel::Session> can select a subset of widgets to be applicable to that
session by adding a subset of available groups to that session.

=cut


# Stores handlers as arrays per group
my %widget_handlers;

sub register_widget_handler {
    my ($class, $group, %conditions) = @_;

    # make sure we can use the module by pre-loading it
    use_module $class;

    return push @{$widget_handlers{$group}}, {
        class => $class,
        conditions => \%conditions,
    };
}

=item best_match_handler_class($driver, $_id, $groups)

Returns the best matching handler's class name, within the groups
listed in the arrayref C<$groups>, or C<undef> in case of no match.

When C<$groups> is undef, all registered handlers will be searched.

When multiple handlers are considered "best match", the one last added
to the group last mentioned in C<$groups> is selected.

=cut

sub _cached_elem_att {
    my ($cache, $driver, $_id, $att) = @_;

    return (exists $cache->{$att})
        ? $cache->{$att}
        : ($cache->{$att} = $driver->get_attribute($_id, $att));
}

sub _att_eq {
    my ($att1, $att2) = @_;

    return ($att1 // '') eq ($att2 // '');
}

sub best_match_handler_class {
    my ($driver, $_id, $groups) = @_;

    $groups //= [ keys %widget_handlers ];   # undef --> unrestricted

    my @matches;
    my $elem_att_cache = {};
    my $elem_classes;

    my $tag = $driver->tag_name($_id);
    for my $group (@{$groups}) {
        my $handlers = $widget_handlers{$group};

      HANDLER:
        for my $handler (@{$handlers}) {
            my $conditions = $handler->{conditions};

            next unless $tag eq $conditions->{tag_name};
            my $match_count = 1;

            if (exists $conditions->{classes}) {
                %{$elem_classes} =
                   map { $_ => 1 }
                   split /\s+/x, ($driver->get_attribute($_id, 'class')
                                 // '')
                       unless defined $elem_classes;

                for my $class (@{$conditions->{classes}}) {
                    next HANDLER
                        unless exists $elem_classes->{$class};
                    $match_count++;
                }
            }

            for my $att (keys %{$conditions->{attributes}}) {
                next HANDLER
                    unless _att_eq(
                        $conditions->{attributes}->{$att},
                        _cached_elem_att(
                            $elem_att_cache, $driver, $_id, $att));
                $match_count++;
            }

            push @matches, {
                count => $match_count,
                class => $handler->{class},
            };
        }
    }
    my $max_count = max map { $_->{count} } @matches;
    @matches = grep { $_->{count} == $max_count } @matches;

    warn "multiple matching handlers for element\n"
        if scalar(@matches) > 1;

    my $best_match = pop @matches;
    return $best_match ? $best_match->{class} : undef;
}

=back

=cut

=head1 AUTHOR

Erik Huelsmann

=head1 CONTRIBUTORS

Erik Huelsmann
Yves Lavoie

=head1 MAINTAINERS

Erik Huelsmann

=head1 BUGS AND LIMITATIONS

Bugs can be filed in the GitHub issue tracker for the Weasel project:
 https://github.com/perl-weasel/weasel/issues

=head1 SOURCE

The source code repository for Weasel is at
 https://github.com/perl-weasel/weasel

=head1 SUPPORT

Community support is available through
L<[e-mail]|mailto:[e-mail]>.

=head1 LICENSE AND COPYRIGHT

 (C) 2016-2023  Erik Huelsmann

Licensed under the same terms as Perl.

=cut


1;