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