Thread Perl/Tk mit Menü-Widget eine Passwortabfrage??? (4 answers)
Opened by renee at 2005-09-13 14:27

renee
 2005-09-15 17:25
#44607 #44607
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Mein Vorschlag:
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
package My::UserPassword;

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 => '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;


Im Skript dann:
Code: (dl )
1
2
3
my $passwordwidget = My::UserPassword->new($manwindow,%args);
my ($user,$passwd) = $passwordwidget->Show();
print "User:\t\t$user\nPassword:\t$passwd\n";
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/

View full thread Perl/Tk mit Menü-Widget eine Passwortabfrage???