File Coverage

blib/lib/Getopt/EX/termcolor/iTerm.pm
Criterion Covered Total %
statement 17 30 56.6
branch 0 8 0.0
condition n/a
subroutine 6 10 60.0
pod 0 3 0.0
total 23 51 45.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Getopt::EX::termcolor::iTerm
4              
5             =head1 SYNOPSIS
6              
7             command -Mtermcolor::iTerm
8              
9             =head1 DESCRIPTION
10              
11             This is a L module for iTerm.
12              
13             =head1 SEE ALSO
14              
15             L
16              
17             =cut
18              
19             package Getopt::EX::termcolor::iTerm;
20              
21 1     1   971 use v5.14;
  1         4  
22 1     1   5 use warnings;
  1         2  
  1         24  
23 1     1   41 use Data::Dumper;
  1         4  
  1         69  
24              
25             {
26 1     1   7 no warnings 'once';
  1         1  
  1         69  
27 1     1   627 use Getopt::EX::Colormap;
  1         15943  
  1         172  
28             $Getopt::EX::Colormap::RGB24 = 1;
29             }
30              
31             our $debug = 0;
32              
33             sub get_colors {
34             map {
35 0     0 0   my @rgb = get_color($_);
  0            
36 0 0         @rgb ? undef : [ @rgb ];
37             } @_;
38             }
39              
40             sub get_color {
41 0     0 0   my $cat = lc shift;
42 0 0         if ($cat eq 'background') {
43 0           return background_rgb();
44             }
45 0           ();
46             }
47              
48             my %script = (
49              
50             'background' => <
51             tell application "iTerm"
52             tell current session of current window
53             background color
54             end tell
55             end tell
56             END
57              
58             );
59              
60 1     1   608 use Capture::Tiny ':all';
  1         25185  
  1         257  
61              
62             sub background_rgb {
63 0     0 0   my $script = $script{background};
64             my($stdout, $stderr, $exit) = capture {
65 0     0     system 'osascript', '-e', $script;
66 0           };
67 0 0         $exit == 0 or return;
68 0           my @rgb = $stdout =~ /(\d+)/g;
69 0 0         @rgb == 3 ? ( { max => 65535 }, @rgb) : ();
70             }
71              
72             1;
73              
74             __DATA__