| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Net::OSCAR::Callbacks; |
|
2
|
|
|
|
|
|
|
BEGIN { |
|
3
|
1
|
|
|
1
|
|
24
|
$Net::OSCAR::Callbacks::VERSION = '1.928'; |
|
4
|
|
|
|
|
|
|
} |
|
5
|
1
|
|
|
1
|
|
7
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
27
|
|
|
6
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
32
|
|
|
7
|
1
|
|
|
1
|
|
5
|
use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data); |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
481
|
|
|
8
|
|
|
|
|
|
|
sub { |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
return if exists($data{exchange}); # This was a rights request |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
foreach my $room (@{$data{room}}) { |
|
13
|
|
|
|
|
|
|
# Generate a random request ID |
|
14
|
|
|
|
|
|
|
my($reqid) = ""; |
|
15
|
|
|
|
|
|
|
$reqid = pack("n", 4); |
|
16
|
|
|
|
|
|
|
$reqid .= randchars(2); |
|
17
|
|
|
|
|
|
|
($reqid) = unpack("N", $reqid); |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
$session->{chats}->{$reqid} = $room; |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
$session->svcdo(CONNTYPE_BOS, protobit => "service_request", reqid => $reqid, protodata => { |
|
22
|
|
|
|
|
|
|
type => CONNTYPE_CHAT, |
|
23
|
|
|
|
|
|
|
chat => { |
|
24
|
|
|
|
|
|
|
exchange => $room->{exchange}, |
|
25
|
|
|
|
|
|
|
url => $room->{url} |
|
26
|
|
|
|
|
|
|
} |
|
27
|
|
|
|
|
|
|
}); |
|
28
|
|
|
|
|
|
|
} |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
}; |