Tk-LockDisplay

 view release on metacpan or  search on metacpan

LockDisplay.pm  view on Meta::CPAN

    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.
    
    $cw->withdraw;
    $cw->protocol('WM_DELETE_WINDOW' => sub {});
    $cw->overrideredirect(1);

    # Process arguments.

    my $user;
    if (not $user = getlogin) {
        if ($^O eq 'MSWin32') {
            $user = $^O;
        } else {
            die "Can't get user name." if not $user = getpwuid($<);
        }
    }
    $cw->{user} = $user;
    $cw->{-authenticate} = delete $args->{-authenticate};
    die "-authenticate callback is improper or missing." unless ref($cw->{-authenticate}) eq 'CODE';
    $cw->{-debug} = delete $args->{-debug};
    $cw->{-debug} ||= 0;
    $args->{-animation} ||= 'lines';
    $cw->SUPER::Populate($args);
    
    # Miscellaneous constants.

    my($w, $h) = ($cw->screenwidth, $cw->screenheight);
    $cw->{w} = $w;
    $cw->{h} = $h;
    my $ti = "tklock $Tk::LockDisplay::VERSION";

    # The canvas/label/entry, et.al.
    
    my $mez = $args->{-animation};
    my $pw;
    $cw->{pw} = \$pw;
    my $canvas = $cw->Canvas;
    $cw->{canvas} = $canvas;
    my $frame = $canvas->Frame;
    my $l = $frame->Label(-text => $ti, -font => 'fixed')->grid;
    $cw->{label} = $l;
    my $e = $frame->Entry(-textvariable => \$pw, -show => '*', -width => 10)->grid;
    $cw->{entry} = $e;

    if ($mez eq 'none') {
	$cw->geometry('+' . int($w/2) . '+' . int($h/2));
	$canvas->createWindow(64, 24, -window => $frame);
	$canvas->configure(-width => 126, -height => 47);
    } else {
	$canvas->configure(-width => $w, -height => $h);
	$canvas->createWindow($w/2, $h/2, -window => $frame);
    }
    $canvas->grid;

    # Composite widget parameter definitions.

    $cw->ConfigSpecs(
		     -animation         => [qw/PASSIVE animation Animation lines/],
		     -animationinterval => [qw/PASSIVE animationInterval AnimationInterval 200/],
		     -background        => [$canvas, qw/background Background black/],
		     -foreground        => [$l, qw/ foreground Foreground blue/],
		     -hide              => [qw/PASSIVE hide Hide 10/],
		     -text              => [qw/METHOD text Text/, $ti],
		     );

    $cw->{tid} = undef;		# timer ID
    $cw->{mid} = undef;		# mesmerizer ID
    $cw->{unlock} = 1;		# unlock flag
    $cw->{plug_init} = 0;	# 0 until plugin initialized

    # Widget bindings.

    $cw->bind('<Motion>'   => [\&awake, $cw]);
    $cw->bind('<Any-Key>'  => [\&awake, $cw]);

LockDisplay.pm  view on Meta::CPAN


=over 4

=item C<$lock-E<gt>B<Lock>;>

This method locks the display and waits for the user's authentication data.

=back

=head1 EXAMPLE

I<$lock> = I<$mw>-E<gt>B<LockDisplay>(-authenticate =E<gt> \&check_pw);

sub check_pw {

    # Perform AFS validation unless on Win32.

    my($user, $pw) = @_;

    if ($^O eq 'MSWin32') {
	($pw eq $^O) ? exit(0) : return(0);
    } else {
	system "/usr/afsws/bin/klog $user " . quotemeta($pw) . " 2> /dev/null";
	($? == 0) ? exit(0) : return(0);
    }

} # end check_pw

=head1 PLUGIN FORMAT

Refer to the "counter" plugin file .../Tk/LockDisplay/counter.pm for
details on the structure of a LockDisplay animation plugin.  Basically,
you create a ".pm" file that describes your plugin, "counter.pm" for
instance.  This file must contain a subroutine called Animate($canvas),
where $canvas is the canvas widget reference passed to it.

LockDisplay first require()s your plugin file, and, if that succeeds,
calls it once to perform initialization.  Animate() should return 0 for
failure, 1 for success, and > 1 for success I<and> to specifiy a private
-animationinterval (in milliseconds).  Subsequent calls to Animate() are
for its "main loop" processing.  As before, the return code should be
0 or 1 for failure or success, respectively.

=head1 HISTORY

=over 4

=item Version 1.0

    Beta Release.

=item Version 1.1

    . Implement plugins and other fixes suggested by Achim Bohnet.
      Thanks!
    . Allow plugin name 'none' to disable screensaver.  Thanks to
      Roderick Anderson!

=item Version 1.2

    . getlogin() fails on HPUX, so try getpwuid() as a fallback.
      Thanks to Paul Schinder for the CPAN-Testers bug report.
    . Plugins can return() their own -animationinterval value 
      during preset.
    . Add 'neko' plugin.

=item Version 1.3

    . Fix value of pi in neko plugin!
    . Add Windows 95 support

=back

=head1 AUTHOR

Stephen.O.Lidie@Lehigh.EDU

=head1 COPYRIGHT

Copyright (C) 1998 - 1998, Stephen O. Lidie.

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 KEYWORDS

screeensaver, dialog, modal

=cut



( run in 1.530 second using v1.01-cache-2.11-cpan-39bf76dae61 )