Hi all. I have been searching for about 4 months to build a program that: 1) hides the desktop 2) shows a login ID/password input 3) checks/saves to a MySQL DB that is already running. 4) display a timer count down & 4) logs the user off

The idea is to limit usage on public access computers. I came close using TK but when it came time to push the data to the database server, the ID/PW seems to have vanished.

#!/usr/local/bin/perl
use strict;
use warnings;
use Config;    # ?
use Tk;
use Tkx;
use Tk::LabFrame;
use Tk::Checkbox;
use Tk::NumEntry;
use Tk::NumEntryPlain;
use Tk::DialogBox;
use Tie::Watch;
require Tk::Menu::Item;

our $VERSION = "3.2";
# Perl2exe <- compile perl script

my $Machine =  $ENV{'COMPUTERNAME'};
my $check = 0;
use vars qw/ $FONT $BOLD_FONT $LARGE_FONT $MONOSPACE_FONT $FONT_SMALL 
+$XFT $ClientID $id $ID $PW $FName /;
use vars qw/ $proposed $changes $current $index $type /;
require ('b:\\Perl\\sbin\\settings.pl');

my $tm=30; # read from database how long to allow setting $tm=xx then 
+the above line with '.$tm.' where it says 30 min

my $mw = MainWindow->new;
$mw->title( 'Welcome to the GRACE Network');
$mw->iconname('widget');
my $DEFAULT_FONT_FAMILY = $XFT ? "sans-serif" : "Helvetica";
my $FONT                = "$DEFAULT_FONT_FAMILY 12";
my $FONT_SMALL            = "$DEFAULT_FONT_FAMILY 8";
my $SMALL_BOLD            = "$DEFAULT_FONT_FAMILY 10 bold";
my $BOLD_FONT            = "$DEFAULT_FONT_FAMILY 12 bold";
my $LARGE_FONT            = "$DEFAULT_FONT_FAMILY 18";
my $MONOSPACE_FONT        = "Courier 12";
my $l                     = $mw->Label;
my $default_font         = $l->cget(-font);
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # # # # # # # # # # # # # # # # # # # # # # Start
my $tl = $mw->Toplevel(
    -background        =>'#000000',
    -title            =>'Desktop'
);
$tl->FullScreen(1);                # Main window used to hide desktop 
+- Found the screen res & set bigger
                                # Possibly put ICONs on the 'Desktop' 
+and keep hiding the windows desktop
my $logo = $mw->Label(
    -image       => $mw->Photo(-file => Tk->findINC('logo.gif')),
    -borderwidth => 1,
    -relief      => 'sunken',
)->pack;
$mw->Label(-text => 'Welcome to the GRACE Network using computer: '.$M
+achine,
    -height            =>5,
    -width            =>200,
    -font            =>$MONOSPACE_FONT,
    -borderwidth        =>2
)->pack;
$mw->Label(-text => '
1. Do not adjust any settings: Anyone caught doing so will receive a v
+iolation.
2. Identification must be provided: (HMIS Number)
3. Volume levels will be kept at a reasonable level:
    If staff asks you to turn it down, do so or use your headphones. T
+wo warnings in one day equals a violation.
4. Sign in\'s are for '.$tm.' minute sessions:
    When your time is up, you may stay on until someone else arrives t
+o use their time.
5. Arguing with the staff or volunteer on duty will result in a violat
+ion.
6. Be gentle with the computers, keyboards and mice:
    Two warnings in one day will result in a violation.
',
    -height            =>10,
    -width            =>500,
    -background        =>'#ffffff',
    -justify        =>'left',
    -font            =>$SMALL_BOLD,
    -borderwidth        =>1
)->pack;
my $top = $mw->LabFrame(
    CenterWindow($mw, 1150, 750),        # Sign in Frame needs to clos
+e and timer box needs to move to bottom left corner of screen
    -background        =>'#00ff00',
    -font            =>'#ffffff',
    -foreground        =>'#000000',
    -label            =>'                              HIMS ID #      
+              Password                    First Name                 
+   Read Rules
                                                                 (Opti
+onal)
',
    -font            =>$FONT_SMALL,
    -borderwidth    =>0
)->pack(-fill => 'both');
my $id = $top->Label(-text=>'HMIS ID#')->pack(-side=>'left');
my $fn = $top->Label(-text=>'First Name')->pack(-side=>'left');
my $pw = $top->Label(-text=>'Password')->pack(-side=>'left');
my $cb1 = $top->Label(-text=>'Rules')->pack(-side=>'left');
my @trxtype = keys %$id;
$id = $top->NumEntryPlain(
    -font            =>$FONT,
    -validatecommand    => sub {
        my ($proposed, $changes, $current, $index, $type) = @_;
            return not $proposed =~ m/[^\d]/g;
        },
    -width            =>20,
    -bell            =>1,
    -textvariable    =>$ID
)->pack;
$id->configure(
    -invalidcommand =>
     [\&entry_flash, $id, $id->cget(-fg), $id->cget(-bg)],
);
$pw = $top->Entry(
    -font            =>$FONT,
    -width            =>20,
    -textvariable    =>$PW
)->pack;
$fn = $top->Entry(
    -font            =>$FONT,
    -width            =>20,
    -textvariable    =>$FName
)->pack;
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # CheckBox
# my $cb1  = $mw->Checkbox->grid(-row => 0, -column => 0, -sticky => '
+nw');
$cb1 = $top->Checkbox (
    -variable        =>\$check,
#    -command        =>\&test_check,
    -onvalue        =>1,
    -offvalue        =>0,
    #-noinitialcallback    =>'1',
    -size            =>'15'
)->pack;

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# # # # 
my $GstBtn = $top->Button(
    -text            =>' Guest Log In ',
    -command        =>\&AddItemNew
#     -font            =>$font
)->pack(
    -side => 'left',
    -padx => 10,
    -pady => 10
);
my $AdmnBtn = $top->Button(
    -text            =>' Admin Log In ',
    -command        =>\&Cleanup
#     -font            =>$font
)->pack(
    -side => 'right',
    -padx => 10,
    -pady => 10
);

$mw->Label(-text => 'Version: '.$VERSION)->pack(-side => 'bottom');
$mw->focus;                    # Ensure we're talking to the main wind
+ow
MainLoop;
# --------------------------------------------------------------------
+---------- Subs
# --------------------------------------------------------------------
+---------- Subs
# --------------------------------------------------------------------
+---------- Subs
sub Cleanup {
    $mw->destroy;
}

        # Log off computer guest account so admin can login
        # Win32::AdminMisc::ExitWindows(EWX_LOGOFF | EWX_FORCE)
print    "\tid=$id\n";
print    "\tpw=$pw\n";
print    "\tfn=$fn\n";
print    "\tcb1=$cb1\n\n";

print    "\tID=$ID\n";
print    "\tPW=$PW\n";
print    "\tFName=$FName\n";
print    "\tcheck=$check\n\n";


sub test_check {
    if ($check == 0) {
        print "\t\nMust check to verify user read the rules\n";
#         Make pop up telling user they must read rules and check
    }else{
        print "\t\nLog to DB they have read the rules: $check\n";
    }
}
sub entry3_flash {
    my ($w, $fg, $bg) = @_;
    $w->focusForce;
    $w->{count} = 9 unless defined $w->{count};
    if ($w->{count} < 1) {
        $w->configure(-foreground => $fg, -background => $bg);
        $w->{count} = 9;
    } else {
        if ($w->{count} % 2) {
            $w->configure(-foreground => $bg, -background => $fg);
        } else {
            $w->configure(-foreground => $fg, -background => $bg);
        }
        $w->{count}--;
        $w->after(200 => [\&entry3_flash, $w, $fg, $bg]);
    }
} # end entry3_flash
sub CenterWindow {
    my($window, $width, $height) = @_;
    $window->idletasks;
    $width = $window->reqwidth unless $width;
    $height = $window->reqheight unless $height;
    my $x = int(($window->screenwidth / 2) - ($width / 2));
    my $y = int(($window->screenheight / 2) - ($height / 2));
    $window->geometry("=${width}x${height}+${x}+${y}");
}
[download]