There is no problem with DialogBox, an it allows you to make up really complex dialogs.

I attached a piece of code here, and it is a big chunk, but it is some real code I am using. It is highly OO'd. I believe that it shows you most of the things you want and how to deliver them in Tk.

package OpenRemoteFile;

use VisitedHosts;
use Net::FTP;
use Tk::DialogBox;
use File::Temp qw/:POSIX/;
use IO::Socket::INET;

use Hash::Util (lock_keys);

use strict;
use warnings;


sub new {
    my $self = {};
    shift;
    $self->{PARENT_WIDGET} = shift;
    $self->{HOST} = undef;
    $self->{USER} = undef;
    $self->{PASSWD} = undef;
    $self->{VISITED_HOSTS} = new VisitedHosts;
    $self->{DIRECTORY} = undef;
    $self->{FILE} = undef;
    $self->{CURRENT_FTP_SESSION} = undef;
    $self->{DATA} = [];
    $self->{DEBUG} = 1;
    bless($self);
    return $self;
}

sub Show {
    my $self = shift;
    $self->{HOST} = undef;
    $self->{FILE} = undef;
    $self->clean();
    $self->{CURRENT_FTP_SESSION} = undef;
    my $continueinue = 1;

    $continueinue = $self->host_dialog();
    if ($continueinue) {
        $continueinue = $self->login_dialog();
    }
        
    if ($continueinue) {
        $continueinue = $self->file_dialog();
    }
    return $continueinue;
}

sub host_dialog {
    my $self = shift;
    my $continueinue = 1;
    my $host_first_try = 1;

    while (1) {
        my $host_dialog = $self->{PARENT_WIDGET}->DialogBox(-buttons =
+> ["OK", "Cancel"],
                                                            -title => 
+"Open Remote File");
        my $instruction;
        if ($host_first_try) {
            $instruction = "Please specify host name: ";
            $host_first_try = 0;
        } else {
            $instruction = "Failed to connect, please try again: "
        }

        $host_dialog->add("Label",
                          anchor => "w",
                          text => $instruction)
                    ->pack(fill => "x");
        my $host_text = $host_dialog->add("Entry",
                                          width => 30)
                                    ->pack();
        my $host_list = $host_dialog->add("Listbox", 
                                           height => 5)
                                    ->pack(fill => "x");
        $host_list->bind("<Double-Button-1>", 
                         sub {
                              my $sel_index = $host_list->curselection
+();
                              if (defined($sel_index)) {
                                  $host_text->delete("1.0", "end");
                                  $host_text->insert("end", $host_list
+->get($sel_index));
                              }
                             });
        my @visited_hosts = sort $self->{VISITED_HOSTS}->all_visited()
+;
        foreach (@visited_hosts) {
            $host_list->insert("end", $_);
        }
        $host_text->focus();
        if ($host_dialog->Show() eq "OK") {
            $self->{HOST} = $host_text->get();
            last if ($self->{CURRENT_FTP_SESSION} = new Net::FTP($self
+->{HOST}));
        } else {
            $continueinue = 0;
            last;
        }
    }
    return $continueinue;
}

sub login_dialog {
    my $self = shift;

    my $continueinue = 1;
    my $login_first_try = 1;    
    my $visited;
    my $id;
    my $passwd;

    if ($visited = $self->{VISITED_HOSTS}->visited($self->{HOST})) {
        $id = $visited->userid();
        $passwd = $visited->passwd();
        $self->{CURRENT_FTP_SESSION}->login($id, $passwd);
    } else {
        while (1) {
            my $dialog = $main::self->{MAIN_WINDOW}
                                    ->DialogBox(-buttons => ["OK", "Ca
+ncel"],
                                                -title => "Login");
            my $instruction;
            if ($login_first_try) {
                $instruction = "Please provide id/passwd: ";
                $login_first_try = 0;
            } else {
                $instruction = "Failed to login, please try again: "
            }

            $dialog->add("Label",
                              anchor => "w",
                              text => $instruction)
                        ->pack(fill => "x");
            my $id_text = $dialog->add("Entry",
                                              width => 30)
                                        ->pack();
            my $passwd_text = $dialog->add("Entry",
                                           show => "*",
                                           width => 30)
                                     ->pack();
            $id_text->focus();
            if ($dialog->Show() eq "OK") {
                $id = $id_text->get();
                $passwd = $passwd_text->get();
                if ($self->{CURRENT_FTP_SESSION}->login($id, $passwd))
+ {
                    $self->{DIRECTORY} = $self->{CURRENT_FTP_SESSION}-
+>pwd();
                    if (!$visited) {
                        $self->{VISITED_HOSTS}->add($self->{HOST}, $id
+, $passwd);
                        $self->{USER} = $id;
                        $self->{PASSWD} = $passwd;
                    }
                    last;
                }
            } else {
                $continueinue = 0;
                last;
            }
        }
    }

    return $continueinue;
}

sub file_dialog {
    my $self = shift;
    my $dialog = $self->{PARENT_WIDGET}
                      ->DialogBox(-buttons => ["OK", "Cancel"],
                                  -title => "Open File");
    $dialog->add("Label",
                 anchor => "w",
                 text => "Host: $self->{HOST}")
           ->pack(fill => "x");
    my $label = $dialog->add("Label",
                             anchor => "w",
                             textvariable => \$self->{DIRECTORY})
                       ->pack(fill => "x"); 
    my $file_list = $dialog->add("Scrolled",
                                 "Listbox",
                                 -scrollbars => "e", 
                                 height => 10,
                                 width => 40)
                           ->pack(fill => "x");
    $file_list->bind("<Double-Button-1>", 
                     sub {
                          $self->display_file_list($file_list, $label)
+;
                         });
    $label->configure("text", $self->{CURRENT_FTP_SESSION}->pwd());
    $self->update_file_list($file_list);
    my $sel_file;
    if ($dialog->Show() eq "OK") {
        my $sel_index = $file_list->curselection();
print "\nsel_index = $sel_index\n";
        if (defined($sel_index)) {
            $self->{FILE} = $file_list->get($sel_index);
print $self->{FILE};
        }
        if (defined($self->{FILE})) {
            $self->open_remote();
        }
    } 
    $self->{CURRENT_FTP_SESSION}->quit();
}

sub update_file_list {
    my ($self, $file_list) = @_;
    my @files = sort($self->{CURRENT_FTP_SESSION}->ls());
    $file_list->delete(0, "end");
    $file_list->insert("end", "..");
    for my $name (@files) {
        $file_list->insert("end", $name);
    }
}

sub display_file_list {
    my ($self, $file_list, $label) = @_;

    my $sel_index = $file_list->curselection();
    if (defined($sel_index)) {
        my $sel = $file_list->get($sel_index);
        if ($self->{CURRENT_FTP_SESSION}->cwd($sel)) {
            $self->update_file_list($file_list);
            $self->{DIRECTORY} = $self->{CURRENT_FTP_SESSION}->pwd();
        } else {
            $self->{FILE} = $sel;
            $self->{CURRENT_FTP_SESSION}->get($self->{FILE});
        }
    } 
}    

sub host {
    my $self = shift;
    return $self->{HOST};
}

sub directory {
    my $self = shift;
    return $self->{DIRECTORY};
}

sub tmp_file {
    my $self = shift;
    return $self->{FILE};
}

sub clean {
    my $self = shift;
    if (defined($self->{TMP_FILE})) {
        unlink($self->{TMP_FILE});
        $self->{TMP_FILE} = undef;
    }
}

sub data {
    my $self = shift;
    return $self->{DATA};
}

sub open_remote {

    my $self = shift;

    my $ftp = new Net::FTP($self->{HOST}, Debug => 1);
    $ftp->login("peip", "930612jg");
    $ftp->cwd($self->{DIRECTORY});
    my $data;
    open(LOCALFILE, ">", "abc") || die "failed";
    print LOCALFILE "abcd1234";
    print "==$self->{FILE}==\n";
    $ftp->get($self->{FILE}, \*LOCALFILE);
    $ftp->quit();
    close(LOCALFILE);
    print $data;
    @{$self->{DATA}} = split(/\n/, $data);
=document
    my $continue = 1;
    
    my $ftp = new IO::Socket::INET(Proto => "tcp", 
                                   PeerAddr => $self->{HOST}, 
                                   PeerPort => 21, 
                                   Timeout => 60, 
                                   Reuse => 1);
    if (!$ftp) {
        $continue = 0;
        print "Failed to new control socket\n" if ($self->{DEBUG});
    }

    if ($continue) {
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        $continue = 0 if ($response !~ /^220/);
    }

    if ($continue) {
        print $ftp "USER $self->{USER}\r\n";
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        $continue = 0 if ($response !~ /^331/);
    }

    if ($continue) {
        print $ftp "PASS $self->{PASSWD}\r\n";
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        $continue = 0 if ($response !~ /^230/);
    }

    if ($continue) {
        print $ftp "CWD $self->{DIRECTORY}\r\n";
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        $continue = 0 if ($response !~ /^250/);
    }

    my $data_l;
    my $data;
    if ($continue) {
        $data_l = new IO::Socket::INET(Proto => "tcp", 
                                       LocalPort => $ftp->sockport(), 
                                       Listen => 1, 
                                       Timeout => 60, 
                                       Reuse => 1);
        if (!$data_l) {
            $continue = 0;
            print "Failed to new data socket\n" if ($self->{DEBUG});
        }
    }

    if ($continue) {
        print $ftp "RETR $self->{FILE}\r\n";
        $data = $data_l->accept();
        close($data_l);
        if (!$data) {
            print "failed to accept data connection\n" if ($self->{DEB
+UG});
            $continue = 0;
        } else {
            my $response = <$ftp>;
            print $response if ($self->{DEBUG});
            @{$self->{DATA}} = <$data>;
            close($data);
            $response = <$ftp>;
            print $response if ($self->{DEBUG});
        }
    }

    if ($ftp) {
        print $ftp "QUIT\r\n";
        my $response = <$ftp>;
        print $response if ($self->{DEBUG});
        close($ftp);
    }
=cut
}

1;
[download]

Thanks pg thats just what I needed to see. I think I got those problems sorted
but I'm after uncovering new problems. I'm trying to

• Set the encryption key using get_key() whether its envoked by new_cipher() or just the Set Encryption Key button in the main window. And store this key so new_cipher() doesn't ask for a new key, the only way to change it would be to click on the Set Encryption Key button in the main window.

This doesn't seem to want to work new_cipher() doesn't envoke get_key() at all. And when new_cipher is run it returns an error of invalid key.(From the DES module) although the key has been created correctly(as far as I can see.) The $key is created at the start of the script and is accessible to all functions.(i.e. its public) in each of the functions I use $newkey  #(a new private var) for creating and setting the key.

See the functions new_cipher() and get_key() below.

sub new_cipher
{
 my $newkey = get_key() if ($key eq "");
 
 my $cipher = Crypt::CBC->new( {'key'             => "$newkey",
                                'cipher'          => 'DES',
                                'iv'              => '$KJh#(}q',
                                'regenerate_key'  => 0,   # default tr
+ue
                                'padding'         => 'space',
                                'prepend_iv'      => 0
                                });
 return $cipher;
}

sub get_key
{
 my $getkeybox = $mw->DialogBox(-title=>"Set Encryption Key",
                                -buttons=>["Ok", "Cancel"]
                                );

 $getkeybox->add('Label',
                 -anchor  => 'w',
                 -justify => 'left',
                 -text    => qq(Please enter your Encryption Key))->pa
+ck(qw/-side top -anchor w/);

 my $keybox = $getkeybox->add('Entry',
                             -takefocus => '1',
                             -textvariable => "$key",
                             )->pack(qw/-side top -fill both -expand 1
+ -anchor w/);

 my $button = $getkeybox->Show();

 my $newkey = pack("H16", $keybox->get) unless $button eq "Cancel";

 $key = $newkey;

 return $newkey;

}
[download]





The error I get is:


Tk::Error: Can't locate object method "TIEHANDLE" via package "" at cbc.pl line
162.


I get this error by clicking straight on the Encryption button which calls new_cipher() before get_key()!!
I'm pretty puzzled. And would apprieciate any help you could give.


All the Best, Eoin...

If everything seems to be going well, you obviously don't know what the hell is going on.

##################UPDATE################

The problems above have been fixed here
use strict;
use warnings;

use Tk 800.000;
use Tk::Frame;
use Tk::TextUndo;
use Tk::Menu;
use Tk::Menubutton;
use Tk::DialogBox;

use Crypt::CBC;
use Crypt::DES;

my $key;

my $mw = new MainWindow;
$mw->geometry('800x600');

my $menu = $mw->Menu(-menuitems => &menubar_menuitems() );
$mw->configure(-menu => $menu);

my $tpfrme = $mw->Frame;
my $mdfrme = $mw->Frame(-height => '50');
my $bmfrme = $mw->Frame;

my($text1)         = $tpfrme->Scrolled('TextUndo',
                                       -height => '1',
                                       -width => '1',
                                       -scrollbars => 'osoe',
                                      );

my $encrypt_button = $mdfrme->Button(-text=>"Encrypt",
                                     -height=>'1',
                                     -command=>[\&OnEncrypt]
                                     );

my $get_key_button = $mdfrme->Button(-text=>"Set Encryption Key",
                                     -height=>'1',
                                     -command=>[\&get_key]
                                     );

my $decrypt_button = $mdfrme->Button(-text=>"Decrypt",
                                     -height=>'1',
                                     -command=>[\&OnDecrypt]
                                     );

my($text2)         = $bmfrme->Scrolled('TextUndo',
                                      -height => '1',
                                      -width => '1',
                                      -scrollbars => 'osoe',
                                      );



$mw->bind('Tk::TextUndo', '<Control-Key-o>',
      sub { OnFileLoad(); }
      );

$mw->bind('Tk::TextUndo', '<Control-Key-s>',
      sub { OnFileSave(); }
      );

$mw->bind('<Control-Key-q>',
      sub { OnExit(); }
      );

$mw->bind('Tk::TextUndo', '<Control-Key-e>',
      sub { OnEncrypt(); }
      );

$mw->bind('Tk::TextUndo', '<Control-Key-d>',
      sub { OnDecrypt(); }
      );

$mw->bind('<Control-Key-a>',
      sub { OnAbout(); }
      );



$tpfrme        ->pack(qw/-side top    -fill both -expand 1            
+   /);
$mdfrme        ->pack(qw/-side top    -fill both -expand 0            
+   /);
$bmfrme        ->pack(qw/-side bottom -fill both -expand 1            
+   /);
$text1         ->pack(qw/-side top    -fill both -expand 1            
+   /);
$encrypt_button->pack(qw/-side left                                   
+   /);
$decrypt_button->pack(qw/-side right                                  
+   /);
$get_key_button->pack(qw/                                             
+   /);
$text2         ->pack(qw/-side top    -fill both -expand 1            
+   /);

MainLoop;

sub menubar_menuitems{
 return
 [ map
   ['cascade', $_->[0], -tearoff=> 0,
    -menuitems => $_->[1]],

   ['~File',    &file_menuitems()   ],
   ['~Actions', &actions_menuitems()],
   ['~Help',    &help_menuitems()   ],
 ];
}

sub file_menuitems
{
 return
     [
     [qw/command ~Open  -accelerator Ctrl-o/,
      -command=>[\&OnFileLoad]],
     [qw/command ~Save  -accelerator Ctrl-s/,
      -command=>[\&OnFileSave]],
     '',
     [qw/command ~Exit  -accelerator Ctrl-q/,
      -command=>[\&OnExit]]
     ];
}



sub actions_menuitems
{
 return
     [
     [qw/command ~Encrypt  -accelerator Ctrl-e/,
      -command=>[\&OnEncrypt]],
     [qw/command ~Decrypt  -accelerator Ctrl-d/,
      -command=>[\&OnDecrypt]],
     ];
}


sub help_menuitems
{
 return
     [
     [qw/command ~About -accelerator Ctrl-a/,
      -command=>[\&OnAbout]
     ]
     ];
}

sub OnFileLoad
{
 $text1->FileLoadPopup();
}

sub OnFileSave
{
 $text2->FileSaveAsPopup();
}

sub OnExit
{
 exit 0;
}

sub OnEncrypt
{
 my $text           = $text1->get(0.1, 'end')   ;
 my $encrypted_data = encrypt_string($text)     ;
 my $widget         = $text2->Subwidget("text") ;
 tie *STDOUT, ref $widget, $widget;
 print $encrypted_data;
}

sub OnDecrypt
{
 my $text           = $text1->get(0.1, 'end')   ;
 my $decrypted_data = decrypt_string($text)     ;
 my $widget         = $text2->Subwidget("text") ;
 tie *STDOUT, ref $widget, $widget;
 print $decrypted_data;
}

sub encrypt_string
{
 my $cipher      = new_cipher()             ;
 my $string      = shift                    ;
 my $encryp_data = $cipher->encrypt($string);
 $cipher         = ""                       ;
 return $encryp_data                        ;
}

sub decrypt_string
{
 my $cipher      = new_cipher()             ;
 my $string      = shift                    ;
 my $decryp_data = $cipher->decrypt($string);
 $cipher         = ""                       ;
 return $decryp_data                        ;
}

sub new_cipher
{
 my $usedkey;
 if(defined $key)
 {
  $usedkey = $key;
 }
 elsif(undef $key)
 {
  $key = get_key();
  $usedkey = $key;
 }
 else
 {
 return $key
 }


 my $cipher = Crypt::CBC->new( {'key'             => "$usedkey",
                                'cipher'          => 'DES',
                                'iv'              => '$KJh#(}q',
                                'regenerate_key'  => 0,   # default tr
+ue
                                'padding'         => 'space',
                                'prepend_iv'      => 0
                                });
 return $cipher;
}

sub get_key
{
 my $getkeybox = $mw->DialogBox(-title=>"Set Encryption Key",
                                -buttons=>["Ok", "Cancel"]
                                );
 $getkeybox->add('Label',
                 -anchor  => 'w',
                 -justify => 'left',
                 -text    => qq(Please enter your Encryption Key))->pa
+ck(qw/-side top -anchor w/);
 my $keybox = $getkeybox->add('Entry',
                             -takefocus => '1',
                             -textvariable => "$key",
                             )->pack(qw/-side top -fill both -expand 1
+ -anchor w/);
 my $button = $getkeybox->Show();
 $key = pack("H16", $keybox->get) unless $button eq "Cancel";
 print $key;
 if($button eq "Cancel"){
                if(defined $key)
                {
                 return $key
                }
                elsif(undef $key)
                {
                 return $key
                }
               }
 return $key;

}
[download]
Thanks for the help pg.

Eoin.