package App::Raps2::UI; use strict; use warnings; use 5.010; use Carp qw(confess); use POSIX; use Term::ReadLine; our $VERSION = '0.2'; =head1 NAME App::Raps2::UI - App::Raps2 User Interface =head1 SYNOPSIS my $ui = App::Raps2::UI->new(); my $input = $ui->read_line('Say something'); my $password = $ui->read_pw('New password', 1); $ui->to_clipboard('stuff!'); =head1 VERSION This manual documents B version 0.2 =head1 METHODS =over =item $ui = App::Raps2::UI->new() Returns a new App::Raps2::UI object. =cut sub new { my ($obj) = @_; my $ref = {}; $ref->{term_readline} = Term::ReadLine->new('App::Raps2'); return bless($ref, $obj); } =item $ui->list(I<\@item1>, I<\@item2>, I<\@item3>) Print the list items neatly formatted to stdout. Each I looks like B<[> I, I B<]>. When B is called for the first time, it will print the keys as well as the values. =cut sub list { my ($self, @list) = @_; my $format = "%-20s %-20s %s\n"; if (not $self->{list}->{header}) { printf($format, map { $_->[0] } @list); $self->{list}->{header} = 1; } printf($format, map { $_->[1] // q{} } @list); } =item $ui->read_line(I<$question>, [I<$prefill>]) Print "I: " to stdout and wait for the user to input text followed by a newline. I sets the default content of the answer field. Returns the user's reply, excluding the newline. =cut sub read_line { my ($self, $str, $pre) = @_; my $input = $self->{term_readline}->readline("${str}: ", $pre); return $input; } =item $ui->read_multiline(I<$message>) Like B, but repeats I each time the user hits return. Input is terminated by EOF (Ctrl+D). Returns a string concatenation of all lines (including newlines). =cut sub read_multiline { my ($self, $str) = @_; my $in; say "${str} (^D to quit)"; while (my $line = $self->read_line('multiline')) { $in .= "${line}\n"; } return $in; } =item $ui->read_pw(I<$message>, I<$verify>) Prompt the user for a password. I is displayed, the user's input is noch echoed. If I is set, the user has to enter the same input twice, otherwise B dies. Returns the input. =cut sub read_pw { my ($self, $str, $verify) = @_; my ($in1, $in2); my $term = POSIX::Termios->new(); $term->getattr(0); $term->setlflag($term->getlflag() & ~POSIX::ECHO); $term->setattr(0, POSIX::TCSANOW); print "${str}: "; $in1 = readline(STDIN); print "\n"; if ($verify) { print 'Verify: '; $in2 = readline(STDIN); print "\n"; } $term->setlflag($term->getlflag() | POSIX::ECHO); $term->setattr(0, POSIX::TCSANOW); if ($verify and $in1 ne $in2) { confess('Input lines did not match'); } chomp $in1; return $in1; } =item $ui->to_clipboard(I<$string>) Place I in the primary X Clipboard. =cut sub to_clipboard { my ($self, $str) = @_; open(my $clipboard, '|-', 'xclip -l 1'); print $clipboard $str; close($clipboard); return; } =item $ui->output(I<\@pair>, I<...>) I consinsts of B<[> I, I B<]>. For each I, prints " key : value" to stdout. =cut sub output { my ($self, @out) = @_; for my $pair (@out) { printf( "%-8s : %s\n", $pair->[0], $pair->[1] // q{}, ); } return; } 1; __END__ =back =head1 DEPENDENCIES This module requires B and the B executable. =head1 SEE ALSO App::Raps2(3pm). =head1 AUTHOR Copyright (C) 2011 by Daniel Friesel Ederf@finalrewind.orgE =head1 LICENSE 0. You just DO WHAT THE FUCK YOU WANT TO.