view release on metacpan or  search on metacpan

LockDisplay.pm  view on Meta::CPAN

$Tk::LockDisplay::VERSION = '1.3';

package Tk::LockDisplay;

# An xlock-like dialog that requires authentication before unlocking the display.
#
# Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center.  98/08/12
#
# This program is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.

use 5.004;
use Carp;
use Tk::Toplevel;
use strict;
use base qw/Tk::Derived Tk::Toplevel/;
Construct Tk::Widget 'LockDisplay';

sub Lock {

    # Realize the dialog, start the screensaver and snooze timer events, clear the password entry, save the current
    # focus and grab and set ours, raise the dialog and wait for the password, release our grab, clear timers, hide
    # the dialog and restore the original focus and grab.  Whew.  (Of course, no timer stuff unless we're animating.)

    my($self) = @_;
    
    my $mez = $self->{Configure}{-animation};
    unless ($mez eq 'none') {
	$self->{mid} = $self->repeat($self->{Configure}{-animationinterval} => [$self => 'mesmerize']);
	$self->{tid} = $self->after($self->{Configure}{-hide} * 1000  => [$self => 'snooze']);
    }
    $self->deiconify;
    $self->waitVisibility;
    $self->{entry}->delete(0 => 'end');
    my $old_focus = $self->focusSave;
    my $old_grab  = $self->grabSave;
    $self->{entry}->focusForce;
    $self->grab(-global);
    $self->raise;
    $self->waitVariable(\$self->{unlock});
    $self->grabRelease;
    unless ($mez eq 'none') {
	$self->afterCancel($self->{tid});
	$self->afterCancel($self->{mid});
    }
    $self->withdraw;
    &$old_focus;
    &$old_grab;

} # end Lock

sub Populate {

    # LockDisplay constructor.  These are the composite widget instance keys:
    #
    # -authenticate => authentication subroutine
    # user          => username
    # pw            => password
    # unlock        => modified when user properly authenticates
    #
    # w             => display width, pixels
    # h             => display height, pixels
    # canvas        => canvas widget reference
    # label         => label widget reference
    # entry         => entry widget reference
    #
    # tid           => -hide after() timer id
    # mid           => -animationinterval repeat() id
    #
    # plug_init     => 1 IFF plugin initialized
    # -debug        => 1 IFF <Double-1> can unlock display

    my($cw, $args) = @_;

    # Disable interactions with the window manager.