File Coverage

blib/lib/Ask/Wx.pm
Criterion Covered Total %
statement 15 17 88.2
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 21 23 91.3


line stmt bran cond sub pod time code
1 3     3   1294 use 5.008008;
  3         9  
2 3     3   15 use strict;
  3         6  
  3         61  
3 3     3   22 use warnings;
  3         8  
  3         179  
4              
5             package Ask::Wx;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.014';
9              
10 3     3   17 use Moo;
  3         5  
  3         26  
11 3     3   972 use Path::Tiny 'path';
  3         6  
  3         165  
12 3     3   635 use Wx;
  0            
  0            
13             use namespace::autoclean;
14              
15             with 'Ask::API';
16              
17             sub is_usable {
18             my ( $self ) = @_;
19             return !!$ENV{'DISPLAY'};
20             }
21              
22             sub quality {
23             return 10; # raise to 50 once multi file selection implemented
24             }
25              
26             sub info {
27             my ( $self, %o ) = @_;
28             $o{messagebox_icon} = Wx::wxICON_INFORMATION()
29             unless defined $o{messagebox_icon};
30             $o{messagebox_buttons} = Wx::wxOK() unless defined $o{messagebox_buttons};
31             $o{text} = '' unless exists $o{text};
32             $o{title} = 'Information' unless exists $o{title};
33             Wx::MessageBox(
34             $o{text},
35             $o{title},
36             $o{messagebox_icon} | $o{messagebox_buttons},
37             );
38             } #/ sub info
39              
40             sub warning {
41             my ( $self, %o ) = @_;
42             $self->info( messagebox_icon => Wx::wxICON_WARNING(), title => 'Warning', %o );
43             }
44              
45             sub error {
46             my ( $self, %o ) = @_;
47             $self->info( messagebox_icon => Wx::wxICON_ERROR(), title => 'Error', %o );
48             }
49              
50             sub question {
51             my ( $self, %o ) = @_;
52             Wx::wxYES() == $self->info(
53             title => 'Question',
54             messagebox_icon => Wx::wxICON_QUESTION(),
55             messagebox_buttons => Wx::wxYES_NO(),
56             %o,
57             );
58             }
59              
60             sub entry {
61             my ( $self, %o ) = @_;
62            
63             $o{text} = '' unless exists $o{text};
64             $o{title} = 'Text extry' unless exists $o{title};
65             $o{entry_text} = '' unless exists $o{entry_text};
66            
67             $o{hide_text}
68             ? Wx::GetPasswordFromUser( $o{text}, $o{title}, $o{entry_text} )
69             : Wx::GetTextFromUser( $o{text}, $o{title}, $o{entry_text} );
70             } #/ sub entry
71              
72             sub file_selection {
73             my ( $self, %o ) = @_;
74            
75             $o{text} = '' unless exists $o{text};
76            
77             return Wx::DirSelector( $o{text} )
78             if $o{dir};
79            
80             warn "Multiple file selection box not implemented in Ask::Wx yet!\n"
81             if $o{multiple};
82            
83             my $f = Wx::FileSelector(
84             $o{text},
85             '', # default path
86             '', # default filename
87             '', # default extension
88             '*.*', # wildcard
89             $o{save} ? Wx::wxFD_SAVE() : Wx::wxFD_OPEN(),
90             );
91            
92             path( $f );
93             } #/ sub file_selection
94              
95             sub single_choice {
96             my ( $self, %o ) = @_;
97            
98             $o{text} = '' unless exists $o{text};
99             $o{title} = 'Choose one' unless exists $o{title};
100             $o{choices} = [] unless defined $o{choices};
101            
102             my $return = Wx::GetSingleChoiceIndex(
103             $o{text} || $o{title},
104             $o{title},
105             [ map $_->[1], @{ $o{choices} } ],
106             );
107             return if $return < 0;
108             return $o{choices}[$return][0];
109             } #/ sub single_choice
110              
111             sub multiple_choice {
112             my ( $self, %o ) = @_;
113            
114             $o{text} = '' unless exists $o{text};
115             $o{title} = 'Choose one' unless exists $o{title};
116             $o{choices} = [] unless defined $o{choices};
117            
118             my @return = Wx::GetMultipleChoices(
119             $o{text} || $o{title},
120             $o{title},
121             [ map $_->[1], @{ $o{choices} } ],
122             );
123             return if @return && $return[0] < 0;
124             return map $o{choices}[$_][0], @return;
125             } #/ sub multiple_choice
126              
127             1;
128              
129             __END__