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() ;
74 Stem::Event::Queue::_init_queue() if defined &Stem::Event::Queue::_init_queue ;
80 $loop_class->_start_loop() ;
85 $loop_class->_stop_loop() ;
90 my( $self, $method ) = @_ ;
92 # never trigger inactive events
94 return unless $self->{active} ;
97 $method ||= $self->{'method'} ;
98 #print "METHOD [$method]\n" ;
100 $self->{'object'}->$method( $self->{'id'} ) ;
102 Stem::Msg::process_queue() if defined &Stem::Msg::process_queue;
108 # all the stuff below is a rough cell call trace thing. it needs work
109 # it would be put inside the trigger method
110 # 'log_type' attribute is set or the event type is used.
111 #_init subs need to set event_log_type in the object
112 #use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
113 #use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
114 # $log_type = $self->{'log_type'} || $self->{'event_type'} ;
115 # TraceStatus "[$log_type] [$object] [$method]\n" ;
116 # $Stem::Event::current_object = $object ;
117 # my ( $cell_name, $target ) = Stem::Route::lookup_cell_name( $object ) ;
118 # if ( $cell_name ) {
120 # # "EVENT $event to $cell_name:$target [$object] [$method]\n" ;
123 # # Debug "EVENT $event to [$object] [$method]\n" ;
128 # get all the event objects for an event type
129 # this is a class sub.
133 my( $event_type ) = @_ ;
135 my $events = $all_events{ $event_type } ;
137 return unless $events ;
139 return values %{$events} if wantarray ;
144 # initialize the subclass object for this event and store generic event
147 sub _build_core_event {
151 my( $self, $event_type ) = @_ ;
154 #print "EVT [$self] [$event_type]\n" ;
156 # call and and check the return of the core event constructor
158 if ( my $core_event = $self->_build() ) {
160 # return the error if it was an error string
162 return $core_event unless ref $core_event ;
164 # save the core event
166 $self->{core_event} = $core_event ;
169 # mark the event type and track it
171 $self->{event_type} = $event_type ;
172 $all_events{ $event_type }{ $self } = $self ;
177 # these are the public versions of the support methods.
178 # subclasses can provide a _method to override the stub ones in this class.
184 $self->{'active'} = 0 ;
185 delete $self->{'object'} ;
187 # delete the core object
189 if ( my $core_event = delete $self->{core_event} ) {
191 # call the core cancel
193 $self->_cancel( $core_event ) ;
196 # delete this event from the tracking hash
198 delete $all_events{ $self->{event_type} }{ $self } ;
206 $self->{'active'} = 1 ;
207 $self->_start( $self->{core_event} ) ;
215 $self->{'active'} = 0 ;
216 $self->_stop( $self->{core_event} ) ;
221 # stubs for the internal methods that subclasses should override if needed.
230 use Stem::Debug qw( dump_socket dump_owner dump_data ) ;
234 print dump_data( \%all_events ) ;
241 my $event_text = <<TEXT ;
243 ACT: $self->{'active'}
246 my $obj_dump = dump_owner $self->{'object'} ;
247 $event_text .= <<TEXT ;
249 METH: $self->{'method'}
252 if ( my $fh = $self->{'fh'} ) {
254 my $fh_text = dump_socket( $self->{'fh'} ) ;
255 $event_text .= <<TEXT ;
260 if ( $self->{event_type} eq 'timer' ) {
262 my $delay = $self->{delay} || 'NONE' ;
263 my $interval = $self->{interval} || 'NONE' ;
264 $event_text .= <<TEXT ;
270 if ( my $io_timer_event = $self->{'io_timer_event'} ) {
272 $event_text = "IO TIMER: >>>>>\n" . $io_timer_event->dump() .
286 # change this to a cleaner loop style which can handle more event loops and
287 # try them in sequence
290 sub _get_loop_class {
292 my $loop_type = $Stem::Vars::Env{ 'event_loop' } ||
293 ($^O =~ /win32/i ? 'perl' : 'event' );
295 $loop_type = 'perl' unless $loop_to_class{ $loop_type } ;
296 my $loop_class = "Stem::Event::$loop_to_class{ $loop_type }" ;
298 unless ( eval "require $loop_class" ) {
299 die "can't load $loop_class: $@" if $@ && $@ !~ /locate/ ;
301 $loop_type = 'perl' ;
302 eval { require Stem::Event::Perl } ;
303 die "can't load event loop Stem::Event::Perl $@" if $@ ;
306 # save the event loop that we loaded.
308 #print "using event loop [$loop_type]\n" ;
309 $Stem::Vars::Env{ 'event_loop' } = $loop_type ;
315 ############################################################################
317 package Stem::Event::Plain ;
320 @Stem::Event::Plain::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->_core_event_build( 'plain' ) ;
369 return $err if $err ;
374 ############################################################################
376 package Stem::Event::Signal ;
378 BEGIN { our @ISA = qw( Stem::Event ) } ;
380 =head2 Stem::Event::Signal::new
382 This class creates an event that will trigger a callback whenever
383 its its signal has been received.
387 $signal_event = Stem::Event::Signal->new( 'object' => $self,
388 'signal' => 'INT' ) ;
390 sub sig_int_handler { die "SIGINT\n" }
394 my $attr_spec_signal = [
401 This object gets the method callbacks
407 This method is called on the object when this event is triggered. The
408 default method name for the signal NAME is 'sig_name_handler' (all lower case)
415 This is the name of the signal to handle. It is used as part of the
416 default handler method name.
424 This flag marks the event as being active. It can be toggled with the
431 The id is passed to the callback method as its only argument. Use it to
432 identify different instances of this object.
440 my( $class ) = shift ;
442 my $self = Stem::Class::parse_args( $attr_spec_signal, @_ ) ;
443 return $self unless ref $self ;
445 my $signal = uc $self->{'signal'} ;
447 return "Unknown signal: $signal" unless exists $SIG{ $signal } ;
449 $self->{'method'} ||= "sig_\L${signal}_handler" ;
450 $self->{'signal'} = $signal ;
452 my $err = $self->_build_core_event( 'signal' ) ;
453 return $err if $err ;
455 #print "SELF SIG $self\nPID $$\n" ;
461 ############################################################################
463 package Stem::Event::Timer ;
465 BEGIN { our @ISA = qw( Stem::Event ) } ;
467 =head2 Stem::Event::Timer::new
469 This class creates an event that will trigger a callback after a time
470 period has elapsed. The initial timer delay is set from the 'delay',
471 'at' or 'interval' attributes in that order. If the 'interval'
472 attribute is not set, the timer will cancel itself after its first
473 triggering (it is a one-shot). The 'hard' attribute means that the
474 next interval delay starts before the callback to the object is
475 made. If a soft timer is selected (hard is 0), the delay starts after
476 the callback returns. So the hard timer ignores the time taken by the
477 callback and so it is a more accurate timer. The accuracy a soft timer
478 is affected by how much time the callback takes.
482 $timer_event = Stem::Event::Timer->new( 'object' => $self,
486 sub timed_out { print "timer alert\n" } ;
493 my $attr_spec_timer = [
500 This object gets the method callbacks
505 'default' => 'timed_out',
507 This method is called on the object when the timeout is triggered
513 Delay this amount of seconds before triggering the first time. If this
514 is not set then the 'at' or 'interval' attributes will be used.
518 'name' => 'interval',
520 Wait this time (in seconds) before any repeated triggers. If not set
521 then the timer is a one-shot
527 Trigger in the future at this time (in epoch seconds). It will set the intial
528 delay to the different between the current time and the 'at' time.
536 If this is set, the interval time starts when the event is
537 triggered. If it is not set, the interval time starts when the object
538 callback has finished. So 'hard' timers repeat closer to equal
539 intervals while without 'hard' the repeat time is dependant on how
540 long the callback takes.
548 This flag marks the event as being active. It can be toggled with the
555 The id is passed to the callback method as its only argument. Use it to
556 identify different instances of this object.
564 my( $class ) = shift ;
566 my $self = Stem::Class::parse_args( $attr_spec_timer, @_ ) ;
567 return $self unless ref $self ;
569 # the delay is either set, or at a future time or the interval
571 my $delay = exists( $self->{ 'delay' } ) ?
573 exists( $self->{ 'at' } ) ?
574 $self->{ 'at' } - time() :
575 $self->{'interval'} ;
577 #print "INT $self->{'interval'} DELAY $delay\n" ;
579 # squawk if no delay value
581 return "No initial delay was specified for timer"
582 unless defined $delay ;
584 $self->{'delay'} = $delay ;
585 $self->{'time_left'} = $delay ;
587 my $err = $self->_build_core_event( 'timer' ) ;
588 return $err if $err ;
591 # check on this logic
594 $self->_stop unless $self->{'active'} ;
603 my( $self, $reset_delay ) = @_ ;
605 return unless $self->{'active'} ;
607 # if we don't get passed a delay, use the interval or the delay attribute
609 $reset_delay ||= ($self->{'interval'}) ?
610 $self->{'interval'} : $self->{'delay'} ;
612 # track the new delay and reset the real timer (if we are using one)
614 $self->{'time_left'} = $reset_delay ;
616 $self->_reset( $self->{core_event}, $reset_delay ) ;
621 sub timer_triggered {
625 #print time(), " TIMER TRIG\n" ;
626 #use Carp qw( cluck ) ;
629 # check if this is a one-shot timer
631 $self->cancel() unless $self->{'interval'} ;
633 # reset the timer count before the trigger code for hard timers
634 #(trigger on fixed intervals)
636 $self->reset( $self->{'interval'} ) if $self->{'hard'};
640 # reset the timer count before the trigger code for soft timers
641 #(trigger on at least fixed intervals)
643 $self->reset( $self->{'interval'} ) unless $self->{'hard'};
646 ############################################################################
648 ####################################################################
649 # common methods for the Read/Write event classes to handle the optional
651 # these override Stem::Event's methods and then call those via SUPER::
653 package Stem::Event::IO ;
655 BEGIN { our @ISA = qw( Stem::Event ) } ;
657 sub init_io_timeout {
661 my $timeout = $self->{'timeout'} ;
662 return unless $timeout ;
664 $self->{'io_timer_event'} = Stem::Event::Timer->new(
666 'interval' => $timeout,
676 #print "IO CANCEL $self\n" ;
678 if ( my $io_timer_event = delete $self->{'io_timer_event'} ) {
679 $io_timer_event->cancel() ;
682 $self->SUPER::cancel() ;
684 delete $self->{'fh'} ;
693 if ( my $io_timer_event = $self->{'io_timer_event'} ) {
694 $io_timer_event->start() ;
697 $self->SUPER::start() ;
706 $self->{'active'} = 0 ;
708 if ( my $io_timer_event = $self->{'io_timer_event'} ) {
709 $io_timer_event->stop() ;
712 $self->SUPER::stop() ;
721 # $self->{log_type} = "$self->{'event_type'}_timeout" ;
722 $self->trigger( $self->{'timeout_method'} ) ;
725 #######################################################
727 package Stem::Event::Read ;
729 BEGIN { our @ISA = qw( Stem::Event::IO ) }
731 =head2 Stem::Event::Read::new
733 This class creates an event that will trigger a callback whenever
734 its file descriptor has data to be read. It takes an optional timeout
735 value which will trigger a callback to the object if no data has been
736 read during that period.
738 Read events are active when created - a call to the stop method is
739 needed to deactivate them.
745 my $attr_spec_read = [
752 This object gets the method callbacks
760 This file handle is checked if it has data to read
766 How long to wait (in seconds) without being readable before calling
772 'default' => 'readable',
774 This method is called on the object when the file handle has data to read
778 'name' => 'timeout_method',
779 'default' => 'read_timeout',
781 This method is called on the object when the hasn't been readable
782 after the timeout period
790 This flag marks the event as being active. It can be toggled with the
797 The id is passed to the callback method as its only argument. Use it to
798 identify different instances of this object.
806 my( $class ) = shift ;
808 my $self = Stem::Class::parse_args( $attr_spec_read, @_ ) ;
809 return $self unless ref $self ;
811 # return <<ERR unless defined fileno $self->{fh} ;
812 # Stem::Event::Read: $self->{fh} is not an open handle
815 my $err = $self->_build_core_event( 'read' ) ;
816 return $err if $err ;
818 $self->init_io_timeout() ;
824 ############################################################################
826 package Stem::Event::Write ;
828 BEGIN { our @ISA = qw( Stem::Event::IO ) } ;
830 =head2 Stem::Event::Write::new
832 This class creates an event that will trigger a callback whenever
833 its file descriptor can be written to. It takes an optional timeout
834 value which will trigger a callback to the object if no data has been
835 written during that period.
837 Write events are stopped when created - a call to the start method is
838 needed to activate them.
842 my $attr_spec_write = [
849 This object gets the method callbacks
857 This file handle is checked if it is writeable
863 How long to wait (in seconds) without being writeable before calling
869 'default' => 'writeable',
871 This method is called on the object when the file handle is writeable
875 'name' => 'timeout_method',
876 'default' => 'write_timeout',
878 This method is called on the object when the hasn't been writeable
879 after the timeout period
887 This flag marks the event as being active. It can be toggled with the
889 NOTE: Write events are not active by default.
895 The id is passed to the callback method as its only argument. Use it to
896 identify different instances of this object.
904 my( $class ) = shift ;
906 my $self = Stem::Class::parse_args( $attr_spec_write, @_ ) ;
907 return $self unless ref $self ;
909 my $err = $self->_build_core_event( 'write' ) ;
910 return $err if $err ;
912 #print $self->dump_events() ;
914 $self->init_io_timeout() ;
916 $self->stop() unless $self->{'active'} ;
918 #print $self->dump() ;