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 Stem::Event::Queue::_init_queue() if defined &Stem::Event::Queue::_init_queue ;
74 $loop_class->_init_loop() ;
81 $loop_class->_start_loop() ;
86 $loop_class->_stop_loop() ;
91 my( $self, $method ) = @_ ;
93 # never trigger inactive events
95 return unless $self->{active} ;
98 $method ||= $self->{'method'} ;
99 #print "METHOD [$method]\n" ;
101 $self->{'object'}->$method( $self->{'id'} ) ;
103 Stem::Msg::process_queue() if defined &Stem::Msg::process_queue;
109 # all the stuff below is a rough cell call trace thing. it needs work
110 # it would be put inside the trigger method
111 # 'log_type' attribute is set or the event type is used.
112 #_init subs need to set event_log_type in the object
113 #use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
114 #use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
115 # $log_type = $self->{'log_type'} || $self->{'event_type'} ;
116 # TraceStatus "[$log_type] [$object] [$method]\n" ;
117 # $Stem::Event::current_object = $object ;
118 # my ( $cell_name, $target ) = Stem::Route::lookup_cell_name( $object ) ;
119 # if ( $cell_name ) {
121 # # "EVENT $event to $cell_name:$target [$object] [$method]\n" ;
124 # # Debug "EVENT $event to [$object] [$method]\n" ;
129 # get all the event objects for an event type
130 # this is a class sub.
134 my( $event_type ) = @_ ;
136 my $events = $all_events{ $event_type } ;
138 return unless $events ;
140 return values %{$events} if wantarray ;
145 # initialize the subclass object for this event and store generic event
148 sub _build_core_event {
152 my( $self, $event_type ) = @_ ;
155 #print "EVT [$self] [$event_type]\n" ;
157 # call and and check the return of the core event constructor
159 if ( my $core_event = $self->_build() ) {
161 # return the error if it was an error string
163 return $core_event unless ref $core_event ;
165 # save the core event
167 $self->{core_event} = $core_event ;
170 # mark the event type and track it
172 $self->{event_type} = $event_type ;
173 $all_events{ $event_type }{ $self } = $self ;
178 # these are the public versions of the support methods.
179 # subclasses can provide a _method to override the stub ones in this class.
185 $self->{'active'} = 0 ;
186 delete $self->{'object'} ;
188 # delete the core object
190 if ( my $core_event = delete $self->{core_event} ) {
192 # call the core cancel
194 $self->_cancel( $core_event ) ;
197 # delete this event from the tracking hash
199 delete $all_events{ $self->{event_type} }{ $self } ;
207 $self->{'active'} = 1 ;
208 $self->_start( $self->{core_event} ) ;
216 $self->{'active'} = 0 ;
217 $self->_stop( $self->{core_event} ) ;
222 # stubs for the internal methods that subclasses should override if needed.
231 use Stem::Debug qw( dump_socket dump_owner dump_data ) ;
235 print dump_data( \%all_events ) ;
242 my $event_text = <<TEXT ;
244 ACT: $self->{'active'}
247 my $obj_dump = dump_owner $self->{'object'} ;
248 $event_text .= <<TEXT ;
250 METH: $self->{'method'}
253 if ( my $fh = $self->{'fh'} ) {
255 my $fh_text = dump_socket( $self->{'fh'} ) ;
256 $event_text .= <<TEXT ;
261 if ( $self->{event_type} eq 'timer' ) {
263 my $delay = $self->{delay} || 'NONE' ;
264 my $interval = $self->{interval} || 'NONE' ;
265 $event_text .= <<TEXT ;
271 if ( my $io_timer_event = $self->{'io_timer_event'} ) {
273 $event_text = "IO TIMER: >>>>>\n" . $io_timer_event->dump() .
287 # change this to a cleaner loop style which can handle more event loops and
288 # try them in sequence
291 sub _get_loop_class {
293 my $loop_type = $Stem::Vars::Env{ 'event_loop' } ||
294 ($^O =~ /win32/i ? 'perl' : 'event' );
296 $loop_type = 'perl' unless $loop_to_class{ $loop_type } ;
297 my $loop_class = "Stem::Event::$loop_to_class{ $loop_type }" ;
299 print "LOOP $loop_class\n" ;
301 unless ( eval "require $loop_class" ) {
302 die "can't load $loop_class: $@" if $@ && $@ !~ /locate/ ;
304 print "not found\n" ;
306 $loop_type = 'perl' ;
307 eval { require Stem::Event::Perl } ;
308 die "can't load event loop Stem::Event::Perl $@" if $@ ;
312 # save the event loop that we loaded.
314 #print "using event loop [$loop_type]\n" ;
315 $Stem::Vars::Env{ 'event_loop' } = $loop_type ;
322 ############################################################################
324 package Stem::Event::Plain ;
325 our @ISA = qw( Stem::Event ) ;
327 =head2 Stem::Event::Plain::new
329 This class creates an event that will trigger a callback after all
330 other pending events have been triggered.
334 $plain_event = Stem::Event::Plain->new( 'object' => $self ) ;
338 my $attr_spec_plain = [
345 This object gets the method callbacks
350 'default' => 'triggered',
352 This method is called on the object when the plain event is triggered
358 The id is passed to the callback method as its only argument. Use it to
359 identify different instances of this object.
367 my( $class ) = shift ;
369 my $self = Stem::Class::parse_args( $attr_spec_plain, @_ ) ;
370 return $self unless ref $self ;
372 my $err = $self->_build_core_event( 'plain' ) ;
373 return $err if $err ;
378 ############################################################################
380 package Stem::Event::Signal ;
381 our @ISA = qw( Stem::Event ) ;
383 =head2 Stem::Event::Signal::new
385 This class creates an event that will trigger a callback whenever
386 its its signal has been received.
390 $signal_event = Stem::Event::Signal->new( 'object' => $self,
391 'signal' => 'INT' ) ;
393 sub sig_int_handler { die "SIGINT\n" }
397 my $attr_spec_signal = [
404 This object gets the method callbacks
410 This method is called on the object when this event is triggered. The
411 default method name for the signal NAME is 'sig_name_handler' (all lower case)
418 This is the name of the signal to handle. It is used as part of the
419 default handler method name.
427 This flag marks the event as being active. It can be toggled with the
434 The id is passed to the callback method as its only argument. Use it to
435 identify different instances of this object.
443 my( $class ) = shift ;
445 my $self = Stem::Class::parse_args( $attr_spec_signal, @_ ) ;
446 return $self unless ref $self ;
448 my $signal = uc $self->{'signal'} ;
450 return "Unknown signal: $signal" unless exists $SIG{ $signal } ;
452 $self->{'method'} ||= "sig_\L${signal}_handler" ;
453 $self->{'signal'} = $signal ;
455 my $err = $self->_build_core_event( 'signal' ) ;
456 return $err if $err ;
458 #print "SELF SIG $self\nPID $$\n" ;
464 ############################################################################
466 package Stem::Event::Timer ;
467 our @ISA = qw( Stem::Event ) ;
469 =head2 Stem::Event::Timer::new
471 This class creates an event that will trigger a callback after a time
472 period has elapsed. The initial timer delay is set from the 'delay',
473 'at' or 'interval' attributes in that order. If the 'interval'
474 attribute is not set, the timer will cancel itself after its first
475 triggering (it is a one-shot). The 'hard' attribute means that the
476 next interval delay starts before the callback to the object is
477 made. If a soft timer is selected (hard is 0), the delay starts after
478 the callback returns. So the hard timer ignores the time taken by the
479 callback and so it is a more accurate timer. The accuracy a soft timer
480 is affected by how much time the callback takes.
484 $timer_event = Stem::Event::Timer->new( 'object' => $self,
488 sub timed_out { print "timer alert\n" } ;
495 my $attr_spec_timer = [
502 This object gets the method callbacks
507 'default' => 'timed_out',
509 This method is called on the object when the timeout is triggered
515 Delay this amount of seconds before triggering the first time. If this
516 is not set then the 'at' or 'interval' attributes will be used.
520 'name' => 'interval',
522 Wait this time (in seconds) before any repeated triggers. If not set
523 then the timer is a one-shot
529 Trigger in the future at this time (in epoch seconds). It will set the intial
530 delay to the different between the current time and the 'at' time.
538 If this is set, the interval time starts when the event is
539 triggered. If it is not set, the interval time starts when the object
540 callback has finished. So 'hard' timers repeat closer to equal
541 intervals while without 'hard' the repeat time is dependant on how
542 long the callback takes.
550 This flag marks the event as being active. It can be toggled with the
557 The id is passed to the callback method as its only argument. Use it to
558 identify different instances of this object.
566 my( $class ) = shift ;
568 my $self = Stem::Class::parse_args( $attr_spec_timer, @_ ) ;
569 return $self unless ref $self ;
571 # the delay is either set, or at a future time or the interval
573 my $delay = exists( $self->{ 'delay' } ) ?
575 exists( $self->{ 'at' } ) ?
576 $self->{ 'at' } - time() :
577 $self->{'interval'} ;
579 #print "INT $self->{'interval'} DELAY $delay\n" ;
581 # squawk if no delay value
583 return "No initial delay was specified for timer"
584 unless defined $delay ;
586 $self->{'delay'} = $delay ;
587 $self->{'time_left'} = $delay ;
589 my $err = $self->_build_core_event( 'timer' ) ;
590 return $err if $err ;
593 # check on this logic
596 $self->_stop unless $self->{'active'} ;
605 my( $self, $reset_delay ) = @_ ;
607 return unless $self->{'active'} ;
609 # if we don't get passed a delay, use the interval or the delay attribute
611 $reset_delay ||= ($self->{'interval'}) ?
612 $self->{'interval'} : $self->{'delay'} ;
614 # track the new delay and reset the real timer (if we are using one)
616 $self->{'time_left'} = $reset_delay ;
618 $self->_reset( $self->{core_event}, $reset_delay ) ;
623 sub timer_triggered {
627 #print time(), " TIMER TRIG\n" ;
628 #use Carp qw( cluck ) ;
631 # check if this is a one-shot timer
633 $self->cancel() unless $self->{'interval'} ;
635 # reset the timer count before the trigger code for hard timers
636 #(trigger on fixed intervals)
638 $self->reset( $self->{'interval'} ) if $self->{'hard'};
642 # reset the timer count before the trigger code for soft timers
643 #(trigger on at least fixed intervals)
645 $self->reset( $self->{'interval'} ) unless $self->{'hard'};
648 ############################################################################
650 ####################################################################
651 # common methods for the Read/Write event classes to handle the optional
653 # these override Stem::Event's methods and then call those via SUPER::
655 package Stem::Event::IO ;
656 our @ISA = qw( Stem::Event ) ;
658 sub init_io_timeout {
662 my $timeout = $self->{'timeout'} ;
663 return unless $timeout ;
665 $self->{'io_timer_event'} = Stem::Event::Timer->new(
667 'interval' => $timeout,
677 #print "IO CANCEL $self\n" ;
679 if ( my $io_timer_event = delete $self->{'io_timer_event'} ) {
680 $io_timer_event->cancel() ;
683 $self->SUPER::cancel() ;
685 delete $self->{'fh'} ;
694 if ( my $io_timer_event = $self->{'io_timer_event'} ) {
695 $io_timer_event->start() ;
698 $self->SUPER::start() ;
707 $self->{'active'} = 0 ;
709 if ( my $io_timer_event = $self->{'io_timer_event'} ) {
710 $io_timer_event->stop() ;
713 $self->SUPER::stop() ;
722 # $self->{log_type} = "$self->{'event_type'}_timeout" ;
723 $self->trigger( $self->{'timeout_method'} ) ;
726 #######################################################
728 package Stem::Event::Read ;
729 our @ISA = qw( Stem::Event::IO ) ;
733 =head2 Stem::Event::Read::new
735 This class creates an event that will trigger a callback whenever
736 its file descriptor has data to be read. It takes an optional timeout
737 value which will trigger a callback to the object if no data has been
738 read during that period.
740 Read events are active when created - a call to the stop method is
741 needed to deactivate them.
747 my $attr_spec_read = [
754 This object gets the method callbacks
762 This file handle is checked if it has data to read
768 How long to wait (in seconds) without being readable before calling
774 'default' => 'readable',
776 This method is called on the object when the file handle has data to read
780 'name' => 'timeout_method',
781 'default' => 'read_timeout',
783 This method is called on the object when the hasn't been readable
784 after the timeout period
792 This flag marks the event as being active. It can be toggled with the
799 The id is passed to the callback method as its only argument. Use it to
800 identify different instances of this object.
808 my( $class ) = shift ;
811 my $self = Stem::Class::parse_args( $attr_spec_read, @_ ) ;
812 return $self unless ref $self ;
815 # return <<ERR unless defined fileno $self->{fh} ;
816 # Stem::Event::Read: $self->{fh} is not an open handle
819 my $err = $self->_build_core_event( 'read' ) ;
820 return $err if $err ;
822 $self->init_io_timeout() ;
828 ############################################################################
830 package Stem::Event::Write ;
831 our @ISA = qw( Stem::Event::IO ) ;
833 =head2 Stem::Event::Write::new
835 This class creates an event that will trigger a callback whenever
836 its file descriptor can be written to. It takes an optional timeout
837 value which will trigger a callback to the object if no data has been
838 written during that period.
840 Write events are stopped when created - a call to the start method is
841 needed to activate them.
845 my $attr_spec_write = [
852 This object gets the method callbacks
860 This file handle is checked if it is writeable
866 How long to wait (in seconds) without being writeable before calling
872 'default' => 'writeable',
874 This method is called on the object when the file handle is writeable
878 'name' => 'timeout_method',
879 'default' => 'write_timeout',
881 This method is called on the object when the hasn't been writeable
882 after the timeout period
890 This flag marks the event as being active. It can be toggled with the
892 NOTE: Write events are not active by default.
898 The id is passed to the callback method as its only argument. Use it to
899 identify different instances of this object.
907 my( $class ) = shift ;
909 my $self = Stem::Class::parse_args( $attr_spec_write, @_ ) ;
910 return $self unless ref $self ;
912 my $err = $self->_build_core_event( 'write' ) ;
913 return $err if $err ;
915 #print $self->dump_events() ;
917 $self->init_io_timeout() ;
919 $self->stop() unless $self->{'active'} ;
921 #print $self->dump() ;