view release on metacpan or  search on metacpan

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

    @callback_calls = ();
    $bot->Process(1);
    return @callback_calls;
}

# =========================================================================
# Test 1: Personal (chat) message delivers correct parameters
# =========================================================================
{
    inject_message(
        from => "alice\@$server/desktop",
        type => 'chat',
        body => 'Hello bot!',
    );

    my @calls = process_and_collect();
    is( scalar @calls, 1, 'chat message: callback called once' );

    my $c = $calls[0];
    isa_ok( $c->{bot_object}, 'Net::Jabber::Bot', 'chat message: bot_object' );
    is( $c->{from_full}, "alice\@$server/desktop", 'chat message: from_full' );
    is( $c->{body},      'Hello bot!',             'chat message: body' );
    is( $c->{type},      'chat',                   'chat message: type' );
    is( $c->{reply_to},  "alice\@$server/desktop",
        'chat message: reply_to equals from_full (no resource stripping for chat)' );
    ok( !defined $c->{bot_address_from},
        'chat message: bot_address_from is undef for non-groupchat' );
    isa_ok( $c->{message}, 'Net::Jabber::Message', 'chat message: raw message object' );
}

# =========================================================================
# Test 2: Groupchat message with alias prefix strips it from body
# =========================================================================
{

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

}

# =========================================================================
# Test 14: Message with no handler defined logs warning but doesn't crash
# =========================================================================
{
    my $saved_handler = $bot->message_function;
    $bot->message_function(undef);

    inject_message(
        from => "alice\@$server/desktop",
        type => 'chat',
        body => 'No handler here',
    );

    # Should not die
    my @calls = process_and_collect();
    is( scalar @calls, 0, 'no handler: callback not called (no handler)' );

    $bot->message_function($saved_handler);    # restore
}

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

    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);