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 our @ISA = qw( Stem::Event ) ;
 320
 321 =head2 Stem::Event::Plain::new
 322
 323 This class creates an event that will trigger a callback after all
 324 other pending events have been triggered.
 325
 326 =head2 Example
 327
 328         $plain_event = Stem::Event::Plain->new( 'object' => $self ) ;
 329
 330 =cut
 331
 332 my $attr_spec_plain = [
 333
 334         {
 335                 'name'          => 'object',
 336                 'required'      => 1,
 337                 'type'          => 'object',
 338                 'help'          => <<HELP,
 339 This object gets the method callbacks
 340 HELP
 341         },
 342         {
 343                 'name'          => 'method',
 344                 'default'       => 'triggered',
 345                 'help'          => <<HELP,
 346 This method is called on the object when the plain event is triggered
 347 HELP
 348         },
 349         {
 350                 'name'          => 'id',
 351                 'help'          => <<HELP,
 352 The id is passed to the callback method as its only argument. Use it to
 353 identify different instances of this object.
 354 HELP
 355
 356         },
 357 ] ;
 358
 359 sub new {
 360
 361         my( $class ) = shift ;
 362
 363         my $self = Stem::Class::parse_args( $attr_spec_plain, @_ ) ;
 364         return $self unless ref $self ;
 365
 366         my $err = $self->_build_core_event( 'plain' ) ;
 367         return $err if $err ;
 368
 369         return $self ;
 370 }
 371
 372 ############################################################################
 373
 374 package Stem::Event::Signal ;
 375
 376 our @ISA = qw( Stem::Event ) ;
 377
 378 =head2 Stem::Event::Signal::new
 379
 380 This class creates an event that will trigger a callback whenever
 381 its its signal has been received.
 382
 383 =head2 Example
 384
 385         $signal_event = Stem::Event::Signal->new( 'object' => $self,
 386                                                   'signal' => 'INT' ) ;
 387
 388         sub sig_int_handler { die "SIGINT\n" }
 389
 390 =cut
 391
 392 my $attr_spec_signal = [
 393
 394         {
 395                 'name'          => 'object',
 396                 'required'      => 1,
 397                 'type'          => 'object',
 398                 'help'          => <<HELP,
 399 This object gets the method callbacks
 400 HELP
 401         },
 402         {
 403                 'name'          => 'method',
 404                 'help'          => <<HELP,
 405 This method is called on the object when this event is triggered. The
 406 default method name for the signal NAME is 'sig_name_handler' (all lower case)
 407 HELP
 408         },
 409         {
 410                 'name'          => 'signal',
 411                 'required'      => 1,
 412                 'help'          => <<HELP,
 413 This is the name of the signal to handle. It is used as part of the
 414 default handler method name.
 415 HELP
 416         },
 417         {
 418                 'name'          => 'active',
 419                 'default'       => 1,
 420                 'type'          => 'boolean',
 421                 'help'          => <<HELP,
 422 This flag marks the event as being active. It can be toggled with the
 423 start/stop methods.
 424 HELP
 425         },
 426         {
 427                 'name'          => 'id',
 428                 'help'          => <<HELP,
 429 The id is passed to the callback method as its only argument. Use it to
 430 identify different instances of this object.
 431 HELP
 432
 433         },
 434 ] ;
 435
 436 sub new {
 437
 438         my( $class ) = shift ;
 439
 440         my $self = Stem::Class::parse_args( $attr_spec_signal, @_ ) ;
 441         return $self unless ref $self ;
 442
 443         my $signal = uc $self->{'signal'} ;
 444
 445         return "Unknown signal: $signal" unless exists $SIG{ $signal } ;
 446
 447         $self->{'method'} ||= "sig_\L${signal}_handler" ;
 448         $self->{'signal'} = $signal ;
 449
 450         my $err = $self->_build_core_event( 'signal' ) ;
 451         return $err if $err ;
 452
 453 #print "SELF SIG $self\nPID $$\n" ;
 454
 455         return $self ;
 456 }
 457
 458
 459 ############################################################################
 460
 461 package Stem::Event::Timer ;
 462
 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
 653 our @ISA = qw( Stem::Event ) ;
 654
 655 sub init_io_timeout {
 656
 657         my( $self ) = @_ ;
 658
 659         my $timeout = $self->{'timeout'} ;
 660         return unless $timeout ;
 661
 662         $self->{'io_timer_event'} = Stem::Event::Timer->new(
 663                 'object'        => $self,
 664                 'interval'      => $timeout,
 665         ) ;
 666
 667         return ;
 668 }
 669
 670 sub cancel {
 671
 672         my( $self ) = @_ ;
 673
 674 #print "IO CANCEL $self\n" ;
 675
 676         if ( my $io_timer_event = delete $self->{'io_timer_event'} ) {
 677                 $io_timer_event->cancel() ;
 678         }
 679
 680         $self->SUPER::cancel() ;
 681
 682         delete $self->{'fh'} ;
 683
 684         return ;
 685 }
 686
 687 sub start {
 688
 689         my( $self ) = @_ ;
 690
 691         if ( my $io_timer_event = $self->{'io_timer_event'} ) {
 692                 $io_timer_event->start() ;
 693         }
 694
 695         $self->SUPER::start() ;
 696
 697         return ;
 698 }
 699
 700 sub stop {
 701
 702         my( $self ) = @_ ;
 703
 704         $self->{'active'} = 0 ;
 705
 706         if ( my $io_timer_event = $self->{'io_timer_event'} ) {
 707                 $io_timer_event->stop() ;
 708         }
 709
 710         $self->SUPER::stop() ;
 711
 712         return ;
 713 }
 714
 715 sub timed_out {
 716
 717         my( $self ) = @_ ;
 718
 719 #       $self->{log_type} = "$self->{'event_type'}_timeout" ;
 720         $self->trigger( $self->{'timeout_method'} ) ;
 721 }
 722
 723 #######################################################
 724
 725 package Stem::Event::Read ;
 726
 727 our @ISA = qw( Stem::Event::IO ) ;
 728
 729 =head2 Stem::Event::Read::new
 730
 731 This class creates an event that will trigger a callback whenever
 732 its file descriptor has data to be read.  It takes an optional timeout
 733 value which will trigger a callback to the object if no data has been
 734 read during that period.
 735
 736 Read events are active when created - a call to the stop method is
 737 needed to deactivate them.
 738
 739 =cut
 740
 741 BEGIN {
 742
 743 my $attr_spec_read = [
 744
 745         {
 746                 'name'          => 'object',
 747                 'required'      => 1,
 748                 'type'          => 'object',
 749                 'help'          => <<HELP,
 750 This object gets the method callbacks
 751 HELP
 752         },
 753         {
 754                 'name'          => 'fh',
 755                 'required'      => 1,
 756                 'type'          => 'handle',
 757                 'help'          => <<HELP,
 758 This file handle is checked if it has data to read
 759 HELP
 760         },
 761         {
 762                 'name'          => 'timeout',
 763                 'help'          => <<HELP,
 764 How long to wait (in seconds) without being readable before calling
 765 the timeout method
 766 HELP
 767         },
 768         {
 769                 'name'          => 'method',
 770                 'default'       => 'readable',
 771                 'help'          => <<HELP,
 772 This method is called on the object when the file handle has data to read
 773 HELP
 774         },
 775         {
 776                 'name'          => 'timeout_method',
 777                 'default'       => 'read_timeout',
 778                 'help'          => <<HELP,
 779 This method is called on the object when the hasn't been readable
 780 after the timeout period
 781 HELP
 782         },
 783         {
 784                 'name'          => 'active',
 785                 'default'       => 1,
 786                 'type'          => 'boolean',
 787                 'help'          => <<HELP,
 788 This flag marks the event as being active. It can be toggled with the
 789 start/stop methods.
 790 HELP
 791         },
 792         {
 793                 'name'          => 'id',
 794                 'help'          => <<HELP,
 795 The id is passed to the callback method as its only argument. Use it to
 796 identify different instances of this object.
 797 HELP
 798
 799         },
 800 ] ;
 801
 802 sub new {
 803
 804         my( $class ) = shift ;
 805
 806         my $self = Stem::Class::parse_args( $attr_spec_read, @_ ) ;
 807         return $self unless ref $self ;
 808
 809 #       return <<ERR unless defined fileno $self->{fh} ;
 810 # Stem::Event::Read: $self->{fh} is not an open handle
 811 # ERR
 812
 813         my $err = $self->_build_core_event( 'read' ) ;
 814         return $err if $err ;
 815
 816         $self->init_io_timeout() ;
 817
 818         return $self ;
 819 }
 820
 821 }
 822 ############################################################################
 823
 824 package Stem::Event::Write ;
 825
 826 our @ISA = qw( Stem::Event::IO ) ;
 827
 828 =head2 Stem::Event::Write::new
 829
 830 This class creates an event that will trigger a callback whenever
 831 its file descriptor can be written to.  It takes an optional timeout
 832 value which will trigger a callback to the object if no data has been
 833 written during that period.
 834
 835 Write events are stopped when created - a call to the start method is
 836 needed to activate them.
 837
 838 =cut
 839
 840 my $attr_spec_write = [
 841
 842         {
 843                 'name'          => 'object',
 844                 'required'      => 1,
 845                 'type'          => 'object',
 846                 'help'          => <<HELP,
 847 This object gets the method callbacks
 848 HELP
 849         },
 850         {
 851                 'name'          => 'fh',
 852                 'required'      => 1,
 853                 'type'          => 'handle',
 854                 'help'          => <<HELP,
 855 This file handle is checked if it is writeable
 856 HELP
 857         },
 858         {
 859                 'name'          => 'timeout',
 860                 'help'          => <<HELP,
 861 How long to wait (in seconds) without being writeable before calling
 862 the timeout method
 863 HELP
 864         },
 865         {
 866                 'name'          => 'method',
 867                 'default'       => 'writeable',
 868                 'help'          => <<HELP,
 869 This method is called on the object when the file handle is writeable
 870 HELP
 871         },
 872         {
 873                 'name'          => 'timeout_method',
 874                 'default'       => 'write_timeout',
 875                 'help'          => <<HELP,
 876 This method is called on the object when the hasn't been writeable
 877 after the timeout period
 878 HELP
 879         },
 880         {
 881                 'name'          => 'active',
 882                 'default'       => 0,
 883                 'type'          => 'boolean',
 884                 'help'          => <<HELP,
 885 This flag marks the event as being active. It can be toggled with the
 886 start/stop methods.
 887 NOTE: Write events are not active by default.
 888 HELP
 889         },
 890         {
 891                 'name'          => 'id',
 892                 'help'          => <<HELP,
 893 The id is passed to the callback method as its only argument. Use it to
 894 identify different instances of this object.
 895 HELP
 896
 897         },
 898 ] ;
 899
 900 sub new {
 901
 902         my( $class ) = shift ;
 903
 904         my $self = Stem::Class::parse_args( $attr_spec_write, @_ ) ;
 905         return $self unless ref $self ;
 906
 907         my $err = $self->_build_core_event( 'write' ) ;
 908         return $err if $err ;
 909
 910 #print $self->dump_events() ;
 911
 912         $self->init_io_timeout() ;
 913
 914         $self->stop() unless $self->{'active'} ;
 915
 916 #print $self->dump() ;
 917
 918         return $self ;
 919 }
 920
 921 1 ;