Dogcows Code - chaz/git-codeowners/blob - 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 = '0.50'; # 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
  83 sub new {
  84     my $class = shift;
  85     my @args  = @_;
  86
  87     # assume UTF-8 args if non-ASCII
  88     @args = map { decode('UTF-8', $_) } @args if grep { /\P{ASCII}/ } @args;
  89
  90     my $self = bless {}, $class;
  91
  92     my @args_copy = @args;
  93
  94     my $opts = $self->get_options(
  95         args    => \@args,
  96         spec    => $self->_early_options,
  97         config  => 'pass_through',
  98     ) or _pod2usage(2);
  99
 100     if ($ENV{CODEOWNERS_COMPLETIONS}) {
 101         $self->{command} = $args[0] || '';
 102         my $cword = $ENV{CWORD};
 103         my $cur   = $ENV{CUR} || '';
 104         # Adjust cword to remove progname
 105         while (0 < --$cword) {
 106             last if $cur eq ($args_copy[$cword] || '');
 107         }
 108         $self->completions($cword, @args_copy);
 109         exit 0;
 110     }
 111
 112     if ($opts->{version}) {
 113         my $progname = path($0)->basename;
 114         print "${progname} ${VERSION}\n";
 115         exit 0;
 116     }
 117     if ($opts->{help}) {
 118         _pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS COMMANDS)]);
 119     }
 120     if ($opts->{manual}) {
 121         _pod2usage(-exitval => 0, -verbose => 2);
 122     }
 123     if (defined $opts->{shell_completion}) {
 124         $self->shell_completion($opts->{shell_completion});
 125         exit 0;
 126     }
 127
 128     # figure out the command (or default to "show")
 129     my $command = shift @args;
 130     my $command_options = $self->_command_options->{$command || ''};
 131     if (!$command_options) {
 132         unshift @args, $command if defined $command;
 133         $command = 'show';
 134         $command_options = $self->_command_options->{$command};
 135     }
 136
 137     my $more_opts = $self->get_options(
 138         args    => \@args,
 139         spec    => $command_options,
 140     ) or _pod2usage(2);
 141
 142     %$self = (%$opts, %$more_opts, command => $command, args => \@args);
 143     return $self;
 144 }
 145
 146
 147 sub command {
 148     my $self = shift;
 149     my $command = $self->{command};
 150     my @commands = sort keys %{$self->_command_options};
 151     return if not grep { $_ eq $command } @commands;
 152     $command =~ s/[^a-z]/_/g;
 153     return $command;
 154 }
 155
 156
 157 sub args {
 158     my $self = shift;
 159     return @{$self->{args} || []};
 160 }
 161
 162
 163 sub get_options {
 164     my $self = shift;
 165     my $args = {@_ == 1 && ref $_[0] eq 'HASH' ? %{$_[0]} : @_};
 166
 167     my %options;
 168     my %results;
 169     while (my ($opt, $default_value) = each %{$args->{spec}}) {
 170         my ($name) = $opt =~ /^([^=:!|]+)/;
 171         $name =~ s/-/_/g;
 172         $results{$name} = $default_value;
 173         $options{$opt}  = \$results{$name};
 174     }
 175
 176     if (my $fn = $args->{callback}) {
 177         $options{'<>'} = sub {
 178             my $arg = shift;
 179             $fn->($arg, \%results);
 180         };
 181     }
 182
 183     my $p = Getopt::Long::Parser->new;
 184     $p->configure($args->{config} || 'default');
 185     return if !$p->getoptionsfromarray($args->{args}, %options);
 186
 187     return \%results;
 188 }
 189
 190
 191 sub shell_completion {
 192     my $self = shift;
 193     my $type = lc(shift || 'bash');
 194
 195     if ($type eq 'bash') {
 196     print <<'END';
 197 # git-codeowners - Bash completion
 198 # To use, eval this code:
 199 #   eval "$(git-codeowners --shell-completion)"
 200 # This will work without the bash-completion package, but handling of colons
 201 # in the completion word will work better with bash-completion installed and
 202 # enabled.
 203 _git_codeowners() {
 204     local cur words cword
 205     if declare -f _get_comp_words_by_ref >/dev/null
 206     then
 207         _get_comp_words_by_ref -n : cur cword words
 208     else
 209         words=("${COMP_WORDS[@]}")
 210         cword=${COMP_CWORD}
 211         cur=${words[cword]}
 212     fi
 213     local IFS=$'\n'
 214     COMPREPLY=($(CODEOWNERS_COMPLETIONS=1 CWORD="$cword" CUR="$cur" ${words[@]}))
 215     # COMPREPLY=($(${words[0]} --completions "$cword" "${words[@]}"))
 216     if [[ "$?" -eq 9 ]]
 217     then
 218         COMPREPLY=($(compgen -A "${COMPREPLY[0]}" -- "$cur"))
 219     fi
 220     declare -f __ltrim_colon_completions >/dev/null && \
 221         __ltrim_colon_completions "$cur"
 222     return 0
 223 }
 224 complete -F _git_codeowners git-codeowners
 225 END
 226     }
 227     else {
 228         # TODO - Would be nice to support Zsh
 229         warn "No such shell completion: $type\n";
 230     }
 231 }
 232
 233
 234 sub completions {
 235     my $self    = shift;
 236     my $cword   = shift;
 237     my @words   = @_;
 238
 239     my $current = $words[$cword]     || '';
 240     my $prev    = $words[$cword - 1] || '';
 241
 242     my $reply;
 243
 244     if ($prev eq '--format' || $prev eq '-f') {
 245         $reply = $self->_completion_formats;
 246     }
 247     elsif ($current =~ /^-/) {
 248         $reply = $self->_completion_options;
 249     }
 250     else {
 251         if (!$self->command) {
 252             $reply = [$self->_commands, @{$self->_completion_options([keys %{$self->_early_options}])}];
 253         }
 254         else {
 255             print 'file';
 256             exit 9;
 257         }
 258     }
 259
 260     local $, = "\n";
 261     print grep { /^\Q$current\E/ } @$reply;
 262     exit 0;
 263 }
 264
 265 sub _completion_options {
 266     my $self = shift;
 267     my $opts = shift || [$self->_options];
 268
 269     my @options;
 270
 271     for my $option (@$opts) {
 272         my ($names, $op, $vtype) = $option =~ /^([^=:!]+)([=:!]?)(.*)$/;
 273         my @names = split(/\|/, $names);
 274
 275         for my $name (@names) {
 276             if ($op eq '!') {
 277                 push @options, "--$name", "--no-$name";
 278             }
 279             else {
 280                 if (length($name) > 1) {
 281                     push @options, "--$name";
 282                 }
 283                 else {
 284                     push @options, "-$name";
 285                 }
 286             }
 287         }
 288     }
 289
 290     return [sort @options];
 291 }
 292
 293 sub _completion_formats { [qw(csv json json:pretty tsv yaml)] }
 294
 295 1;
 296
 297 __END__
 298
 299 =pod
 300
 301 =encoding UTF-8
 302
 303 =head1 NAME
 304
 305 App::Codeowners::Options - Getopt and shell completion for App::Codeowners
 306
 307 =head1 VERSION
 308
 309 version 0.50
 310
 311 =head1 METHODS
 312
 313 =head2 new
 314
 315     $options = App::Codeowners::Options->new(@ARGV);
 316
 317 Construct a new object.
 318
 319 =head2 command
 320
 321     $str = $options->command;
 322
 323 Get the command specified by args provided when the object was created.
 324
 325 =head2 args
 326
 327     $args = $options->args;
 328
 329 Get the args provided when the object was created.
 330
 331 =head2 get_options
 332
 333     $options = $options->get_options(
 334         args     => \@ARGV,
 335         spec     => \@expected_options,
 336         callback => sub { my ($arg, $results) = @_; ... },
 337     );
 338
 339 Convert command-line arguments to options, based on specified rules.
 340
 341 Returns a hashref of options or C<undef> if an error occurred.
 342
 343 =over 4
 344
 345 =item *
 346
 347 C<args> - Arguments from the caller (e.g. C<@ARGV>).
 348
 349 =item *
 350
 351 C<spec> - List of L<Getopt::Long> compatible option strings.
 352
 353 =item *
 354
 355 C<callback> - Optional coderef to call for non-option arguments.
 356
 357 =item *
 358
 359 C<config> - Optional L<Getopt::Long> configuration string.
 360
 361 =back
 362
 363 =head2 shell_completion
 364
 365     $options->shell_completion($shell_type);
 366
 367 Print shell code to C<STDOUT> for the given type of shell. When eval'd, the shell code enables
 368 completion for the F<git-codeowners> command.
 369
 370 =head2 completions
 371
 372     $options->completions($current_arg_index, @args);
 373
 374 Print completions to C<STDOUT> for the given argument list and cursor position, and exit.
 375
 376 May also exit with status 9 and a compgen action printed to C<STDOUT> to indicate that the shell
 377 should generate its own completions.
 378
 379 Doesn't return.
 380
 381 =head1 BUGS
 382
 383 Please report any bugs or feature requests on the bugtracker website
 384 L<https://github.com/chazmcgarvey/git-codeowners/issues>
 385
 386 When submitting a bug or request, please include a test-file or a
 387 patch to an existing test-file that illustrates the bug or desired
 388 feature.
 389
 390 =head1 AUTHOR
 391
 392 Charles McGarvey <chazmcgarvey@brokenzipper.com>
 393
 394 =head1 COPYRIGHT AND LICENSE
 395
 396 This software is copyright (c) 2021 by Charles McGarvey.
 397
 398 This is free software; you can redistribute it and/or modify it under
 399 the same terms as the Perl 5 programming language system itself.
 400
 401 =cut