Net-XMPP

 view release on metacpan or  search on metacpan

t/gtalk.t  view on Meta::CPAN

        );

        SKIP: {
            skip 'Needs Test::Memory::Cycle', 1 if not $memory_cycle; 
            memory_cycle_ok($conn[$i], 'after calling Connect');
        }

        SKIP: {
            skip "need GTALK$i = username:password", 1 if not $users[$i];

            my ( $res, $msg ) = $conn[$i]->AuthSend(
                username => $users[$i]{username},
                password => $users[$i]{password},
                resource => 'notify v1.0',
            );
            is $res, 'ok', 'result is ok';
            if (not defined $res or $res ne 'ok') {
               diag $!;
            }

            $conn[$i]->SetCallBacks(
                message => \&on_message,
                presence => \&on_presence,
                receive  => \&on_receive,
            );
            $conn[$i]->PresenceSend();
        }
    }

    for my $i (0..5) {
        my $status = $conn[$i % 2]->Process(1);
        die if not defined $status;
    }
    # receive presence message
    # send and receive messages

    return print_size('after calling Run');
}

sub print_size {
    my ($msg) = @_;
    return 0 if not -x '/bin/ps';
    my @lines = grep { /^$$\s/ } qx{/bin/ps -e -o pid,rss,command};
    chomp @lines;
    my $RSS;
    foreach my $line (@lines) {
        my ($pid, $rss) = split /\s+/, $line;
        diag "RSS: $rss   - $msg";
        $RSS = $rss;
    }
    return $RSS;
}

sub on_presence {
    my ($sid, $presence) = @_;
    my $to = $presence->GetTo;
    my $from = $presence->GetFrom;
    my $type = $presence->GetType || 'available';
    my $status = $presence->GetStatus || '';

    ($to)   = split m{/}, $to;
    ($from) = split m{/}, $from;

    diag "$to - $from - $type - $status";
}

sub on_receive {
    # called on every message received
}

sub on_message {
    my ($message) = @_;
    my $type     = $message->GetType;
    my $fromJID  = $message->fromJID('jid');
    my $from     = $message->GetUserID;
    my $resource = $message->GetResource;
    my $subject  = $message->GetSubject;
    my $body     = $message->GetBody;
    my $xml      = $message->GetXML;

    diag "$from - $body";
}



( run in 1.408 second using v1.01-cache-2.11-cpan-71847e10f99 )