Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
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 perusing the Monastery: (10)
As of 2015-07-07 02:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (86 votes), past polls