Annotation of embedaddon/curl/scripts/completion.pl, revision 1.1.1.1

1.1       misho       1: #!/usr/bin/env perl
                      2: #***************************************************************************
                      3: #                                  _   _ ____  _
                      4: #  Project                     ___| | | |  _ \| |
                      5: #                             / __| | | | |_) | |
                      6: #                            | (__| |_| |  _ <| |___
                      7: #                             \___|\___/|_| \_\_____|
                      8: #
                      9: # Copyright (C) 1998 - 2020, 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.haxx.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: ###########################################################################
                     23: 
                     24: use strict;
                     25: use warnings;
                     26: use Getopt::Long();
                     27: use Pod::Usage();
                     28: 
                     29: my $curl = 'curl';
                     30: my $shell = 'zsh';
                     31: my $help = 0;
                     32: Getopt::Long::GetOptions(
                     33:     'curl=s' => \$curl,
                     34:     'shell=s' => \$shell,
                     35:     'help' => \$help,
                     36: ) or Pod::Usage::pod2usage();
                     37: Pod::Usage::pod2usage() if $help;
                     38: 
                     39: my $regex = '\s+(?:(-[^\s]+),\s)?(--[^\s]+)\s*(\<.+?\>)?\s+(.*)';
                     40: my @opts = parse_main_opts('--help', $regex);
                     41: 
                     42: if ($shell eq 'fish') {
                     43:     print "# curl fish completion\n\n";
                     44:     print qq{$_ \n} foreach (@opts);
                     45: } elsif ($shell eq 'zsh') {
                     46:     my $opts_str;
                     47: 
                     48:     $opts_str .= qq{  $_ \\\n} foreach (@opts);
                     49:     chomp $opts_str;
                     50: 
                     51: my $tmpl = <<"EOS";
                     52: #compdef curl
                     53: 
                     54: # curl zsh completion
                     55: 
                     56: local curcontext="\$curcontext" state state_descr line
                     57: typeset -A opt_args
                     58: 
                     59: local rc=1
                     60: 
                     61: _arguments -C -S \\
                     62: $opts_str
                     63:   '*:URL:_urls' && rc=0
                     64: 
                     65: return rc
                     66: EOS
                     67: 
                     68:     print $tmpl;
                     69: } else {
                     70:     die("Unsupported shell: $shell");
                     71: }
                     72: 
                     73: sub parse_main_opts {
                     74:     my ($cmd, $regex) = @_;
                     75: 
                     76:     my @list;
                     77:     my @lines = call_curl($cmd);
                     78: 
                     79:     foreach my $line (@lines) {
                     80:         my ($short, $long, $arg, $desc) = ($line =~ /^$regex/) or next;
                     81: 
                     82:         my $option = '';
                     83: 
                     84:         $arg =~ s/\:/\\\:/g if defined $arg;
                     85: 
                     86:         $desc =~ s/'/'\\''/g if defined $desc;
                     87:         $desc =~ s/\[/\\\[/g if defined $desc;
                     88:         $desc =~ s/\]/\\\]/g if defined $desc;
                     89:         $desc =~ s/\:/\\\:/g if defined $desc;
                     90: 
                     91:         if ($shell eq 'fish') {
                     92:             $option .= "complete --command curl";
                     93:             $option .= " --short-option '" . strip_dash(trim($short)) . "'"
                     94:                 if defined $short;
                     95:             $option .= " --long-option '" . strip_dash(trim($long)) . "'"
                     96:                 if defined $long;
                     97:             $option .= " --description '" . strip_dash(trim($desc)) . "'"
                     98:                 if defined $desc;
                     99:         } elsif ($shell eq 'zsh') {
                    100:             $option .= '{' . trim($short) . ',' if defined $short;
                    101:             $option .= trim($long)  if defined $long;
                    102:             $option .= '}' if defined $short;
                    103:             $option .= '\'[' . trim($desc) . ']\'' if defined $desc;
                    104: 
                    105:             $option .= ":'$arg'" if defined $arg;
                    106: 
                    107:             $option .= ':_files'
                    108:                 if defined $arg and ($arg eq '<file>' || $arg eq '<filename>'
                    109:                     || $arg eq '<dir>');
                    110:         }
                    111: 
                    112:         push @list, $option;
                    113:     }
                    114: 
                    115:     # Sort longest first, because zsh won't complete an option listed
                    116:     # after one that's a prefix of it.
                    117:     @list = sort {
                    118:         $a =~ /([^=]*)/; my $ma = $1;
                    119:         $b =~ /([^=]*)/; my $mb = $1;
                    120: 
                    121:         length($mb) <=> length($ma)
                    122:     } @list if $shell eq 'zsh';
                    123: 
                    124:     return @list;
                    125: }
                    126: 
                    127: sub trim { my $s = shift; $s =~ s/^\s+|\s+$//g; return $s };
                    128: sub strip_dash { my $s = shift; $s =~ s/^-+//g; return $s };
                    129: 
                    130: sub call_curl {
                    131:     my ($cmd) = @_;
                    132:     my $output = `"$curl" $cmd`;
                    133:     if ($? == -1) {
                    134:         die "Could not run curl: $!";
                    135:     } elsif ((my $exit_code = $? >> 8) != 0) {
                    136:         die "curl returned $exit_code with output:\n$output";
                    137:     }
                    138:     return split /\n/, $output;
                    139: }
                    140: 
                    141: __END__
                    142: 
                    143: =head1 NAME
                    144: 
                    145: completion.pl - Generates tab-completion files for various shells
                    146: 
                    147: =head1 SYNOPSIS
                    148: 
                    149: completion.pl [options...]
                    150: 
                    151:     --curl   path to curl executable
                    152:     --shell  zsh/fish
                    153:     --help   prints this help
                    154: 
                    155: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>