line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::VTide::Command; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Created on: 2016-01-30 15:06:14 |
4
|
|
|
|
|
|
|
# Create by: Ivan Wills |
5
|
|
|
|
|
|
|
# $Id$ |
6
|
|
|
|
|
|
|
# $Revision$, $HeadURL$, $Date$ |
7
|
|
|
|
|
|
|
# $Revision$, $Source$, $Date$ |
8
|
|
|
|
|
|
|
|
9
|
5
|
|
|
5
|
|
3825
|
use Moo; |
|
5
|
|
|
|
|
17
|
|
|
5
|
|
|
|
|
38
|
|
10
|
5
|
|
|
5
|
|
14226
|
use warnings; |
|
5
|
|
|
|
|
15
|
|
|
5
|
|
|
|
|
161
|
|
11
|
5
|
|
|
5
|
|
33
|
use version; |
|
5
|
|
|
|
|
15
|
|
|
5
|
|
|
|
|
43
|
|
12
|
5
|
|
|
5
|
|
340
|
use Carp; |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
270
|
|
13
|
5
|
|
|
5
|
|
47
|
use English qw/ -no_match_vars /; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
52
|
|
14
|
5
|
|
|
5
|
|
2633
|
use File::chdir; |
|
5
|
|
|
|
|
1998
|
|
|
5
|
|
|
|
|
442
|
|
15
|
5
|
|
|
5
|
|
44
|
use Path::Tiny; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
272
|
|
16
|
5
|
|
|
5
|
|
108
|
use YAML::Syck; |
|
5
|
|
|
|
|
17
|
|
|
5
|
|
|
|
|
348
|
|
17
|
5
|
|
|
5
|
|
1368
|
use List::MoreUtils qw/uniq/; |
|
5
|
|
|
|
|
27213
|
|
|
5
|
|
|
|
|
41
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our $VERSION = version->new('1.0.4'); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
has [qw/ defaults options /] => ( is => 'rw', ); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
has vtide => ( |
24
|
|
|
|
|
|
|
is => 'rw', |
25
|
|
|
|
|
|
|
required => 1, |
26
|
|
|
|
|
|
|
handles => [qw/ config hooks /], |
27
|
|
|
|
|
|
|
); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
has history => ( |
30
|
|
|
|
|
|
|
is => 'rw', |
31
|
|
|
|
|
|
|
default => sub { return path $ENV{HOME}, '.vtide/history.yml' }, |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
has glob_depth => ( |
35
|
|
|
|
|
|
|
is => 'rw', |
36
|
|
|
|
|
|
|
lazy => 1, |
37
|
|
|
|
|
|
|
default => sub { return $_[0]->config->get->{default}{glob_depth} || 3 }, |
38
|
|
|
|
|
|
|
); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub save_session { |
41
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $name, $dir ) = @_; |
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
0
|
my $file = $self->history; |
44
|
0
|
|
0
|
|
|
0
|
my $sessions = eval { LoadFile($file) } || {}; |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
0
|
$sessions->{sessions}{$name} = { |
47
|
|
|
|
|
|
|
time => scalar time, |
48
|
|
|
|
|
|
|
dir => "$dir", |
49
|
|
|
|
|
|
|
}; |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
|
|
0
|
DumpFile( $file, $sessions ); |
52
|
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
0
|
return; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub session_dir { |
57
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $name ) = @_; |
58
|
0
|
|
0
|
|
|
0
|
$name ||= ''; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# there are 3 ways of determining a session name: |
61
|
|
|
|
|
|
|
# 1. Passed in directly |
62
|
|
|
|
|
|
|
# 2. Set from the environment variable VTIDE_NAME |
63
|
|
|
|
|
|
|
# 3. Found in a config file in the current directory |
64
|
0
|
0
|
|
|
|
0
|
if ( !$name ) { |
65
|
0
|
0
|
|
|
|
0
|
die "No session name found!\n" if !-f '.vtide.yml'; |
66
|
0
|
|
|
|
|
0
|
my $config = LoadFile('.vtide.yml'); |
67
|
0
|
|
|
|
|
0
|
$name = $config->{name}; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
0
|
|
|
|
|
0
|
my $file = $self->history; |
71
|
0
|
|
0
|
|
|
0
|
my $sessions = eval { LoadFile($file) } || {}; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $dir = |
74
|
|
|
|
|
|
|
ref $sessions->{sessions}{$name} |
75
|
|
|
|
|
|
|
? $sessions->{sessions}{$name}{dir} |
76
|
|
|
|
|
|
|
: $sessions->{sessions}{$name} |
77
|
|
|
|
|
|
|
|| $ENV{VTIDE_DIR} |
78
|
0
|
0
|
0
|
|
|
0
|
|| path('.')->absolute; |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
0
|
my $config = path $dir, '.vtide.yml'; |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
0
|
$self->config->local_config($config); |
83
|
0
|
|
|
|
|
0
|
$self->env( $name, $dir, $config ); |
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
0
|
return ( $name, $dir ); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub env { |
89
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $name, $dir, $config ) = @_; |
90
|
|
|
|
|
|
|
|
91
|
0
|
|
0
|
|
|
0
|
$dir ||= path( $ENV{VTIDE_DIR} || '.' )->absolute; |
|
|
|
0
|
|
|
|
|
92
|
0
|
|
|
|
|
0
|
$dir = path($dir); |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
0
|
|
|
0
|
$config ||= $ENV{VTIDE_CONFIG} || $dir->path('.vtide.yml'); |
|
|
|
0
|
|
|
|
|
95
|
|
|
|
|
|
|
$name ||= |
96
|
|
|
|
|
|
|
$ENV{VTIDE_NAME} |
97
|
|
|
|
|
|
|
|| $self->defaults->{name} |
98
|
|
|
|
|
|
|
|| $self->config->get->{name} |
99
|
0
|
|
0
|
|
|
0
|
|| $dir->basename; |
|
|
|
0
|
|
|
|
|
100
|
|
|
|
|
|
|
|
101
|
0
|
|
|
|
|
0
|
$ENV{VTIDE_NAME} = "$name"; |
102
|
0
|
|
|
|
|
0
|
$ENV{VTIDE_DIR} = "$dir"; |
103
|
0
|
|
|
|
|
0
|
$ENV{VTIDE_CONFIG} = "$config"; |
104
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
0
|
return ( $name, $dir, $config ); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub auto_complete { |
109
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
110
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
0
|
warn lc( ref $self =~ /.*::/ ), " has no --auto-complete support\n"; |
112
|
0
|
|
|
|
|
0
|
return; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub _dglob { |
116
|
0
|
|
|
0
|
|
0
|
my ( $self, $glob ) = @_; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# if the "glob" is actually a single file then just return it |
119
|
0
|
0
|
|
|
|
0
|
return ($glob) if -f $glob; |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
0
|
my @files; |
122
|
0
|
|
|
|
|
0
|
for my $deep_glob ( $self->_globable($glob) ) { |
123
|
0
|
|
|
|
|
0
|
push @files, glob $deep_glob; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
0
|
return uniq @files; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub _globable { |
130
|
32
|
|
|
32
|
|
2615
|
my ( $self, $glob ) = @_; |
131
|
|
|
|
|
|
|
|
132
|
32
|
|
|
|
|
82
|
my ( $base, $rest ) = $glob =~ m{^(.*?) [*][*] /? (.*)$}xms; |
133
|
|
|
|
|
|
|
|
134
|
32
|
100
|
|
|
|
81
|
return ($glob) if !$rest; |
135
|
|
|
|
|
|
|
|
136
|
7
|
|
|
|
|
13
|
my @globs; |
137
|
7
|
|
|
|
|
126
|
for ( 0 .. $self->glob_depth ) { |
138
|
27
|
|
|
|
|
99
|
push @globs, $self->_globable("$base$rest"); |
139
|
27
|
|
|
|
|
51
|
$base .= '*/'; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
7
|
|
|
|
|
28
|
return @globs; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
1; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
__END__ |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=head1 NAME |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
App::VTide::Command - Base class for VTide sub commands |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head1 VERSION |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
This documentation refers to App::VTide::Command version 1.0.4 |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head1 SYNOPSIS |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# in a package with the prefix App::VTide::Command:: |
160
|
|
|
|
|
|
|
extends 'App::VTide::Command'; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# child class code |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head1 DESCRIPTION |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
C<App::VTide::Command> is the base class for the sub-commands of C<vtide>. |
167
|
|
|
|
|
|
|
It provides helper methods and default attributes for those commands. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head2 C<new ( %hash )> |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
See the attributes for the arguments to pass here. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=head2 C<session_dir ( $name )> |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
Get the session directory for C<$name>. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 C<save_session ( $name, $dir )> |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Save the session and directory in the history file if it is configured. If |
182
|
|
|
|
|
|
|
its not, then the environment variable C<$VTIDE_DIR> is used and failing that |
183
|
|
|
|
|
|
|
falls back to the current directory. The local C<.vtide.yml> is then loaded |
184
|
|
|
|
|
|
|
into the config. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head2 C<env ( $name, $dir, $config )> |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
Configure the environment variables based on C<$name>, C<$dir> and C<$config> |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=head2 C<auto_complete ()> |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
Default auto-complete action for sub-commands |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head2 C<_dglob ( $glob )> |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Gets the files globs from $glob |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head2 C<_globable ( $glob )> |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Converts a deep blog (e.g. **/*.js) to a series of perl globs |
201
|
|
|
|
|
|
|
(e.g. ['*.js', '*/*.js', '*/*/*.js', '*/*/*/*.js']) |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head2 C<defaults> |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Values from command line arguments |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=head2 C<options> |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
Command line configuration |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head2 C<vtide> |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
Reference to parent command with configuration object. |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=head2 C<history> |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
History configuration file |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head1 DIAGNOSTICS |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=head1 INCOMPATIBILITIES |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
There are no known bugs in this module. |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
Please report problems to Ivan Wills (ivan.wills@gmail.com). |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
Patches are welcome. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=head1 AUTHOR |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Ivan Wills - (ivan.wills@gmail.com) |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Copyright (c) 2016 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077). |
244
|
|
|
|
|
|
|
All rights reserved. |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it under |
247
|
|
|
|
|
|
|
the same terms as Perl itself. See L<perlartistic>. This program is |
248
|
|
|
|
|
|
|
distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; |
249
|
|
|
|
|
|
|
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A |
250
|
|
|
|
|
|
|
PARTICULAR PURPOSE. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=cut |