File Coverage

blib/lib/App/VTide/Command/Sessions.pm
Criterion Covered Total %
statement 27 121 22.3
branch 0 24 0.0
condition 0 13 0.0
subroutine 9 24 37.5
pod 3 11 27.2
total 39 193 20.2


line stmt bran cond sub pod time code
1             package App::VTide::Command::Sessions;
2              
3             # Created on: 2016-03-22 15:42:06
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 1     1   1019 use Moo;
  1         2  
  1         6  
10 1     1   2462 use warnings;
  1         3  
  1         28  
11 1     1   6 use version;
  1         2  
  1         6  
12 1     1   60 use Carp;
  1         2  
  1         48  
13 1     1   6 use English qw/ -no_match_vars /;
  1         3  
  1         6  
14 1     1   355 use YAML::Syck qw/ DumpFile LoadFile /;
  1         2  
  1         75  
15 1     1   8 use Path::Tiny;
  1         2  
  1         39  
16 1     1   6 use App::VTide::Sessions;
  1         2  
  1         37  
17 1     1   6 use Data::Dumper qw/Dumper/;
  1         3  
  1         1614  
18              
19             extends 'App::VTide::Command::Run';
20              
21             our $VERSION = version->new('1.0.5');
22             our $NAME = 'sessions';
23             our $OPTIONS = [
24             'dest|d=s', 'global|g', 'session|source|s=s', 'verbose|v+',
25             'update|u!', 'test|t!'
26             ];
27 0     0 1   sub details_sub { return ( $NAME, $OPTIONS ) }
28              
29             has global => (
30             is => 'ro',
31             lazy => 1,
32             default => sub {
33             $_[0]->options->opt->{global} || !$ENV{VTIDE_NAME};
34             },
35             );
36             has sessions => (
37             is => 'ro',
38             lazy => 1,
39             default => sub {
40             my ($self) = @_;
41             my $file =
42             $self->global
43             ? $App::VTide::Sessions::global_file
44             : $App::VTide::Sessions::local_file;
45             return App::VTide::Sessions->new( { sessions_file => $file } );
46             },
47             );
48              
49             sub run {
50 0     0 1   my ($self) = @_;
51              
52 0   0       $self->options->opt->{update} //= 1;
53 0   0       $self->options->opt->{session} ||= 'current';
54 0           my $local = !$self->global;
55 0   0       my $command = 'session_' . ( shift @{ $self->options->files } || 'list' );
56              
57 0 0         if ( !$self->can($command) ) {
58 0           warn "Unknown command $command!\n";
59 0           return;
60             }
61              
62 0           my $session = $self->sessions;
63              
64 0           $self->$command($session);
65              
66 0           return;
67             }
68              
69             sub session_list {
70 0     0 0   my ( $self, $session ) = @_;
71 0           my $name = $self->options->opt->{session};
72 0   0       $session ||= $self->sessions;
73              
74 0 0         if ( $self->options->opt->{verbose} ) {
75 0           print "Sessions:\n";
76 0           for my $name ( sort keys %{ $session->sessions } ) {
  0            
77 0           print " $name\n";
78             }
79 0           print "\n";
80             }
81              
82 0           print "$name:\n";
83 0 0         if ( $session->sessions->{$name} ) {
84 0 0         my $cmd = "vtide session"
85             . (
86             $name eq 'current'
87             ? ''
88             : " --session $name"
89             );
90 0           for my $i ( 0 ... @{ $session->sessions->{$name} } - 2 ) {
  0            
91 0           my $files = $session->sessions->{$name}[$i];
92              
93 0           print " ", ( join " ", @$files ), "\n";
94 0 0         if ( $i == 0 ) {
    0          
95 0           print " ('$cmd shift' to run)\n";
96             }
97 0           elsif ( $i == @{ $session->sessions->{$name} } - 2 ) {
98 0           print " ('$cmd pop' to run)\n";
99             }
100             }
101             }
102             else {
103 0           print " Empty\n";
104             }
105             }
106              
107             sub session_unshift {
108 0     0 0   my ($self) = @_;
109             return $self->modify_session(
110             sub {
111 0     0     unshift @{ $_[0] }, $self->options->files;
  0            
112 0           return;
113             }
114 0           );
115              
116             }
117              
118             sub session_push {
119 0     0 0   my ($self) = @_;
120             return $self->modify_session(
121             sub {
122 0     0     push @{ $_[0] }, $self->options->files;
  0            
123 0           return;
124             }
125 0           );
126              
127             }
128              
129             sub session_shift {
130 0     0 0   my ($self) = @_;
131             return $self->modify_session(
132             sub {
133 0     0     my ($session) = @_;
134 0           warn "running $session->[0][0]\n";
135 0           return shift @$session;
136             }
137 0           );
138             }
139              
140             sub session_pop {
141 0     0 0   my ($self) = @_;
142             return $self->modify_session(
143             sub {
144 0     0     my ($session) = @_;
145 0           return pop @$session;
146             }
147 0           );
148             }
149              
150             sub modify_session {
151 0     0 0   my ( $self, $modify ) = @_;
152 0           my $name = $self->options->opt->{session};
153              
154 0           my $session = $self->sessions->sessions;
155              
156 0           my $files = $modify->( $session->{$name} );
157              
158 0 0         if ( !@{ $session->{$name} } ) {
  0            
159 0           delete $session->{$name};
160 0           warn "Empty session removed!\n";
161             }
162              
163             # TODO work out why update unset with --no-update
164             # write the new session out
165 0 0         if ( $self->options->opt->update ) {
166 0           $self->sessions->write_session();
167             }
168              
169 0 0         if ( !$files ) {
170 0           $self->session_list();
171 0           return;
172             }
173              
174 0 0         my $action = $self->global ? "start" : "edit";
175 0           warn join ' ', 'vtide', $action, @$files;
176 0           system 'vtide', $action, @$files;
177 0           warn join ' ', 'vtide', $action, @$files;
178             }
179              
180             sub session_copy {
181 0     0 0   my ($self) = @_;
182 0           my $src = $self->options->opt->{session};
183 0           my $dest = $self->options->opt->{dest};
184              
185 0           my $session = $self->sessions->sessions;
186              
187 0 0         if ( !$dest ) {
188 0           warn "No destination name!";
189 0           return;
190             }
191 0           $session->{$dest} = [ map { [@$_] } @{ $session->{$src} } ];
  0            
  0            
192              
193 0           $self->sessions->write_session();
194 0           $self->session_list();
195             }
196              
197             sub session_save {
198 0     0 0   my ($self) = @_;
199 0   0       my $dest = $self->options->opt->{dest} || 'current';
200 0           my $session = $self->sessions->get_sessions($dest);
201              
202 0 0         if ( $self->options->opt->{global} ) {
203 0           my @list = map { ( split /:/, $_ )[0] } `tmux ls`;
  0            
204              
205 0           push @$session, @list;
206             }
207             else {
208 0           warn "Haven't yet built local session saving";
209             }
210              
211 0           $self->sessions->write_session();
212             }
213              
214             sub auto_complete {
215 0     0 1   my ( $self, $auto ) = @_;
216              
217 0   0       my $partial = $ARGV[ $auto - 1 ] || '';
218 0           print join ' ', grep { /^$partial/ } qw/
  0            
219             copy
220             list
221             pop
222             push
223             shift
224             unshift
225             /;
226             }
227              
228             1;
229              
230             __END__
231              
232             =head1 NAME
233              
234             App::VTide::Command::Sessions - Create/Update/List saved vtide sessions
235              
236             =head1 VERSION
237              
238             This documentation refers to App::VTide::Command::Sessions version 1.0.5
239              
240             =head1 SYNOPSIS
241              
242             vtide sessions [list] [(-s|--session) name] [-g|--global] [-v|--verbose]
243             vtide sessions unshift [(-s|--session) name] [-g|--global] [--no-update] [-v|--verbose]
244             vtide sessions push [(-s|--session) name] [-g|--global] [--no-update] [-v|--verbose]
245             vtide sessions shift [(-s|--session) name] [-g|--global] [--no-update] [-v|--verbose]
246             vtide sessions pop [(-s|--session) name] [-g|--global] [--no-update] [-v|--verbose]
247             vtide sessions copy (-s|--source) source_session [-d|--destination] destination_session [-g|--global] [-v|--verbose]
248             vtide sessions save [-d|--destination] destination-session-name
249              
250             OPTIONS
251             -g --global Look at the global sessions when in side a vtide managed terminal
252             -s --session[=]name
253             Look at or modify this session (Default current)
254             -s --source[=]name
255             Copy this session
256             -d --dest[=]name
257             Replace/add this session
258             -u --update Update sessions (default)
259             --no-update Don't update sessions
260              
261             -v --verbose Show more detailed output
262             --help Show this help
263             --man Show the full man page
264              
265             =head1 DESCRIPTION
266              
267             =head1 SUBROUTINES/METHODS
268              
269             =head3 C<run ()>
270              
271             Run the command
272              
273             =head2 C<auto_complete ()>
274              
275             Auto completes sub-commands that can have help shown
276              
277             =head2 C<details_sub ()>
278              
279             Returns the commands details
280              
281             =head1 DIAGNOSTICS
282              
283             =head1 CONFIGURATION AND ENVIRONMENT
284              
285             =head1 DEPENDENCIES
286              
287             =head1 INCOMPATIBILITIES
288              
289             =head1 BUGS AND LIMITATIONS
290              
291             There are no known bugs in this module.
292              
293             Please report problems to Ivan Wills (ivan.wills@gmail.com).
294              
295             Patches are welcome.
296              
297             =head1 AUTHOR
298              
299             Ivan Wills - (ivan.wills@gmail.com)
300              
301             =head1 LICENSE AND COPYRIGHT
302              
303             Copyright (c) 2016 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
304             All rights reserved.
305              
306             This module is free software; you can redistribute it and/or modify it under
307             the same terms as Perl itself. See L<perlartistic>. This program is
308             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
309             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
310             PARTICULAR PURPOSE.
311              
312             =cut