lib/Stem/Event.pm

   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
  67 INIT{ init_loop() ; }
  68
  69
  70 sub init_loop {
  71
  72         $loop_class->_init_loop() ;
  73 }
  74
  75 sub start_loop {
  76
  77         $loop_class->_start_loop() ;
  78 }
  79
  80 sub stop_loop {
  81
  82         $loop_class->_stop_loop() ;
  83 }
  84
  85 sub trigger {
  86
  87         my( $self, $method ) = @_ ;
  88
  89 # never trigger inactive events
  90
  91         return unless $self->{active} ;
  92
  93
  94         $method ||= $self->{'method'} ;
  95 #print "METHOD [$method]\n" ;
  96
  97         $self->{'object'}->$method( $self->{'id'} ) ;
  98
  99         Stem::Msg::process_queue() if defined &Stem::Msg::process_queue;
 100
 101         return ;
 102 }
 103
 104 #################
 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 ) {
 116 # #             Debug
 117 # #                 "EVENT $event to $cell_name:$target [$object] [$method]\n" ;
 118 #       }
 119 #       else {
 120 # #             Debug "EVENT $event to [$object] [$method]\n" ;
 121 #       }
 122 #################
 123
 124
 125 # get all the event objects for an event type
 126 # this is a class sub.
 127
 128 sub _get_events {
 129
 130         my( $event_type ) = @_ ;
 131
 132         my $events = $all_events{ $event_type } ;
 133
 134         return unless $events ;
 135
 136         return values %{$events} if wantarray ;
 137
 138         return $events ;
 139 }
 140
 141 # initialize the subclass object for this event and store generic event
 142 # info.
 143
 144 sub _build_core_event {
 145
 146 #print "BAZ\n" ;
 147
 148         my( $self, $event_type ) = @_ ;
 149
 150
 151 #print "EVT [$self] [$event_type]\n" ;
 152
 153 # call and and check the return of the core event constructor
 154
 155         if ( my $core_event = $self->_build() ) {
 156
 157 # return the error if it was an error string
 158
 159                 return $core_event unless ref $core_event ;
 160
 161 # save the core event
 162
 163                 $self->{core_event} = $core_event ;
 164         }
 165
 166 # mark the event type and track it
 167
 168         $self->{event_type} = $event_type ;
 169         $all_events{ $event_type }{ $self } = $self ;
 170
 171         return ;
 172 }
 173
 174 # these are the public versions of the support methods.
 175 # subclasses can provide a _method to override the stub ones in this class.
 176
 177 sub cancel {
 178
 179         my( $self ) = @_ ;
 180
 181         $self->{'active'} = 0 ;
 182         delete $self->{'object'} ;
 183
 184 # delete the core object
 185
 186         if ( my $core_event = delete $self->{core_event} ) {
 187
 188         # call the core cancel
 189
 190                 $self->_cancel( $core_event ) ;
 191         }
 192
 193 # delete this event from the tracking hash
 194
 195         delete $all_events{ $self->{event_type} }{ $self } ;
 196
 197         return ;
 198 }
 199
 200 sub start {
 201         my( $self ) = @_ ;
 202
 203         $self->{'active'} = 1 ;
 204         $self->_start( $self->{core_event} ) ;
 205
 206         return ;
 207 }
 208
 209 sub stop {
 210         my( $self ) = @_ ;
 211
 212         $self->{'active'} = 0 ;
 213         $self->_stop( $self->{core_event} ) ;
 214
 215         return ;
 216 }
 217
 218 # stubs for the internal methods that subclasses should override if needed.
 219
 220 sub _init_loop {}
 221 sub _build {}
 222 sub _start {}
 223 sub _stop {}
 224 sub _reset {}
 225 sub _cancel {}
 226
 227 use Stem::Debug qw( dump_socket dump_owner dump_data ) ;
 228
 229 sub dump_events {
 230
 231         print dump_data( \%all_events ) ;
 232 }
 233
 234 sub dump {
 235
 236         my( $self ) = @_ ;
 237
 238         my $event_text = <<TEXT ;
 239 EV:     $self
 240 ACT:    $self->{'active'}
 241 TEXT
 242
 243         my $obj_dump = dump_owner $self->{'object'} ;
 244         $event_text .= <<TEXT ;
 245 OBJ:    $obj_dump
 246 METH:   $self->{'method'}
 247 TEXT
 248
 249         if ( my $fh = $self->{'fh'} ) {
 250
 251                 my $fh_text = dump_socket( $self->{'fh'} ) ;
 252                 $event_text .= <<TEXT ;
 253 FH:     $fh_text
 254 TEXT
 255         }
 256
 257         if ( $self->{event_type} eq 'timer' ) {
 258
 259                 my $delay = $self->{delay} || 'NONE' ;
 260                 my $interval = $self->{interval} || 'NONE' ;
 261                 $event_text .= <<TEXT ;
 262 DELAY:  $delay
 263 INT:    $interval
 264 TEXT
 265         }
 266
 267         if ( my $io_timer_event = $self->{'io_timer_event'} ) {
 268
 269                 $event_text = "IO TIMER: >>>>>\n" . $io_timer_event->dump() .
 270                                 "END\n";
 271         }
 272
 273         return <<DUMP ;
 274
 275 >>>
 276 $event_text<<<
 277
 278 DUMP
 279
 280 }
 281
 282 #############
 283 # change this to a cleaner loop style which can handle more event loops and
 284 # try them in sequence
 285 #############
 286
 287 sub _get_loop_class {
 288
 289         my $loop_type = $Stem::Vars::Env{ 'event_loop' } ||
 290                         ($^O =~ /win32/i ? 'perl' : 'event' );
 291
 292         $loop_type = 'perl' unless $loop_to_class{ $loop_type } ;
 293         my $loop_class = "Stem::Event::$loop_to_class{ $loop_type }" ;
 294
 295 #print "LOOP $loop_class\n" ;
 296
 297         unless ( eval "require $loop_class" ) {
 298                 die "can't load $loop_class: $@" if $@ && $@ !~ /locate/ ;
 299
 300 print "not found\n" ;
 301
 302                 $loop_type = 'perl' ;
 303                 eval { require Stem::Event::Perl } ;
 304                 die "can't load event loop Stem::Event::Perl $@" if $@ ;
 305         }
 306
 307
 308         # save the event loop that we loaded.
 309
 310         #print "using event loop [$loop_type]\n" ;
 311         $Stem::Vars::Env{ 'event_loop' } = $loop_type ;
 312
 313
 314         return $loop_class ;
 315 }
 316
 317
 318 ############################################################################
 319
 320 package Stem::Event::Plain ;
 321 our @ISA = qw( Stem::Event ) ;
 322
 323 =head2 Stem::Event::Plain::new
 324
 325 This class creates an event that will trigger a callback after all
 326 other pending events have been triggered.
 327
 328 =head2 Example
 329
 330         $plain_event = Stem::Event::Plain->new( 'object' => $self ) ;
 331
 332 =cut
 333
 334 my $attr_spec_plain = [
 335
 336         {
 337                 'name'          => 'object',
 338                 'required'      => 1,
 339                 'type'          => 'object',
 340                 'help'          => <<HELP,
 341 This object gets the method callbacks
 342 HELP
 343         },
 344         {
 345                 'name'          => 'method',
 346                 'default'       => 'triggered',
 347                 'help'          => <<HELP,
 348 This method is called on the object when the plain event is triggered
 349 HELP
 350         },
 351         {
 352                 'name'          => 'id',
 353                 'help'          => <<HELP,
 354 The id is passed to the callback method as its only argument. Use it to
 355 identify different instances of this object.
 356 HELP
 357
 358         },
 359 ] ;
 360
 361 sub new {
 362
 363         my( $class ) = shift ;
 364
 365         my $self = Stem::Class::parse_args( $attr_spec_plain, @_ ) ;
 366         return $self unless ref $self ;
 367
 368         my $err = $self->_build_core_event( 'plain' ) ;
 369         return $err if $err ;
 370
 371         return $self ;
 372 }
 373
 374 ############################################################################
 375
 376 package Stem::Event::Signal ;
 377 our @ISA = qw( Stem::Event ) ;
 378
 379 =head2 Stem::Event::Signal::new
 380
 381 This class creates an event that will trigger a callback whenever
 382 its its signal has been received.
 383
 384 =head2 Example
 385
 386         $signal_event = Stem::Event::Signal->new( 'object' => $self,
 387                                                   'signal' => 'INT' ) ;
 388
 389         sub sig_int_handler { die "SIGINT\n" }
 390
 391 =cut
 392
 393 my $attr_spec_signal = [
 394
 395         {
 396                 'name'          => 'object',
 397                 'required'      => 1,
 398                 'type'          => 'object',
 399                 'help'          => <<HELP,
 400 This object gets the method callbacks
 401 HELP
 402         },
 403         {
 404                 'name'          => 'method',
 405                 'help'          => <<HELP,
 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)
 408 HELP
 409         },
 410         {
 411                 'name'          => 'signal',
 412                 'required'      => 1,
 413                 'help'          => <<HELP,
 414 This is the name of the signal to handle. It is used as part of the
 415 default handler method name.
 416 HELP
 417         },
 418         {
 419                 'name'          => 'active',
 420                 'default'       => 1,
 421                 'type'          => 'boolean',
 422                 'help'          => <<HELP,
 423 This flag marks the event as being active. It can be toggled with the
 424 start/stop methods.
 425 HELP
 426         },
 427         {
 428                 'name'          => 'id',
 429                 'help'          => <<HELP,
 430 The id is passed to the callback method as its only argument. Use it to
 431 identify different instances of this object.
 432 HELP
 433
 434         },
 435 ] ;
 436
 437 sub new {
 438
 439         my( $class ) = shift ;
 440
 441         my $self = Stem::Class::parse_args( $attr_spec_signal, @_ ) ;
 442         return $self unless ref $self ;
 443
 444         my $signal = uc $self->{'signal'} ;
 445
 446         return "Unknown signal: $signal" unless exists $SIG{ $signal } ;
 447
 448         $self->{'method'} ||= "sig_\L${signal}_handler" ;
 449         $self->{'signal'} = $signal ;
 450
 451         my $err = $self->_build_core_event( 'signal' ) ;
 452         return $err if $err ;
 453
 454 #print "SELF SIG $self\nPID $$\n" ;
 455
 456         return $self ;
 457 }
 458
 459
 460 ############################################################################
 461
 462 package Stem::Event::Timer ;
 463 our @ISA = qw( Stem::Event ) ;
 464
 465 =head2 Stem::Event::Timer::new
 466
 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.
 477
 478 =head2 Example
 479
 480         $timer_event = Stem::Event::Timer->new( 'object' => $self,
 481                                                 'delay'  => 5,
 482                                                 'interval'  => 10 ) ;
 483
 484         sub timed_out { print "timer alert\n" } ;
 485
 486
 487 =cut
 488
 489 BEGIN {
 490
 491 my $attr_spec_timer = [
 492
 493         {
 494                 'name'          => 'object',
 495                 'required'      => 1,
 496                 'type'          => 'object',
 497                 'help'          => <<HELP,
 498 This object gets the method callbacks
 499 HELP
 500         },
 501         {
 502                 'name'          => 'method',
 503                 'default'       => 'timed_out',
 504                 'help'          => <<HELP,
 505 This method is called on the object when the timeout is triggered
 506 HELP
 507         },
 508         {
 509                 'name'          => 'delay',
 510                 'help'          => <<HELP,
 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.
 513 HELP
 514         },
 515         {
 516                 'name'          => 'interval',
 517                 'help'          => <<HELP,
 518 Wait this time (in seconds) before any repeated triggers. If not set
 519 then the timer is a one-shot
 520 HELP
 521         },
 522         {
 523                 'name'          => 'at',
 524                 'help'          => <<HELP,
 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.
 527 HELP
 528         },
 529         {
 530                 'name'          => 'hard',
 531                 'type'          => 'boolean',
 532                 'default'       => 0,
 533                 'help'          => <<HELP,
 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.
 539 HELP
 540         },
 541         {
 542                 'name'          => 'active',
 543                 'default'       => 1,
 544                 'type'          => 'boolean',
 545                 'help'          => <<HELP,
 546 This flag marks the event as being active. It can be toggled with the
 547 start/stop methods.
 548 HELP
 549         },
 550         {
 551                 'name'          => 'id',
 552                 'help'          => <<HELP,
 553 The id is passed to the callback method as its only argument. Use it to
 554 identify different instances of this object.
 555 HELP
 556
 557         },
 558 ] ;
 559
 560 sub new {
 561
 562         my( $class ) = shift ;
 563
 564         my $self = Stem::Class::parse_args( $attr_spec_timer, @_ ) ;
 565         return $self unless ref $self ;
 566
 567 # the delay is either set, or at a future time or the interval
 568
 569         my $delay = exists( $self->{ 'delay' } ) ?
 570                         $self->{ 'delay' } :
 571                         exists( $self->{ 'at' } ) ?
 572                                 $self->{ 'at' } - time() :
 573                                 $self->{'interval'} ;
 574
 575 #print "INT $self->{'interval'} DELAY $delay\n" ;
 576
 577 # squawk if no delay value
 578
 579         return "No initial delay was specified for timer"
 580                 unless defined $delay ;
 581
 582         $self->{'delay'} = $delay ;
 583         $self->{'time_left'} = $delay ;
 584
 585         my $err = $self->_build_core_event( 'timer' ) ;
 586         return $err if $err ;
 587
 588 ##########
 589 # check on this logic
 590 #########
 591
 592         $self->_stop unless $self->{'active'} ;
 593
 594         return $self ;
 595 }
 596
 597 }
 598
 599 sub reset {
 600
 601         my( $self, $reset_delay ) = @_ ;
 602
 603         return unless $self->{'active'} ;
 604
 605 # if we don't get passed a delay, use the interval or the delay attribute
 606
 607         $reset_delay ||= ($self->{'interval'}) ?
 608                         $self->{'interval'} : $self->{'delay'} ;
 609
 610 # track the new delay and reset the real timer (if we are using one)
 611
 612         $self->{'time_left'} = $reset_delay ;
 613
 614         $self->_reset( $self->{core_event}, $reset_delay ) ;
 615
 616         return ;
 617 }
 618
 619 sub timer_triggered {
 620
 621         my( $self ) = @_ ;
 622
 623 #print time(), " TIMER TRIG\n" ;
 624 #use Carp qw( cluck ) ;
 625 #cluck ;
 626
 627 # check if this is a one-shot timer
 628
 629         $self->cancel() unless $self->{'interval'} ;
 630
 631 # reset the timer count before the trigger code for hard timers
 632 #(trigger on fixed intervals)
 633
 634         $self->reset( $self->{'interval'} ) if $self->{'hard'};
 635
 636         $self->trigger() ;
 637
 638 # reset the timer count before the trigger code for soft timers
 639 #(trigger on at least fixed intervals)
 640
 641         $self->reset( $self->{'interval'} ) unless $self->{'hard'};
 642 }
 643
 644 ############################################################################
 645
 646 ####################################################################
 647 # common methods for the Read/Write event classes to handle the optional
 648 # I/O timeouts.
 649 # these override Stem::Event's methods and then call those via SUPER::
 650
 651 package Stem::Event::IO ;
 652 our @ISA = qw( Stem::Event ) ;
 653
 654 sub init_io_timeout {
 655
 656         my( $self ) = @_ ;
 657
 658         my $timeout = $self->{'timeout'} ;
 659         return unless $timeout ;
 660
 661         $self->{'io_timer_event'} = Stem::Event::Timer->new(
 662                 'object'        => $self,
 663                 'interval'      => $timeout,
 664         ) ;
 665
 666         return ;
 667 }
 668
 669 sub cancel {
 670
 671         my( $self ) = @_ ;
 672
 673 #print "IO CANCEL $self\n" ;
 674
 675         if ( my $io_timer_event = delete $self->{'io_timer_event'} ) {
 676                 $io_timer_event->cancel() ;
 677         }
 678
 679         $self->SUPER::cancel() ;
 680
 681         delete $self->{'fh'} ;
 682
 683         return ;
 684 }
 685
 686 sub start {
 687
 688         my( $self ) = @_ ;
 689
 690         if ( my $io_timer_event = $self->{'io_timer_event'} ) {
 691                 $io_timer_event->start() ;
 692         }
 693
 694         $self->SUPER::start() ;
 695
 696         return ;
 697 }
 698
 699 sub stop {
 700
 701         my( $self ) = @_ ;
 702
 703         $self->{'active'} = 0 ;
 704
 705         if ( my $io_timer_event = $self->{'io_timer_event'} ) {
 706                 $io_timer_event->stop() ;
 707         }
 708
 709         $self->SUPER::stop() ;
 710
 711         return ;
 712 }
 713
 714 sub timed_out {
 715
 716         my( $self ) = @_ ;
 717
 718 #       $self->{log_type} = "$self->{'event_type'}_timeout" ;
 719         $self->trigger( $self->{'timeout_method'} ) ;
 720 }
 721
 722 #######################################################
 723
 724 package Stem::Event::Read ;
 725 our @ISA = qw( Stem::Event::IO ) ;
 726
 727 =head2 Stem::Event::Read::new
 728
 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.
 733
 734 Read events are active when created - a call to the stop method is
 735 needed to deactivate them.
 736
 737 =cut
 738
 739 BEGIN {
 740
 741 my $attr_spec_read = [
 742
 743         {
 744                 'name'          => 'object',
 745                 'required'      => 1,
 746                 'type'          => 'object',
 747                 'help'          => <<HELP,
 748 This object gets the method callbacks
 749 HELP
 750         },
 751         {
 752                 'name'          => 'fh',
 753                 'required'      => 1,
 754                 'type'          => 'handle',
 755                 'help'          => <<HELP,
 756 This file handle is checked if it has data to read
 757 HELP
 758         },
 759         {
 760                 'name'          => 'timeout',
 761                 'help'          => <<HELP,
 762 How long to wait (in seconds) without being readable before calling
 763 the timeout method
 764 HELP
 765         },
 766         {
 767                 'name'          => 'method',
 768                 'default'       => 'readable',
 769                 'help'          => <<HELP,
 770 This method is called on the object when the file handle has data to read
 771 HELP
 772         },
 773         {
 774                 'name'          => 'timeout_method',
 775                 'default'       => 'read_timeout',
 776                 'help'          => <<HELP,
 777 This method is called on the object when the hasn't been readable
 778 after the timeout period
 779 HELP
 780         },
 781         {
 782                 'name'          => 'active',
 783                 'default'       => 1,
 784                 'type'          => 'boolean',
 785                 'help'          => <<HELP,
 786 This flag marks the event as being active. It can be toggled with the
 787 start/stop methods.
 788 HELP
 789         },
 790         {
 791                 'name'          => 'id',
 792                 'help'          => <<HELP,
 793 The id is passed to the callback method as its only argument. Use it to
 794 identify different instances of this object.
 795 HELP
 796
 797         },
 798 ] ;
 799
 800 sub new {
 801
 802         my( $class ) = shift ;
 803
 804         my $self = Stem::Class::parse_args( $attr_spec_read, @_ ) ;
 805         return $self unless ref $self ;
 806
 807
 808 #       return <<ERR unless defined fileno $self->{fh} ;
 809 # Stem::Event::Read: $self->{fh} is not an open handle
 810 # ERR
 811
 812         my $err = $self->_build_core_event( 'read' ) ;
 813         return $err if $err ;
 814
 815         $self->init_io_timeout() ;
 816
 817         return $self ;
 818 }
 819
 820 }
 821 ############################################################################
 822
 823 package Stem::Event::Write ;
 824 our @ISA = qw( Stem::Event::IO ) ;
 825
 826 =head2 Stem::Event::Write::new
 827
 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.
 832
 833 Write events are stopped when created - a call to the start method is
 834 needed to activate them.
 835
 836 =cut
 837
 838 my $attr_spec_write = [
 839
 840         {
 841                 'name'          => 'object',
 842                 'required'      => 1,
 843                 'type'          => 'object',
 844                 'help'          => <<HELP,
 845 This object gets the method callbacks
 846 HELP
 847         },
 848         {
 849                 'name'          => 'fh',
 850                 'required'      => 1,
 851                 'type'          => 'handle',
 852                 'help'          => <<HELP,
 853 This file handle is checked if it is writeable
 854 HELP
 855         },
 856         {
 857                 'name'          => 'timeout',
 858                 'help'          => <<HELP,
 859 How long to wait (in seconds) without being writeable before calling
 860 the timeout method
 861 HELP
 862         },
 863         {
 864                 'name'          => 'method',
 865                 'default'       => 'writeable',
 866                 'help'          => <<HELP,
 867 This method is called on the object when the file handle is writeable
 868 HELP
 869         },
 870         {
 871                 'name'          => 'timeout_method',
 872                 'default'       => 'write_timeout',
 873                 'help'          => <<HELP,
 874 This method is called on the object when the hasn't been writeable
 875 after the timeout period
 876 HELP
 877         },
 878         {
 879                 'name'          => 'active',
 880                 'default'       => 0,
 881                 'type'          => 'boolean',
 882                 'help'          => <<HELP,
 883 This flag marks the event as being active. It can be toggled with the
 884 start/stop methods.
 885 NOTE: Write events are not active by default.
 886 HELP
 887         },
 888         {
 889                 'name'          => 'id',
 890                 'help'          => <<HELP,
 891 The id is passed to the callback method as its only argument. Use it to
 892 identify different instances of this object.
 893 HELP
 894
 895         },
 896 ] ;
 897
 898 sub new {
 899
 900         my( $class ) = shift ;
 901
 902         my $self = Stem::Class::parse_args( $attr_spec_write, @_ ) ;
 903         return $self unless ref $self ;
 904
 905         my $err = $self->_build_core_event( 'write' ) ;
 906         return $err if $err ;
 907
 908 #print $self->dump_events() ;
 909
 910         $self->init_io_timeout() ;
 911
 912         $self->stop() unless $self->{'active'} ;
 913
 914 #print $self->dump() ;
 915
 916         return $self ;
 917 }
 918
 919 1 ;