view release on metacpan or  search on metacpan

t/07-test_presence_and_iq.t  view on Meta::CPAN

    like( $client->{last_version_send}->{os}, qr/^Perl v/, "OS string starts with 'Perl v'" );
};

# ─── IQ: non-version query is ignored ─────────────────────────

subtest 'IQ with non-version xmlns does not send version' => sub {
    delete $client->{last_version_send};

    my $iq = Net::Jabber::IQ->new();
    $iq->SetFrom('other@example.com');
    $iq->SetType('get');

    # Use a different namespace
    my $query = $iq->NewQuery('jabber:iq:roster');

    $iq_cb->($session_id, $iq);

    ok( !defined $client->{last_version_send}, "VersionSend NOT called for non-version query" );
};

# ─── IQ: no query element ─────────────────────────────────────

subtest 'IQ without query element does not crash' => sub {
    delete $client->{last_version_send};

    my $iq = Net::Jabber::IQ->new();
    $iq->SetFrom('bare@example.com');
    $iq->SetType('result');
    # No query added

    eval { $iq_cb->($session_id, $iq) };
    ok( !$@, "IQ with no query does not crash" );
    ok( !defined $client->{last_version_send}, "VersionSend NOT called when no query" );
};

# ─── IQ: version response contains valid Perl version ─────────

subtest 'IQ version response has well-formatted Perl version' => sub {
    delete $client->{last_version_send};

    my $iq = Net::Jabber::IQ->new();
    $iq->SetFrom('checker@example.com');
    $iq->SetType('get');
    $iq->NewQuery('jabber:iq:version');

    $iq_cb->($session_id, $iq);

    my $os = $client->{last_version_send}->{os};
    # Perl version should be formatted like "Perl v5.X.Y" (not raw like "Perl v5.042000")
    like( $os, qr/^Perl v\d+\.\d+/, "OS contains formatted Perl version" );
    unlike( $os, qr/\d{6}/, "Perl version does not contain raw 6-digit minor version" );
};

# ═══════════════════════════════════════════════════════════════
# Integration: Presence feeds into GetStatus
# ═══════════════════════════════════════════════════════════════

subtest 'presence updates are visible via GetStatus' => sub {
    # Send an "available" presence
    my $presence = Net::Jabber::Presence->new();
    $presence->SetFrom('statustest@example.com/desktop');
    $presence->SetPriority(1);

    $presence_cb->($session_id, $presence);

    my $status = $bot->GetStatus('statustest@example.com/desktop');
    is( $status, 'available', "GetStatus returns available for presence with no show" );

    # Now send an "away" presence
    my $away = Net::Jabber::Presence->new();
    $away->SetFrom('statustest@example.com/desktop');
    $away->SetShow('away');
    $away->SetPriority(1);

    $presence_cb->($session_id, $away);

    $status = $bot->GetStatus('statustest@example.com/desktop');
    is( $status, 'away', "GetStatus reflects updated show value" );
};

# ═══════════════════════════════════════════════════════════════
# Integration: auto_subscribe toggle at runtime
# ═══════════════════════════════════════════════════════════════

subtest 'auto_subscribe can be toggled at runtime' => sub {
    # Start with auto_subscribe on
    $bot->auto_subscribe(1);
    @{$client->{subscription_log}} = ();

    my $p1 = Net::Jabber::Presence->new();
    $p1->SetFrom('toggle1@example.com');
    $p1->SetType('subscribe');
    $presence_cb->($session_id, $p1);

    is( scalar @{$client->{subscription_log}}, 2, "auto_subscribe on: 2 calls" );

    # Turn it off
    $bot->auto_subscribe(0);
    @{$client->{subscription_log}} = ();

    my $p2 = Net::Jabber::Presence->new();
    $p2->SetFrom('toggle2@example.com');
    $p2->SetType('subscribe');
    $presence_cb->($session_id, $p2);

    is( scalar @{$client->{subscription_log}}, 0, "auto_subscribe off: 0 calls" );

    # Turn it back on
    $bot->auto_subscribe(1);
    @{$client->{subscription_log}} = ();

    my $p3 = Net::Jabber::Presence->new();
    $p3->SetFrom('toggle3@example.com');
    $p3->SetType('subscribe');
    $presence_cb->($session_id, $p3);

    is( scalar @{$client->{subscription_log}}, 2, "auto_subscribe back on: 2 calls" );
};

done_testing();