File Coverage

blib/lib/Net/OSCAR/Callbacks/19/buddylist_modification_acknowledgement.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   28 $Net::OSCAR::Callbacks::VERSION = '1.928';
4             }
5 1     1   9 use strict;
  1         2  
  1         33  
6 1     1   5 use warnings;
  1         2  
  1         38  
7 1     1   5 use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
  1         3  
  1         2817  
8             sub {
9              
10             if(!ref($session->{budmods}) || !@{$session->{budmods}}) {
11             $connection->log_print(OSCAR_DBG_WARN, "Unexpected blmod ack!");
12             return;
13             }
14             my $budmods = $session->{budmods};
15              
16             $connection->log_print(OSCAR_DBG_DEBUG, "Got blmod ack (", scalar(@$budmods), " left).");
17             my(@errors) = @{$data{error}};
18              
19             my @reqdata = @$reqdata;
20             foreach my $error(reverse @errors) {
21             my($errdata) = shift @reqdata;
22             last unless $errdata;
23             if($error != 0) {
24             $session->{buderrors} = 1;
25             my($type, $gid, $bid) = ($errdata->{type}, $errdata->{gid}, $errdata->{bid});
26             if(exists($session->{blold}->{$type}) and exists($session->{blold}->{$type}->{$gid}) and exists($session->{blold}->{$type}->{$gid}->{$bid})) {
27             $session->{blinternal}->{$type}->{$gid}->{$bid} = $session->{blold}->{$type}->{$gid}->{$bid};
28             } else {
29             delete $session->{blinternal}->{$type} unless exists($session->{blold}->{$type});
30             delete $session->{blinternal}->{$type}->{$gid} unless exists($session->{blold}->{$type}) and exists($session->{blold}->{$type}->{$gid});
31             delete $session->{blinternal}->{$type}->{$gid}->{$bid} unless exists($session->{blold}->{$type}) and exists($session->{blold}->{$type}->{$gid}) and exists($session->{blold}->{$type}->{$gid}->{$bid});
32             }
33              
34             $connection->proto_send(%{pop @$budmods}); # Stop making changes
35             delete $session->{budmods};
36             $session->callback_buddylist_error($error, $errdata->{desc});
37             last;
38             }
39             }
40              
41             if($session->{buderrors}) {
42             Net::OSCAR::_BLInternal::BLI_to_NO($session) if $session->{buderrors};
43             delete $session->{qw(blold buderrors budmods)};
44             } else {
45             if(@$budmods) {
46             $connection->proto_send(%{shift @$budmods});
47             }
48              
49             if(!@$budmods) {
50             delete $session->{budmods};
51             $session->callback_buddylist_ok;
52             }
53             }
54              
55             };