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