@array = subr();
foreach(@array){print $_};

sub subr{
    my $mw = new MainWindow;
    my $frame = $mw -> Frame() -> pack();
    my $ok_but = $frame -> Button(-text=>"Ok", -command =>\&subr2) -> pack();
    MainLoop;
    
    sub subr2{
        @array = (1, 2, 3);
        $mw -> destroy();
        return @array;
    }
}

#!/usr/bin/perl
use strict;
use warnings;
use Tk;

my @array = subr();
foreach (@array){print $_};

sub subr{
    my $mw = tkinit();
    my @array;
    my $frame = $mw -> Frame() -> pack();
    my $ok_but = $frame -> Button(-text=>"Ok", -command => sub{@array = subr2($mw);}) -> pack();
    MainLoop;
    return @array;
    
    sub subr2{
        my $mw = shift;
        my @array = (1, 2, 3);
        $mw -> destroy();
        return @array;
    }
}

@angaben = anmeldeFenster();
foreach(@angaben){print $_};

sub anmeldeFenster {
    my $mw = new MainWindow;
    my $image = $mw->Photo(-file=>"d:/logo.gif");
    $mw->iconimage($image);
    my $frame = $mw -> Frame() -> pack();
    my $user_lab = $frame -> Label(-text=>"Benutzer: ")-> pack();
    my $ben_feld = $frame -> Entry() ->pack(); 
    my $pass_lab = $frame -> Label(-text=>"Passwort: ") -> pack();
    my $pass_feld = $frame -> Entry(-show=>'*') -> pack();
    $pass_feld->bind('<Return>',  \&ok_button);
    my $ok_but = $frame -> Button(-text=>"Ok", -command =>\&ok_button) -> pack();
    MainLoop;

    sub ok_button{
        $benutzer = $ben_feld -> get();
        $passwort = $pass_feld -> get();
        @angaben = ($benutzer, $passwort);
        
        $mw -> destroy();
        
        return @angaben;
    }
    
}

package Tk::UserPassword;

#
#  Copyright (c) 2005 Renee Baecker (module@renee-baecker.de)
#

use 5.006001;
use strict;
use warnings;
use Carp;

require Tk;
require Tk::Toplevel;
require Exporter;

our @ISA     = qw(Exporter);
our $VERSION = '0.01';
our @list    = ();

sub Show{
  my ($self) = @_;
  my $cw = $self->{cw};
  $cw->Popup();
  $cw->waitVariable(\$cw->{Selected});
  $cw->withdraw;
  $cw->{Selected} = [""] unless(defined $cw->{Selected});
  return wantarray ? @{$cw->{Selected}} : join("; ",@{$cw->{Selected}});
}# Show

sub Accept{
  my ($cw) = @_;
  my $user = $cw->Subwidget('user_frame')->Subwidget('user')->get();
  my $pass = $cw->Subwidget('password_frame')->Subwidget('password')->get();
  $cw->{Selected} = [$user,$pass];
  $cw->{Selected} = [""] unless($user || $pass);
}# Accept

sub Cancel{
  my ($cw) = @_;
  $cw->{Selected} = undef;
  $cw->withdraw;
}#Cancel

sub new{
  my ($class,$cw,%args) = @_;
  my $self = {};
  bless($self,$class);
  
  my $top = $cw->Toplevel(%args);
  $top->protocol('WM_DELETE_WINDOW' => [\&Cancel, $top]);
  
  # User Frame  
  my $entry_var = '';
  my $user_frm = $top->Component('Frame' => 'user_frame')->pack(-expand => 1, -fill => 'both');
  $user_frm->Label(-text => 'User: ')->pack(-anchor => 'w', 
               
               
              -side&
nbsp;  => 'left',);
  $user_frm->Component('Entry'       => 'user',
               
        -textvariable => \$entry_var,
               
       )->pack(-anchor => 'e',
               
               
-side   => 'right',);
  
  # Password Frame  
  my $password_var = '';
  my $pass_frm = $top->Component('Frame' => 'password_frame')->pack(-expand => 1, -fill => 'both');
  $pass_frm->Label(-text => 'Password: ')->pack(-anchor => 'w', 
               
               
               
   -side   => 'left',);
  $pass_frm->Component('Entry'       => 'password',
               
        -textvariable => \$password_var,
               
        -show         => '*',
               
       )->pack(-anchor => 'e',
               
               
-side   => 'right',);
  
  # ok-Button
  $top->Button(-text => 'ok', -command => [\&Accept,$top])->pack();
  
  $self->{cw} = $top;
  return $self;
}# Populate

1;

#!/usr/bin/perl

use strict;
use warnings;

my $mw = tkinit();
# der andere Tk-Kram
MainLoop;

sub irgendein_callback{
    my $up = Tk::UserPassword->new;
    my ($user,$pass) = $up->Show();
}

+ skript.pl
+ perllib
     + Tk
         + UserPassword.pm

#!/usr/bin/perl

use strict;
use warnings;
use Tk;
use lib qw(./perllib);
use Tk::UserPassword;

my $mw = tkinit();
# der andere Tk-Kram
$mw->Button( -command => \&irgendein_callback, -text => 'Klick mich' )->pack;
MainLoop;

sub irgendein_callback{
    my $up = Tk::UserPassword->new($mw);
    my ($user,$pass) = $up->Show();
    print $user, " :: ", $pass;
}

my $up = Tk::UserPassword->new();
my ($user,$pass) = $up->Show();