File Coverage

blib/lib/Ask/API.pm
Criterion Covered Total %
statement 42 76 55.2
branch 9 18 50.0
condition 3 12 25.0
subroutine 10 14 71.4
pod 0 8 0.0
total 64 128 50.0


line stmt bran cond sub pod time code
1 4     4   2045 use 5.008008;
  4         13  
2 4     4   22 use strict;
  4         7  
  4         80  
3 4     4   19 use warnings;
  4         7  
  4         255  
4              
5             package Ask::API;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.014';
9              
10 4     4   23 use Moo::Role;
  4         9  
  4         28  
11 4     4   4182 use Path::Tiny 'path';
  4         37321  
  4         4240  
12              
13             requires 'entry'; # get a string of text
14             requires 'info'; # display a string of text
15              
16             sub _lang_support {
17 3     3   7 my $self = shift;
18 3         1065 require Lingua::Boolean::Tiny;
19 3         30685 "Lingua::Boolean::Tiny"->new( @_ );
20             }
21              
22             sub is_usable {
23 0     0 0 0 my ( $self ) = @_;
24 0         0 return 1;
25             }
26              
27             sub quality {
28 0     0 0 0 return 50;
29             }
30              
31             sub warning {
32 1     1 0 548 my ( $self, %o ) = @_;
33 1         5 $o{text} = "WARNING: $o{text}";
34 1         6 return $self->info( %o );
35             }
36              
37             sub error {
38 2     2 0 8344 my ( $self, %o ) = @_;
39 2         11 $o{text} = "ERROR: $o{text}";
40 2         13 return $self->info( %o );
41             }
42              
43             sub question {
44 3     3 0 1875 my ( $self, %o ) = @_;
45            
46 3         13 my $response = $self->entry( text => $o{text} );
47 3         20 my $lang = $self->_lang_support( $o{lang} );
48 3         500 $lang->boolean( $response );
49             }
50              
51             sub file_selection {
52 2     2 0 1909 my ( $self, %opts ) = ( shift, @_ );
53            
54 2   50     8 $opts{text} ||= 'Enter file name';
55            
56 2         3 my @chosen;
57            
58             FILE: {
59 2         4 my $got = $self->entry( text => $opts{text} );
  5         11  
60            
61 5 100       21 if ( not length $got ) {
62 1 50       5 last FILE if $opts{multiple};
63 0         0 redo FILE;
64             }
65            
66 4         13 $got = path $got;
67            
68 4 50 33     131 if ( $opts{existing} and not $got->exists ) {
69 0         0 $self->error( text => 'Does not exist.' );
70 0         0 redo FILE;
71             }
72            
73 4 50 33     11 if ( $opts{directory} and not $got->is_dir ) {
74 0         0 $self->error( text => 'Is not a directory.' );
75 0         0 redo FILE;
76             }
77            
78 4         7 push @chosen, $got;
79            
80 4 100       9 if ( $opts{multiple} ) {
81 3         9 $self->info( text => 'Enter another file, or leave blank to finish.' );
82 3         12 redo FILE;
83             }
84             } #/ FILE:
85            
86 2 100       13 $opts{multiple} ? @chosen : $chosen[0];
87             } #/ sub file_selection
88              
89             my $format_choices = sub {
90             my ( $self, $choices ) = @_;
91             join q[, ], map { sprintf( '"%s" (%s)', @$_ ) } @$choices;
92             };
93              
94             my $filter_chosen = sub {
95             my ( $self, $choices, $response ) = @_;
96             my $valid = {};
97             $valid->{ $_->[0] }++ for @$choices;
98             my @choices = ( $response =~ /\w+/g );
99             return (
100             [ grep $valid->{$_}, @choices ],
101             [ grep !$valid->{$_}, @choices ],
102             );
103             };
104              
105             sub multiple_choice {
106 0     0 0   my ( $self, %o ) = @_;
107 0           my $choices = $self->$format_choices( $o{choices} );
108            
109 0           my ( $allowed, $disallowed, $repeat );
110            
111 0           for ( ; ; ) {
112 0   0       my $response = $self->entry(
113             text =>
114             "$o{text}. Choices: $choices. (Separate multiple choices with white space.)",
115             entry_text => $repeat || '',
116             );
117 0           ( $allowed, $disallowed ) = $self->$filter_chosen( $o{choices}, $response );
118 0 0         if ( @$disallowed ) {
119 0           my $d = join q[, ], @$disallowed;
120 0           $self->error(
121             text => "Not valid: $d. Please try again.",
122             );
123 0           $repeat = join q[ ], @$allowed;
124             }
125             else {
126 0           last;
127             }
128             } #/ for ( ; ; )
129            
130 0           return @$allowed;
131             } #/ sub multiple_choice
132              
133             sub single_choice {
134 0     0 0   my ( $self, %o ) = @_;
135 0           my $choices = $self->$format_choices( $o{choices} );
136            
137 0           my ( $allowed, $disallowed, $repeat );
138            
139 0           for ( ; ; ) {
140 0   0       my $response = $self->entry(
141             text => "$o{text}. Choices: $choices. (Choose one.)",
142             entry_text => $repeat || '',
143             );
144 0           ( $allowed, $disallowed ) = $self->$filter_chosen( $o{choices}, $response );
145 0 0         if ( @$disallowed ) {
    0          
146 0           my $d = join q[, ], @$disallowed;
147 0           $self->error(
148             text => "Not valid: $d. Please try again.",
149             );
150 0           $repeat = $allowed->[0];
151             }
152             elsif ( @$allowed != 1 ) {
153 0           $self->error(
154             text => "Not valid: choose one.",
155             );
156 0           $repeat = $allowed->[0];
157             }
158             else {
159 0           last;
160             }
161             } #/ for ( ; ; )
162            
163 0           return $allowed->[0];
164             } #/ sub single_choice
165              
166             1;
167              
168             __END__