Changeset 2920


Ignore:
Timestamp:
08/21/10 22:26:24 (18 months ago)
Author:
karpet
Message:

restructure tests to avoid Cat 5.8 warnings; bump version

Location:
trunk/Catalyst-Plugin-Alarm
Files:
4 added
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/Catalyst-Plugin-Alarm/Alarm.pm

    r1977 r2920  
    1616# because Win32 doesn't use POSIX signals 
    1717our $WIN32 = 1; 
    18 unless ($^O eq 'MSWin32') 
    19 { 
     18unless ( $^O eq 'MSWin32' ) { 
    2019    require Sys::SigAction; 
    2120    $WIN32 = 0; 
    2221} 
    2322 
    24 our $VERSION       = 0.04; 
     23our $VERSION       = 0.05; 
    2524our $TIMEOUT       = 180; 
    2625our $LOCAL_TIMEOUT = 30; 
     
    2928my $ALARM_RE = qr/^[\d]+$/; 
    3029 
    31 BEGIN 
    32 { 
     30BEGIN { 
    3331    __PACKAGE__->mk_accessors(qw/ alarm /); 
    3432} 
    3533 
    36 sub prepare 
    37 { 
     34sub prepare { 
    3835    my $class = shift; 
    3936    my $c     = $class->next::method(@_); 
     
    4441 
    4542    # copy of config for easy checking and temp overriding 
    46     my %conf = %{$c->config->{alarm}}; 
     43    my %conf = %{ $c->config->{alarm} }; 
    4744 
    4845    # should we override forward method? 
     
    5249    if (    exists $conf{timeout} 
    5350        and exists $conf{override} 
    54         and $conf{timeout}) 
     51        and $conf{timeout} ) 
    5552    { 
    5653        my $re = $conf{override}->{re} || ''; 
    57         if ($re && $c->req->path =~ m/$re/) 
    58         { 
     54        if ( $re && $c->req->path =~ m/$re/ ) { 
    5955            $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} ); 
    6561            } 
    6662            $conf{global} = $conf{override}->{timeout}; 
     
    6965 
    7066    # 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 ) 
    7369    { 
    7470        my $timeout = $conf{global}; 
    7571 
    7672        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/ ) { 
    8178 
    8279            # avoid spurious warning 
     
    8582            #$timeout = '' unless defined $timeout; 
    8683            Catalyst::Exception->throw( 
    87                              "Global Alarm timeout value is invalid: $timeout"); 
     84                "Global Alarm timeout value is invalid: $timeout"); 
    8885        } 
    8986 
    9087        # configure alarm 
    9188        $alarm{timeout} = $timeout; 
    92         $alarm{start}   = [Time::HiRes::gettimeofday()]; 
     89        $alarm{start}   = [ Time::HiRes::gettimeofday() ]; 
    9390        $alarm{handler} = $handler; 
    9491        $alarm{failed}  = []; 
     
    9693        my $alarm_handler = sub { 
    9794            $c->alarm->on(1); 
    98             $c->alarm->sounded(Time::HiRes::gettimeofday()); 
     95            $c->alarm->sounded( Time::HiRes::gettimeofday() ); 
    9996            $c->error( 
    100                       "Global Alarm sounded at ~$timeout seconds: " 
    101                         . Time::HiRes::tv_interval( 
    102                                             $c->alarm->start, $c->alarm->sounded 
    103                         ) 
    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 ); 
    108105        }; 
    109106 
    110         if ($WIN32) 
    111         { 
     107        if ($WIN32) { 
    112108            $SIG{ALRM} = $alarm_handler; 
    113109        } 
    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 } ); 
    120115 
    121116        } 
     
    126121 
    127122        $c->log->debug("global alarm set for $timeout seconds") 
    128           if $c->debug; 
     123            if $c->debug; 
    129124 
    130125    } 
    131126 
    132127    # set accessor 
    133     $c->alarm(bless \%alarm, 'Catalyst::Alarm'); 
     128    $c->alarm( bless \%alarm, 'Catalyst::Alarm' ); 
    134129 
    135130    return $c; 
    136131} 
    137132 
    138 sub finalize 
    139 { 
     133sub finalize { 
    140134    my $c = shift; 
    141135 
    142     if (!$c->alarm || !$c->alarm->{start}) { 
     136    if ( !$c->alarm || !$c->alarm->{start} ) { 
    143137        $c->next::method(@_); 
    144138        return 1; 
     
    148142    # has already been called, but for completeness' sake. 
    149143 
    150     $c->alarm->stop(Time::HiRes::gettimeofday()); 
     144    $c->alarm->stop( Time::HiRes::gettimeofday() ); 
    151145    $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} ) ); 
    153147 
    154148    # turn off alarm 
     
    168162} 
    169163 
    170 sub forward 
    171 { 
     164sub forward { 
    172165    my $c = shift; 
    173166 
     
    176169    $c->{stack} = [] unless $c->stack; 
    177170 
    178     if ($c->alarm && $c->alarm->{forward}) 
    179     { 
     171    if ( $c->alarm && $c->alarm->{forward} ) { 
    180172        return $c->timeout(@_); 
    181173    } 
    182174 
    183     return $c->dispatcher->forward($c, @_); 
     175    return $c->dispatcher->forward( $c, @_ ); 
    184176} 
    185177 
    186 sub timeout 
    187 { 
     178sub timeout { 
    188179    my $c = shift; 
    189     my ($timeout, @arg); 
     180    my ( $timeout, @arg ); 
    190181 
    191182    # set a default if not configured 
    192183    my $conf = {}; 
    193     if (!exists $c->config->{alarm}) 
    194     { 
     184    if ( !exists $c->config->{alarm} ) { 
    195185        $conf->{timeout} = $LOCAL_TIMEOUT; 
    196186    } 
    197     else 
    198     { 
     187    else { 
    199188        $conf = $c->config->{alarm}; 
    200189    } 
    201190 
    202     if (ref $_[0]) 
    203     { 
     191    if ( ref $_[0] ) { 
    204192        $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 ) ) { 
    209196        my %e = @_; 
    210197        $timeout = $e{timeout} || $conf->{timeout}; 
    211         @arg = ref $e{action} ? @{$e{action}} : $e{action}; 
     198        @arg = ref $e{action} ? @{ $e{action} } : $e{action}; 
    212199 
    213200        # 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] ) { 
    216202            @arg = @_; 
    217203        } 
    218204 
    219205    } 
    220     else 
    221     { 
     206    else { 
    222207        @arg     = @_; 
    223208        $timeout = $conf->{timeout}; 
    224209    } 
    225210 
    226     if (!defined $timeout or $timeout !~ m/$ALARM_RE/) 
    227     { 
     211    if ( !defined $timeout or $timeout !~ m/$ALARM_RE/ ) { 
    228212 
    229213        # avoid spurious warning 
    230214        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 ); 
    235220    my @ret; 
    236221    $c->alarm->on(0); 
    237222 
    238223    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") }; 
    240225 
    241226    my $prev_alarm = 0; 
     
    243228    my $alarm_handler = sub { 
    244229        $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 ); 
    250236 
    251237    }; 
     
    253239    eval { 
    254240        my $h = $SIG{ALRM}; 
    255         if ($WIN32) 
    256         { 
     241        if ($WIN32) { 
    257242            $SIG{ALRM} = $alarm_handler; 
    258243        } 
    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 } ); 
    264247        } 
    265248 
    266249        #$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 after 
    271         # only 1.4.. seconds when $timeout is much greater 
    272         # 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); 
    274257        $prev_alarm = CORE::alarm($timeout); 
    275258        $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 ); 
    279262 
    280263        # NOTE that on alarm, if the default handler is used, we never 
     
    283266 
    284267        #$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 ); 
    287270 
    288271        #warn "intv = $intv\n"; 
    289272        $c->log->debug("resetting alarm after $intv seconds") 
    290           if $c->debug; 
     273            if $c->debug; 
    291274 
    292275        #Time::HiRes::alarm(0); 
     
    296279        # NOTE that because CORE alarm uses only ints that we end 
    297280        # up taking longer for global alarm than originally configed. 
    298         if ($prev_alarm > 0) 
    299         { 
     281        if ( $prev_alarm > 0 ) { 
    300282            $prev_alarm = $prev_alarm - int($intv); 
    301283            $prev_alarm = 1 if $prev_alarm <= 0; 
    302284            $c->log->debug("prev_alarm = $prev_alarm") 
    303               if $c->debug; 
     285                if $c->debug; 
    304286        } 
    305287 
    306288        CORE::alarm($prev_alarm); 
    307289 
    308         if ($WIN32) 
    309         { 
     290        if ($WIN32) { 
    310291            $SIG{ALRM} = $h; 
    311292        } 
     
    324305    # that scalar behaviour. 
    325306 
    326     return $c->alarm->on ? undef: $ret[0]; 
     307    return $c->alarm->on ? undef : $ret[0]; 
    327308} 
    328309 
     
    334315__PACKAGE__->mk_accessors( 
    335316    qw/ 
    336       timeout 
    337       start 
    338       stop 
    339       total 
    340       sig_handler 
    341       handler 
    342       failed 
    343       sounded 
    344       forward 
    345       override 
    346       on 
    347       / 
     317        timeout 
     318        start 
     319        stop 
     320        total 
     321        sig_handler 
     322        handler 
     323        failed 
     324        sounded 
     325        forward 
     326        override 
     327        on 
     328        / 
    348329); 
    349330 
    350 sub off 
    351 { 
     331sub off { 
    352332 
    353333    #Time::HiRes::alarm(0); 
  • trunk/Catalyst-Plugin-Alarm/t/01-alarm.t

    r898 r2920  
    1 package TestApp; 
    21use strict; 
    3 use warnings; 
    4  
     2use lib 't'; 
     3use Catalyst::Test 'TestApp'; 
    54use Test::More tests => 7; 
    65 
    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 
    287 
    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"); 
     8ok( get('/sleeper'),    "get /sleeper" ); 
     9ok( get('/sleeper/10'), "get /sleeper/10" ); 
     10ok( get('/foo'),        "get /foo" ); 
    10711 
    108121; 
Note: See TracChangeset for help on using the changeset viewer.