scripts/completion.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
  10 #
  11 # This software is licensed as described in the file COPYING, which
  12 # you should have received as part of this distribution. The terms
  13 # are also available at https://curl.se/docs/copyright.html.
  14 #
  15 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  16 # copies of the Software, and permit persons to whom the Software is
  17 # furnished to do so, under the terms of the COPYING file.
  18 #
  19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  20 # KIND, either express or implied.
  21 #
  22 # SPDX-License-Identifier: curl
  23 #
  24 ###########################################################################
  25
  26 use strict;
  27 use warnings;
  28 use Getopt::Long();
  29 use Pod::Usage();
  30
  31 my $curl = 'curl';
  32 my $shell = 'zsh';
  33 my $help = 0;
  34 Getopt::Long::GetOptions(
  35     'curl=s' => \$curl,
  36     'shell=s' => \$shell,
  37     'help' => \$help,
  38 ) or Pod::Usage::pod2usage();
  39 Pod::Usage::pod2usage() if $help;
  40
  41 my $regex = '\s+(?:(-[^\s]+),\s)?(--[^\s]+)\s*(\<.+?\>)?\s+(.*)';
  42 my @opts = parse_main_opts('--help all', $regex);
  43
  44 if ($shell eq 'fish') {
  45     print "# curl fish completion\n\n";
  46     print qq{$_ \n} foreach (@opts);
  47 } elsif ($shell eq 'zsh') {
  48     my $opts_str;
  49
  50     $opts_str .= qq{  $_ \\\n} foreach (@opts);
  51     chomp $opts_str;
  52
  53 my $tmpl = <<"EOS";
  54 #compdef curl
  55
  56 # curl zsh completion
  57
  58 local curcontext="\$curcontext" state state_descr line
  59 typeset -A opt_args
  60
  61 local rc=1
  62
  63 _arguments -C -S \\
  64 $opts_str
  65   '*:URL:_urls' && rc=0
  66
  67 return rc
  68 EOS
  69
  70     print $tmpl;
  71 } else {
  72     die("Unsupported shell: $shell");
  73 }
  74
  75 sub parse_main_opts {
  76     my ($cmd, $regex) = @_;
  77
  78     my @list;
  79     my @lines = call_curl($cmd);
  80
  81     foreach my $line (@lines) {
  82         my ($short, $long, $arg, $desc) = ($line =~ /^$regex/) or next;
  83
  84         my $option = '';
  85
  86         $arg =~ s/\:/\\\:/g if defined $arg;
  87
  88         $desc =~ s/'/'\\''/g if defined $desc;
  89         $desc =~ s/\[/\\\[/g if defined $desc;
  90         $desc =~ s/\]/\\\]/g if defined $desc;
  91         $desc =~ s/\:/\\\:/g if defined $desc;
  92
  93         if ($shell eq 'fish') {
  94             $option .= "complete --command curl";
  95             $option .= " --short-option '" . strip_dash(trim($short)) . "'"
  96                 if defined $short;
  97             $option .= " --long-option '" . strip_dash(trim($long)) . "'"
  98                 if defined $long;
  99             $option .= " --description '" . strip_dash(trim($desc)) . "'"
 100                 if defined $desc;
 101         } elsif ($shell eq 'zsh') {
 102             $option .= '{' . trim($short) . ',' if defined $short;
 103             $option .= trim($long)  if defined $long;
 104             $option .= '}' if defined $short;
 105             $option .= '\'[' . trim($desc) . ']\'' if defined $desc;
 106
 107             if (defined $arg) {
 108                 $option .= ":'$arg'";
 109                 if ($arg =~ /<file ?(name)?>|<path>/) {
 110                     $option .= ':_files';
 111                 } elsif ($arg =~ /<dir>/) {
 112                     $option .= ":'_path_files -/'";
 113                 } elsif ($arg =~ /<url>/i) {
 114                     $option .= ':_urls';
 115                 } elsif ($long =~ /ftp/ && $arg =~ /<method>/) {
 116                     $option .= ":'(multicwd nocwd singlecwd)'";
 117                 } elsif ($arg =~ /<method>/) {
 118                     $option .= ":'(DELETE GET HEAD POST PUT)'";
 119                 }
 120             }
 121         }
 122
 123         push @list, $option;
 124     }
 125
 126     # Sort longest first, because zsh won't complete an option listed
 127     # after one that's a prefix of it.
 128     @list = sort {
 129         $a =~ /([^=]*)/; my $ma = $1;
 130         $b =~ /([^=]*)/; my $mb = $1;
 131
 132         length($mb) <=> length($ma)
 133     } @list if $shell eq 'zsh';
 134
 135     return @list;
 136 }
 137
 138 sub trim { my $s = shift; $s =~ s/^\s+|\s+$//g; return $s };
 139 sub strip_dash { my $s = shift; $s =~ s/^-+//g; return $s };
 140
 141 sub call_curl {
 142     my ($cmd) = @_;
 143     my $output = `"$curl" $cmd`;
 144     if ($? == -1) {
 145         die "Could not run curl: $!";
 146     } elsif ((my $exit_code = $? >> 8) != 0) {
 147         die "curl returned $exit_code with output:\n$output";
 148     }
 149     return split /\n/, $output;
 150 }
 151
 152 __END__
 153
 154 =head1 NAME
 155
 156 completion.pl - Generates tab-completion files for various shells
 157
 158 =head1 SYNOPSIS
 159
 160 completion.pl [options...]
 161
 162     --curl   path to curl executable
 163     --shell  zsh/fish
 164     --help   prints this help
 165
 166 =cut