| line | stmt | bran | cond | sub | pod | time | code | 
| 1 | 3 |  |  | 3 |  | 1316 | use 5.008008; | 
|  | 3 |  |  |  |  | 11 |  | 
| 2 | 3 |  |  | 3 |  | 16 | use strict; | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 57 |  | 
| 3 | 3 |  |  | 3 |  | 14 | use warnings; | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 177 |  | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | package Ask::Zenity; | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | our $AUTHORITY = 'cpan:TOBYINK'; | 
| 8 |  |  |  |  |  |  | our $VERSION   = '0.013'; | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 3 |  |  | 3 |  | 19 | use Moo; | 
|  | 3 |  |  |  |  | 15 |  | 
|  | 3 |  |  |  |  | 17 |  | 
| 11 | 3 |  |  | 3 |  | 2382 | use File::Which qw(which); | 
|  | 3 |  |  |  |  | 3333 |  | 
|  | 3 |  |  |  |  | 172 |  | 
| 12 | 3 |  |  | 3 |  | 1597 | use System::Command; | 
|  | 3 |  |  |  |  | 20716 |  | 
|  | 3 |  |  |  |  | 13 |  | 
| 13 | 3 |  |  | 3 |  | 127 | use Path::Tiny qw( path ); | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 139 |  | 
| 14 | 3 |  |  | 3 |  | 19 | use namespace::autoclean; | 
|  | 3 |  |  |  |  | 5 |  | 
|  | 3 |  |  |  |  | 23 |  | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | has zenity_path => ( | 
| 17 |  |  |  |  |  |  | is      => 'ro', | 
| 18 |  |  |  |  |  |  | default => sub { which( 'zenity' ) || '/usr/bin/zenity' }, | 
| 19 |  |  |  |  |  |  | ); | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | has system_wrapper => ( | 
| 22 |  |  |  |  |  |  | is      => 'ro', | 
| 23 |  |  |  |  |  |  | default => sub { 'System::Command' }, | 
| 24 |  |  |  |  |  |  | ); | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | with 'Ask::API'; | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | sub is_usable { | 
| 29 | 0 |  |  | 0 | 0 | 0 | my ( $self ) = @_; | 
| 30 | 0 | 0 |  |  |  | 0 | return unless !!$ENV{'DISPLAY'}; | 
| 31 | 0 | 0 |  |  |  | 0 | return unless -x $self->zenity_path; | 
| 32 | 0 |  |  |  |  | 0 | return 1; | 
| 33 |  |  |  |  |  |  | } | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | sub quality { | 
| 36 | 9 |  |  | 9 | 0 | 32 | return 40; | 
| 37 |  |  |  |  |  |  | } | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | sub _optionize { | 
| 40 | 0 |  |  | 0 |  |  | my $opt = shift; | 
| 41 | 0 |  |  |  |  |  | $opt =~ s/_/-/g; | 
| 42 | 0 |  |  |  |  |  | return "--$opt"; | 
| 43 |  |  |  |  |  |  | } | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | sub _zenity { | 
| 46 | 0 |  |  | 0 |  |  | my ( $self, $cmd, %o ) = @_; | 
| 47 |  |  |  |  |  |  | my $zen = $self->system_wrapper->new( | 
| 48 |  |  |  |  |  |  | $self->zenity_path, | 
| 49 |  |  |  |  |  |  | _optionize( $cmd ), | 
| 50 | 0 |  |  |  |  |  | map sprintf( '%s="%s"', _optionize( $_ ), $o{$_} ), keys %o, | 
| 51 |  |  |  |  |  |  | ); | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | # warn join q[ ], $zen->cmdline; | 
| 54 | 0 |  |  |  |  |  | return $zen; | 
| 55 |  |  |  |  |  |  | } #/ sub _zenity | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | sub entry { | 
| 58 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 59 | 0 |  |  |  |  |  | my $text = readline( $self->_zenity( entry => @_ )->stdout ); | 
| 60 | 0 |  |  |  |  |  | chomp $text; | 
| 61 | 0 |  |  |  |  |  | return $text; | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | sub info { | 
| 65 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 66 | 0 |  |  |  |  |  | $self->_zenity( info => @_ )->close; | 
| 67 |  |  |  |  |  |  | } | 
| 68 |  |  |  |  |  |  |  | 
| 69 |  |  |  |  |  |  | sub warning { | 
| 70 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 71 | 0 |  |  |  |  |  | $self->_zenity( warning => @_ )->close; | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | sub error { | 
| 75 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 76 | 0 |  |  |  |  |  | $self->_zenity( error => @_ )->close; | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | sub question { | 
| 80 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 81 | 0 |  |  |  |  |  | my $zen  = $self->_zenity( error => @_ ); | 
| 82 | 0 |  |  |  |  |  | $zen->close; | 
| 83 | 0 |  |  |  |  |  | return not $zen->exit; | 
| 84 |  |  |  |  |  |  | } | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | sub file_selection { | 
| 87 | 0 |  |  | 0 | 0 |  | my $self = shift; | 
| 88 | 0 |  |  |  |  |  | my $text = readline( $self->_zenity( file_selection => @_ )->stdout ); | 
| 89 | 0 |  |  |  |  |  | chomp $text; | 
| 90 | 0 |  |  |  |  |  | my @files = map path( $_ ), split m#[|]#, $text; | 
| 91 | 0 | 0 |  |  |  |  | @files == 1 ? $files[0] : @files; | 
| 92 |  |  |  |  |  |  | } | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | sub single_choice { | 
| 95 | 0 |  |  | 0 | 0 |  | my ( $self, %o ) = @_; | 
| 96 | 0 | 0 |  |  |  |  | $o{title} = 'Single choice' unless exists $o{title}; | 
| 97 | 0 | 0 |  |  |  |  | $o{text}  = 'Choose one.'   unless exists $o{text}; | 
| 98 | 0 |  |  |  |  |  | my ( $c ) = $self->_choice( radiolist => 1, %o ); | 
| 99 | 0 |  |  |  |  |  | return $c; | 
| 100 |  |  |  |  |  |  | } | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | sub multiple_choice { | 
| 103 | 0 |  |  | 0 | 0 |  | my ( $self, %o ) = @_; | 
| 104 | 0 | 0 |  |  |  |  | $o{title} = 'Multiple choice' unless exists $o{title}; | 
| 105 | 0 | 0 |  |  |  |  | $o{text}  = ''                unless exists $o{text}; | 
| 106 | 0 |  |  |  |  |  | return $self->_choice( multiple => 1, checklist => 1, %o ); | 
| 107 |  |  |  |  |  |  | } | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | sub _choice { | 
| 110 | 0 |  |  | 0 |  |  | my ( $self, %o ) = @_; | 
| 111 | 0 |  |  |  |  |  | my $subsequent; | 
| 112 |  |  |  |  |  |  | my $zen = $self->system_wrapper->new( | 
| 113 |  |  |  |  |  |  | $self->zenity_path, | 
| 114 |  |  |  |  |  |  | '--list', | 
| 115 |  |  |  |  |  |  | ( $o{radiolist} ? '--radiolist' : () ), | 
| 116 |  |  |  |  |  |  | ( $o{checklist} ? '--checklist' : () ), | 
| 117 |  |  |  |  |  |  | ( $o{multiple}  ? '--multiple'  : () ), | 
| 118 |  |  |  |  |  |  | '--column=Select', | 
| 119 |  |  |  |  |  |  | '--column=Code', | 
| 120 |  |  |  |  |  |  | '--column=Choice', | 
| 121 |  |  |  |  |  |  | '--hide-column=2', | 
| 122 |  |  |  |  |  |  | '--text', $o{text}, | 
| 123 | 0 | 0 |  |  |  |  | map { ( $subsequent++ ? 'FALSE' : 'TRUE' ), @$_ } @{ $o{choices} }, | 
|  | 0 | 0 |  |  |  |  |  | 
|  | 0 | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | ); | 
| 125 | 0 |  |  |  |  |  | chomp( my $line = readline( $zen->stdout ) ); | 
| 126 | 0 |  |  |  |  |  | split m{\|}, $line; | 
| 127 |  |  |  |  |  |  | } #/ sub _choice | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | 1; | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | __END__ |