view release on metacpan or  search on metacpan

lib/App/PerlXLock.pm  view on Meta::CPAN

sub check_password {
    my $pw = shift;
    defined( PLOCK_PASSWORD ) && return(PLOCK_PASSWORD eq $pw);
    check_unix_password($pw) == 0;
}

sub main_loop {
    my $d = open_connection();
    lock_all($d);
    grab_keyboard( $d, 0 );
    my $locked = 1;
    while ($locked) {
        check_event($d);
        if ( $buffer[-1] && $buffer[-1] eq "\n" ) {
            pop(@buffer);
            if ( password_accessible() ) {
                for my $n ( 0 .. $#buffer ) {
                    if ( check_password( join( "", @buffer[ $n .. $#buffer ] ) ) ) {
                        $locked = 0;
                    }
                }
            }
            else {
                $locked = 0;
            }
            @buffer = ();
        }
    }
    unlock_all($d);
    ungrab_keyboard($d);
    close_connection($d);
}

sub unlock_all {