File Coverage

lib/HTML/Object/Event.pm
Criterion Covered Total %
statement 91 210 43.3
branch 5 144 3.4
condition 1 50 2.0
subroutine 29 39 74.3
pod 26 26 100.0
total 152 469 32.4


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## HTML Object - ~/lib/HTML/Object/Event.pm
3             ## Version v0.2.0
4             ## Copyright(c) 2021 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2021/12/11
7             ## Modified 2022/09/18
8             ## All rights reserved
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package HTML::Object::Event;
15             BEGIN
16             {
17 18     18   3837 use strict;
  18         48  
  18         674  
18 18     18   96 use warnings;
  18         35  
  18         649  
19 18     18   94 use parent qw( Module::Generic );
  18         35  
  18         153  
20 18     18   1443 use vars qw( @EXPORT_OK %EXPORT_TAGS $VERSION );
  18         43  
  18         1300  
21 18     18   111 use Nice::Try;
  18         64  
  18         186  
22 18     18   6850583 use Time::HiRes ();
  18         44  
  18         1248  
23             use constant {
24 18         7370 NONE => 0,
25             CAPTURING_PHASE => 1,
26             AT_TARGET => 2,
27             BUBBLING_PHASE => 3,
28            
29             CANCEL_PROPAGATION => 1,
30             CANCEL_IMMEDIATE_PROPAGATION => 2,
31            
32             ABORT => 1,
33             BLUR => 2,
34             CLICK => 4,
35             CHANGE => 16,
36             DBLCLICK => 32,
37             DRAGDDROP => 64,
38             ERROR => 128,
39             FOCUS => 256,
40             KEYDOWN => 512,
41             KEYPRESS => 1024,
42             KEYUP => 2048,
43             LOAD => 4096,
44             MOUSEDOWN => 8192,
45             MOUSEMOVE => 16384,
46             MOUSEOUT => 32768,
47             MOUSEOVER => 65536,
48             MOUSEUP => 131072,
49             MOVE => 262144,
50             RESET => 524288,
51             RESIZE => 1048576,
52             SELECT => 2097152,
53             SUBMIT => 4194304,
54             UNLOAD => 8388608,
55 18     18   171 };
  18         46  
56 18     18   156 our @EXPORT_OK = qw(
57             NONE CAPTURING_PHASE AT_TARGET BUBBLING_PHASE CANCEL_PROPAGATION CANCEL_IMMEDIATE_PROPAGATION
58             ABORT BLUR CLICK CHANGE DBLCLICK DRAGDDROP ERROR FOCUS KEYDOWN KEYPRESS KEYUP LOAD
59             MOUSEDOWN MOUSEMOVE MOUSEOUT MOUSEOVER MOUSEUP MOVE RESET RESIZE SELECT SUBMIT UNLOAD
60             );
61 18         253 our %EXPORT_TAGS = (
62             'all' => [qw(
63             NONE CAPTURING_PHASE AT_TARGET BUBBLING_PHASE
64             CANCEL_PROPAGATION CANCEL_IMMEDIATE_PROPAGATION
65             ABORT BLUR CLICK CHANGE DBLCLICK DRAGDDROP ERROR FOCUS KEYDOWN KEYPRESS KEYUP LOAD
66             MOUSEDOWN MOUSEMOVE MOUSEOUT MOUSEOVER MOUSEUP MOVE RESET RESIZE SELECT SUBMIT UNLOAD
67             )],
68             'events'=> [qw(
69             ABORT BLUR CLICK CHANGE DBLCLICK DRAGDDROP ERROR FOCUS KEYDOWN KEYPRESS KEYUP LOAD
70             MOUSEDOWN MOUSEMOVE MOUSEOUT MOUSEOVER MOUSEUP MOVE RESET RESIZE SELECT SUBMIT UNLOAD
71             )],
72             'phase' => [qw( NONE CAPTURING_PHASE AT_TARGET BUBBLING_PHASE )]
73             );
74 18         473 our $VERSION = 'v0.2.0';
75             };
76              
77 18     18   132 use strict;
  18         44  
  18         573  
78 18     18   156 use warnings;
  18         48  
  18         32294  
79              
80             sub init
81             {
82 141     141 1 13628 my $self = shift( @_ );
83 141   50     924 my $type = shift( @_ ) || return( $self->error( "No event type was provided." ) );
84 141         1806 $self->{bubbles} = 1;
85 141         488 $self->{cancelable} = 1;
86             # Property that, if set to true, will be checked to stop events handlers and propagation
87 141         394 $self->{cancelled} = 0;
88 141         423 $self->{composed} = 0;
89 141         413 $self->{currentTarget} = undef;
90 141         351 $self->{defaultPrevented} = 0;
91 141         482 $self->{detail} = {};
92 141         552 $self->{eventPhase} = NONE;
93 141         443 $self->{isTrusted} = 1;
94             # array of html element for which their event handler will be called
95 141         439 $self->{path} = [];
96 141         388 $self->{target} = undef;
97 141         715 $self->{timeStamp} = Time::HiRes::time();
98 141         388 $self->{type} = $type;
99 141         388 $self->{_init_strict_use_sub} = 1;
100 141 50       832 $self->SUPER::init( @_ ) || return( $self->pass_error );
101             # Our immediate caller is new() in Module::Generic, so we skip that
102 141         7908 my( $pack, $file, $line ) = caller(1);
103 141         1189 my $sub = [caller(2)]->[3];
104 141         676 $self->{package} = $pack;
105 141         419 $self->{file} = $file;
106 141         407 $self->{line} = $line;
107 141         418 $self->{subroutine} = $sub;
108 141         507 return( $self );
109             }
110              
111             # Note: Property
112 141     141 1 18977 sub bubbles : lvalue { return( shift->_set_get_boolean( 'bubbles', @_ ) ); }
113              
114             # Note: Property
115 153     153 1 135754 sub cancelable : lvalue { return( shift->_set_get_boolean( 'cancelable', @_ ) ); }
116              
117             # Note: Property
118 0     0 1 0 sub cancellable : lvalue { return( shift->_set_get_boolean( 'cancelable', @_ ) ); }
119              
120             # Note: Property
121 0     0 1 0 sub canceled : lvalue { return( shift->_set_get_number( 'cancelled', @_ ) ); }
122              
123             # Note: Property
124 37     37 1 1531 sub cancelled : lvalue { return( shift->_set_get_number( 'cancelled', @_ ) ); }
125              
126             # Note: Property
127 1     1 1 41273 sub composed : lvalue { return( shift->_set_get_boolean( 'composed', @_ ) ); }
128              
129             sub composedPath
130             {
131 3     3 1 1822 my $self = shift( @_ );
132             # already set
133 3 50       19 return( $self->path ) if( !$self->path->is_empty );
134 3         2191 my $target = $self->target;
135 3 100       93 return( $self->error( "No target element is set yet!" ) ) if( !$target );
136 2         6 my $original_target = $target;
137 2         6 my $path = $self->path;
138 2         1718 while( $target->parentNode )
139             {
140 4         106 $path->push( $target );
141 4         32 $target = $target->parentNode;
142             }
143 2         749 my $doc = $original_target->root;
144 2 50       13 $path->push( $doc ) if( $doc );
145             # Module::Generic::Array object
146 2         17 return( $path );
147             }
148              
149             # Note: Property
150 25     25 1 4514 sub currentTarget : lvalue { return( shift->_set_get_lvalue( 'currentTarget', @_ ) ); }
151              
152             # Note: Property
153 3     3 1 1261 sub defaultPrevented : lvalue { return( shift->_set_get_boolean( 'defaultPrevented', @_ ) ); }
154              
155             # Note : Property from CustomEvent, but we add it here as a standard
156 153     153 1 139642 sub detail : lvalue { return( shift->_set_get_hash_as_mix_object( 'detail', @_ ) ); }
157              
158             sub dispatch
159             {
160 0     0 1 0 my $self = shift( @_ );
161 0   0     0 my $elem = shift( @_ ) || return( $self->error({
162             message => "No element was provided to dispatch this event to.",
163             class => 'HTML::Object::SyntaxError',
164             }) );
165 0 0       0 return( $self->error({
166             message => "Object provided is not a node object (HTML::Object::DOM::Node)",
167             class => 'HTML::Object::SyntaxError',
168             }) ) if( !$self->_is_a( $elem => 'HTML::Object::DOM::Node' ) );
169 0         0 return( $elem->dispatchEvent( $self ) );
170             }
171              
172             # Note: Property
173 15     15 1 1317 sub eventPhase : lvalue { return( shift->_set_get_lvalue( 'eventPhase', @_ ) ); }
174              
175 0     0 1 0 sub file { return( shift->_set_get_scalar( 'file', @_ ) ); }
176              
177             # Note: Property
178 1     1 1 1553 sub isTrusted : lvalue { return( shift->_set_get_boolean( 'isTrusted', @_ ) ); }
179              
180 0     0 1 0 sub line { return( shift->_set_get_scalar( 'line', @_ ) ); }
181              
182 0     0 1 0 sub package { return( shift->_set_get_scalar( 'package', @_ ) ); }
183              
184 5     5 1 30 sub path { return( shift->_set_get_array_as_object( 'path', @_ ) ); }
185              
186             # Note: preventDefault does nothing, except set defaultPrevented to true
187             sub preventDefault
188             {
189 1     1 1 2897 my $self = shift( @_ );
190 1         7 $self->defaultPrevented(1);
191 1         1045 return( $self );
192             }
193              
194             sub setTimestamp
195             {
196 0     0 1 0 my $self = shift( @_ );
197 0 0       0 my $now = scalar( @_ ) ? shift( @_ ) : Time::HiRes::time();
198 0 0 0     0 try
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
199 0     0   0 {
200 0         0 my $dt;
201 0 0       0 unless( $self->_is_a( $now => 'DateTime' ) )
202             {
203 0         0 $dt = DateTime->from_epoch( epoch => $now );
204             }
205 0         0 return( $self->_set_get_datetime( timeStamp => $dt ) );
206             }
207 0 0 0     0 catch( $e )
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
208 0     0   0 {
209 0         0 return( $self->error( "Error setting event timestamp: $e" ) );
210 18 0 0 18   159 }
  18 0 0     58  
  18 0 0     6052  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0 0     0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0 0       0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
211             }
212              
213             sub stopImmediatePropagation
214             {
215 1     1 1 1554 my $self = shift( @_ );
216 1         6 $self->cancelled( CANCEL_IMMEDIATE_PROPAGATION );
217 1         41232 return( $self );
218             }
219              
220             sub stopPropagation
221             {
222 1     1 1 1645 my $self = shift( @_ );
223 1         6 $self->cancelled( CANCEL_PROPAGATION );
224 1         40428 return( $self );
225             }
226              
227 0     0 1 0 sub subroutine { return( shift->_set_get_scalar( 'subroutine', @_ ) ); }
228              
229             # Note: Property
230 146     146 1 205545 sub target { return( shift->_set_get_object_without_init( 'target', 'HTML::Object::Element', @_ ) ); }
231              
232             # Note: Property
233 1     1 1 566 sub timeStamp : lvalue { return( shift->_set_get_datetime( 'timeStamp', @_ ) ); }
234              
235             # Note: Property
236 15     15 1 5224868 sub type : lvalue { return( shift->_set_get_lvalue( 'type', @_ ) ); }
237              
238             1;
239             # NOTE: POD
240             __END__
241              
242             =encoding utf-8
243              
244             =head1 NAME
245              
246             HTML::Object::Event - HTML Object Event Class
247              
248             =head1 SYNOPSIS
249              
250             use HTML::Object::Event;
251             my $event = HTML::Object::Event->new ||
252             die( HTML::Object::Event->error, "\n" );
253              
254             =head1 VERSION
255              
256             v0.2.0
257              
258             =head1 DESCRIPTION
259              
260             This module represents an event which takes place in the DOM.
261              
262             Of course, unlike a web browser environment, there is no user interaction here, so all event "fired" are triggered programatically.
263              
264             Events are attached to L<HTML elements|HTML::Object::Element>
265              
266             One L<element|HTML::Object::Element> can have several such L<handlers|HTML::Object::EventTarget>, even for the exact same event
267              
268             =head1 CONSTRUCTOR
269              
270             =head2 new
271              
272             Provided with a type and an hash or hash reference of options and this creates a new L<HTML::Object::Event> object. An event created in this way is called a C<synthetic> event, as opposed to an event fired by the browser, and can be dispatched by a script.
273              
274             It returns the new event object upon success, or upon error, returns C<undef> and sets an L<error|HTML::Object::Exception>
275              
276             Parameters accepted:
277              
278             =over 4
279              
280             =item I<type>
281              
282             This is a string representing the type of the event.
283              
284             =item I<options hash or hash reference>
285              
286             The options can have the following properties. All of them are optional. Each of them can be accessed or modified by they equivalent method listed below.
287              
288             =over 8
289              
290             =item I<bubbles>
291              
292             A boolean value indicating whether the event bubbles. The default is true.
293              
294             When true, this means the event will be passed on from the element that triggered it on to its parent and its parent's parent and so on up to the top L<element|HTML::Object::DOM::Document>. This is the default behaviour. When set to false, the event will not bubble up.
295              
296             =item I<cancelable>
297              
298             A boolean value indicating whether the event can be cancelled. The default is true.
299              
300             It can also be called as C<cancellable> for non-American speakers.
301              
302             =item I<composed>
303              
304             Because this is a perl environment, this value is always false, and discarded.
305              
306             A boolean value indicating whether the event will trigger listeners outside of a shadow root (see L</composed> for more details). The default is C<false>.
307              
308             =item I<detail>
309              
310             An optional hash reference of arbitrary key-valu pairs that will be stored in the event object and can be later retrieved by the event handlers.
311              
312             =back
313              
314             =back
315              
316             For example:
317              
318             Create a look event that bubbles up and cannot be canceled
319              
320             my $evt = HTML::Object::Event->new( look => { bubbles => 1, cancelable => 0 } );
321             $doc->dispatchEvent( $evt );
322              
323             # event can be dispatched from any element, not only the document
324             $myDiv->dispatchEvent( $evt );
325              
326             =head1 PROPERTIES
327              
328             =head2 bubbles
329              
330             Read-only
331              
332             A boolean value indicating whether or not the event bubbles up through the DOM. Default to false
333              
334             When true, this means the event will be passed on from the element that triggered it on to its parent and its parent's parent and so on up to the top L<element|HTML::Object::DOM::Document>. This is the default behaviour. When set to false, the event will not bubble up.
335              
336             =head2 cancelable
337              
338             Read-only
339              
340             A boolean value indicating whether the event is cancelable. Default to true
341              
342             It can also be called as C<cancellable> for non-American speakers.
343              
344             =head2 canceled
345              
346             Read-only
347              
348             An integer value indicating whether the event has been canceled. Its value is 1 if it has been cancelled with L</stopPropagation> and 2 if it has been cancelled with L</stopImmediatePropagation>
349              
350             It can also be called as C<cancelled> for non-American speakers.
351              
352             =head2 cancellable
353              
354             Alias for L</cancelable>
355              
356             =head2 cancelled
357              
358             Alias for L</canceled>
359              
360             =head2 composed
361              
362             Read-only
363              
364             A boolean indicating whether or not the event can bubble across the boundary between the shadow DOM and the regular DOM. Default to false
365              
366             Since this is a perl environment, this is always false, and its value is ignored.
367              
368             =head2 currentTarget
369              
370             Read-only
371              
372             A reference to the currently registered L<target|HTML::Object::Element> for the event. This is the L<object|HTML::Object::Element> to which the event is currently slated to be sent. It's possible this has been changed along the way through retargeting.
373              
374             =head2 defaultPrevented
375              
376             Read-only
377              
378             Indicates whether or not the call to L</preventDefault> canceled the event. Default to false
379              
380             =head2 detail
381              
382             Set or get an hash reference of arbitrary key-value pairs that will be stored in this event.
383              
384             =head2 eventPhase
385              
386             Read-only
387              
388             Returns an integer value which specifies the current evaluation phase of the event flow. Possible values are: C<NONE> (0), C<CAPTURING_PHASE> (1), C<AT_TARGET> (2), C<BUBBLING_PHASE> (3).
389              
390             You can export those constants in your namespace by calling L<HTML::Object::Event> like this:
391              
392             use HTML::Object::Event qw( NONE CAPTURING_PHASE AT_TARGET BUBBLING_PHASE );
393              
394             or, more simply:
395              
396             use HTML::Object::Event ':phase';
397              
398             See L<for more information|https://developer.mozilla.org/en-US/docs/Web/API/Event/eventPhase>
399              
400             =head2 isTrusted
401              
402             Read-only
403              
404             Obviously, since this is a perl environment, this is always true, because although it would be script-generated, it is fair to say your own script is trustworthy.
405              
406             Indicates whether or not the event was initiated by the browser (after a user click, for instance) or by a script (using an event creation method, for example).
407              
408             =head2 path
409              
410             Returns the computed elements path by L</composedPath>, as an L<array object|Module::Generic::Array>
411              
412             =head2 target
413              
414             Read-only
415              
416             A reference to the L<object|HTML::Object::Element> to which the event was originally dispatched.
417              
418             =head2 timeStamp
419              
420             Read-only
421              
422             The time at which the event was created (in milliseconds). By specification, this value is time since epoch using L<Time::HiRes>. This is actually a L<DateTime> object. L<DateTime> object supports nanoseconds.
423              
424             =head2 type
425              
426             Read-only
427              
428             The case-insensitive type indentifying the event.
429              
430             =head1 METHODS
431              
432             =head2 composedPath
433              
434             Returns the event's path (an array of objects on which listeners will be invoked).
435              
436             =head2 dispatch
437              
438             Provided with a L<node|HTML::Object::DOM::Node> and this will dispatch this event to the given C<node>.
439              
440             It returns the value returned by L</HTML::Object::EventTarget/dispatchEvent>
441              
442             =head2 file
443              
444             Returns the file path where this event was called from.
445              
446             =head2 line
447              
448             Returns the line at which this event was called from.
449              
450             =head2 package
451              
452             Returns the package name where this event was called from.
453              
454             =head2 preventDefault
455              
456             This does nothing under perl, except set the value of L</defaultPrevented> to true.
457              
458             Under JavaScript, this method is used to stop the browser’s default behavior when performing an action, such as checking a checkbox upon user click.
459              
460             =head2 setTimestamp
461              
462             Takes an optional unix timestamp or a L<DateTime> object, and this will set the event timestamp. If no argument is provided, this will resort to set the timestamp using L<Time::HiRes/time>, which provides a timestamp in milliseconds.
463              
464             It returns a L<DateTime> object.
465              
466             =head2 stopImmediatePropagation
467              
468             For this particular event, prevent all other listeners from being called. This includes listeners attached to the same element as well as those attached to elements that will be traversed later (during the capture phase, for instance).
469              
470             =head2 stopPropagation
471              
472             Stops the propagation of events further along in the DOM.
473              
474             =head2 subroutine
475              
476             Returns the subroutine where this event was called from.
477              
478             =head1 CONSTANTS
479              
480             =head2 NONE (0)
481              
482             The event is not being processed at this time.
483              
484             =head2 CAPTURING_PHASE (1)
485              
486             The event is being propagated through the target's ancestor objects. This process starts with the L<Document|HTML::Object::Document>, then the L<HTML html element|HTML::Object::Element>, and so on through the elements until the target's parent is reached. Event listeners registered for capture mode when L<HTML::Object::EventTarget/addEventListener> was called are triggered during this phase.
487              
488             =head2 AT_TARGET (2)
489              
490             The event has arrived at the event's target. Event listeners registered for this phase are called at this time. If L</bubbles> is false, processing the event is finished after this phase is complete.
491              
492             =head2 BUBBLING_PHASE (3)
493              
494             The event is propagating back up through the target's ancestors in reverse order, starting with the parent, and eventually reaching the containing L<document|HTML::Object::Document>. This is known as bubbling, and occurs only if L</bubbles> is true. Event listeners registered for this phase are triggered during this process.
495              
496             =head2 CANCEL_PROPAGATION (1)
497              
498             State of the propagation being cancelled.
499              
500             $event->stopPropagation();
501             $event->cancelled == CANCEL_PROPAGATION;
502              
503             =head2 CANCEL_IMMEDIATE_PROPAGATION (2)
504              
505             State of immediate propagation being cancelled.
506              
507             $event->stopImmediatePropagation();
508             $event->cancelled == CANCEL_IMMEDIATE_PROPAGATION;
509              
510             =head1 AUTHOR
511              
512             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
513              
514             =head1 SEE ALSO
515              
516             L<https://developer.mozilla.org/en-US/docs/Web/API/Event>
517              
518             L<https://developer.mozilla.org/en-US/docs/Web/Events/Creating_and_triggering_events>
519              
520             L<https://developer.mozilla.org/en-US/docs/Learn/JavaScript/Building_blocks/Events>
521              
522             L<https://developer.mozilla.org/en-US/docs/Web/API/CustomEvent/CustomEvent>
523              
524             =head1 COPYRIGHT & LICENSE
525              
526             Copyright(c) 2021 DEGUEST Pte. Ltd.
527              
528             All rights reserved
529              
530             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
531              
532             =cut