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