Commits

Toby Inkster committed 5bddc54

initial commit

  • Participants

Comments (0)

Files changed (20)

+use inc::Module::Package 'RDF:tobyink 0.009';
+

File examples/extending.pl

+use 5.010;
+use strict;
+use warnings;
+use Ask;
+
+{
+	package AskX::Method::Password;
+	use Moo::Role;
+	sub password {
+		my ($self, %o) = @_;
+		$o{hide_text} //= 1;
+		$o{text}      //= "please enter your password";
+		$self->entry(%o);
+	}
+}
+
+my $ask = Ask->detect(traits => ['AskX::Method::Password']);
+say "GOT: ", $ask->password;

File examples/synopsis.pl

+use 5.010;
+use Ask;
+
+my $ask = Ask->detect;
+if ($ask->question(text => "Are you happy?")
+and $ask->question(text => "Do you know it?")
+and $ask->question(text => "Really want to show it?")) {
+	$ask->info(text => "Then clap your hands!");
+}
+use 5.010;
+use strict;
+use warnings;
+
+{
+	package Ask;
+	
+	our $AUTHORITY = 'cpan:TOBYINK';
+	our $VERSION   = '0.001';
+	
+	use Carp qw(croak);
+	use File::Which qw(which);
+	use Moo::Role qw();
+	use Module::Runtime qw(use_module use_package_optimistically);
+	use namespace::sweep 0.006;
+	
+	sub detect {
+		my $class  = shift;
+		my %args   = @_==1 ? %{$_[0]} : @_;
+		
+		my $instance_class = $class->_detect_class_with_traits(\%args)
+			or croak "Could not establish an appropriate Ask backend";
+		
+		return $instance_class->new(\%args);
+	}
+	
+	my %_classes;
+	sub _detect_class_with_traits {
+		my ($class, $args) = @_;
+		my @traits = @{ delete($args->{traits}) // [] };
+		
+		my $instance_class = $class->_detect_class($args);
+		return unless defined $instance_class;
+		return $instance_class unless @traits;
+		
+		# Cache class
+		my $key = join q(|), $instance_class, sort @traits;
+		$_classes{$key} //= "Moo::Role"->create_class_with_roles(
+			$instance_class,
+			@traits,
+		);
+	}
+	
+	sub _detect_class {
+		my ($class, $args) = @_;
+		
+		if (exists $args->{class}) {
+			return use_package_optimistically(delete $args->{class});
+		}
+		
+		if (-t STDIN and -t STDOUT) {
+			return use_module("Ask::STDIO");
+		}
+		
+		if (my $zenity = which('zenity')) {
+			$args->{zenity} //= $zenity;
+			return use_module("Ask::Zenity");
+		}
+		
+		return;
+	}
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Ask - ask your users about stuff
+
+=head1 SYNOPSIS
+
+	use 5.010;
+	use Ask;
+	
+	my $ask = Ask->detect;
+	
+	if ($ask->question(text => "Are you happy?")
+	and $ask->question(text => "Do you know it?")
+	and $ask->question(text => "Really want to show it?")) {
+		$ask->info(text => "Then clap your hands!");
+	}
+
+=head1 DESCRIPTION
+
+The C<Ask> suite is a set of modules for interacting with users; prompting
+them for information, displaying messages, warnings and errors, etc.
+
+There are already countless CPAN modules for doing this sort of thing, but
+what sets C<Ask> apart from them is that C<Ask> will detect how your script
+is being run (in a terminal, headless, etc) and choose an appropriate way
+to interact with the user.
+
+=head2 Class Method
+
+=over
+
+=item C<< Ask->detect(%arguments) >>
+
+A constructor, sort of. It inspects the program's environment and returns an
+object that implements the Ask API (see below).
+
+Note that these objects don't usually inherit from C<Ask>, so the following
+will typically be false:
+
+	my $ask = Ask->detect(%arguments);
+	$ask->isa("Ask");
+
+Instead, check:
+
+	my $ask = Ask->detect(%arguments);
+	$ask->DOES("Ask::API");
+
+=back
+
+=head2 The Ask API
+
+Objects returned by the C<detect> method implement the Ask API. This
+section documents that API.
+
+The following methods are provided by objects implementing the Ask
+API. They are largely modeled on the interface for GNOME Zenity.
+
+=over
+
+=item C<< info(text => $text, %arguments) >>
+
+Display a message to the user.
+
+Setting the argument C<no_wrap> to true can be used to I<hint> that line
+wrapping should be avoided.
+
+=item C<< warning(text => $text, %arguments) >>
+
+Display a warning to the user.
+
+Supports the same arguments as C<info>.
+
+=item C<< error(text => $text, %arguments) >>
+
+Display an error message (not necessarily fatal) to the user.
+
+Supports the same arguments as C<info>.
+
+=item C<< entry(%arguments) >>
+
+Ask the user to enter some text. Returns that text.
+
+The C<text> argument is supported as a way of communicating what you'd like
+them to enter. The C<hide_text> argument can be set to true to I<hint> that
+the text entered should not be displayed on screen (e.g. password input).
+
+=item C<< question(text => $text, %arguments) >>
+
+Ask the user to answer a affirmative/negative question (i.e. OK/cancel,
+yes/no) defaulting to affirmative. Returns boolean.
+
+The C<text> argument is the text of the question; the C<ok_label> argument
+can be used to set the label for the affirmative button; the C<cancel_label>
+argument for the negative button.
+
+=item C<< file_selection(%arguments) >>
+
+Ask the user for a file name. Returns the file name. No checks are made to
+ensure the file exists.
+
+The C<multiple> argument can be used to indicate that multiple files may be
+selected (they are returned as a list); the C<directory> argument can be
+used to I<hint> that you want a directory.
+
+=back
+
+If you wish to create your own implementation of the Ask API, please
+read L<Ask::API> for more information.
+
+=head2 Extending Ask
+
+Implementing L<Ask::API> allows you to extend Ask to other environments.
+
+To add extra methods to the Ask API you may use Moo roles:
+
+	{
+		package AskX::Method::Password;
+		use Moo::Role;
+		sub password {
+			my ($self, %o) = @_;
+			$o{hide_text} //= 1;
+			$o{text}      //= "please enter your password";
+			$self->entry(%o);
+		}
+	}
+
+	my $ask = Ask->detect(traits => ['AskX::Method::Password']);
+	say "GOT: ", $ask->password;
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Ask>.
+
+=head1 SEE ALSO
+
+See L<Ask::API> for documentation of API internals.
+
+Bundled API implementations are L<Ask::STDIO> and L<Ask::Zenity>.
+
+Similar modules: L<IO::Prompt>, L<IO::Prompt::Tiny> and many others.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

File lib/Ask/API.pm

+use 5.010;
+use strict;
+use warnings;
+
+{
+	package Ask::API;
+	
+	our $AUTHORITY = 'cpan:TOBYINK';
+	our $VERSION   = '0.001';
+	
+	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 to finish)');
+			my @filenames;
+			while (my $f = $self->entry) {
+				push @filenames, $f;
+			}
+			return @filenames;
+		}
+		else {
+			return $self->entry(text => ($o{text} // 'Enter file name'));
+		}
+	}
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Ask::API - an API to ask users things
+
+=head1 SYNOPSIS
+
+	{
+		package Ask::AwesomeWidgets;
+		use Moo;
+		with 'Ask::API';
+		sub info {
+			my ($self, %arguments) = @_;
+			...
+		}
+		sub entry {
+			my ($self, %arguments) = @_;
+			...
+		}
+	}
+
+=head1 DESCRIPTION
+
+C<Ask::API> is a L<Moo> role. This means that you can write your
+implementation as either a Moo or Moose class.
+
+The only two methods that you absolutely must implement are C<info> and
+C<entry>.
+
+C<Ask::API> provides default implementations of C<warning>, C<error>,
+C<question> and C<file_selection> methods, but they're not espcially
+good, so you probably want to implement them too.
+
+There is not currently any mechanism to "register" your implementation
+with L<Ask> so that C<< Ask->detect >> knows about it.
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Ask>.
+
+=head1 SEE ALSO
+
+L<Ask>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

File lib/Ask/STDIO.pm

+use 5.010;
+use strict;
+use warnings;
+
+{
+	package Ask::STDIO;
+	
+	our $AUTHORITY = 'cpan:TOBYINK';
+	our $VERSION   = '0.001';
+	
+	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}";
+	}
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Ask::STDIO - use STDIN/STDOUT/STDERR to interact with a user
+
+=head1 SYNOPSIS
+
+	my $ask = Ask::STDIO->new;
+	
+	$ask->info(text => "I'm Charles Xavier");
+	if ($ask->question(text => "Would you like some breakfast?")) {
+		...
+	}
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Ask>.
+
+=head1 SEE ALSO
+
+L<Ask>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

File lib/Ask/Zenity.pm

+use 5.010;
+use strict;
+use warnings;
+
+{
+	package Ask::Zenity;
+	
+	our $AUTHORITY = 'cpan:TOBYINK';
+	our $VERSION   = '0.001';
+	
+	use Moo;
+	use System::Command;
+	use namespace::sweep;
+	
+	has zenity_path => (
+		is       => 'ro',
+		isa      => sub { die "$_[0] not executable" unless -x $_[0] },
+		default  => sub { '/usr/bin/zenity' },
+	);
+	
+	has system_wrapper => (
+		is       => 'ro',
+		default  => sub { 'System::Command' },
+	);
+	
+	with 'Ask::API';
+	
+	sub _optionize {
+		my $opt = shift;
+		$opt =~ s/_/-/g;
+		return "--$opt";
+	}
+	
+	sub _zenity {
+		my ($self, $cmd, %o) = @_;
+		my $zen = $self->system_wrapper->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 => @_)->stdout);
+		chomp $text;
+		return split m#[|]#, $text;
+	}
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Ask::Zenity - use C<< /usr/bin/zenity >> to interact with a user
+
+=head1 SYNOPSIS
+
+	my $ask = Ask::Zenity->new(
+		zenity_path => '/usr/bin/zenity',
+	);
+	
+	$ask->info(text => "I'm Charles Xavier");
+	if ($ask->question(text => "Would you like some breakfast?")) {
+		...
+	}
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Ask>.
+
+=head1 SEE ALSO
+
+L<Ask>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

File meta/changes.pret

+# This file acts as the project's changelog.
+
+`Ask 0.001 cpan:TOBYINK`
+	issued  2012-11-28;
+	label   "Initial release".
+

File meta/doap.pret

+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`Ask`
+	:programming-language "Perl" ;
+	:shortdesc            "ask your users about stuff";
+	:homepage             <https://metacpan.org/release/Ask>;
+	:download-page        <https://metacpan.org/release/Ask>;
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=Ask>;
+	:repository           [ a :HgRepository; :browse <https://bitbucket.org/tobyink/Ask> ];
+	:created              2012-11-28;
+	:license              <http://dev.perl.org/licenses/>;
+	:maintainer           cpan:TOBYINK;
+	:developer            cpan:TOBYINK.
+
+<http://dev.perl.org/licenses/>
+	dc:title  "the same terms as the perl 5 programming language system itself".
+

File meta/makefile.pret

+# This file provides instructions for packaging.
+
+`Ask`
+	perl_version_from m`Ask`;
+	version_from      m`Ask`;
+	readme_from       m`Ask`;
+	test_requires     p`Test::More 0.61`;
+	requires          p`File::Which`;
+	requires          p`Module::Runtime`;
+	requires          p`Moo`;
+	requires          p`namespace::sweep`;
+	requires          p`System::Command`;
+.
+

File meta/people.pret

+# This file contains data about the project developers.
+
+@prefix : <http://xmlns.com/foaf/0.1/>.
+
+cpan:TOBYINK
+	:name  "Toby Inkster";
+	:mbox  <mailto:tobyink@cpan.org>.
+
+use Test::More tests => 1;
+BEGIN { use_ok('Ask') };
+
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

File xt/02pod_coverage.config

+{"skip_all":"doesn't cope well with role-based programming"}

File xt/02pod_coverage.t

+use XT::Util;
+use Test::More;
+use Test::Pod::Coverage;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pod_coverage_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pod_coverage_ok();
+}
+

File xt/03meta_uptodate.config

+{"package":"Ask"}
+

File xt/03meta_uptodate.t

+use XT::Util;
+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok(__CONFIG__->{package}, __CONFIG__->{version_from});
+
+use Test::EOL;
+all_perl_files_ok();
+use Test::Tabs;
+all_perl_files_ok();

File xt/06versions.t

+use XT::Util;
+use Test::More;
+use Test::HasVersion;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pm_version_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pm_version_ok();
+}
+