3 # This file is part of Stem.
4 # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
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.
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.
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
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:
24 # Stem Systems, Inc. 781-643-7504
25 # 79 Everett St. info@stemsystems.com
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.
39 # this will hold the hashes of events for each event type.
50 # table of loop types to the Stem::Event::* class name
62 # use the requested event loop and default to perl on windows and
65 my $loop_class = _get_loop_class() ;
72 $loop_class->_init_loop() ;
77 $loop_class->_start_loop() ;
82 $loop_class->_stop_loop() ;
87 my( $self, $method ) = @_ ;
89 # never trigger inactive events
91 return unless $self->{active} ;
94 $method ||= $self->{'method'} ;
95 #print "METHOD [$method]\n" ;
97 $self->{'object'}->$method( $self->{'id'} ) ;
99 Stem::Msg::process_queue() if defined &Stem::Msg::process_queue;
105 # all the stuff below is a rough cell call trace thing. it needs work
106 # it would be put inside the trigger method
107 # 'log_type' attribute is set or the event type is used.
108 #_init subs need to set event_log_type in the object
109 #use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
110 #use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
111 # $log_type = $self->{'log_type'} || $self->{'event_type'} ;
112 # TraceStatus "[$log_type] [$object] [$method]\n" ;
113 # $Stem::Event::current_object = $object ;
114 # my ( $cell_name, $target ) = Stem::Route::lookup_cell_name( $object ) ;
115 # if ( $cell_name ) {
117 # # "EVENT $event to $cell_name:$target [$object] [$method]\n" ;
120 # # Debug "EVENT $event to [$object] [$method]\n" ;
125 # get all the event objects for an event type
126 # this is a class sub.
130 my( $event_type ) = @_ ;
132 my $events = $all_events{ $event_type } ;
134 return unless $events ;
136 return values %{$events} if wantarray ;
141 # initialize the subclass object for this event and store generic event
144 sub _build_core_event {
148 my( $self, $event_type ) = @_ ;
151 #print "EVT [$self] [$event_type]\n" ;
153 # call and and check the return of the core event constructor
155 if ( my $core_event = $self->_build() ) {
157 # return the error if it was an error string
159 return $core_event unless ref $core_event ;
161 # save the core event
163 $self->{core_event} = $core_event ;
166 # mark the event type and track it
168 $self->{event_type} = $event_type ;
169 $all_events{ $event_type }{ $self } = $self ;
174 # these are the public versions of the support methods.
175 # subclasses can provide a _method to override the stub ones in this class.
181 $self->{'active'} = 0 ;
182 delete $self->{'object'} ;
184 # delete the core object
186 if ( my $core_event = delete $self->{core_event} ) {
188 # call the core cancel
190 $self->_cancel( $core_event ) ;
193 # delete this event from the tracking hash
195 delete $all_events{ $self->{event_type} }{ $self } ;
203 $self->{'active'} = 1 ;
204 $self->_start( $self->{core_event} ) ;
212 $self->{'active'} = 0 ;
213 $self->_stop( $self->{core_event} ) ;
218 # stubs for the internal methods that subclasses should override if needed.
227 use Stem::Debug qw( dump_socket dump_owner dump_data ) ;
231 print dump_data( \%all_events ) ;
238 my $event_text = <<TEXT ;
240 ACT: $self->{'active'}
243 my $obj_dump = dump_owner $self->{'object'} ;
244 $event_text .= <<TEXT ;
246 METH: $self->{'method'}
249 if ( my $fh = $self->{'fh'} ) {
251 my $fh_text = dump_socket( $self->{'fh'} ) ;
252 $event_text .= <<TEXT ;
257 if ( $self->{event_type} eq 'timer' ) {
259 my $delay = $self->{delay} || 'NONE' ;
260 my $interval = $self->{interval} || 'NONE' ;
261 $event_text .= <<TEXT ;
267 if ( my $io_timer_event = $self->{'io_timer_event'} ) {
269 $event_text = "IO TIMER: >>>>>\n" . $io_timer_event->dump() .
283 # change this to a cleaner loop style which can handle more event loops and
284 # try them in sequence
287 sub _get_loop_class {
289 my $loop_type = $Stem::Vars::Env{ 'event_loop' } ||
290 ($^O =~ /win32/i ? 'perl' : 'event' );
292 $loop_type = 'perl' unless $loop_to_class{ $loop_type } ;
293 my $loop_class = "Stem::Event::$loop_to_class{ $loop_type }" ;
295 #print "LOOP $loop_class\n" ;
297 unless ( eval "require $loop_class" ) {
298 die "can't load $loop_class: $@" if $@ && $@ !~ /locate/ ;
300 print "not found\n" ;
302 $loop_type = 'perl' ;
303 eval { require Stem::Event::Perl } ;
304 die "can't load event loop Stem::Event::Perl $@" if $@ ;
308 # save the event loop that we loaded.
310 #print "using event loop [$loop_type]\n" ;
311 $Stem::Vars::Env{ 'event_loop' } = $loop_type ;
318 ############################################################################
320 package Stem::Event::Plain ;
321 our @ISA = qw( Stem::Event ) ;
323 =head2 Stem::Event::Plain::new
325 This class creates an event that will trigger a callback after all
326 other pending events have been triggered.
330 $plain_event = Stem::Event::Plain->new( 'object' => $self ) ;
334 my $attr_spec_plain = [
341 This object gets the method callbacks
346 'default' => 'triggered',
348 This method is called on the object when the plain event is triggered
354 The id is passed to the callback method as its only argument. Use it to
355 identify different instances of this object.
363 my( $class ) = shift ;
365 my $self = Stem::Class::parse_args( $attr_spec_plain, @_ ) ;
366 return $self unless ref $self ;
368 my $err = $self->_build_core_event( 'plain' ) ;
369 return $err if $err ;
374 ############################################################################
376 package Stem::Event::Signal ;
377 our @ISA = qw( Stem::Event ) ;
379 =head2 Stem::Event::Signal::new
381 This class creates an event that will trigger a callback whenever
382 its its signal has been received.
386 $signal_event = Stem::Event::Signal->new( 'object' => $self,
387 'signal' => 'INT' ) ;
389 sub sig_int_handler { die "SIGINT\n" }
393 my $attr_spec_signal = [
400 This object gets the method callbacks
406 This method is called on the object when this event is triggered. The
407 default method name for the signal NAME is 'sig_name_handler' (all lower case)
414 This is the name of the signal to handle. It is used as part of the
415 default handler method name.
423 This flag marks the event as being active. It can be toggled with the
430 The id is passed to the callback method as its only argument. Use it to
431 identify different instances of this object.
439 my( $class ) = shift ;
441 my $self = Stem::Class::parse_args( $attr_spec_signal, @_ ) ;
442 return $self unless ref $self ;
444 my $signal = uc $self->{'signal'} ;
446 return "Unknown signal: $signal" unless exists $SIG{ $signal } ;
448 $self->{'method'} ||= "sig_\L${signal}_handler" ;
449 $self->{'signal'} = $signal ;
451 my $err = $self->_build_core_event( 'signal' ) ;
452 return $err if $err ;
454 #print "SELF SIG $self\nPID $$\n" ;
460 ############################################################################
462 package Stem::Event::Timer ;
463 our @ISA = qw( Stem::Event ) ;
465 =head2 Stem::Event::Timer::new
467 This class creates an event that will trigger a callback after a time
468 period has elapsed. The initial timer delay is set from the 'delay',
469 'at' or 'interval' attributes in that order. If the 'interval'
470 attribute is not set, the timer will cancel itself after its first
471 triggering (it is a one-shot). The 'hard' attribute means that the
472 next interval delay starts before the callback to the object is
473 made. If a soft timer is selected (hard is 0), the delay starts after
474 the callback returns. So the hard timer ignores the time taken by the
475 callback and so it is a more accurate timer. The accuracy a soft timer
476 is affected by how much time the callback takes.
480 $timer_event = Stem::Event::Timer->new( 'object' => $self,
484 sub timed_out { print "timer alert\n" } ;
491 my $attr_spec_timer = [
498 This object gets the method callbacks
503 'default' => 'timed_out',
505 This method is called on the object when the timeout is triggered
511 Delay this amount of seconds before triggering the first time. If this
512 is not set then the 'at' or 'interval' attributes will be used.
516 'name' => 'interval',
518 Wait this time (in seconds) before any repeated triggers. If not set
519 then the timer is a one-shot
525 Trigger in the future at this time (in epoch seconds). It will set the intial
526 delay to the different between the current time and the 'at' time.
534 If this is set, the interval time starts when the event is
535 triggered. If it is not set, the interval time starts when the object
536 callback has finished. So 'hard' timers repeat closer to equal
537 intervals while without 'hard' the repeat time is dependant on how
538 long the callback takes.
546 This flag marks the event as being active. It can be toggled with the
553 The id is passed to the callback method as its only argument. Use it to
554 identify different instances of this object.
562 my( $class ) = shift ;
564 my $self = Stem::Class::parse_args( $attr_spec_timer, @_ ) ;
565 return $self unless ref $self ;
567 # the delay is either set, or at a future time or the interval
569 my $delay = exists( $self->{ 'delay' } ) ?
571 exists( $self->{ 'at' } ) ?
572 $self->{ 'at' } - time() :
573 $self->{'interval'} ;
575 #print "INT $self->{'interval'} DELAY $delay\n" ;
577 # squawk if no delay value
579 return "No initial delay was specified for timer"
580 unless defined $delay ;
582 $self->{'delay'} = $delay ;
583 $self->{'time_left'} = $delay ;
585 my $err = $self->_build_core_event( 'timer' ) ;
586 return $err if $err ;
589 # check on this logic
592 $self->_stop unless $self->{'active'} ;
601 my( $self, $reset_delay ) = @_ ;
603 return unless $self->{'active'} ;
605 # if we don't get passed a delay, use the interval or the delay attribute
607 $reset_delay ||= ($self->{'interval'}) ?
608 $self->{'interval'} : $self->{'delay'} ;
610 # track the new delay and reset the real timer (if we are using one)
612 $self->{'time_left'} = $reset_delay ;
614 $self->_reset( $self->{core_event}, $reset_delay ) ;
619 sub timer_triggered {
623 #print time(), " TIMER TRIG\n" ;
624 #use Carp qw( cluck ) ;
627 # check if this is a one-shot timer
629 $self->cancel() unless $self->{'interval'} ;
631 # reset the timer count before the trigger code for hard timers
632 #(trigger on fixed intervals)
634 $self->reset( $self->{'interval'} ) if $self->{'hard'};
638 # reset the timer count before the trigger code for soft timers
639 #(trigger on at least fixed intervals)
641 $self->reset( $self->{'interval'} ) unless $self->{'hard'};
644 ############################################################################
646 ####################################################################
647 # common methods for the Read/Write event classes to handle the optional
649 # these override Stem::Event's methods and then call those via SUPER::
651 package Stem::Event::IO ;
652 our @ISA = qw( Stem::Event ) ;
654 sub init_io_timeout {
658 my $timeout = $self->{'timeout'} ;
659 return unless $timeout ;
661 $self->{'io_timer_event'} = Stem::Event::Timer->new(
663 'interval' => $timeout,
673 #print "IO CANCEL $self\n" ;
675 if ( my $io_timer_event = delete $self->{'io_timer_event'} ) {
676 $io_timer_event->cancel() ;
679 $self->SUPER::cancel() ;
681 delete $self->{'fh'} ;
690 if ( my $io_timer_event = $self->{'io_timer_event'} ) {
691 $io_timer_event->start() ;
694 $self->SUPER::start() ;
703 $self->{'active'} = 0 ;
705 if ( my $io_timer_event = $self->{'io_timer_event'} ) {
706 $io_timer_event->stop() ;
709 $self->SUPER::stop() ;
718 # $self->{log_type} = "$self->{'event_type'}_timeout" ;
719 $self->trigger( $self->{'timeout_method'} ) ;
722 #######################################################
724 package Stem::Event::Read ;
725 our @ISA = qw( Stem::Event::IO ) ;
727 =head2 Stem::Event::Read::new
729 This class creates an event that will trigger a callback whenever
730 its file descriptor has data to be read. It takes an optional timeout
731 value which will trigger a callback to the object if no data has been
732 read during that period.
734 Read events are active when created - a call to the stop method is
735 needed to deactivate them.
741 my $attr_spec_read = [
748 This object gets the method callbacks
756 This file handle is checked if it has data to read
762 How long to wait (in seconds) without being readable before calling
768 'default' => 'readable',
770 This method is called on the object when the file handle has data to read
774 'name' => 'timeout_method',
775 'default' => 'read_timeout',
777 This method is called on the object when the hasn't been readable
778 after the timeout period
786 This flag marks the event as being active. It can be toggled with the
793 The id is passed to the callback method as its only argument. Use it to
794 identify different instances of this object.
802 my( $class ) = shift ;
804 my $self = Stem::Class::parse_args( $attr_spec_read, @_ ) ;
805 return $self unless ref $self ;
808 # return <<ERR unless defined fileno $self->{fh} ;
809 # Stem::Event::Read: $self->{fh} is not an open handle
812 my $err = $self->_build_core_event( 'read' ) ;
813 return $err if $err ;
815 $self->init_io_timeout() ;
821 ############################################################################
823 package Stem::Event::Write ;
824 our @ISA = qw( Stem::Event::IO ) ;
826 =head2 Stem::Event::Write::new
828 This class creates an event that will trigger a callback whenever
829 its file descriptor can be written to. It takes an optional timeout
830 value which will trigger a callback to the object if no data has been
831 written during that period.
833 Write events are stopped when created - a call to the start method is
834 needed to activate them.
838 my $attr_spec_write = [
845 This object gets the method callbacks
853 This file handle is checked if it is writeable
859 How long to wait (in seconds) without being writeable before calling
865 'default' => 'writeable',
867 This method is called on the object when the file handle is writeable
871 'name' => 'timeout_method',
872 'default' => 'write_timeout',
874 This method is called on the object when the hasn't been writeable
875 after the timeout period
883 This flag marks the event as being active. It can be toggled with the
885 NOTE: Write events are not active by default.
891 The id is passed to the callback method as its only argument. Use it to
892 identify different instances of this object.
900 my( $class ) = shift ;
902 my $self = Stem::Class::parse_args( $attr_spec_write, @_ ) ;
903 return $self unless ref $self ;
905 my $err = $self->_build_core_event( 'write' ) ;
906 return $err if $err ;
908 #print $self->dump_events() ;
910 $self->init_io_timeout() ;
912 $self->stop() unless $self->{'active'} ;
914 #print $self->dump() ;