File Coverage

blib/lib/Ask/Prima.pm
Criterion Covered Total %
statement 12 14 85.7
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 17 19 89.4


line stmt bran cond sub pod time code
1 3     3   1351 use 5.008008;
  3         10  
2 3     3   16 use strict;
  3         5  
  3         60  
3 3     3   14 use warnings;
  3         5  
  3         170  
4              
5             package Ask::Prima;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.015';
9              
10 3     3   20 use Moo;
  3         6  
  3         16  
11 3     3   1608 use Prima 1.59 ();
  0            
  0            
12             use Path::Tiny 'path';
13             use namespace::autoclean;
14              
15             with 'Ask::API';
16              
17             has application => (
18             is => 'lazy',
19             default => sub {
20             require Prima::Application;
21             require Prima::MsgBox;
22             'Prima::Application'->import;
23             return 1;
24             },
25             );
26              
27             sub is_usable {
28             my ( $self ) = ( shift );
29             return !!$ENV{'DISPLAY'};
30             }
31              
32             sub entry {
33             my ( $self, %opts ) = ( shift, @_ );
34            
35             $self->application;
36            
37             my $return = Prima::MsgBox::input_box(
38             $opts{title} || 'Input',
39             $opts{text} || 'Enter text:',
40             $opts{default} || '',
41             );
42            
43             return $return;
44             } #/ sub entry
45              
46             sub info {
47             my ( $self, %opts ) = ( shift, @_ );
48            
49             $self->application;
50            
51             Prima::MsgBox::message_box(
52             $opts{title} || 'Info',
53             $opts{text},
54             mb::Ok | mb::Information,
55             );
56            
57             return;
58             } #/ sub info
59              
60             sub warning {
61             my ( $self, %opts ) = ( shift, @_ );
62            
63             $self->application;
64            
65             Prima::MsgBox::message_box(
66             $opts{title} || 'Warning',
67             $opts{text},
68             mb::Ok | mb::Warning,
69             );
70            
71             return;
72             } #/ sub warning
73              
74             sub error {
75             my ( $self, %opts ) = ( shift, @_ );
76            
77             $self->application;
78            
79             Prima::MsgBox::message_box(
80             $opts{title} || 'Error',
81             $opts{text},
82             mb::Ok | mb::Error,
83             );
84            
85             return;
86             } #/ sub error
87              
88             sub question {
89             my ( $self, %opts ) = ( shift, @_ );
90            
91             $self->application;
92            
93             my $return;
94            
95             Prima::MsgBox::message_box(
96             $opts{title} || 'Question',
97             $opts{text},
98             mb::Yes | mb::No | mb::Question,
99             buttons => {
100             mb::Yes,
101             {
102             text => $opts{ok_label} || 'Yes',
103             onClick => sub { $return = 1 },
104             },
105             mb::No,
106             {
107             text => $opts{cancel_label} || 'No',
108             onClick => sub { $return = 0 },
109             },
110             },
111             );
112            
113             return $return;
114             } #/ sub question
115              
116             sub file_selection {
117             my ( $self, %opts ) = ( shift, @_ );
118            
119             $self->application;
120            
121             require Prima::Dialog::FileDialog;
122            
123             my $dl;
124            
125             if ( $opts{directory} ) {
126             if ( $opts{multiple} ) {
127             my @dirs;
128             while ( 1 ) {
129             $dl = 'Prima::Dialog::ChDirDialog'->new;
130             if ( $dl->execute ) {
131             push @dirs, path( $dl->directory );
132             }
133             $self->question( text => "Select another directory?" ) or last;
134             }
135             return map path( $_ ), @dirs;
136             } #/ if ( $opts{multiple} )
137             else {
138             $dl = 'Prima::Dialog::ChDirDialog'->new;
139             if ( $dl->execute ) {
140             return path( $dl->directory );
141             }
142             }
143             } #/ if ( $opts{directory} )
144             else {
145             my $class =
146             $opts{save}
147             ? 'Prima::Dialog::SaveDialog'
148             : 'Prima::Dialog::FileDialog';
149            
150             my %dlopts = (
151             system => 1,
152             showDotFiles => 1,
153             fileMustExist => 0+ !!$opts{existing},
154             multiSelect => 0+ !!$opts{multiple},
155             );
156             if ( $opts{default} ) {
157             $dlopts{fileName} = $opts{multiple} ? $opts{default} : [ $opts{default} ];
158             }
159            
160             $dl = $class->new( %dlopts );
161            
162             if ( $dl->execute ) {
163             return map path( $_ ), $dl->fileName;
164             }
165             } #/ else [ if ( $opts{directory} )]
166            
167             $opts{multiple} ? @{ $opts{default} or [] } : $opts{default};
168             } #/ sub file_selection
169              
170             1;
171              
172             __END__