Re: Drop-In Password Dialog?

[tobyink]

in reply to Drop-In Password Dialog?

I can't find any... which is a shame as it seems quite a useful sort of thing to do. Here's a quick stab at a module that can prompt the user for basic information such as passwords, text entry, file selection, etc.

It provides two backends - one for STDIN/STDOUT, and one that uses the Gnome tool Zenity to provide GUI prompts. The choice of which backend is made automatically.

use 5.010;

{
    package Ask;
    use Carp qw(croak);
    use File::Which qw(which);
    
    sub new {
        if (-t STDIN and -t STDOUT) {
            return "Ask::STDIO"->new;
        }
        if (my $zenity = which('zenity')) {
            return "Ask::Zenity"->new(zenity => $zenity);
        }
        croak "Could not establish an appropriate Ask backend";
    }
}

{
    package Ask::API;
    use Moo::Role;
    
    requires 'entry';     # get a string of text
    requires 'info';      # display a string of text
    
    sub warning {
        my ($self, %o) = @_;
        $o{text} = "WARNING: $o{text}";
        return $self->info(%o);
    }

    sub error {
        my ($self, %o) = @_;
        $o{text} = "ERROR: $o{text}";
        return $self->info(%o);
    }

    sub question {
        my ($self, %o) = @_;
        
        $o{cancel} //= qr{^(no|n|cancel)$}i;
        
        my $response = $self->entry(text => $o{text});
        return !!1 if $response ~~ $o{ok};
        return !!0 if $response ~~ $o{cancel};
        return !!1;
    }
    
    sub file_selection {
        my ($self, %o) = @_;
        
        if ($o{multiple}) {
            $self->info(text => $o{text} // 'Enter file names (blank t
+o finish)');
            my @filenames;
            while (my $f = $self->entry) {
                push @filenames, $f;
            }
            return @filenames;
        }
        else {
            return $self->entry(text => ($o{text} // 'Enter file name'
+));
        }
    }
}

{
    package Ask::STDIO;
    
    use Moo;
    use namespace::sweep;
    
    with 'Ask::API';
    
    sub entry {
        my ($self, %o) = @_;
        $self->info(text => $o{text}) if exists $o{text};
        my $line;
        
        if ($o{hide_text}) {
            require Term::ReadKey;
            Term::ReadKey::ReadMode('noecho');
            chomp( $line = <STDIN> );
            Term::ReadKey::ReadMode(0);
        }
        else {
            chomp( $line = <STDIN> );
        }
        
        return $line;
    }

    sub info {
        my ($self, %o) = @_;
        say STDOUT $o{text};
    }

    sub warning {
        my ($self, %o) = @_;
        say STDERR "WARNING: $o{text}";
    }

    sub error {
        my ($self, %o) = @_;
        say STDERR "ERROR: $o{text}";
    }
}

{
    package Ask::Zenity;
    
    use Moo;
    use aliased 'System::Command';
    use namespace::sweep;
    
    has zenity_path => (
        is       => 'ro',
        isa      => sub { die "$_[0] not executable" unless -x $_[0] }
+,
        default  => sub { '/usr/bin/zenity' },
    );
    
    with 'Ask::API';
    
    sub _optionize {
        my $opt = shift;
        $opt =~ s/_/-/g;
        return "--$opt";
    }
    
    sub _zenity {
        my ($self, $cmd, %o) = @_;
        my $zen = Command->new(
            $self->zenity_path,
            _optionize($cmd),
            map sprintf('%s=%s', _optionize($_), $o{$_}), keys %o,
        );
        # warn join q[ ], $zen->cmdline;
        return $zen;
    }
    
    sub entry {
        my $self = shift;
        my $text = readline($self->_zenity(entry => @_)->stdout);
        chomp $text;
        return $text;
    }

    sub info {
        my $self = shift;
        $self->_zenity(info => @_);
    }

    sub warning {
        my $self = shift;
        $self->_zenity(warning => @_);
    }

    sub error {
        my $self = shift;
        $self->_zenity(error => @_);
    }

    sub question {
        my $self = shift;
        my $zen  = $self->_zenity(error => @_);
        $zen->close;
        return not $zen->exit;
    }
    
    sub file_selection {
        my $self = shift;
        my $text = readline($self->_zenity(file_selection => @_)->stdo
+ut);
        chomp $text;
        return split m#[|]#, $text;
    }
}

# Usage...
my $ask = Ask->new;
say "GOT: ", $ask->entry(text => "Please enter your password!", hide_t
+ext => 1);

Anyone fancy implementing Tk or Wx backends?

Update: now on Bitbucket and GitHub

[ColonelPanic]

Thanks for putting so much work into this. It looks like a great module concept. I look forward to trying this out when I get back to work.

[tobyink]

A developer release is on CPAN now... Ask-0.000_01.

[ColonelPanic]

I appreciate your hard work on this, even creating a module on CPAN, great! For now, I have gone with zentara's solution, because it uses Tk, which is more of a standard tool.

Perhaps I will find some time to convert that into a Tk implementation for your module.