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