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();
}