lib/Stem/Gather.pm

   1 #  File: Stem/Gather.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 package Stem::Gather ;
  30
  31 #use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
  32 #use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
  33
  34 =head1 Description
  35
  36 This is a object module used by Stem Cells and objects to detect when
  37 a set of asynchronous events have finished. It is constructed by an
  38 owner object which then stores it in itselt. Gather objects are
  39 initialized with a set of keys to be gathered. When the owner object
  40 is notified of an event, it calls the C<gathered> method of the gather
  41 object with a list of keys. When all of the keys are gathered, a
  42 callback is made to the owner object. An optional timeout is available
  43 which will also generate a callback if the keys are not gathered in
  44 time.
  45
  46 =head1 Synopsis
  47
  48         use Stem::Gather ;
  49
  50         # $self is the owner object that has already been created
  51
  52         my $gather = Stem::Gather->new(
  53                 'object'        => $self,
  54                 'keys'          => [qw( msg1 msg2 )]
  55         ) ;
  56
  57         $self->{'gather'} = $gather ;
  58
  59         sub msg1_in {
  60
  61                 my( $self ) = @_ ;
  62                 $self->{'gather'}->gathered( 'msg1' ) ;
  63         }
  64
  65         sub msg2_in {
  66
  67                 my( $self ) = @_ ;
  68                 $self->{'gather'}->gathered( 'msg2' ) ;
  69         }
  70
  71         sub gather_done {
  72
  73                 my( $self ) = @_ ;
  74
  75                 print "we have gathered\n" ;
  76         }
  77
  78 =cut
  79
  80 use strict ;
  81
  82 my %class_to_attr_name ;
  83
  84 my $attr_spec = [
  85
  86         {
  87                 'name'          => 'object',
  88                 'required'      => 1,
  89                 'type'          => 'object',
  90                 'help'          => <<HELP,
  91 This is the owner object which has the methods that get called when Stem::Gather
  92 has either finished gathering all of the keys or it has timed out.
  93 HELP
  94         },
  95         {
  96                 'name'          => 'keys',
  97                 'required'      => 1,
  98                 'type'          => 'list',
  99                 'help'          => <<HELP,
 100 This is the list of keys to gather.
 101 HELP
 102         },
 103         {
 104                 'name'          => 'gathered_method',
 105                 'default'       => 'gather_done',
 106                 'help'          => <<HELP,
 107 This method is called in the owner object when all of the keys are gathered.
 108 HELP
 109         },
 110         {
 111                 'name'          => 'no_start',
 112                 'type'          => 'boolean',
 113                 'help'          => <<HELP,
 114 If set, then do not start the gather object upon creation. A call to
 115 the C<restart> must be made. This only meaningful if this gather has a
 116 timeout set.
 117 HELP
 118         },
 119         {
 120                 'name'          => 'timeout',
 121                 'help'          => <<HELP,
 122 This is an optional timeout period (in seconds) waiting for the gather
 123 to be completed
 124 HELP
 125         },
 126         {
 127                 'name'          => 'timeout_method',
 128                 'default'       => 'gather_timeout',
 129                 'help'          => <<HELP,
 130 This method is called in the owner object if the gather timed out
 131 before all keys were gathered.
 132 HELP
 133         },
 134 ] ;
 135
 136
 137 ###########
 138 # This POD section is autoegenerated. Any edits to it will be lost.
 139
 140 =head2 Constructor Attributes for Class Stem::Gather
 141
 142 =over 4
 143
 144
 145 =item * Attribute - B<object>
 146
 147 =over 4
 148
 149
 150 =item Description:
 151 This is the owner object which has the methods that get called when Stem::Gather
 152 has either finished gathering all of the keys or it has timed out.
 153
 154
 155 =item Its B<type> is: object
 156
 157 =item It is B<required>.
 158
 159 =back
 160
 161 =item * Attribute - B<keys>
 162
 163 =over 4
 164
 165
 166 =item Description:
 167 This is the list of keys to gather.
 168
 169
 170 =item Its B<type> is: list
 171
 172 =item It is B<required>.
 173
 174 =back
 175
 176 =item * Attribute - B<gathered_method>
 177
 178 =over 4
 179
 180
 181 =item Description:
 182 This method is called in the owner object when all of the keys are gathered.
 183
 184
 185 =item It B<defaults> to: gather_done
 186
 187 =back
 188
 189 =item * Attribute - B<no_start>
 190
 191 =over 4
 192
 193
 194 =item Description:
 195 If set, then do not start the gather object upon creation. A call to
 196 the C<restart> must be made. This only meaningful if this gather has a
 197 timeout set.
 198
 199
 200 =item Its B<type> is: boolean
 201
 202 =back
 203
 204 =item * Attribute - B<timeout>
 205
 206 =over 4
 207
 208
 209 =item Description:
 210 This is an optional timeout period (in seconds) waiting for the gather
 211 to be completed
 212
 213
 214 =back
 215
 216 =item * Attribute - B<timeout_method>
 217
 218 =over 4
 219
 220
 221 =item Description:
 222 This method is called in the owner object if the gather timed out
 223 before all keys were gathered.
 224
 225
 226 =item It B<defaults> to: gather_timeout
 227
 228 =back
 229
 230 =back
 231
 232 =cut
 233
 234 # End of autogenerated POD
 235 ###########
 236
 237
 238
 239
 240 =head2 Method new
 241
 242 This is the constructor method for Stem::Gather. It uses the standard
 243 Stem key/value API with the
 244
 245 =cut
 246
 247 sub new {
 248
 249         my( $class ) = shift ;
 250
 251         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
 252         return $self unless ref $self ;
 253
 254 #       return 'Stem::Gather "keys" is not an array reference'
 255 #               unless ref $self->{'keys'} eq 'ARRAY' ;
 256
 257         $self->restart() unless $self->{'no_start'} ;
 258
 259         return( $self ) ;
 260 }
 261
 262 =head2 Method restart
 263
 264 This method is called to start up the gather object when it has
 265 already gathered all the keys, it has timed out or it was never
 266 started (the no_start attribute was enabled). It takes no arguments.
 267
 268 =cut
 269
 270
 271 sub restart {
 272
 273         my( $self ) = @_ ;
 274
 275         $self->{'gathered'} = 0 ;
 276
 277         $self->{'keys_left'} = { map { $_, 1 } @{$self->{'keys'}} } ;
 278
 279 #       TraceStatus "GAT keys '@{$self->{'keys'}}'" ;
 280
 281         $self->_cancel_timeout() ;
 282
 283         if ( my $timeout = $self->{'timeout'} ) {
 284
 285                 $self->{'timer_event'} = Stem::Event::Timer->new(
 286                                 'object'        => $self,
 287                                 'delay'         => $timeout,
 288                                 'hard'          => 1,
 289                                 'repeat'        => 0 ) ;
 290         }
 291 }
 292
 293 =head2 Method add_keys
 294
 295 This method is passed a list of keys which will be added to the list
 296 to be watched for by the Stem::Gather object. The new keys are not
 297 looked for until a call to the C<restart> method is made.
 298
 299 =cut
 300
 301 sub add_keys {
 302
 303         my( $self, @keys ) = @_ ;
 304
 305         push @{$self->{'keys'}}, @keys ;
 306 }
 307
 308 =head2 Method gathered
 309
 310 This method is called with a list of keys that are gathered. The keys
 311 that haven't been gathered before are marked as gathered. If there are
 312 no more keys to be gathered, the method in the C<gathered_method>
 313 attribute is called in the owner object. You have to call the
 314 C<restart> method on this gather object to use it again.You can pass
 315 this methods keys that have been gathered or are not even in the list
 316 to be gathered and they are ignored.
 317
 318 =cut
 319
 320 sub gathered {
 321
 322         my( $self, @keys ) = @_ ;
 323
 324 #       TraceStatus "gathered: @keys" ;
 325
 326         return if $self->{'gathered'} ;
 327
 328         delete @{$self->{'keys_left'}}{@keys} ;
 329
 330         return if keys %{$self->{'keys_left'}} ;
 331
 332         $self->_cancel_timeout() ;
 333         $self->{'gathered'} = 1 ;
 334
 335         my $method = $self->{'gathered_method'} ;
 336
 337 #       TraceStatus "gathered done: calling $method" ;
 338
 339         return $self->{'object'}->$method() ;
 340 }
 341
 342 sub timed_out {
 343
 344         my( $self ) = @_ ;
 345
 346         $self->_cancel_timeout() ;
 347
 348         my $method = $self->{'timeout_method'} ;
 349         $self->{'object'}->$method() ;
 350
 351         return ;
 352 }
 353
 354 sub _cancel_timeout {
 355
 356         my( $self ) = @_ ;
 357
 358         if ( my $timer = $self->{'timer_event'} ) {
 359                 $timer->cancel() ;
 360
 361                 delete $self->{'timer_event'} ;
 362         }
 363 }
 364
 365 =head2 Method
 366
 367 This method B<must> be called if the owner object is being shut down or
 368 destroyed. It will cancel any pending timeout and break the link back
 369 to the owner object. The owner object can then be destroyed without
 370 leaking memory.
 371
 372 =cut
 373
 374 sub shut_down {
 375
 376         my( $self ) = @_ ;
 377
 378         $self->_cancel_timeout() ;
 379
 380         delete $self->{'object'} ;
 381 }
 382
 383 1 ;