File Coverage

blib/lib/Ask/Question.pm
Criterion Covered Total %
statement 88 154 57.1
branch 37 104 35.5
condition 14 65 21.5
subroutine 10 13 76.9
pod 1 3 33.3
total 150 339 44.2


line stmt bran cond sub pod time code
1 1     1   19 use 5.008008;
  1         4  
2 1     1   5 use strict;
  1         7  
  1         20  
3 1     1   5 use warnings;
  1         2  
  1         66  
4              
5             package Ask::Question;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.014';
9              
10 1     1   12 use Moo;
  1         2  
  1         8  
11 1     1   386 use Scalar::Util 'blessed';
  1         2  
  1         83  
12              
13             use overload (
14 2     2   2040 '&{}' => sub { shift->coderef },
15 1         16 fallback => 1,
16 1     1   7 );
  1         2  
17              
18 0     0 1 0 sub ask { shift->coderef->() }
19              
20             has backend => ( is => 'lazy' );
21             has type => ( is => 'rwp', predicate => 1 );
22             has spec => ( is => 'rwp', predicate => 1 );
23             has title => ( is => 'rwp', predicate => 1 );
24             has text => ( is => 'rwp', predicate => 1 );
25             has multiple => ( is => 'rwp' );
26             has choices => ( is => 'rwp' );
27             has coderef => ( is => 'lazy', init_arg => undef );
28             has default => ( is => 'rwp', predicate => 1 );
29             has method => ( is => 'rwp' );
30              
31             sub _build_backend {
32 0     0   0 require Ask;
33 0         0 'Ask'->detect;
34             }
35              
36             sub BUILDARGS {
37 1     1 0 1736 my ( $class, @args ) = ( shift, @_ );
38 1 50 33     6 @args == 1 and ref $args[0] and return $args[0];
39 1 50       5 unshift @args, 'text' if @args % 2;
40 1         21 +{@args};
41             }
42              
43             sub isa { # trick Moose
44 0 0   0 0 0 return 1 if $_[1] eq __PACKAGE__;
45 0 0       0 return 1 if $_[1] eq 'Class::MOP::Method';
46 0 0       0 return 1 if $_[1] eq 'Moo::Object';
47 0 0       0 return 1 if $_[1] eq 'UNIVERSAL';
48 0         0 return 0;
49             }
50              
51             sub _build_coderef {
52 1     1   10 my ( $self ) = ( shift );
53            
54             # Avoid closing over $self
55 1         18 my $ask = $self->backend;
56 1         11 my $type = $self->type;
57 1         4 my $choices = $self->choices;
58 1         7 my $multiple = $self->multiple;
59 1   50     12 my $spec = $self->spec || {};
60 1 50       14 my $default = $self->has_default ? $self->default : $spec->{default};
61 1 50       7 my $text = $self->has_text ? $self->text : $spec->{documentation};
62 1         2 my $method = $self->method;
63 1         3 my $title = $self->title;
64            
65 1 50 33     6 undef $default if ( blessed $default and $default == $self );
66            
67             return sub {
68 1     1   4975 my @args = @_;
69 1         4 my ( $instance ) = ( @args );
70            
71 1         2 my $local_text = $text;
72 1 50       4 if ( ref $local_text ) {
73 0         0 $local_text = $local_text->( @args );
74             }
75 1 50       4 if ( not defined $local_text ) {
76 0         0 $local_text = '?';
77             }
78            
79 1         2 my $local_default = $default;
80 1 50       3 if ( ref $local_default ) {
81 0         0 $local_default = $local_default->( @args );
82             }
83            
84 1         3 my $local_type = $type;
85 1 50       4 if ( not ref $local_type ) {
86            
87 0   0     0 $local_type ||= $spec->{type};
88            
89 0 0 0     0 if ( defined $local_type and not ref $local_type ) {
    0 0        
    0 0        
90 0         0 require Type::Utils;
91 0         0 $local_type = Type::Utils::dwim_type(
92             $local_type,
93             for => ref( $instance ),
94             );
95             }
96            
97             elsif ( defined $spec->{'isa'} and not ref $local_type ) {
98             $local_type =
99             ref( $spec->{'isa'} )
100             ? $spec->{'isa'}
101 0 0       0 : do {
102 0         0 require Type::Utils;
103             Type::Utils::dwim_type(
104 0         0 $spec->{'isa'},
105             for => ref( $instance ),
106             fallback => ['make_class_type'],
107             );
108             };
109             } #/ elsif ( defined $spec->{'isa'...})
110            
111             elsif ( defined $spec->{'does'} and not ref $local_type ) {
112             $local_type =
113             ref( $spec->{'does'} )
114             ? $spec->{'does'}
115 0 0       0 : do {
116 0         0 require Type::Utils;
117             Type::Utils::dwim_type(
118 0         0 $spec->{'does'},
119             for => ref( $instance ),
120             fallback => ['make_role_type'],
121             );
122             };
123             } #/ elsif ( defined $spec->{'does'...})
124             } #/ if ( not ref $local_type)
125            
126 1         2 my $local_multiple = $multiple;
127 1 50 33     8 if ( blessed $local_type and not defined $local_multiple ) {
128 1         11 require Types::Standard;
129 1         4 $local_multiple = ( $local_type <= Types::Standard::ArrayRef() );
130             }
131            
132 1         437 my $local_choices = $choices;
133 1 50 33     10 if ( defined $local_type
      33        
134             and blessed $local_type
135             and not defined $local_choices )
136             {
137 1         7 my $map = sub { [ map [ $_ x 2 ], @{ +shift } ] };
  0         0  
  0         0  
138 1         8 require Types::Standard;
139 1 50 33     4 if ( $local_type->isa( 'Type::Tiny::Enum' ) ) {
    50          
    50          
140 0         0 $local_choices = $map->( $local_type->unique_values );
141             }
142             elsif ( $local_type->isa( 'Moose::Meta::TypeConstraint::Enum' ) ) {
143 0         0 $local_choices = $map->( $local_type->values );
144             }
145             elsif ( $local_type <= Types::Standard::ArrayRef()
146             and $local_type->is_parameterized )
147             {
148 1         361 my $tp = $local_type->type_parameter;
149 1 50       10 if ( $tp->isa( 'Type::Tiny::Enum' ) ) {
    50          
150 0         0 $local_choices = $map->( $tp->unique_values );
151             }
152             elsif ( $tp->isa( 'Moose::Meta::TypeConstraint::Enum' ) ) {
153 0         0 $local_choices = $map->( $tp->values );
154             }
155             } #/ elsif ( $local_type <= Types::Standard::ArrayRef...)
156             } #/ if ( defined $local_type...)
157            
158 1         22 my $is_bool;
159 1 50 33     8 if ( defined $local_type and blessed $local_type ) {
160 1         6 require Types::Standard;
161 1         6 $is_bool = !!( $local_type <= Types::Standard::Bool() );
162             }
163            
164 1         1024 my ( $is_path, $is_dir, $is_abs );
165 1 50 33     11 if ( defined $local_type and blessed $local_type ) {
166            
167 1 50       2 if ( eval { require Types::Path::Tiny } ) {
  1         210  
168 0         0 $is_path = !!( $local_type <= Types::Path::Tiny::Path() );
169 0 0       0 my $path_type = $is_path ? $local_type : undef;
170            
171 0         0 require Types::Standard;
172 0 0 0     0 if ( !$is_path
      0        
173             and $local_type <= Types::Standard::ArrayRef()
174             and $local_type->is_parameterized )
175             {
176 0         0 my $tp = $local_type->type_parameter;
177 0 0       0 if ( $tp <= Types::Path::Tiny::Path() ) {
178 0         0 $is_path = 1;
179 0         0 $local_multiple = 1;
180 0         0 $path_type = $tp;
181             }
182             } #/ if ( !$is_path and $local_type...)
183            
184 0 0       0 if ( $is_path ) {
185 0   0     0 $is_dir = ( $path_type <= Types::Path::Tiny::Dir() )
186             || ( $path_type <= Types::Path::Tiny::AbsDir() );
187 0   0     0 $is_abs =
188             ( $path_type <= Types::Path::Tiny::AbsPath() )
189             || ( $path_type <= Types::Path::Tiny::AbsFile() )
190             || ( $path_type <= Types::Path::Tiny::AbsDir() );
191             }
192             } #/ if ( eval { require Types::Path::Tiny...})
193             } #/ if ( defined $local_type...)
194            
195 1 50       9 my @common = (
    50          
196             text => $local_text,
197             defined( $title ) ? ( title => $title ) : (),
198             defined( $local_default ) ? ( default => $local_default ) : (),
199             );
200            
201             my $get_answer = sub {
202            
203 2 50 33     35 if ( $method ) {
    50 33        
    50          
    50          
    50          
    50          
    50          
204 0         0 my $str = $ask->$method(
205             choices => $choices,
206             multiple => $multiple,
207             @common,
208             );
209 0         0 chomp $str;
210 0         0 return $str;
211             }
212            
213             elsif ( $local_multiple and $local_choices ) {
214 0         0 my @values = $ask->multiple_choice( @common, choices => $local_choices );
215 0         0 return \@values;
216             }
217            
218             elsif ( $local_choices ) {
219 0         0 return $ask->single_choice( @common, choices => $local_choices );
220             }
221            
222             elsif ( $local_multiple and $is_path ) {
223 0         0 require Path::Tiny;
224 0         0 my @paths = map( 'Path::Tiny'->new( $_ ),
225             $ask->file_selection( @common, directory => $is_dir, multiple => 1 ),
226             );
227 0 0       0 if ( $is_abs ) {
228 0         0 @paths = map $_->absolute, @paths;
229             }
230 0         0 return \@paths;
231             } #/ elsif ( $local_multiple and...)
232            
233             elsif ( $is_path ) {
234 0         0 require Path::Tiny;
235 0         0 my $path = 'Path::Tiny'->new(
236             $ask->file_selection( @common, directory => $is_dir, multiple => 0 ),
237             );
238 0 0       0 return $is_abs ? $path->absolute : $path;
239             }
240            
241             elsif ( $is_bool ) {
242 0         0 return $ask->question( @common, ok_label => 'TRUE', cancel_label => 'FALSE' );
243             }
244            
245             elsif ( $local_multiple ) {
246 2         5 my @strings;
247 2         3 STRING: while ( 1 ) {
248 6         18 chomp( my $str = $ask->entry( @common ) );
249 6 100       42 if ( length $str ) {
250 4         34 push @strings, $str;
251             }
252             else {
253 2         23 last STRING;
254             }
255 4 50       12 return if @strings >= 100;
256             } #/ STRING: while ( 1 )
257 2         7 return \@strings;
258             } #/ elsif ( $local_multiple )
259            
260             else {
261 0         0 chomp( my $str = $ask->entry( @common ) );
262 0         0 return $str;
263             }
264            
265 1         16 }; # sub $get_answer
266            
267 1         3 my $answer;
268 1         1 my $tries = 0;
269 1         4 TRY: while ( !defined $answer ) {
270            
271 2         8 $answer = $get_answer->();
272 2         5 ++$tries;
273            
274 2 50       11 if ( blessed $local_type ) {
    0          
275 2         10 my $okay = $local_type->check( $answer );
276            
277 2 50 33     57 if ( !$okay
      33        
278             and $local_type->can( 'has_coercion' )
279             and $local_type->has_coercion )
280             {
281 2         84 $answer = $local_type->coerce( $answer );
282 2         1361 $okay = $local_type->check( $answer );
283             }
284            
285 2 100       41 if ( not $okay ) {
286 1         6 $ask->error( text => $local_type->get_message( $answer ) );
287 1         9 $answer = undef;
288             }
289             } #/ if ( blessed $local_type)
290            
291             elsif ( ref $local_type ) {
292 0         0 local $@;
293 0         0 my $okay = eval { $local_type->( $answer ); 1 };
  0         0  
  0         0  
294 0 0       0 if ( not $okay ) {
295 0         0 $ask->error( text => $@ );
296 0         0 $answer = undef;
297             }
298             }
299            
300 2 50 33     11 if ( $tries >= 3 and not defined $answer ) {
301 0         0 $ask->error( text => 'Too many retries!' );
302 0         0 last TRY;
303             }
304             } #/ TRY: while ( !defined $answer )
305            
306 1 50       85 return $answer if defined $answer;
307 0           return $local_default;
308 1         10 }; # built sub
309             } #/ sub _build_coderef
310              
311             1;
312              
313             __END__