Commit | Line | Data |
4536f655 |
1 | # File: Stem/Event.pm |
2 | |
3 | # This file is part of Stem. |
4 | # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc. |
5 | |
6 | # Stem is free software; you can redistribute it and/or modify |
7 | # it under the terms of the GNU General Public License as published by |
8 | # the Free Software Foundation; either version 2 of the License, or |
9 | # (at your option) any later version. |
10 | |
11 | # Stem is distributed in the hope that it will be useful, |
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
14 | # GNU General Public License for more details. |
15 | |
16 | # You should have received a copy of the GNU General Public License |
17 | # along with Stem; if not, write to the Free Software |
18 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
19 | |
20 | # For a license to use the Stem under conditions other than those |
21 | # described here, to purchase support for this software, or to purchase a |
22 | # commercial warranty contract, please contact Stem Systems at: |
23 | |
24 | # Stem Systems, Inc. 781-643-7504 |
25 | # 79 Everett St. info@stemsystems.com |
26 | # Arlington, MA 02474 |
27 | # USA |
28 | |
29 | # this is the base class for all of the other event classes. it |
30 | # provides common services and also stubs for the internal _methods so |
31 | # the other classes don't need to declare them if they don't use them. |
32 | |
33 | package Stem::Event ; |
34 | |
35 | use Stem::Class ; |
36 | |
37 | use strict ; |
38 | |
39 | # this will hold the hashes of events for each event type. |
40 | |
41 | my %all_events = ( |
42 | |
43 | plain => {}, |
44 | signal => {}, |
45 | timer => {}, |
46 | read => {}, |
47 | write => {}, |
48 | ) ; |
49 | |
50 | # table of loop types to the Stem::Event::* class name |
51 | |
52 | my %loop_to_class = ( |
53 | |
54 | event => 'EventPM', |
55 | perl => 'Perl', |
56 | tk => 'Tk', |
57 | wx => 'Wx', |
58 | # gtk => 'Gtk', |
59 | # qt => 'Qt', |
60 | ) ; |
61 | |
62 | # use the requested event loop and default to perl on windows and |
63 | # event.pm elsewhere. |
64 | |
65 | my $loop_class = _get_loop_class() ; |
66 | |
f4d1dc84 |
67 | INIT{ init_loop() ; } |
4536f655 |
68 | |
69 | |
70 | sub init_loop { |
71 | |
f4d1dc84 |
72 | Stem::Event::Queue::_init_queue() if defined &Stem::Event::Queue::_init_queue ; |
73 | |
4536f655 |
74 | $loop_class->_init_loop() ; |
75 | |
d88e4371 |
76 | <<<<<<< HEAD:lib/Stem/Event.pm |
4932dd97 |
77 | #Stem::Event::Queue::_init_queue() if defined &Stem::Event::Queue::_init_queue ; |
d88e4371 |
78 | ======= |
79 | >>>>>>> master:lib/Stem/Event.pm |
4536f655 |
80 | |
81 | } |
82 | |
83 | sub start_loop { |
84 | |
85 | $loop_class->_start_loop() ; |
86 | } |
87 | |
88 | sub stop_loop { |
89 | |
90 | $loop_class->_stop_loop() ; |
91 | } |
92 | |
93 | sub trigger { |
94 | |
95 | my( $self, $method ) = @_ ; |
96 | |
97 | # never trigger inactive events |
98 | |
99 | return unless $self->{active} ; |
100 | |
101 | |
102 | $method ||= $self->{'method'} ; |
103 | #print "METHOD [$method]\n" ; |
104 | |
105 | $self->{'object'}->$method( $self->{'id'} ) ; |
106 | |
107 | Stem::Msg::process_queue() if defined &Stem::Msg::process_queue; |
108 | |
109 | return ; |
110 | } |
111 | |
112 | ################# |
113 | # all the stuff below is a rough cell call trace thing. it needs work |
114 | # it would be put inside the trigger method |
115 | # 'log_type' attribute is set or the event type is used. |
116 | #_init subs need to set event_log_type in the object |
117 | #use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ; |
118 | #use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ; |
119 | # $log_type = $self->{'log_type'} || $self->{'event_type'} ; |
120 | # TraceStatus "[$log_type] [$object] [$method]\n" ; |
121 | # $Stem::Event::current_object = $object ; |
122 | # my ( $cell_name, $target ) = Stem::Route::lookup_cell_name( $object ) ; |
123 | # if ( $cell_name ) { |
124 | # # Debug |
125 | # # "EVENT $event to $cell_name:$target [$object] [$method]\n" ; |
126 | # } |
127 | # else { |
128 | # # Debug "EVENT $event to [$object] [$method]\n" ; |
129 | # } |
130 | ################# |
131 | |
132 | |
133 | # get all the event objects for an event type |
134 | # this is a class sub. |
135 | |
136 | sub _get_events { |
137 | |
138 | my( $event_type ) = @_ ; |
139 | |
140 | my $events = $all_events{ $event_type } ; |
141 | |
142 | return unless $events ; |
143 | |
144 | return values %{$events} if wantarray ; |
145 | |
146 | return $events ; |
147 | } |
148 | |
149 | # initialize the subclass object for this event and store generic event |
150 | # info. |
151 | |
152 | sub _build_core_event { |
153 | |
154 | #print "BAZ\n" ; |
155 | |
156 | my( $self, $event_type ) = @_ ; |
157 | |
158 | |
159 | #print "EVT [$self] [$event_type]\n" ; |
160 | |
161 | # call and and check the return of the core event constructor |
162 | |
163 | if ( my $core_event = $self->_build() ) { |
164 | |
165 | # return the error if it was an error string |
166 | |
167 | return $core_event unless ref $core_event ; |
168 | |
169 | # save the core event |
170 | |
171 | $self->{core_event} = $core_event ; |
172 | } |
173 | |
174 | # mark the event type and track it |
175 | |
176 | $self->{event_type} = $event_type ; |
177 | $all_events{ $event_type }{ $self } = $self ; |
178 | |
179 | return ; |
180 | } |
181 | |
182 | # these are the public versions of the support methods. |
183 | # subclasses can provide a _method to override the stub ones in this class. |
184 | |
185 | sub cancel { |
186 | |
187 | my( $self ) = @_ ; |
188 | |
189 | $self->{'active'} = 0 ; |
190 | delete $self->{'object'} ; |
191 | |
192 | # delete the core object |
193 | |
194 | if ( my $core_event = delete $self->{core_event} ) { |
195 | |
196 | # call the core cancel |
197 | |
198 | $self->_cancel( $core_event ) ; |
199 | } |
200 | |
201 | # delete this event from the tracking hash |
202 | |
203 | delete $all_events{ $self->{event_type} }{ $self } ; |
204 | |
205 | return ; |
206 | } |
207 | |
208 | sub start { |
209 | my( $self ) = @_ ; |
210 | |
211 | $self->{'active'} = 1 ; |
212 | $self->_start( $self->{core_event} ) ; |
213 | |
214 | return ; |
215 | } |
216 | |
217 | sub stop { |
218 | my( $self ) = @_ ; |
219 | |
220 | $self->{'active'} = 0 ; |
221 | $self->_stop( $self->{core_event} ) ; |
222 | |
223 | return ; |
224 | } |
225 | |
226 | # stubs for the internal methods that subclasses should override if needed. |
227 | |
228 | sub _init_loop {} |
229 | sub _build {} |
230 | sub _start {} |
231 | sub _stop {} |
232 | sub _reset {} |
233 | sub _cancel {} |
234 | |
235 | use Stem::Debug qw( dump_socket dump_owner dump_data ) ; |
236 | |
237 | sub dump_events { |
238 | |
239 | print dump_data( \%all_events ) ; |
240 | } |
241 | |
242 | sub dump { |
243 | |
244 | my( $self ) = @_ ; |
245 | |
246 | my $event_text = <<TEXT ; |
247 | EV: $self |
248 | ACT: $self->{'active'} |
249 | TEXT |
250 | |
251 | my $obj_dump = dump_owner $self->{'object'} ; |
252 | $event_text .= <<TEXT ; |
253 | OBJ: $obj_dump |
254 | METH: $self->{'method'} |
255 | TEXT |
256 | |
257 | if ( my $fh = $self->{'fh'} ) { |
258 | |
259 | my $fh_text = dump_socket( $self->{'fh'} ) ; |
260 | $event_text .= <<TEXT ; |
261 | FH: $fh_text |
262 | TEXT |
263 | } |
264 | |
265 | if ( $self->{event_type} eq 'timer' ) { |
266 | |
267 | my $delay = $self->{delay} || 'NONE' ; |
268 | my $interval = $self->{interval} || 'NONE' ; |
269 | $event_text .= <<TEXT ; |
270 | DELAY: $delay |
271 | INT: $interval |
272 | TEXT |
273 | } |
274 | |
275 | if ( my $io_timer_event = $self->{'io_timer_event'} ) { |
276 | |
277 | $event_text = "IO TIMER: >>>>>\n" . $io_timer_event->dump() . |
278 | "END\n"; |
279 | } |
280 | |
281 | return <<DUMP ; |
282 | |
283 | >>> |
284 | $event_text<<< |
285 | |
286 | DUMP |
287 | |
288 | } |
289 | |
290 | ############# |
291 | # change this to a cleaner loop style which can handle more event loops and |
292 | # try them in sequence |
293 | ############# |
294 | |
295 | sub _get_loop_class { |
296 | |
297 | my $loop_type = $Stem::Vars::Env{ 'event_loop' } || |
298 | ($^O =~ /win32/i ? 'perl' : 'event' ); |
299 | |
300 | $loop_type = 'perl' unless $loop_to_class{ $loop_type } ; |
301 | my $loop_class = "Stem::Event::$loop_to_class{ $loop_type }" ; |
302 | |
f4d1dc84 |
303 | print "LOOP $loop_class\n" ; |
304 | |
4536f655 |
305 | unless ( eval "require $loop_class" ) { |
306 | die "can't load $loop_class: $@" if $@ && $@ !~ /locate/ ; |
307 | |
f4d1dc84 |
308 | print "not found\n" ; |
309 | |
4536f655 |
310 | $loop_type = 'perl' ; |
311 | eval { require Stem::Event::Perl } ; |
312 | die "can't load event loop Stem::Event::Perl $@" if $@ ; |
313 | } |
314 | |
f4d1dc84 |
315 | |
4536f655 |
316 | # save the event loop that we loaded. |
317 | |
318 | #print "using event loop [$loop_type]\n" ; |
319 | $Stem::Vars::Env{ 'event_loop' } = $loop_type ; |
320 | |
f4d1dc84 |
321 | |
4536f655 |
322 | return $loop_class ; |
323 | } |
324 | |
325 | |
326 | ############################################################################ |
327 | |
328 | package Stem::Event::Plain ; |
d88e4371 |
329 | <<<<<<< HEAD:lib/Stem/Event.pm |
4536f655 |
330 | |
d88e4371 |
331 | ======= |
332 | >>>>>>> master:lib/Stem/Event.pm |
4932dd97 |
333 | our @ISA = qw( Stem::Event ) ; |
4536f655 |
334 | |
335 | =head2 Stem::Event::Plain::new |
336 | |
337 | This class creates an event that will trigger a callback after all |
338 | other pending events have been triggered. |
339 | |
340 | =head2 Example |
341 | |
342 | $plain_event = Stem::Event::Plain->new( 'object' => $self ) ; |
343 | |
344 | =cut |
345 | |
346 | my $attr_spec_plain = [ |
347 | |
348 | { |
349 | 'name' => 'object', |
350 | 'required' => 1, |
351 | 'type' => 'object', |
352 | 'help' => <<HELP, |
353 | This object gets the method callbacks |
354 | HELP |
355 | }, |
356 | { |
357 | 'name' => 'method', |
358 | 'default' => 'triggered', |
359 | 'help' => <<HELP, |
360 | This method is called on the object when the plain event is triggered |
361 | HELP |
362 | }, |
363 | { |
364 | 'name' => 'id', |
365 | 'help' => <<HELP, |
366 | The id is passed to the callback method as its only argument. Use it to |
367 | identify different instances of this object. |
368 | HELP |
369 | |
370 | }, |
371 | ] ; |
372 | |
373 | sub new { |
374 | |
375 | my( $class ) = shift ; |
376 | |
377 | my $self = Stem::Class::parse_args( $attr_spec_plain, @_ ) ; |
378 | return $self unless ref $self ; |
379 | |
4932dd97 |
380 | my $err = $self->_build_core_event( 'plain' ) ; |
4536f655 |
381 | return $err if $err ; |
382 | |
383 | return $self ; |
384 | } |
385 | |
386 | ############################################################################ |
387 | |
388 | package Stem::Event::Signal ; |
d88e4371 |
389 | <<<<<<< HEAD:lib/Stem/Event.pm |
4536f655 |
390 | |
d88e4371 |
391 | ======= |
392 | >>>>>>> master:lib/Stem/Event.pm |
4932dd97 |
393 | our @ISA = qw( Stem::Event ) ; |
4536f655 |
394 | |
395 | =head2 Stem::Event::Signal::new |
396 | |
397 | This class creates an event that will trigger a callback whenever |
398 | its its signal has been received. |
399 | |
400 | =head2 Example |
401 | |
402 | $signal_event = Stem::Event::Signal->new( 'object' => $self, |
403 | 'signal' => 'INT' ) ; |
404 | |
405 | sub sig_int_handler { die "SIGINT\n" } |
406 | |
407 | =cut |
408 | |
409 | my $attr_spec_signal = [ |
410 | |
411 | { |
412 | 'name' => 'object', |
413 | 'required' => 1, |
414 | 'type' => 'object', |
415 | 'help' => <<HELP, |
416 | This object gets the method callbacks |
417 | HELP |
418 | }, |
419 | { |
420 | 'name' => 'method', |
421 | 'help' => <<HELP, |
422 | This method is called on the object when this event is triggered. The |
423 | default method name for the signal NAME is 'sig_name_handler' (all lower case) |
424 | HELP |
425 | }, |
426 | { |
427 | 'name' => 'signal', |
428 | 'required' => 1, |
429 | 'help' => <<HELP, |
430 | This is the name of the signal to handle. It is used as part of the |
431 | default handler method name. |
432 | HELP |
433 | }, |
434 | { |
435 | 'name' => 'active', |
436 | 'default' => 1, |
437 | 'type' => 'boolean', |
438 | 'help' => <<HELP, |
439 | This flag marks the event as being active. It can be toggled with the |
440 | start/stop methods. |
441 | HELP |
442 | }, |
443 | { |
444 | 'name' => 'id', |
445 | 'help' => <<HELP, |
446 | The id is passed to the callback method as its only argument. Use it to |
447 | identify different instances of this object. |
448 | HELP |
449 | |
450 | }, |
451 | ] ; |
452 | |
453 | sub new { |
454 | |
455 | my( $class ) = shift ; |
456 | |
457 | my $self = Stem::Class::parse_args( $attr_spec_signal, @_ ) ; |
458 | return $self unless ref $self ; |
459 | |
460 | my $signal = uc $self->{'signal'} ; |
461 | |
462 | return "Unknown signal: $signal" unless exists $SIG{ $signal } ; |
463 | |
464 | $self->{'method'} ||= "sig_\L${signal}_handler" ; |
465 | $self->{'signal'} = $signal ; |
466 | |
467 | my $err = $self->_build_core_event( 'signal' ) ; |
468 | return $err if $err ; |
469 | |
470 | #print "SELF SIG $self\nPID $$\n" ; |
471 | |
472 | return $self ; |
473 | } |
474 | |
475 | |
476 | ############################################################################ |
477 | |
478 | package Stem::Event::Timer ; |
d88e4371 |
479 | <<<<<<< HEAD:lib/Stem/Event.pm |
4536f655 |
480 | |
d88e4371 |
481 | ======= |
482 | >>>>>>> master:lib/Stem/Event.pm |
4932dd97 |
483 | our @ISA = qw( Stem::Event ) ; |
4536f655 |
484 | |
485 | =head2 Stem::Event::Timer::new |
486 | |
487 | This class creates an event that will trigger a callback after a time |
488 | period has elapsed. The initial timer delay is set from the 'delay', |
489 | 'at' or 'interval' attributes in that order. If the 'interval' |
490 | attribute is not set, the timer will cancel itself after its first |
491 | triggering (it is a one-shot). The 'hard' attribute means that the |
492 | next interval delay starts before the callback to the object is |
493 | made. If a soft timer is selected (hard is 0), the delay starts after |
494 | the callback returns. So the hard timer ignores the time taken by the |
495 | callback and so it is a more accurate timer. The accuracy a soft timer |
496 | is affected by how much time the callback takes. |
497 | |
498 | =head2 Example |
499 | |
500 | $timer_event = Stem::Event::Timer->new( 'object' => $self, |
501 | 'delay' => 5, |
502 | 'interval' => 10 ) ; |
503 | |
504 | sub timed_out { print "timer alert\n" } ; |
505 | |
506 | |
507 | =cut |
508 | |
509 | BEGIN { |
510 | |
511 | my $attr_spec_timer = [ |
512 | |
513 | { |
514 | 'name' => 'object', |
515 | 'required' => 1, |
516 | 'type' => 'object', |
517 | 'help' => <<HELP, |
518 | This object gets the method callbacks |
519 | HELP |
520 | }, |
521 | { |
522 | 'name' => 'method', |
523 | 'default' => 'timed_out', |
524 | 'help' => <<HELP, |
525 | This method is called on the object when the timeout is triggered |
526 | HELP |
527 | }, |
528 | { |
529 | 'name' => 'delay', |
530 | 'help' => <<HELP, |
531 | Delay this amount of seconds before triggering the first time. If this |
532 | is not set then the 'at' or 'interval' attributes will be used. |
533 | HELP |
534 | }, |
535 | { |
536 | 'name' => 'interval', |
537 | 'help' => <<HELP, |
538 | Wait this time (in seconds) before any repeated triggers. If not set |
539 | then the timer is a one-shot |
540 | HELP |
541 | }, |
542 | { |
543 | 'name' => 'at', |
544 | 'help' => <<HELP, |
545 | Trigger in the future at this time (in epoch seconds). It will set the intial |
546 | delay to the different between the current time and the 'at' time. |
547 | HELP |
548 | }, |
549 | { |
550 | 'name' => 'hard', |
551 | 'type' => 'boolean', |
552 | 'default' => 0, |
553 | 'help' => <<HELP, |
554 | If this is set, the interval time starts when the event is |
555 | triggered. If it is not set, the interval time starts when the object |
556 | callback has finished. So 'hard' timers repeat closer to equal |
557 | intervals while without 'hard' the repeat time is dependant on how |
558 | long the callback takes. |
559 | HELP |
560 | }, |
561 | { |
562 | 'name' => 'active', |
563 | 'default' => 1, |
564 | 'type' => 'boolean', |
565 | 'help' => <<HELP, |
566 | This flag marks the event as being active. It can be toggled with the |
567 | start/stop methods. |
568 | HELP |
569 | }, |
570 | { |
571 | 'name' => 'id', |
572 | 'help' => <<HELP, |
573 | The id is passed to the callback method as its only argument. Use it to |
574 | identify different instances of this object. |
575 | HELP |
576 | |
577 | }, |
578 | ] ; |
579 | |
580 | sub new { |
581 | |
582 | my( $class ) = shift ; |
583 | |
584 | my $self = Stem::Class::parse_args( $attr_spec_timer, @_ ) ; |
585 | return $self unless ref $self ; |
586 | |
587 | # the delay is either set, or at a future time or the interval |
588 | |
589 | my $delay = exists( $self->{ 'delay' } ) ? |
590 | $self->{ 'delay' } : |
591 | exists( $self->{ 'at' } ) ? |
592 | $self->{ 'at' } - time() : |
593 | $self->{'interval'} ; |
594 | |
595 | #print "INT $self->{'interval'} DELAY $delay\n" ; |
596 | |
597 | # squawk if no delay value |
598 | |
599 | return "No initial delay was specified for timer" |
600 | unless defined $delay ; |
601 | |
602 | $self->{'delay'} = $delay ; |
603 | $self->{'time_left'} = $delay ; |
604 | |
605 | my $err = $self->_build_core_event( 'timer' ) ; |
606 | return $err if $err ; |
607 | |
608 | ########## |
609 | # check on this logic |
610 | ######### |
611 | |
612 | $self->_stop unless $self->{'active'} ; |
613 | |
614 | return $self ; |
615 | } |
616 | |
617 | } |
618 | |
619 | sub reset { |
620 | |
621 | my( $self, $reset_delay ) = @_ ; |
622 | |
623 | return unless $self->{'active'} ; |
624 | |
625 | # if we don't get passed a delay, use the interval or the delay attribute |
626 | |
627 | $reset_delay ||= ($self->{'interval'}) ? |
628 | $self->{'interval'} : $self->{'delay'} ; |
629 | |
630 | # track the new delay and reset the real timer (if we are using one) |
631 | |
632 | $self->{'time_left'} = $reset_delay ; |
633 | |
634 | $self->_reset( $self->{core_event}, $reset_delay ) ; |
635 | |
636 | return ; |
637 | } |
638 | |
639 | sub timer_triggered { |
640 | |
641 | my( $self ) = @_ ; |
642 | |
643 | #print time(), " TIMER TRIG\n" ; |
644 | #use Carp qw( cluck ) ; |
645 | #cluck ; |
646 | |
647 | # check if this is a one-shot timer |
648 | |
649 | $self->cancel() unless $self->{'interval'} ; |
650 | |
651 | # reset the timer count before the trigger code for hard timers |
652 | #(trigger on fixed intervals) |
653 | |
654 | $self->reset( $self->{'interval'} ) if $self->{'hard'}; |
655 | |
656 | $self->trigger() ; |
657 | |
658 | # reset the timer count before the trigger code for soft timers |
659 | #(trigger on at least fixed intervals) |
660 | |
661 | $self->reset( $self->{'interval'} ) unless $self->{'hard'}; |
662 | } |
663 | |
664 | ############################################################################ |
665 | |
666 | #################################################################### |
667 | # common methods for the Read/Write event classes to handle the optional |
668 | # I/O timeouts. |
669 | # these override Stem::Event's methods and then call those via SUPER:: |
670 | |
671 | package Stem::Event::IO ; |
d88e4371 |
672 | <<<<<<< HEAD:lib/Stem/Event.pm |
4536f655 |
673 | |
d88e4371 |
674 | ======= |
675 | >>>>>>> master:lib/Stem/Event.pm |
4932dd97 |
676 | our @ISA = qw( Stem::Event ) ; |
4536f655 |
677 | |
678 | sub init_io_timeout { |
679 | |
680 | my( $self ) = @_ ; |
681 | |
682 | my $timeout = $self->{'timeout'} ; |
683 | return unless $timeout ; |
684 | |
685 | $self->{'io_timer_event'} = Stem::Event::Timer->new( |
686 | 'object' => $self, |
687 | 'interval' => $timeout, |
688 | ) ; |
689 | |
690 | return ; |
691 | } |
692 | |
693 | sub cancel { |
694 | |
695 | my( $self ) = @_ ; |
696 | |
697 | #print "IO CANCEL $self\n" ; |
698 | |
699 | if ( my $io_timer_event = delete $self->{'io_timer_event'} ) { |
700 | $io_timer_event->cancel() ; |
701 | } |
702 | |
703 | $self->SUPER::cancel() ; |
704 | |
705 | delete $self->{'fh'} ; |
706 | |
707 | return ; |
708 | } |
709 | |
710 | sub start { |
711 | |
712 | my( $self ) = @_ ; |
713 | |
714 | if ( my $io_timer_event = $self->{'io_timer_event'} ) { |
715 | $io_timer_event->start() ; |
716 | } |
717 | |
718 | $self->SUPER::start() ; |
719 | |
720 | return ; |
721 | } |
722 | |
723 | sub stop { |
724 | |
725 | my( $self ) = @_ ; |
726 | |
727 | $self->{'active'} = 0 ; |
728 | |
729 | if ( my $io_timer_event = $self->{'io_timer_event'} ) { |
730 | $io_timer_event->stop() ; |
731 | } |
732 | |
733 | $self->SUPER::stop() ; |
734 | |
735 | return ; |
736 | } |
737 | |
738 | sub timed_out { |
739 | |
740 | my( $self ) = @_ ; |
741 | |
742 | # $self->{log_type} = "$self->{'event_type'}_timeout" ; |
743 | $self->trigger( $self->{'timeout_method'} ) ; |
744 | } |
745 | |
746 | ####################################################### |
747 | |
748 | package Stem::Event::Read ; |
f4d1dc84 |
749 | our @ISA = qw( Stem::Event::IO ) ; |
750 | print "B @ISA\n" ; |
4536f655 |
751 | |
d88e4371 |
752 | <<<<<<< HEAD:lib/Stem/Event.pm |
4932dd97 |
753 | our @ISA = qw( Stem::Event::IO ) ; |
d88e4371 |
754 | ======= |
755 | >>>>>>> master:lib/Stem/Event.pm |
4536f655 |
756 | |
757 | =head2 Stem::Event::Read::new |
758 | |
759 | This class creates an event that will trigger a callback whenever |
760 | its file descriptor has data to be read. It takes an optional timeout |
761 | value which will trigger a callback to the object if no data has been |
762 | read during that period. |
763 | |
764 | Read events are active when created - a call to the stop method is |
765 | needed to deactivate them. |
766 | |
767 | =cut |
768 | |
769 | BEGIN { |
770 | |
771 | my $attr_spec_read = [ |
772 | |
773 | { |
774 | 'name' => 'object', |
775 | 'required' => 1, |
776 | 'type' => 'object', |
777 | 'help' => <<HELP, |
778 | This object gets the method callbacks |
779 | HELP |
780 | }, |
781 | { |
782 | 'name' => 'fh', |
783 | 'required' => 1, |
784 | 'type' => 'handle', |
785 | 'help' => <<HELP, |
786 | This file handle is checked if it has data to read |
787 | HELP |
788 | }, |
789 | { |
790 | 'name' => 'timeout', |
791 | 'help' => <<HELP, |
792 | How long to wait (in seconds) without being readable before calling |
793 | the timeout method |
794 | HELP |
795 | }, |
796 | { |
797 | 'name' => 'method', |
798 | 'default' => 'readable', |
799 | 'help' => <<HELP, |
800 | This method is called on the object when the file handle has data to read |
801 | HELP |
802 | }, |
803 | { |
804 | 'name' => 'timeout_method', |
805 | 'default' => 'read_timeout', |
806 | 'help' => <<HELP, |
807 | This method is called on the object when the hasn't been readable |
808 | after the timeout period |
809 | HELP |
810 | }, |
811 | { |
812 | 'name' => 'active', |
813 | 'default' => 1, |
814 | 'type' => 'boolean', |
815 | 'help' => <<HELP, |
816 | This flag marks the event as being active. It can be toggled with the |
817 | start/stop methods. |
818 | HELP |
819 | }, |
820 | { |
821 | 'name' => 'id', |
822 | 'help' => <<HELP, |
823 | The id is passed to the callback method as its only argument. Use it to |
824 | identify different instances of this object. |
825 | HELP |
826 | |
827 | }, |
828 | ] ; |
829 | |
830 | sub new { |
831 | |
832 | my( $class ) = shift ; |
f4d1dc84 |
833 | print "@ISA\n" ; |
4536f655 |
834 | |
835 | my $self = Stem::Class::parse_args( $attr_spec_read, @_ ) ; |
836 | return $self unless ref $self ; |
837 | |
f4d1dc84 |
838 | |
4536f655 |
839 | # return <<ERR unless defined fileno $self->{fh} ; |
840 | # Stem::Event::Read: $self->{fh} is not an open handle |
841 | # ERR |
842 | |
843 | my $err = $self->_build_core_event( 'read' ) ; |
844 | return $err if $err ; |
845 | |
846 | $self->init_io_timeout() ; |
847 | |
848 | return $self ; |
849 | } |
850 | |
851 | } |
852 | ############################################################################ |
853 | |
854 | package Stem::Event::Write ; |
d88e4371 |
855 | <<<<<<< HEAD:lib/Stem/Event.pm |
4536f655 |
856 | |
d88e4371 |
857 | ======= |
858 | >>>>>>> master:lib/Stem/Event.pm |
4932dd97 |
859 | our @ISA = qw( Stem::Event::IO ) ; |
4536f655 |
860 | |
861 | =head2 Stem::Event::Write::new |
862 | |
863 | This class creates an event that will trigger a callback whenever |
864 | its file descriptor can be written to. It takes an optional timeout |
865 | value which will trigger a callback to the object if no data has been |
866 | written during that period. |
867 | |
868 | Write events are stopped when created - a call to the start method is |
869 | needed to activate them. |
870 | |
871 | =cut |
872 | |
873 | my $attr_spec_write = [ |
874 | |
875 | { |
876 | 'name' => 'object', |
877 | 'required' => 1, |
878 | 'type' => 'object', |
879 | 'help' => <<HELP, |
880 | This object gets the method callbacks |
881 | HELP |
882 | }, |
883 | { |
884 | 'name' => 'fh', |
885 | 'required' => 1, |
886 | 'type' => 'handle', |
887 | 'help' => <<HELP, |
888 | This file handle is checked if it is writeable |
889 | HELP |
890 | }, |
891 | { |
892 | 'name' => 'timeout', |
893 | 'help' => <<HELP, |
894 | How long to wait (in seconds) without being writeable before calling |
895 | the timeout method |
896 | HELP |
897 | }, |
898 | { |
899 | 'name' => 'method', |
900 | 'default' => 'writeable', |
901 | 'help' => <<HELP, |
902 | This method is called on the object when the file handle is writeable |
903 | HELP |
904 | }, |
905 | { |
906 | 'name' => 'timeout_method', |
907 | 'default' => 'write_timeout', |
908 | 'help' => <<HELP, |
909 | This method is called on the object when the hasn't been writeable |
910 | after the timeout period |
911 | HELP |
912 | }, |
913 | { |
914 | 'name' => 'active', |
915 | 'default' => 0, |
916 | 'type' => 'boolean', |
917 | 'help' => <<HELP, |
918 | This flag marks the event as being active. It can be toggled with the |
919 | start/stop methods. |
920 | NOTE: Write events are not active by default. |
921 | HELP |
922 | }, |
923 | { |
924 | 'name' => 'id', |
925 | 'help' => <<HELP, |
926 | The id is passed to the callback method as its only argument. Use it to |
927 | identify different instances of this object. |
928 | HELP |
929 | |
930 | }, |
931 | ] ; |
932 | |
933 | sub new { |
934 | |
935 | my( $class ) = shift ; |
936 | |
937 | my $self = Stem::Class::parse_args( $attr_spec_write, @_ ) ; |
938 | return $self unless ref $self ; |
939 | |
940 | my $err = $self->_build_core_event( 'write' ) ; |
941 | return $err if $err ; |
942 | |
943 | #print $self->dump_events() ; |
944 | |
945 | $self->init_io_timeout() ; |
946 | |
947 | $self->stop() unless $self->{'active'} ; |
948 | |
949 | #print $self->dump() ; |
950 | |
951 | return $self ; |
952 | } |
953 | |
954 | 1 ; |