If you want to see the full dubug connection output, run this from a xterm, and watch the debug out put in the xterm.

A Tk version:

#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
use IO::Pipe;

my $com:shared = '';
my $go:shared = 0;
my $die:shared = 0;
my $val = 0;

my $pipe = IO::Pipe->new();

#create thread before any tk code is called
my $thr = threads->create( \&worker,$pipe );

# call reader after $pipe is connected to thread
my $rh = $pipe->reader();

use Tk;

my $mw = MainWindow->new();
$mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit }); 

$mw->fontCreate('big',
    -weight=>'bold',
    -size=> 24
   );

$mw->fontCreate('medium',
    -weight=>'bold',
    -size=> 16
   );

my $log = $mw->Scrolled('Text',
              -bg =>'black',
              -fg=> 'yellow',
              -font => 'medium',
              -scrollbars=>'osoe',
              )->pack(-expand=>1,-fill=>'both');

$log->tagConfigure( 'skyblue',   -foreground => 'skyblue' );

$log -> Subwidget("yscrollbar")->configure(
               -background => '#dd5555', 
               -activebackground => '#ff8888',
               -troughcolor => '#eeeeff',
           );


my $ent = $mw->Entry(-bg=>'white', 
          -font => 'big')->pack(-expand=>1, -fill=>'x');

$mw->bind('<Any-Enter>' => sub { $ent->Tk::focus });
$ent->bind('<Return>' => \&send_command );


my $button2 = $mw->Button(
         -text => 'Exit',
     -command => \&clean_exit,
      
     )->pack();


$mw->fileevent($rh, readable => sub { 

                my $line = <$rh>;
                
                               
                if ($line =~ m/Doing ftpssl command:/){
                   $log->insert('end', $line, 'skyblue' );           
                 }else{
                   $log->insert('end', $line);           
                 }
                
                $log->see('end');
                      
        } );


MainLoop;

sub clean_exit{

 my @running_threads = threads->list;
 if (scalar(@running_threads) < 1){print "\nFinished\n";exit}
   else{
     $die = 1;
     $thr->join;
     exit;
  }
}

sub send_command{
    
    #prevent a race condition with setting $go:shared
    if( $go == 1){ 
       $log->insert('end',"Please wait for previous command to finish\
+n", 'red');
       }else{

       my $text = $ent->get;
       $ent->delete(qw/0 end/);
       $com = $text;
       $go = 1;  
            }
}


# no Tk code in thread
sub worker {

 my($pipe) = @_;

 my $wh = $pipe->writer;
 $wh->autoflush(1);

 use Net::FTPSSL;
 my $server = "127.0.0.1";
 my $username = "someuser";
 my $passwd = "somepass";
 my @ret;

  @ret = my $ftps = Net::FTPSSL->new($server,
                            Encryption => EXP_CRYPT,
                            Debug => 1,
                       #     Croak => 1,
                         )
     or die "Can't open $server\n$Net::FTPSSL::ERRSTR";

print "####################\n";
print $wh  join "\n", @ret,"\n";
print "####################\n";
print $wh $ftps->last_message, "\n";

 @ret = $ftps->login($username, $passwd)
       or error("Credential error, $ftps->last_message");

print "####################\n";
print $wh join "\n", @ret,"\n";
print "####################\n";
print $wh $ftps->last_message, "\n";
 
 # get default listing and pwd 
 
   @ret = $ftps->list()
        or error("Command error, $ftps->last_message");

print "####################\n";
print  $wh  join "\n", @ret,"\n";
print "####################\n";
print $wh $ftps->last_message, "\n";

# get default pwd
@ret = $ftps->pwd
    or error("Command error, $ftps->last_message");

print "####################\n";
print  $wh join "\n", @ret,"\n";
print "####################\n";
print $wh $ftps->last_message, "\n";

while(1){
       if($die){return}

         if($go){ 

         print $wh "\n\nDoing ftpssl command: $com\n\n";
   
         my @ret =  eval "\$ftps->$com";
            if($@) { 
                   print $wh "Unknown command: error: $com:  @_\n";
           
               }else{
               
                 foreach my $line( @ret){
                  print $wh "$line\n";
                 }
                 print $wh $ftps->last_message, "\n";
              }
                      
              print $wh "\n";

          $go = 0; #turn self off before sleeping
        }
 
   select(undef,undef,undef,.01);
    }
 }
[download]

You don't lock any of the shared variables; race conditions make for nasty bugs. Any reason not to use Thread::Queue?

Good criticisms. I don't use Thread::Queue because I like to keep full control over my thread .... A queue seems to be an added abstraction layer, although if you know a way to make it easily work in my Tk code, feel free to post it.

I think I will make the input entry insensitive, so that $go and $com pose no threat.

I'm trying to figure out Git, so I can make a repository, for these apps. Everyone sees a way to improve it. :-)

---

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh