File Coverage

blib/lib/App/Raps2/UI.pm
Criterion Covered Total %
statement 18 69 26.0
branch 0 10 0.0
condition 0 9 0.0
subroutine 6 13 46.1
pod 7 7 100.0
total 31 108 28.7


line stmt bran cond sub pod time code
1             package App::Raps2::UI;
2              
3 1     1   6 use strict;
  1         2  
  1         36  
4 1     1   6 use warnings;
  1         2  
  1         35  
5 1     1   22 use 5.010;
  1         4  
  1         35  
6              
7 1     1   5 use Carp qw(cluck confess);
  1         2  
  1         71  
8 1     1   1490 use POSIX;
  1         10025  
  1         7  
9 1     1   5787 use Term::ReadLine;
  1         4880  
  1         961  
10              
11             our $VERSION = '0.53';
12              
13             sub new {
14 0     0 1   my ($obj) = @_;
15              
16 0           my $ref = {};
17              
18 0           $ref->{term_readline} = Term::ReadLine->new('App::Raps2');
19              
20 0           return bless( $ref, $obj );
21             }
22              
23             sub list {
24 0     0 1   my ( $self, @list ) = @_;
25              
26 0           my $format = "%-20s %-20s %s\n";
27              
28 0 0         if ( not $self->{list}->{header} ) {
29 0           printf( $format, map { $_->[0] } @list );
  0            
30 0           $self->{list}->{header} = 1;
31             }
32 0   0       printf( $format, map { $_->[1] // q{} } @list );
  0            
33              
34 0           return 1;
35             }
36              
37             sub read_line {
38 0     0 1   my ( $self, $str, $pre ) = @_;
39              
40 0           my $input = $self->{term_readline}->readline( "${str}: ", $pre );
41              
42 0           return $input;
43             }
44              
45             sub read_multiline {
46 0     0 1   my ( $self, $str ) = @_;
47              
48 0           my $in;
49              
50 0           say "${str} (^D or empty line to quit)";
51              
52 0           while ( my $line = $self->read_line('multiline') ) {
53 0           $in .= "${line}\n";
54             }
55              
56 0           return $in;
57             }
58              
59             sub read_pw {
60 0     0 1   my ( $self, $str, $verify ) = @_;
61              
62 0           my ( $in1, $in2 );
63 0           my $term = POSIX::Termios->new();
64              
65 0           $term->getattr(0);
66 0           $term->setlflag( $term->getlflag() & ~POSIX::ECHO );
67 0           $term->setattr( 0, POSIX::TCSANOW );
68              
69 0           print "${str}: ";
70 0           $in1 = readline(STDIN);
71 0           print "\n";
72              
73 0 0         if ($verify) {
74 0           print 'Verify: ';
75 0           $in2 = readline(STDIN);
76 0           print "\n";
77             }
78              
79 0           $term->setlflag( $term->getlflag() | POSIX::ECHO );
80 0           $term->setattr( 0, POSIX::TCSANOW );
81              
82 0 0 0       if ( $verify and $in1 ne $in2 ) {
83 0           confess('Input lines did not match');
84             }
85              
86 0           chomp $in1;
87              
88 0           return $in1;
89             }
90              
91             sub to_clipboard {
92 0     0 1   my ( $self, $str, $cmd ) = @_;
93              
94 0   0       $cmd //= 'xclip -l 1';
95              
96 0 0         open( my $clipboard, q{|-}, $cmd )
97             or return;
98              
99 0           print $clipboard $str;
100              
101 0 0         close($clipboard)
102             or cluck("Failed to close pipe to ${cmd}: ${!}");
103              
104 0           return 1;
105             }
106              
107             sub output {
108 0     0 1   my ( $self, @out ) = @_;
109              
110 0           for my $pair (@out) {
111 0   0       printf( "%-8s : %s\n", $pair->[0], $pair->[1] // q{}, );
112             }
113              
114 0           return 1;
115             }
116              
117             1;
118              
119             __END__