Dear monks

I am experimenting with threads on Windows and macOS for my ChatBot. I have a working example using XMPP and TK. The problem I am facing now is to "disconnect" from the XMPP server, since the function $Connection->Disconnect(); is part of the new thread and separated from my Tk UI. I have done several attempts using a shared control variable (I am new to threads and this seemed the easiest approach to stop the connection or kill the thread). I tried to use my shared variable here:

while(defined($Connection->Process())) {};
[download]

However, since  $Connection->Process() "stops" the while until a new message is received, the UI disconnects from the server after the user press the button "Disconnect" AND after a new message is received.

Any suggestions on how to run $Connection->Disconnect(); immediately after the button is pressed would be really appreciated.

#!/usr/bin/perl

use strict ;
use warnings ;

use Net::XMPP;
use Mozilla::CA       qw( );
use Tk ;
use threads ;
use threads::shared ;
use Thread::Queue ;

my $Connection;
my $queue         : shared = Thread::Queue->new ;
my $keep_running  : shared = 1 ;
my $httpdt = threads->new(\&connect_and_listen) ;
$httpdt->detach ;


my $mw = MainWindow->new ;
$mw->title("ChatBG") ;

my $etext = "" ;
my $tbox  = $mw->Scrolled("Text", -width => 80, -height => 10,-scrollb
+ars => 'se') ;
my $ebox  = $mw->Entry(-width => 70, -textvariable => \$etext) ;
$ebox->bind('<Return>',\&send_text) ;
my $bsend = $mw->Button(-text => 'Send', -command => \&send_text) ;
my $bdisconnect = $mw->Button(
    -text => 'Disconnect', 
    -command => sub {
        print "User pushed disconnect\n";
        $keep_running=0;
    }) ;
$tbox->configure(-state => 'disabled') ;
$tbox->pack(-side => 'top', -expand => 1, -fill => 'x') ;
$ebox->pack(-side => 'left', -expand => 1) ;
$bdisconnect->pack(-side => 'right', -expand => 1, -fill => 'x') ;
$bsend->pack(-side => 'right', -expand => 1, -fill => 'x') ;

$tbox->repeat(300,\&update_chat_window) ;



MainLoop ;

sub connect_and_listen{
my $server = '';
my $username = '';
my $password = '';
my $resource = '';
my $port =5222;

$Connection = new Net::XMPP::Client();

$SIG{HUP} = \&Stop;
$SIG{KILL} = \&Stop;
$SIG{TERM} = \&Stop;
$SIG{INT} = \&Stop;

$Connection->SetCallBacks(message=>\&InMessage,
                          presence=>\&InPresence,
                          iq=>\&InIQ);
 
my $status = $Connection->Connect(
    hostname=>$server,
    connectiontype => 'tcpip',
    tls => 1,
    port => 5222,
    ssl_ca_path => Mozilla::CA::SSL_ca_file(),
    );
 
if (!(defined($status)))
{
    print "ERROR:  Jabber server is down or connection was not allowed
+.\n";
    print "        ($!)\n";
    exit(0);
}
 
my @result = $Connection->AuthSend(
    hostname => $server,
    username => $username,
    password => $password);
 
if ($result[0] ne "ok")
{
    print "ERROR: Authorization failed: $result[0] - $result[1]\n";
}
 
print "Logged in to $server:$port...\n";
 
$Connection->RosterGet();

print "Getting Roster to tell server to send presence info...\n";
 
$Connection->PresenceSend();
 
print "Sending presence to tell world that we are logged in...\n";

while(defined($Connection->Process())) {};

#ATTEMPT 1
#while (1) {
#    if ($keep_running eq 0){
#        Stop();
#    }
#    else{
#        $Connection->Process();
#    }
#}

#ATTEMPT 2
#while(defined($Connection->Process())) {
#    if ($keep_running eq 0){
#        Stop();
#    }
#}

#ATTEMPT 3
#while($keep_running eq 1) {
#    $Connection->Process();
#    if ($keep_running eq 0){
#        Stop();
#    }
#}

print "ERROR: The connection was killed...\n";
}

sub update_chat_window {
  my $message = $queue->dequeue_nb ;
  return if not defined $message ;
  post_to_chat_window($message) ;
}

sub post_to_chat_window {
  my $message = shift ;
  return unless length $message ;
  $tbox->configure(-state => 'normal') ;
  $tbox->insert('end',$message) ;
  $tbox->configure(-state => 'disabled') ;
  $tbox->yviewMoveto(1.0);
}

sub Stop
{
    print "Disconnecting...\n";
    $Connection->Disconnect();
}
 
 
sub InMessage
{
    my $sid = shift;
    my $message = shift;
     
    my $type = $message->GetType();
    my $fromJID = $message->GetFrom("jid");
     
    my $from = $fromJID->GetUserID();
    my $resource = $fromJID->GetResource();
    my $subject = $message->GetSubject();
    my $body = $message->GetBody();
    print "===\n";
    print "Message ($type)\n";
    print "  From: $from ($resource)\n";
    print "  Subject: $subject\n";
    print "  Body: $body\n";
    print "===\n";
    print $message->GetXML(),"\n";
    $queue->enqueue(qq(says: $body\n)) ;
    print "===\n";
}
 
 
sub InIQ
{
    my $sid = shift;
    my $iq = shift;
     
    my $from = $iq->GetFrom();
    my $type = $iq->GetType();
    my $query = $iq->GetQuery();
    my $xmlns = $query->GetXMLNS();
    print "===\n";
    print "IQ\n";
    print "  From $from\n";
    print "  Type: $type\n";
    print "  XMLNS: $xmlns";
    print "===\n";
    print $iq->GetXML(),"\n";
    print "===\n";
}
 
sub InPresence
{
    my $sid = shift;
    my $presence = shift;
     
    my $from = $presence->GetFrom();
    my $type = $presence->GetType();
    my $status = $presence->GetStatus();
    print "===\n";
    print "Presence\n";
    print "  From $from\n";
    print "  Type: $type\n";
    print "  Status: $status\n";
    print "===\n";
    print $presence->GetXML(),"\n";
    print "===\n";
}

END{
    print "Exiting Script\n";
}
[download]