Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re: Drop-In Password Dialog?

by tobyink (Abbot)
on Nov 28, 2012 at 17:17 UTC ( #1006078=note: print w/ replies, xml ) Need Help??


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

perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'


Comment on Re: Drop-In Password Dialog?
Select or Download Code
Re^2: Drop-In Password Dialog?
by ColonelPanic (Friar) on Nov 29, 2012 at 06:35 UTC
    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.


    When's the last time you used duct tape on a duct? --Larry Wall

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

      perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'

        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.



        When's the last time you used duct tape on a duct? --Larry Wall

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1006078]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (11)
As of 2014-12-17 21:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (34 votes), past polls