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