File Coverage

blib/lib/App/VTide/Command/Sessions.pm
Criterion Covered Total %
statement 27 118 22.8
branch 0 24 0.0
condition 0 10 0.0
subroutine 9 24 37.5
pod 3 11 27.2
total 39 187 20.8


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   998 use Moo;
  1         2  
  1         6  
10 1     1   2509 use warnings;
  1         3  
  1         27  
11 1     1   8 use version;
  1         2  
  1         5  
12 1     1   58 use Carp;
  1         3  
  1         50  
13 1     1   6 use English qw/ -no_match_vars /;
  1         2  
  1         5  
14 1     1   349 use YAML::Syck qw/ DumpFile LoadFile /;
  1         4  
  1         69  
15 1     1   7 use Path::Tiny;
  1         2  
  1         50  
16 1     1   7 use App::VTide::Sessions;
  1         3  
  1         25  
17 1     1   5 use Data::Dumper qw/Dumper/;
  1         9  
  1         1865  
18              
19             extends 'App::VTide::Command::Run';
20              
21             our $VERSION = version->new('1.0.4');
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             warn "here";
41             my ($self) = @_;
42             my $file =
43             $self->global
44             ? $App::VTide::Sessions::global_file
45             : $App::VTide::Sessions::local_file;
46             my $obj = App::VTide::Sessions->new( { sessions_file => $file } );
47             warn $obj;
48             return $obj;
49             },
50             );
51              
52             sub run {
53 0     0 1   my ($self) = @_;
54              
55 0   0       $self->options->opt->{update} //= 1;
56 0   0       $self->options->opt->{session} ||= 'current';
57 0           my $local = !$self->global;
58 0   0       my $command = 'session_' . ( shift @{ $self->options->files } || 'list' );
59              
60 0 0         if ( !$self->can($command) ) {
61 0           warn "Unknown command $command!\n";
62 0           return;
63             }
64              
65 0           my $session = $self->sessions;
66              
67 0           $self->$command($session);
68              
69 0           return;
70             }
71              
72             sub session_list {
73 0     0 0   my ( $self, $session ) = @_;
74 0           my $name = $self->options->opt->{session};
75              
76 0 0         if ( $self->options->opt->{verbose} ) {
77 0           print "Sessions:\n";
78 0           for my $name ( sort keys %{ $session->sessions } ) {
  0            
79 0           print " $name\n";
80             }
81 0           print "\n";
82             }
83              
84 0           print "$name:\n";
85 0 0         if ( $session->sessions->{$name} ) {
86 0 0         my $cmd = "vtide session"
87             . (
88             $name eq 'current'
89             ? ''
90             : " --session $name"
91             );
92 0           for my $i ( 0 ... @{ $session->sessions->{$name} } - 2 ) {
  0            
93 0           my $files = $session->sessions->{$name}[$i];
94              
95 0           print " ", ( join " ", @$files ), "\n";
96 0 0         if ( $i == 0 ) {
    0          
97 0           print " ('$cmd shift' to run)\n";
98             }
99 0           elsif ( $i == @{ $session->sessions->{$name} } - 2 ) {
100 0           print " ('$cmd pop' to run)\n";
101             }
102             }
103             }
104             else {
105 0           print " Empty\n";
106             }
107             }
108              
109             sub session_unshift {
110 0     0 0   my ($self) = @_;
111             return $self->modify_session(
112             sub {
113 0     0     unshift @{ $_[0] }, $self->options->files;
  0            
114 0           return;
115             }
116 0           );
117              
118             }
119              
120             sub session_push {
121 0     0 0   my ($self) = @_;
122             return $self->modify_session(
123             sub {
124 0     0     push @{ $_[0] }, $self->options->files;
  0            
125 0           return;
126             }
127 0           );
128              
129             }
130              
131             sub session_shift {
132 0     0 0   my ($self) = @_;
133             return $self->modify_session(
134             sub {
135 0     0     my ($session) = @_;
136 0           return shift @$session;
137             }
138 0           );
139             }
140              
141             sub session_pop {
142 0     0 0   my ($self) = @_;
143             return $self->modify_session(
144             sub {
145 0     0     my ($session) = @_;
146 0           return pop @$session;
147             }
148 0           );
149             }
150              
151             sub modify_session {
152 0     0 0   my ( $self, $modify ) = @_;
153 0           my $name = $self->options->opt->{session};
154              
155 0           my $session = $self->sessions->sessions;
156              
157 0           my $files = $modify->( $session->{$name} );
158              
159 0 0         if ( !@{ $session->{$name} } ) {
  0            
160 0           delete $session->{$name};
161 0           warn "Empty session removed!\n";
162             }
163              
164             # TODO work out why update unset with --no-update
165             # write the new session out
166 0 0         if ( $self->options->opt->update ) {
167 0           $self->sessions->write_session();
168             }
169              
170 0 0         if ( !$files ) {
171 0           $self->session_list();
172 0           return;
173             }
174              
175 0 0         my $action = $self->global ? "start" : "edit";
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.4
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