use strict; use warnings; use Tk; use Tk::DialogBox; use Tk::LabEntry; use prj::cfile; package prj::login; sub new { my $this = shift; my $thisref = ref($this) || $this; my $self; $self->{'parent'} = $_[0]; $self->{'username'} = ""; $self->{'password'} = ""; # create Login-Dialog $self->{'window'} = $self->{'parent'}->DialogBox(-title =>'Login', -default_button => 'OK', -buttons => ['OK', 'Abbrechen'] ); $self->{window}->add('LabEntry', -textvariable => \$self->{'username'}, -width => 20, label => 'Benutzer')->pack(-side =>"top"); $self->{window}->add('LabEntry', -textvariable => \$self->{'password'}, -width => 20, label => 'Passwort', -show =>'*')->pack(-side =>"top"); bless ($self, $thisref); return $self; } sub getpass { my $self = shift; my @heads = ('id', 'name', 'pass', 'grants', 'local', 'server'); my $userdb = prj::cfile->new(@heads, 'dat\\users.dat'); my $result = $self->{'window'}->Show(); $self->{'window'}->bind("", sub{$result = 'OK';}); $self->{'window'}->bind("", sub{print "abbruch!\n"; $result = 'Abbrechen';}); if ('OK' eq $result) { my %find = ( 'name' => $self->{'username'}, 'pass' => $self->{'password'}); my @datarray = @{$userdb->get(\%find)}; my %data = %{$datarray[0]}; if (@datarray == 1) { return \%data; } } return 0; } return 1;