File Coverage

blib/lib/Net/OSCAR/Callbacks/1/rate_change.pm
Criterion Covered Total %
statement 10 10 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 14 100.0


line stmt bran cond sub pod time code
1             package Net::OSCAR::Callbacks;
2             BEGIN {
3 1     1   56 $Net::OSCAR::Callbacks::VERSION = '1.928';
4             }
5 1     1   12 use strict;
  1         2  
  1         53  
6 1     1   7 use warnings;
  1         2  
  1         58  
7 1     1   16 use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
  1         4  
  1         718  
8             sub {
9              
10             my($rate, $worrisome);
11              
12             if($session->{rate_manage_mode} != OSCAR_RATE_MANAGE_NONE) {
13             delete $data{message_type};
14              
15             my $cinfo = $connection->{rate_limits}->{$data{class_id}};
16             $cinfo->{$_} = $data{$_} foreach keys(%data);
17             }
18              
19              
20             if($data{current} <= $data{disconnect}) {
21             $rate = RATE_DISCONNECT;
22             $worrisome = 1;
23             } elsif($data{limit} && $data{current} <= $data{limit}) {
24             $rate = RATE_LIMIT;
25             $worrisome = 1;
26             } elsif($data{alert} && $data{current} <= $data{alert}) {
27             $rate = RATE_ALERT;
28             if($data{current} - $data{limit} < 500) {
29             $worrisome = 1;
30             } else {
31             $worrisome = 0;
32             }
33             } else { # We're clear
34             $rate = RATE_CLEAR;
35             $worrisome = 0;
36             }
37              
38             $session->callback_rate_alert($rate, $data{clear}, $data{window}, $worrisome, 0);
39              
40             };