File Coverage

blib/lib/App/Devmode2.pm
Criterion Covered Total %
statement 21 101 20.7
branch 0 44 0.0
condition 0 12 0.0
subroutine 7 14 50.0
pod 4 4 100.0
total 32 175 18.2


line stmt bran cond sub pod time code
1             package App::Devmode2;
2              
3             # Created on: 2014-10-04 20:31:39
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 1     1   67519 use strict;
  1         2  
  1         27  
10 1     1   5 use warnings;
  1         1  
  1         26  
11 1     1   536 use English qw/ -no_match_vars /;
  1         3538  
  1         6  
12 1     1   1000 use Getopt::Long;
  1         12225  
  1         6  
13 1     1   560 use FindBin qw/$Bin/;
  1         965  
  1         94  
14 1     1   827 use Path::Tiny;
  1         10670  
  1         53  
15 1     1   8 use base qw/Exporter/;
  1         1  
  1         1510  
16              
17             our $VERSION = 0.9;
18             our ($name) = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;
19             our $tmux_conf = path("$ENV{HOME}", '.tmux.conf');
20             our $tmux_layout = path("$ENV{HOME}", '.tmux', 'layout');
21             our $tmux_devmode = path("$ENV{HOME}", '.tmux', 'devmode2');
22             our %option;
23             our %p2u_extra;
24              
25             sub run {
26 0     0 1   my ($self) = @_;
27 0           Getopt::Long::Configure('bundling');
28 0           my $success = GetOptions(
29             \%option,
30             'layout|l=s',
31             'chdir|cd|c=s',
32             'curdir|C',
33             'save|s',
34             'auto|auto-complete',
35             'current=s',
36             'test|t!',
37             'verbose|v+',
38             'man',
39             'help',
40             'version!',
41             );
42              
43 0 0 0       if ( !$success && !$option{auto} ) {
    0          
    0          
    0          
    0          
44 0           require Pod::Usage;
45 0           Pod::Usage::pod2usage(
46             -verbose => 1,
47             -input => __FILE__,
48             %p2u_extra,
49             );
50 0           return 1;
51             }
52             elsif ( $option{'VERSION'} ) {
53 0           print "$name Version = $VERSION\n";
54 0           return 0;
55             }
56             elsif ( $option{'man'} ) {
57 0           require Pod::Usage;
58 0           Pod::Usage::pod2usage(
59             -verbose => 2,
60             -input => __FILE__,
61             %p2u_extra,
62             );
63 0           return 2;
64             }
65             elsif ( $option{'help'} ) {
66 0           require Pod::Usage;
67 0           Pod::Usage::pod2usage(
68             -verbose => 1,
69             -input => __FILE__,
70             %p2u_extra,
71             );
72 0           return 1;
73             }
74             elsif ( $option{auto} ) {
75 0           $self->_auto();
76 0           return 0;
77             }
78              
79             # get the session name
80 0 0         my $session = @ARGV ? shift @ARGV : die "No session name passed!";
81 0           my @sessions = $self->sessions();
82              
83             # set the terminal title to the session name
84 0           $self->set_title($session);
85              
86 0 0         if ( grep { $_ eq $session } @sessions ) {
  0            
87             # connect to session
88 0           $self->_exec('tmux', '-u2', 'attach', '-t', $session);
89 0           return 1;
90             }
91              
92             # creating a new session should do some extra work
93 0           $self->process_config($session, \%option);
94              
95 0 0         if ($option{chdir}) {
96 0 0         die "No directory '$option{chdir}'!\n" if !-d $option{chdir};
97 0           chdir $option{chdir};
98             }
99              
100 0           my @actions = ('-u2', 'new-session', '-s', $session, ';', 'source-file', $tmux_conf);
101 0 0         if ($option{layout}) {
102 0           push @actions, ';', "source-file", $tmux_layout->child($option{layout});
103             }
104              
105 0           $self->_exec('tmux', @actions);
106 0           warn "Not found\n";
107              
108 0           return 1;
109             }
110              
111             sub set_title {
112 0     0 1   my ($self, $session) = @_;
113 0 0         eval { require Term::Title; } or return;
  0            
114 0           Term::Title::set_titlebar($session);
115 0           return;
116             }
117              
118             sub sessions {
119 0     0 1   my $self = shift;
120             return map {
121 0           /^(.+) : \s+ \d+ \s+ window/xms;
  0            
122 0           $1;
123             }
124             $self->_qx('tmux ls');
125             }
126              
127             sub process_config {
128 0     0 1   my ($self, $session, $option) = @_;
129 0           my $config_file = $tmux_devmode->child($session);
130              
131             # return if no config and not saving
132 0 0 0       return if !-f $config_file && !$option->{save};
133              
134 0 0         if ( -f $config_file ) {
135 0           require YAML;
136 0           my ($config) = YAML::LoadFile("$config_file");
137 0           for my $key (keys %{ $config }) {
  0            
138 0 0         $option->{$key} = $config->{$key} if !exists $option->{$key};
139             }
140             }
141              
142             # save the config if requested to
143 0 0 0       if ($option->{save} || $option{curdir}) {
144             # create the path if missing
145 0           $config_file->parent->mkpath();
146              
147             # don't save saving
148 0           delete $option->{save};
149              
150 0 0         if ($option{curdir}) {
151 0           delete $option->{curdir};
152 0           $option->{chdir} = path('.')->realpath . '';
153             }
154              
155             # save the config to YAML
156 0           require YAML;
157 0           YAML::DumpFile("$config_file", $option);
158             }
159              
160 0           return;
161             }
162              
163             sub _qx {
164 0     0     my $self = shift;
165 0           return qx/@_/;
166             }
167              
168             sub _exec {
169 0     0     my $self = shift;
170 0 0         print join ' ', @_, "\n" if $option{verbose};
171 0 0         exec @_ if !$option{test};
172 0           return;
173             }
174              
175             sub _auto {
176 0     0     my ($self) = @_;
177 0           my $current = $ARGV[$option{current}];
178 0           my $previous = $ARGV[$option{current} - 1];
179              
180 0 0 0       if ( defined $current && $current =~ /^-/ ) {
    0          
181 0           print join "\n", qw/-l --layout -s --save -c --cd -C --curdir/, '';
182             }
183             elsif ( $previous =~ /^-c$|^--(?:chdir|cd)$/ ) {
184 0           print join "\n", glob "$current*";
185             }
186             else {
187 0 0         my $dir = $previous =~ /^-\w*l$|^--layout$/ ? $tmux_layout : $tmux_devmode;
188             my @found = sort {
189 0           lc $a cmp lc $b
190             }
191             grep {
192 0 0         !$current || /^$current/i
193             }
194             map {
195 0           m{/([^/]+)$}; $1
  0            
  0            
196             }
197             $dir->children;
198 0           print join "\n", @found, '';
199             }
200             }
201              
202             1;
203              
204             __END__