]> Dogcows Code - chaz/git-codeowners/blob - lib/App/Codeowners/Options.pm
split off File::Codeowners
[chaz/git-codeowners] / lib / App / Codeowners / Options.pm
1 package App::Codeowners::Options;
2 # ABSTRACT: Getopt and shell completion for App::Codeowners
3
4 use v5.10.1;
5 use warnings;
6 use strict;
7
8 use Encode qw(decode);
9 use Getopt::Long 2.39 ();
10 use Path::Tiny;
11
12 our $VERSION = '9999.999'; # VERSION
13
14 sub _pod2usage {
15 eval { require Pod::Usage };
16 if ($@) {
17 my $ref = $VERSION eq '9999.999' ? 'master' : "v$VERSION";
18 my $exit = (@_ == 1 && $_[0] =~ /^\d+$/ && $_[0]) //
19 (@_ % 2 == 0 && {@_}->{'-exitval'}) // 2;
20 print STDERR <<END;
21 Online documentation is available at:
22
23 https://github.com/chazmcgarvey/git-codeowners/blob/$ref/README.md
24
25 Tip: To enable inline documentation, install the Pod::Usage module.
26
27 END
28 exit $exit;
29 }
30 else {
31 Pod::Usage::pod2usage(@_);
32 }
33 }
34
35 sub _early_options {
36 return {
37 'color|colour!' => (-t STDOUT ? 1 : 0), ## no critic (InputOutput::ProhibitInteractiveTest)
38 'format|f=s' => undef,
39 'help|h|?' => 0,
40 'manual|man' => 0,
41 'shell-completion:s' => undef,
42 'version|v' => 0,
43 };
44 }
45
46 sub _command_options {
47 return {
48 'create' => {},
49 'owners' => {
50 'pattern=s' => '',
51 },
52 'patterns' => {
53 'owner=s' => '',
54 },
55 'projects' => {},
56 'show' => {
57 'owner=s@' => [],
58 'pattern=s@' => [],
59 'project=s@' => [],
60 'patterns!' => 0,
61 'projects!' => undef,
62 },
63 'update' => {},
64 };
65 }
66
67 sub _commands {
68 my $self = shift;
69 my @commands = sort keys %{$self->_command_options};
70 return @commands;
71 }
72
73 sub _options {
74 my $self = shift;
75 my @command_options;
76 if (my $command = $self->{command}) {
77 @command_options = keys %{$self->_command_options->{$command} || {}};
78 }
79 return (keys %{$self->_early_options}, @command_options);
80 }
81
82 =method new
83
84 $options = App::Codeowners::Options->new(@ARGV);
85
86 Construct a new object.
87
88 =cut
89
90 sub new {
91 my $class = shift;
92 my @args = @_;
93
94 # assume UTF-8 args if non-ASCII
95 @args = map { decode('UTF-8', $_) } @args if grep { /\P{ASCII}/ } @args;
96
97 my $self = bless {}, $class;
98
99 my @args_copy = @args;
100
101 my $opts = $self->get_options(
102 args => \@args,
103 spec => $self->_early_options,
104 config => 'pass_through',
105 ) or _pod2usage(2);
106
107 if ($ENV{CODEOWNERS_COMPLETIONS}) {
108 $self->{command} = $args[0] || '';
109 my $cword = $ENV{CWORD};
110 my $cur = $ENV{CUR} || '';
111 # Adjust cword to remove progname
112 while (0 < --$cword) {
113 last if $cur eq ($args_copy[$cword] || '');
114 }
115 $self->completions($cword, @args_copy);
116 exit 0;
117 }
118
119 if ($opts->{version}) {
120 my $progname = path($0)->basename;
121 print "${progname} ${VERSION}\n";
122 exit 0;
123 }
124 if ($opts->{help}) {
125 _pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS COMMANDS)]);
126 }
127 if ($opts->{manual}) {
128 _pod2usage(-exitval => 0, -verbose => 2);
129 }
130 if (defined $opts->{shell_completion}) {
131 $self->shell_completion($opts->{shell_completion});
132 exit 0;
133 }
134
135 # figure out the command (or default to "show")
136 my $command = shift @args;
137 my $command_options = $self->_command_options->{$command || ''};
138 if (!$command_options) {
139 unshift @args, $command if defined $command;
140 $command = 'show';
141 $command_options = $self->_command_options->{$command};
142 }
143
144 my $more_opts = $self->get_options(
145 args => \@args,
146 spec => $command_options,
147 ) or _pod2usage(2);
148
149 %$self = (%$opts, %$more_opts, command => $command, args => \@args);
150 return $self;
151 }
152
153 =method command
154
155 $str = $options->command;
156
157 Get the command specified by args provided when the object was created.
158
159 =cut
160
161 sub command {
162 my $self = shift;
163 my $command = $self->{command};
164 my @commands = sort keys %{$self->_command_options};
165 return if not grep { $_ eq $command } @commands;
166 $command =~ s/[^a-z]/_/g;
167 return $command;
168 }
169
170 =method args
171
172 $args = $options->args;
173
174 Get the args provided when the object was created.
175
176 =cut
177
178 sub args {
179 my $self = shift;
180 return @{$self->{args} || []};
181 }
182
183 =method get_options
184
185 $options = $options->get_options(
186 args => \@ARGV,
187 spec => \@expected_options,
188 callback => sub { my ($arg, $results) = @_; ... },
189 );
190
191 Convert command-line arguments to options, based on specified rules.
192
193 Returns a hashref of options or C<undef> if an error occurred.
194
195 =for :list
196 * C<args> - Arguments from the caller (e.g. C<@ARGV>).
197 * C<spec> - List of L<Getopt::Long> compatible option strings.
198 * C<callback> - Optional coderef to call for non-option arguments.
199 * C<config> - Optional L<Getopt::Long> configuration string.
200
201 =cut
202
203 sub get_options {
204 my $self = shift;
205 my $args = {@_ == 1 && ref $_[0] eq 'HASH' ? %{$_[0]} : @_};
206
207 my %options;
208 my %results;
209 while (my ($opt, $default_value) = each %{$args->{spec}}) {
210 my ($name) = $opt =~ /^([^=:!|]+)/;
211 $name =~ s/-/_/g;
212 $results{$name} = $default_value;
213 $options{$opt} = \$results{$name};
214 }
215
216 if (my $fn = $args->{callback}) {
217 $options{'<>'} = sub {
218 my $arg = shift;
219 $fn->($arg, \%results);
220 };
221 }
222
223 my $p = Getopt::Long::Parser->new;
224 $p->configure($args->{config} || 'default');
225 return if !$p->getoptionsfromarray($args->{args}, %options);
226
227 return \%results;
228 }
229
230 =method shell_completion
231
232 $options->shell_completion($shell_type);
233
234 Print shell code to C<STDOUT> for the given type of shell. When eval'd, the shell code enables
235 completion for the F<git-codeowners> command.
236
237 =cut
238
239 sub shell_completion {
240 my $self = shift;
241 my $type = lc(shift || 'bash');
242
243 if ($type eq 'bash') {
244 print <<'END';
245 # git-codeowners - Bash completion
246 # To use, eval this code:
247 # eval "$(git-codeowners --shell-completion)"
248 # This will work without the bash-completion package, but handling of colons
249 # in the completion word will work better with bash-completion installed and
250 # enabled.
251 _git_codeowners() {
252 local cur words cword
253 if declare -f _get_comp_words_by_ref >/dev/null
254 then
255 _get_comp_words_by_ref -n : cur cword words
256 else
257 words=("${COMP_WORDS[@]}")
258 cword=${COMP_CWORD}
259 cur=${words[cword]}
260 fi
261 local IFS=$'\n'
262 COMPREPLY=($(CODEOWNERS_COMPLETIONS=1 CWORD="$cword" CUR="$cur" ${words[@]}))
263 # COMPREPLY=($(${words[0]} --completions "$cword" "${words[@]}"))
264 if [[ "$?" -eq 9 ]]
265 then
266 COMPREPLY=($(compgen -A "${COMPREPLY[0]}" -- "$cur"))
267 fi
268 declare -f __ltrim_colon_completions >/dev/null && \
269 __ltrim_colon_completions "$cur"
270 return 0
271 }
272 complete -F _git_codeowners git-codeowners
273 END
274 }
275 else {
276 # TODO - Would be nice to support Zsh
277 warn "No such shell completion: $type\n";
278 }
279 }
280
281 =method completions
282
283 $options->completions($current_arg_index, @args);
284
285 Print completions to C<STDOUT> for the given argument list and cursor position, and exit.
286
287 May also exit with status 9 and a compgen action printed to C<STDOUT> to indicate that the shell
288 should generate its own completions.
289
290 Doesn't return.
291
292 =cut
293
294 sub completions {
295 my $self = shift;
296 my $cword = shift;
297 my @words = @_;
298
299 my $current = $words[$cword] || '';
300 my $prev = $words[$cword - 1] || '';
301
302 my $reply;
303
304 if ($prev eq '--format' || $prev eq '-f') {
305 $reply = $self->_completion_formats;
306 }
307 elsif ($current =~ /^-/) {
308 $reply = $self->_completion_options;
309 }
310 else {
311 if (!$self->command) {
312 $reply = [$self->_commands, @{$self->_completion_options([keys %{$self->_early_options}])}];
313 }
314 else {
315 print 'file';
316 exit 9;
317 }
318 }
319
320 local $, = "\n";
321 print grep { /^\Q$current\E/ } @$reply;
322 exit 0;
323 }
324
325 sub _completion_options {
326 my $self = shift;
327 my $opts = shift || [$self->_options];
328
329 my @options;
330
331 for my $option (@$opts) {
332 my ($names, $op, $vtype) = $option =~ /^([^=:!]+)([=:!]?)(.*)$/;
333 my @names = split(/\|/, $names);
334
335 for my $name (@names) {
336 if ($op eq '!') {
337 push @options, "--$name", "--no-$name";
338 }
339 else {
340 if (length($name) > 1) {
341 push @options, "--$name";
342 }
343 else {
344 push @options, "-$name";
345 }
346 }
347 }
348 }
349
350 return [sort @options];
351 }
352
353 sub _completion_formats { [qw(csv json json:pretty tsv yaml)] }
354
355 1;
This page took 0.056362 seconds and 4 git commands to generate.