Changeset 2920
- Timestamp:
- 08/21/10 22:26:24 (18 months ago)
- Location:
- trunk/Catalyst-Plugin-Alarm
- Files:
-
- 4 added
- 2 edited
-
Alarm.pm (modified) (17 diffs)
-
t/01-alarm.t (modified) (1 diff)
-
t/TestApp (added)
-
t/TestApp.pm (added)
-
t/TestApp/Controller (added)
-
t/TestApp/Controller/Root.pm (added)
Legend:
- Unmodified
- Added
- Removed
-
trunk/Catalyst-Plugin-Alarm/Alarm.pm
r1977 r2920 16 16 # because Win32 doesn't use POSIX signals 17 17 our $WIN32 = 1; 18 unless ($^O eq 'MSWin32') 19 { 18 unless ( $^O eq 'MSWin32' ) { 20 19 require Sys::SigAction; 21 20 $WIN32 = 0; 22 21 } 23 22 24 our $VERSION = 0.0 4;23 our $VERSION = 0.05; 25 24 our $TIMEOUT = 180; 26 25 our $LOCAL_TIMEOUT = 30; … … 29 28 my $ALARM_RE = qr/^[\d]+$/; 30 29 31 BEGIN 32 { 30 BEGIN { 33 31 __PACKAGE__->mk_accessors(qw/ alarm /); 34 32 } 35 33 36 sub prepare 37 { 34 sub prepare { 38 35 my $class = shift; 39 36 my $c = $class->next::method(@_); … … 44 41 45 42 # copy of config for easy checking and temp overriding 46 my %conf = %{ $c->config->{alarm}};43 my %conf = %{ $c->config->{alarm} }; 47 44 48 45 # should we override forward method? … … 52 49 if ( exists $conf{timeout} 53 50 and exists $conf{override} 54 and $conf{timeout} )51 and $conf{timeout} ) 55 52 { 56 53 my $re = $conf{override}->{re} || ''; 57 if ($re && $c->req->path =~ m/$re/) 58 { 54 if ( $re && $c->req->path =~ m/$re/ ) { 59 55 $alarm{override} = $c->req->path; 60 if ( $c->debug)61 {62 $c->log->debug("found alarm override for: " . $c->req->path);63 $c->log->debug( "setting this request global alarm to "64 . $conf{override}->{timeout});56 if ( $c->debug ) { 57 $c->log->debug( 58 "found alarm override for: " . $c->req->path ); 59 $c->log->debug( "setting this request global alarm to " 60 . $conf{override}->{timeout} ); 65 61 } 66 62 $conf{global} = $conf{override}->{timeout}; … … 69 65 70 66 # special case - allow for disable global timer 71 if ( exists $conf{global}72 && $conf{global} != 0 )67 if ( exists $conf{global} 68 && $conf{global} != 0 ) 73 69 { 74 70 my $timeout = $conf{global}; 75 71 76 72 my $handler = $conf{handler} 77 || sub { Catalyst::Exception->throw("Global Alarm timeout: $timeout") }; 78 79 if (!$timeout or $timeout !~ m/$ALARM_RE/) 80 { 73 || sub { 74 Catalyst::Exception->throw("Global Alarm timeout: $timeout"); 75 }; 76 77 if ( !$timeout or $timeout !~ m/$ALARM_RE/ ) { 81 78 82 79 # avoid spurious warning … … 85 82 #$timeout = '' unless defined $timeout; 86 83 Catalyst::Exception->throw( 87 "Global Alarm timeout value is invalid: $timeout");84 "Global Alarm timeout value is invalid: $timeout"); 88 85 } 89 86 90 87 # configure alarm 91 88 $alarm{timeout} = $timeout; 92 $alarm{start} = [ Time::HiRes::gettimeofday()];89 $alarm{start} = [ Time::HiRes::gettimeofday() ]; 93 90 $alarm{handler} = $handler; 94 91 $alarm{failed} = []; … … 96 93 my $alarm_handler = sub { 97 94 $c->alarm->on(1); 98 $c->alarm->sounded( Time::HiRes::gettimeofday());95 $c->alarm->sounded( Time::HiRes::gettimeofday() ); 99 96 $c->error( 100 "Global Alarm sounded at ~$timeout seconds: "101 . Time::HiRes::tv_interval(102 $c->alarm->start, $c->alarm->sounded103 )104 );105 106 push( @{$c->alarm->{failed}}, $c->action->name);107 &$handler( $c, 1);97 "Global Alarm sounded at ~$timeout seconds: " 98 . Time::HiRes::tv_interval( 99 $c->alarm->start, $c->alarm->sounded 100 ) 101 ); 102 103 push( @{ $c->alarm->{failed} }, $c->action->name ); 104 &$handler( $c, 1 ); 108 105 }; 109 106 110 if ($WIN32) 111 { 107 if ($WIN32) { 112 108 $SIG{ALRM} = $alarm_handler; 113 109 } 114 else 115 { 116 117 $alarm{sig_handler} = 118 Sys::SigAction::set_sig_handler('ALRM', $alarm_handler, 119 {safe => 1}); 110 else { 111 112 $alarm{sig_handler} 113 = Sys::SigAction::set_sig_handler( 'ALRM', $alarm_handler, 114 { safe => 1 } ); 120 115 121 116 } … … 126 121 127 122 $c->log->debug("global alarm set for $timeout seconds") 128 if $c->debug;123 if $c->debug; 129 124 130 125 } 131 126 132 127 # set accessor 133 $c->alarm( bless \%alarm, 'Catalyst::Alarm');128 $c->alarm( bless \%alarm, 'Catalyst::Alarm' ); 134 129 135 130 return $c; 136 131 } 137 132 138 sub finalize 139 { 133 sub finalize { 140 134 my $c = shift; 141 135 142 if ( !$c->alarm || !$c->alarm->{start}) {136 if ( !$c->alarm || !$c->alarm->{start} ) { 143 137 $c->next::method(@_); 144 138 return 1; … … 148 142 # has already been called, but for completeness' sake. 149 143 150 $c->alarm->stop( Time::HiRes::gettimeofday());144 $c->alarm->stop( Time::HiRes::gettimeofday() ); 151 145 $c->alarm->total( 152 Time::HiRes::tv_interval($c->alarm->{start}, $c->alarm->{stop}));146 Time::HiRes::tv_interval( $c->alarm->{start}, $c->alarm->{stop} ) ); 153 147 154 148 # turn off alarm … … 168 162 } 169 163 170 sub forward 171 { 164 sub forward { 172 165 my $c = shift; 173 166 … … 176 169 $c->{stack} = [] unless $c->stack; 177 170 178 if ($c->alarm && $c->alarm->{forward}) 179 { 171 if ( $c->alarm && $c->alarm->{forward} ) { 180 172 return $c->timeout(@_); 181 173 } 182 174 183 return $c->dispatcher->forward( $c, @_);175 return $c->dispatcher->forward( $c, @_ ); 184 176 } 185 177 186 sub timeout 187 { 178 sub timeout { 188 179 my $c = shift; 189 my ( $timeout, @arg);180 my ( $timeout, @arg ); 190 181 191 182 # set a default if not configured 192 183 my $conf = {}; 193 if (!exists $c->config->{alarm}) 194 { 184 if ( !exists $c->config->{alarm} ) { 195 185 $conf->{timeout} = $LOCAL_TIMEOUT; 196 186 } 197 else 198 { 187 else { 199 188 $conf = $c->config->{alarm}; 200 189 } 201 190 202 if (ref $_[0]) 203 { 191 if ( ref $_[0] ) { 204 192 $timeout = $_[0]->{timeout} || $conf->{timeout}; 205 @arg = ref $_[0]->{action} ? @{$_[0]->{action}} : $_[0]->{action}; 206 } 207 elsif (!(@_ % 2)) 208 { 193 @arg = ref $_[0]->{action} ? @{ $_[0]->{action} } : $_[0]->{action}; 194 } 195 elsif ( !( @_ % 2 ) ) { 209 196 my %e = @_; 210 197 $timeout = $e{timeout} || $conf->{timeout}; 211 @arg = ref $e{action} ? @{ $e{action}} : $e{action};198 @arg = ref $e{action} ? @{ $e{action} } : $e{action}; 212 199 213 200 # just in case we called as 'foo',[@args] and not as => pairs 214 if (!scalar(@arg) || !defined $arg[0]) 215 { 201 if ( !scalar(@arg) || !defined $arg[0] ) { 216 202 @arg = @_; 217 203 } 218 204 219 205 } 220 else 221 { 206 else { 222 207 @arg = @_; 223 208 $timeout = $conf->{timeout}; 224 209 } 225 210 226 if (!defined $timeout or $timeout !~ m/$ALARM_RE/) 227 { 211 if ( !defined $timeout or $timeout !~ m/$ALARM_RE/ ) { 228 212 229 213 # avoid spurious warning 230 214 no warnings; 231 Catalyst::Exception->throw("Alarm timeout value is invalid: $timeout"); 232 } 233 234 my $e = join(', ', @arg); 215 Catalyst::Exception->throw( 216 "Alarm timeout value is invalid: $timeout"); 217 } 218 219 my $e = join( ', ', @arg ); 235 220 my @ret; 236 221 $c->alarm->on(0); 237 222 238 223 my $handler = $c->config->{alarm}->{handler} 239 || sub { Catalyst::Exception->throw("Local Alarm timeout for: $e") };224 || sub { Catalyst::Exception->throw("Local Alarm timeout for: $e") }; 240 225 241 226 my $prev_alarm = 0; … … 243 228 my $alarm_handler = sub { 244 229 $c->alarm->on(1); 245 push @{$c->alarm->{failed}}, $e; 246 247 $c->error("Local Alarm sounded after $timeout seconds for action: $e"); 248 249 &$handler($c, \@ret); 230 push @{ $c->alarm->{failed} }, $e; 231 232 $c->error( 233 "Local Alarm sounded after $timeout seconds for action: $e"); 234 235 &$handler( $c, \@ret ); 250 236 251 237 }; … … 253 239 eval { 254 240 my $h = $SIG{ALRM}; 255 if ($WIN32) 256 { 241 if ($WIN32) { 257 242 $SIG{ALRM} = $alarm_handler; 258 243 } 259 else 260 { 261 $h = 262 Sys::SigAction::set_sig_handler('ALRM', $alarm_handler, 263 {safe => 1}); 244 else { 245 $h = Sys::SigAction::set_sig_handler( 'ALRM', $alarm_handler, 246 { safe => 1 } ); 264 247 } 265 248 266 249 #$c->log->debug( Dumper $h ); 267 my $sv = [ Time::HiRes::gettimeofday()];268 269 #$c->log->debug("setting alarm for $timeout seconds");270 # Time::HiRes version of alarm() doing wacky things like going off after271 # only 1.4.. seconds when $timeout is much greater272 # TODO see if I am just using it wrong.273 #my $prev_alarm = Time::HiRes::alarm($timeout);250 my $sv = [ Time::HiRes::gettimeofday() ]; 251 252 #$c->log->debug("setting alarm for $timeout seconds"); 253 # Time::HiRes version of alarm() doing wacky things like going off after 254 # only 1.4.. seconds when $timeout is much greater 255 # TODO see if I am just using it wrong. 256 #my $prev_alarm = Time::HiRes::alarm($timeout); 274 257 $prev_alarm = CORE::alarm($timeout); 275 258 $c->log->debug("previous alarm was $prev_alarm") 276 if $c->debug;277 278 @ret = $c->dispatcher->forward( $c, @arg);259 if $c->debug; 260 261 @ret = $c->dispatcher->forward( $c, @arg ); 279 262 280 263 # NOTE that on alarm, if the default handler is used, we never … … 283 266 284 267 #$c->log->debug("came back"); 285 my $ev = [Time::HiRes::gettimeofday()];286 my $intv = Time::HiRes::tv_interval( $sv, $ev);268 my $ev = [ Time::HiRes::gettimeofday() ]; 269 my $intv = Time::HiRes::tv_interval( $sv, $ev ); 287 270 288 271 #warn "intv = $intv\n"; 289 272 $c->log->debug("resetting alarm after $intv seconds") 290 if $c->debug;273 if $c->debug; 291 274 292 275 #Time::HiRes::alarm(0); … … 296 279 # NOTE that because CORE alarm uses only ints that we end 297 280 # up taking longer for global alarm than originally configed. 298 if ($prev_alarm > 0) 299 { 281 if ( $prev_alarm > 0 ) { 300 282 $prev_alarm = $prev_alarm - int($intv); 301 283 $prev_alarm = 1 if $prev_alarm <= 0; 302 284 $c->log->debug("prev_alarm = $prev_alarm") 303 if $c->debug;285 if $c->debug; 304 286 } 305 287 306 288 CORE::alarm($prev_alarm); 307 289 308 if ($WIN32) 309 { 290 if ($WIN32) { 310 291 $SIG{ALRM} = $h; 311 292 } … … 324 305 # that scalar behaviour. 325 306 326 return $c->alarm->on ? undef : $ret[0];307 return $c->alarm->on ? undef : $ret[0]; 327 308 } 328 309 … … 334 315 __PACKAGE__->mk_accessors( 335 316 qw/ 336 timeout337 start338 stop339 total340 sig_handler341 handler342 failed343 sounded344 forward345 override346 on347 /317 timeout 318 start 319 stop 320 total 321 sig_handler 322 handler 323 failed 324 sounded 325 forward 326 override 327 on 328 / 348 329 ); 349 330 350 sub off 351 { 331 sub off { 352 332 353 333 #Time::HiRes::alarm(0); -
trunk/Catalyst-Plugin-Alarm/t/01-alarm.t
r898 r2920 1 package TestApp;2 1 use strict; 3 use warnings;4 2 use lib 't'; 3 use Catalyst::Test 'TestApp'; 5 4 use Test::More tests => 7; 6 5 7 use Catalyst qw[ Alarm]; 8 __PACKAGE__->config( 9 alarm => { 10 timeout => 3, 11 handler => sub { 12 if (ref $_[1]) 13 { 14 diag(" .... local alarm went off!!"); 15 $_[1]->[0] = 1; 16 $_[0]->alarm->on(0); 17 } 18 else 19 { 20 diag(" .... global alarm went off"); 21 #$_[0]->alarm->on(0); # leave it on to test 22 } 23 }, 24 global => 5 25 } 26 ); 27 __PACKAGE__->setup(); 6 # some tests defined in the TestApp files 28 7 29 # apologies to Woody Allen 30 sub sleeper : Local 31 { 32 my ($self, $c, $l) = @_; 33 $l ||= 0; 34 35 # sleep() may cause alarm() to fail on Win32, 36 # so mimic the idea 37 my $finish = time() + $l; 38 while( $finish > time() ) 39 { 40 1; 41 } 42 43 $c->response->output('ok'); 44 45 $self->clear($c); 46 } 47 48 sub foo : Global 49 { 50 my ($self, $c) = @_; 51 52 can_ok($c, 'alarm'); 53 54 55 ok($c->timeout(action => ['sleeper', [2]], timeout => 1), 56 "sleeper with args"); 57 58 $self->clear($c); 59 60 ok($c->timeout({action => [qw/TestApp sleeper/, [2]], timeout => 1}), 61 "sleeper with everything"); 62 63 $self->clear($c); 64 65 # force global alarm to go off 66 $c->forward('sleeper',[$c->config->{alarm}->{global}]); 67 68 ok($c->alarm->on, "global alarm sounded"); 69 70 $self->clear($c); 71 72 } 73 74 75 sub clear 76 { 77 my ($self, $c) = @_; 78 if (@{$c->error}) 79 { 80 81 #warn ".......... found error ...........\n"; 82 83 my @e = @{$c->error}; 84 if (grep { m/Alarm/ } @e) 85 { 86 87 #$c->clear_errors; # newer Cat versions have this 88 $c->error(0); 89 } 90 } 91 else 92 { 93 $c->log->debug("no error") 94 if $c->debug; 95 } 96 97 1; 98 } 99 100 package main; 101 use Catalyst::Test 'TestApp'; 102 use Test::More; 103 104 ok(get('/sleeper'), "get /sleeper"); 105 ok(get('/sleeper/10'), "get /sleeper/10"); 106 ok(get('/foo'), "get /foo"); 8 ok( get('/sleeper'), "get /sleeper" ); 9 ok( get('/sleeper/10'), "get /sleeper/10" ); 10 ok( get('/foo'), "get /foo" ); 107 11 108 12 1;
Note: See TracChangeset
for help on using the changeset viewer.