File Coverage

blib/lib/Net/OSCAR/Callbacks/1/service_redirect_response.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

package Net::OSCAR::Callbacks;
BEGIN {
  $Net::OSCAR::Callbacks::VERSION = '1.928';
}
use strict;
use warnings;
use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
sub {

my $conntype;
my %chatdata;

my $svctype = $data{service_type};

my $svcmap = tlv();
$svcmap->{$_} = $_ foreach (CONNTYPE_LOGIN, CONNTYPE_CHATNAV, CONNTYPE_CHAT, CONNTYPE_ADMIN, CONNTYPE_BOS, CONNTYPE_ICON);
$conntype = $svcmap->{$svctype} || sprintf("unknown (0x%04X)", $svctype);
if($svctype == CONNTYPE_CHAT) {
	%chatdata = %{$session->{chats}->{$reqid}};
	$conntype = "chat $chatdata{name}";
}

$connection->log_print(OSCAR_DBG_NOTICE, "Got redirect for $svctype.");

my $newconn = $session->addconn(auth => $data{auth_cookie}, conntype => $svctype, description => $conntype, peer => $data{server_ip});
if($svctype == CONNTYPE_CHAT) {
	$session->{chats}->{$reqid} = $newconn;
	my($key, $val);
	while(($key, $val) = each(%chatdata)) { $session->{chats}->{$reqid}->{$key} = $val; }
}

};