Well, I have a Tk version going if anyone is interested. I couldn't use IPC::Open3 or a PTY to run Net::FTPSSL , but threads to the rescue. I put the FTPSSL code in a thread, and get output back thru a pipe. I have a bunch of $ftps->last_message sprinkled in here, to try and grab all the debug output which is available on STDERR. If anyone knows how to get all the FTPSSL debug output from the STDERR in the thread, please enlighten me. :-)
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);
}
}
| [reply]
[d/l] |
| [reply] |
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. :-)
| [reply] |
