File Coverage

blib/lib/Rofi/Script.pm
Criterion Covered Total %
statement 104 146 71.2
branch 11 28 39.2
condition 3 7 42.8
subroutine 23 34 67.6
pod 19 21 90.4
total 160 236 67.8


line stmt bran cond sub pod time code
1             package Rofi::Script;
2             our $VERSION = '1.221970'; # VERSION
3              
4 1     1   195428 use strict;
  1         2  
  1         23  
5 1     1   8 use warnings;
  1         1  
  1         28  
6              
7 1     1   4 use Carp qw( croak );
  1         2  
  1         32  
8 1     1   508 use Data::Printer;
  1         25030  
  1         5  
9              
10 1         4 use Env qw(
11             $ROFI_RETV
12             $ROFI_INFO
13             $ROFI_SCRIPT_DEBUG
14 1     1   1210 );
  1         2268  
15              
16 1     1   167 use base 'Exporter';
  1         2  
  1         123  
17              
18             ## no critic (ProhibitAutomaticExportation)
19             our @EXPORT = qw(
20             rofi
21             );
22              
23 1     1   447 use namespace::autoclean;
  1         13837  
  1         4  
24              
25             =head1 NAME
26              
27             Rofi::Script - perl interface to the rofi menu
28              
29             =head1 DESCRIPTION
30              
31             rofi is a lightweight, extensible, scriptable, menu interface for Linux. It has
32             a scripting API documented in L. This module is a perl
33             interface to that API.
34              
35             Generally, the interface works by L to STDOUT,
36             which appear in the rofi menu for selection. Each time a user selects an option,
37             the script is called again with the most recent selection pushed onto C<@ARGV>.
38              
39             There are also some envars that let you inspect certain user actions. Those are
40             exposed via:
41              
42             =over
43              
44             =item L
45              
46             =item L
47              
48             =item L
49              
50             =back
51              
52             There are also some options that can be set by printing specially formatted
53             strings to STDOUT.
54              
55             =head1 SYNOPSIS
56              
57             use Rofi::Script;
58              
59             # print options on the first call; if a user selects these, we can detect that
60             # in the SWITCH below
61             if (rofi->is_initial_call) {
62             rofi->set_prompt("Please select one")
63             ->add_option("Show markup example");
64             }
65              
66             # handle user selections
67             SWITCH: for (rofi->shift_arg) {
68             next unless $_;
69              
70             /markup/ && rofi
71             ->set_prompt("markup")
72             ->enable_markup_rows
73             ->add_option(qq{You can use pango for markup});
74             }
75              
76             rofi->show;
77              
78             See also the example implementation script in C.
79              
80             =cut
81              
82             my $DELIM = "\n";
83              
84             =head1 EXPORTED FUNCTIONS
85              
86             =head2 rofi
87              
88             rofi
89             ->set_prompt('Please choose')
90             ->add_option("Foo")
91             ->add_option("Bar")
92             if rofi->is_initial_call;
93              
94             if (my $cmd = rofi->shift_arg) {
95             $cmd =~ /foo/ && rofi
96             ->set_prompt("foo")
97             ->add_option("bar");
98             }
99              
100             This is a god object that's the primary interface to the entire script
101             interface. This object uses a fluid configuration style where you can chain
102             various methods and configuration options.
103              
104             With the standard initialization, the object returned by C will:
105              
106             =over
107              
108             =item
109              
110             Parse args from C<@ARGV>
111              
112             =item
113              
114             Print output to STDOUT (this is how the rofi app actually displays things)
115              
116             =back
117              
118             If it doesn't look like the script was called by rofi (i.e. C is
119             unset), I C is unset, this will return undef. So it's
120             possible to know if your script (or whatever) was called from rofi or not.
121              
122             =cut
123              
124             my $ROFI;
125              
126             sub rofi () {
127 31 50   31 1 1256 unless (defined($ROFI_RETV)) {
128 0         0 warn
129             "Script not called from a rofi environment. Set ROFI_RETV if you wish to execute the script outside of a rofi instance. Search `man rofi-script` for ROFI_RETV for values\n";
130             }
131              
132 31 100       200 return $ROFI if $ROFI;
133              
134 7         20 my $init_state = {
135             args => \@ARGV,
136             output_rows => [],
137             mode_options => {},
138             show_handle => undef,
139             };
140              
141 7         16 $ROFI = bless($init_state, __PACKAGE__);
142              
143 7         25 return $ROFI;
144             }
145              
146             sub clear {
147 6     6 0 8 undef($ROFI);
148 6         9 return;
149             }
150              
151             =head1 METHODS
152              
153             =head2 get_args
154              
155             Gets the arguments L is aware of.
156              
157             =cut
158              
159             sub get_args {
160 4     4 1 7 my ($self) = @_;
161 4         5 return @{$self->{args}};
  4         13  
162             }
163              
164             =head2 set_args
165              
166             Setter for the args L cares about.
167              
168             =cut
169              
170             sub set_args {
171 3     3 1 6 my ($self, @args) = @_;
172              
173 3         5 $self->{args} = \@args;
174              
175 3         5 return $self;
176             }
177              
178             =head2 shift_arg
179              
180             my $cmd = rofi->shift_arg
181              
182             Pop the last arg from the args queue. This is how you would navigate your
183             way through the rofi's "call stack"
184              
185             =cut
186              
187             sub shift_arg {
188 3     3 1 6 my ($self) = @_;
189              
190 3         4 my @args = $self->get_args;
191              
192 3         4 my $arg = shift @args;
193 3         7 $self->set_args(@args);
194              
195 3         22 return $arg;
196             }
197              
198             =head2 add_option
199              
200             rofi->add_option("Choice #1");
201             rofi->add_option(
202             "You can also pass options to rows" => (
203             nonselectable => 1,
204             urgent => 1,
205             meta => 'invisible search terms',
206             icon => 'path/to/icon/to/show/in/row'
207             )
208             );
209              
210             Add a row to rofi's output. If you select a row, it will cause your script to
211             be re-called, with the selected row pushed onto the args stack.
212              
213             You can also pass an even sized list after the row text to modify certain
214             aspects of the row.
215              
216             =cut
217              
218             sub add_option {
219 8     8 1 16 my ($self, $option_text, %mode_options) = @_;
220              
221 8         11 my @coerce_bools = qw( nonselectable );
222 8         11 for my $mode_opt (@coerce_bools) {
223 8 50       16 if (exists($mode_options{$mode_opt})) {
224 0   0     0 $mode_options{$mode_opt} &&= 'true';
225             }
226             }
227              
228 8         8 push @{$self->{output_rows}}, [$option_text, \%mode_options];
  8         16  
229              
230 8         15 return $self;
231             }
232              
233             =head2 show
234              
235             rofi->show;
236              
237             Renders the script output to whatever handle was set by L. By
238             default, this goes to STDOUT.
239              
240             =cut
241              
242             sub show {
243 3     3 1 4 my ($self) = @_;
244              
245 3         7 $self->debug;
246              
247 3         20 my @printable_rows;
248 3         3 my @output_rows = @{$self->{output_rows}};
  3         6  
249 3         10 for (my $i = 0; $i < @output_rows; $i++) {
250 6         7 my $output_row = $output_rows[$i];
251              
252 6 50       11 if (ref $output_row eq 'ARRAY') {
253 6         7 my %mode_options = %{$output_row->[1]};
  6         12  
254              
255 6 50       10 if ($mode_options{urgent}) {
256 0         0 $self->mark_row_urgent($i);
257             }
258             }
259              
260 6         12 push @printable_rows, $output_row;
261             }
262              
263 3         8 $self->_print_global_mode_options;
264 3         6 for my $output_row (@printable_rows) {
265 6         8 $self->_print_row($output_row);
266             }
267              
268 3         5 return;
269             }
270              
271             =head2 set_show_handle
272              
273             my $str = '';
274             open my $h, '>', $str;
275             rofi->set_show_handle($h);
276              
277             Set the handle that is printed to by L.
278              
279             =cut
280              
281             sub set_show_handle {
282 3     3 1 4 my ($self, $handle) = @_;
283              
284 3         6 $self->{show_handle} = $handle;
285              
286 3         5 return $self;
287             }
288              
289             =head2 get_show_handle
290              
291             my $h = rofi->get_show_handle;
292             close $h;
293              
294             Return the output handle used by L, set by L.
295              
296             =cut
297              
298             sub get_show_handle {
299 0     0 1 0 my ($self) = @_;
300              
301 0         0 return $self->{show_handle};
302             }
303              
304             =head2 is_initial_call
305              
306             True if this is the first time the script is being called
307              
308             =cut
309              
310             sub is_initial_call {
311 0     0 1 0 return $ROFI_RETV == 0;
312             }
313              
314             =head2 provided_entry_selected
315              
316             The user selected a value from the list of provided entries
317              
318             =cut
319              
320             sub provided_entry_selected {
321 0     0 1 0 return $ROFI_RETV == 1;
322             }
323              
324             =head2 custom_entry_selected
325              
326             User manually entered a value on the previous run
327              
328             =cut
329              
330             sub custom_entry_selected {
331 0     0 1 0 return $ROFI_RETV == 2;
332             }
333              
334             =head2 set_prompt
335              
336             rofi->set_prompt("Please select a value");
337              
338             Set the prompt on the rofi popup
339              
340             =cut
341              
342             sub set_prompt {
343 2     2 1 2 my ($self, $prompt) = @_;
344 2 100       147 croak "Need prompt" unless $prompt;
345 1         3 $self->_set_mode_option(prompt => $prompt);
346              
347 1         2 return $self;
348             }
349              
350             =head2 set_message
351              
352             Set a message in the rofi box
353              
354             =cut
355              
356             sub set_message {
357 0     0 1 0 my ($self, $message) = @_;
358 0 0       0 croak "Need message" unless $message;
359 0         0 $self->_set_mode_option(message => $message);
360              
361 0         0 return $self;
362             }
363              
364             sub mark_row_urgent {
365 0     0 0 0 my ($self, $i) = @_;
366              
367 0         0 my $urgent_rows = $self->_get_mode_option('urgent');
368              
369 0 0       0 unless ($urgent_rows) {
370 0         0 $urgent_rows = $i;
371             }
372             else {
373 0         0 $urgent_rows .= ",$i";
374             }
375              
376 0         0 $self->_set_mode_option(urgent => $urgent_rows);
377              
378 0         0 return $self;
379             }
380              
381             =head2 enable_markup_rows
382              
383             Turn on pango markup for rows
384              
385             =cut
386              
387             sub enable_markup_rows {
388 0     0 1 0 my ($self) = @_;
389              
390 0         0 $self->_set_mode_option(markup_rows => "true");
391              
392 0         0 return $self;
393             }
394              
395             =head2 disable_markup_rows
396              
397             Turn off pango markup for rows
398              
399             =cut
400              
401              
402             sub disable_markup_rows {
403 0     0 1 0 my ($self) = @_;
404              
405 0         0 $self->_set_mode_option(markup_rows => "false");
406              
407 0         0 return $self;
408             }
409              
410             =head2 markup_rows_enabled
411              
412             Query whether or not markup rows are enabled
413              
414             =cut
415              
416             sub markup_rows_enabled {
417 0     0 1 0 my ($self) = @_;
418 0         0 return $self->_get_mode_option('markup_rows') eq 'true';
419             }
420              
421             =head2 set_delim
422              
423             Change the delimiter used to indicate new lines. This is C<\n> by default.
424             There's not really a need to mess with this. I'm not even sure it's implemented
425             100% correctly.
426              
427             =cut
428              
429             sub set_delim {
430 1     1 1 2 my ($self, $delim) = @_;
431              
432 1 50       4 croak "Need delim" unless $delim;
433 1         2 $DELIM = $delim;
434 1         3 $self->_set_mode_option(delim => $delim);
435              
436 1         2 return $self;
437             }
438              
439             =head2 set_no_custom
440              
441             Call this to ignore any custom entries from the user
442              
443             =cut
444              
445             sub set_no_custom {
446 0     0 1 0 my ($self) = @_;
447 0         0 $self->_set_mode_option(no_custom => 'true');
448 0         0 return $self;
449             }
450              
451             sub _set_mode_option {
452 2     2   4 my ($self, $option, $value) = @_;
453              
454 2         4 $option =~ s/_/-/g;
455              
456 2         5 $self->{mode_options}->{$option} = $value;
457              
458 2         2 return;
459             }
460              
461             sub _get_mode_option {
462 0     0   0 my ($self, $option) = @_;
463              
464 0         0 $option =~ s/_/-/g;
465              
466 0         0 return $self->{mode_options}->{$option};
467             }
468              
469             sub _print {
470 8     8   12 my ($self, $whatever) = @_;
471 8   33     15 my $show_handle = $self->{show_handle} || *STDOUT;
472 8   100     15 my $delim = $self->{mode_options}->{delim} || "\n";
473 8         16 print $show_handle $whatever . $delim;
474              
475 8         12 return;
476             }
477              
478             sub _print_global_mode_options {
479 3     3   4 my ($self) = @_;
480              
481 3         4 my %global_mode_options = %{$self->{mode_options}};
  3         9  
482              
483 3         7 for my $opt (keys %global_mode_options) {
484 2         3 my $val = $global_mode_options{$opt};
485 2         3 $self->_print(_render_option($opt => $val));
486             }
487              
488 3         4 return;
489             }
490              
491             sub _print_row {
492 6     6   7 my ($self, $row) = @_;
493              
494 6 50       12 if (ref $row eq 'ARRAY') {
    0          
495 6         8 my $content = $row->[0];
496 6         7 my %mode_options = %{$row->[1]};
  6         9  
497              
498 6         7 my @collected_mode_options;
499 6         8 for my $opt (keys %mode_options) {
500 0 0       0 next if $opt eq 'urgent';
501 0         0 my $val = $mode_options{$opt};
502 0         0 push @collected_mode_options, _render_option($opt => $val);
503             }
504 6         10 my $rendered_mode_options = join "\x1f", @collected_mode_options;
505              
506 6         12 $self->_print($content . $rendered_mode_options);
507             }
508              
509             elsif (not ref $row) {
510 0         0 $self->_print($row);
511             }
512              
513             else {
514 0         0 croak "unsupported output row type: " . ref($row);
515             }
516              
517 6         11 return;
518             }
519              
520             sub _render_option {
521 2     2   4 my ($option, $value) = @_;
522 2         7 return "\x00$option\x1f$value";
523             }
524              
525             =head2 debug
526              
527             # dump the rofi object
528             rofi->debug
529              
530             # dump whatever
531             Rofi::Script::debug($whatever);
532              
533             Dump the contents of the L object (or anything else) to STDERR. Set
534             C to enable this.
535              
536             =cut
537              
538             sub debug {
539 3     3 1 6 my ($maybe_self) = my (@but_maybe_not) = @_;
540              
541 3 50       7 return unless $ROFI_SCRIPT_DEBUG;
542              
543 0 0         if (ref($maybe_self) =~ /Rofi::Script/x) {
544 0           p $maybe_self;
545             }
546             else {
547 0           p @but_maybe_not;
548             }
549              
550 0           return;
551             }
552              
553             1;