lib/Stem/Event/EventPM.pm

   1 #  File: Stem/Event/EventPM.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 #print "required" ;
  30
  31 =head1 Stem::Event::EventPM
  32
  33 This module wraps the CPAN module Event.pm for use by the rest of
  34 Stem. It provides the common API for the standard Stem::Event classes:
  35
  36 =over 4
  37
  38 =item Stem::Event
  39 =item Stem::Event::Plain
  40 =item Stem::Event::Timer
  41 =item Stem::Event::Signal
  42 =item Stem::Event::Read
  43 =item Stem::Event::Write
  44
  45 =back
  46
  47 =cut
  48
  49 package Stem::Event::EventPM ;
  50
  51 use strict ;
  52 use Event ;
  53
  54 @Stem::Event::EventPM::ISA = qw( Stem::Event ) ;
  55
  56 # basic wrappers for top level Event.pm calls.
  57
  58 sub _start_loop {
  59         $Event::DIED = \&_died ;
  60         Event::loop() ;
  61 }
  62
  63 sub _died {
  64         my( $event, $err ) = @_ ;
  65         use Carp;
  66         Carp::cluck( "Stem::Event died: $err", "die called in [$event]\n",
  67                      map( "<$_>", caller() ), "\n" ) ;
  68
  69         exit;
  70 } ;
  71
  72
  73 sub _stop_loop {
  74         Event::unloop_all( 1 ) ;
  75 }
  76
  77 ############################################################################
  78
  79 package Stem::Event::Plain ;
  80
  81 sub _build {
  82
  83         my( $self ) = @_ ;
  84
  85 # create the plain event watcher
  86
  87         $self->{'idle_event'} = Event->idle(
  88                 'cb'            => [ $self, 'idle_triggered' ],
  89                 'repeat'        => 0
  90         ) ;
  91
  92         return $self ;
  93 }
  94
  95 sub idle_triggered {
  96
  97         my( $self ) = @_ ;
  98
  99         $self->trigger( 'plain' ) ;
 100         my $idle_event = delete $self->{'idle_event'} ;
 101         $idle_event->cancel() ;
 102 }
 103
 104 ############################################################################
 105
 106 package Stem::Event::Signal ;
 107
 108 sub _build {
 109
 110         my( $self ) = @_ ;
 111
 112         my $signal = $self->{'signal'} ;
 113
 114 # create the signal event watcher
 115
 116         return Event->signal(
 117                 'cb'            => sub { $self->trigger() },
 118                 'signal'        => $signal,
 119         ) ;
 120 }
 121
 122 sub _cancel {
 123         my( $self, $signal_event ) = @_ ;
 124         $signal_event->cancel() ;
 125         return ;
 126 }
 127
 128 ############################################################################
 129
 130 package Stem::Event::Timer ;
 131
 132 sub _build {
 133
 134         my( $self ) = @_ ;
 135
 136         return Event->timer(
 137                 'cb'            => [ $self, 'timer_triggered' ],
 138                 'hard'          => $self->{'hard'},
 139                 'after'         => $self->{'delay'},
 140                 'interval'      => $self->{'interval'},
 141         ) ;
 142 }
 143
 144 sub _reset {
 145         my( $self, $timer_event, $delay ) = @_ ;
 146         $timer_event->again() ;
 147         return ;
 148 }
 149
 150 sub _cancel {
 151         my( $self, $timer_event ) = @_ ;
 152         $timer_event->cancel() ;
 153         return ;
 154 }
 155
 156 sub _start {
 157         my( $self, $timer_event ) = @_ ;
 158         $timer_event->start() ;
 159         return ;
 160 }
 161
 162 sub _stop {
 163         my( $self, $timer_event ) = @_ ;
 164         $timer_event->stop() ;
 165         return ;
 166 }
 167
 168 ############################################################################
 169
 170 package Stem::Event::Read ;
 171
 172 sub _build {
 173
 174         my( $self ) = @_ ;
 175
 176 # create the read event watcher
 177
 178         return Event->io(
 179                 'cb'    => sub { $self->trigger() },
 180                 'fd'    => $self->{'fh'},
 181                 'poll'  => 'r',
 182         ) ;
 183 }
 184
 185 sub _cancel {
 186         my( $self, $read_event ) = @_ ;
 187         $read_event->cancel() ;
 188         return ;
 189 }
 190
 191 sub _start {
 192         my( $self, $read_event ) = @_ ;
 193         $read_event->start() ;
 194         return ;
 195 }
 196
 197 sub _stop {
 198         my( $self, $read_event ) = @_ ;
 199         $read_event->stop() ;
 200         return ;
 201 }
 202
 203 ############################################################################
 204
 205 package Stem::Event::Write ;
 206
 207 sub _build {
 208
 209         my( $self ) = @_ ;
 210
 211 # create the write event watcher
 212
 213 # create the read event watcher
 214
 215         return Event->io(
 216                 'cb'    => sub { $self->trigger() },
 217                 'fd'    => $self->{'fh'},
 218                 'poll'  => 'w',
 219         ) ;
 220
 221         return $self ;
 222 }
 223
 224 sub _cancel {
 225         my( $self, $write_event ) = @_ ;
 226         $write_event->cancel() ;
 227         return ;
 228 }
 229
 230 sub _start {
 231         my( $self, $write_event ) = @_ ;
 232         $write_event->start() ;
 233         return ;
 234 }
 235
 236 sub _stop {
 237         my( $self, $write_event ) = @_ ;
 238         $write_event->stop() ;
 239         return ;
 240 }
 241
 242 1 ;