1# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2# vim: ts=4 sts=4 sw=4:
3package CPAN::Complete;
4use strict;
5@CPAN::Complete::ISA = qw(CPAN::Debug);
6# Q: where is the "How do I add a new command" HOWTO?
7# A: git log -p -1 355c44e9caaec857e4b12f51afb96498833c3e36 where andk added the report command
8@CPAN::Complete::COMMANDS = sort qw(
9                                    ? ! a b d h i m o q r u
10                                    autobundle
11                                    bye
12                                    clean
13                                    cvs_import
14                                    dump
15                                    exit
16                                    failed
17                                    force
18                                    fforce
19                                    hosts
20                                    install
21                                    install_tested
22                                    is_tested
23                                    look
24                                    ls
25                                    make
26                                    mkmyconfig
27                                    notest
28                                    perldoc
29                                    quit
30                                    readme
31                                    recent
32                                    recompile
33                                    reload
34                                    report
35                                    reports
36                                    scripts
37                                    smoke
38                                    test
39                                    upgrade
40);
41
42use vars qw(
43            $VERSION
44);
45$VERSION = "5.5001";
46
47package CPAN::Complete;
48use strict;
49
50sub gnu_cpl {
51    my($text, $line, $start, $end) = @_;
52    my(@perlret) = cpl($text, $line, $start);
53    # find longest common match. Can anybody show me how to peruse
54    # T::R::Gnu to have this done automatically? Seems expensive.
55    return () unless @perlret;
56    my($newtext) = $text;
57    for (my $i = length($text)+1;;$i++) {
58        last unless length($perlret[0]) && length($perlret[0]) >= $i;
59        my $try = substr($perlret[0],0,$i);
60        my @tries = grep {substr($_,0,$i) eq $try} @perlret;
61        # warn "try[$try]tries[@tries]";
62        if (@tries == @perlret) {
63            $newtext = $try;
64        } else {
65            last;
66        }
67    }
68    ($newtext,@perlret);
69}
70
71#-> sub CPAN::Complete::cpl ;
72sub cpl {
73    my($word,$line,$pos) = @_;
74    $word ||= "";
75    $line ||= "";
76    $pos ||= 0;
77    CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
78    $line =~ s/^\s*//;
79    if ($line =~ s/^((?:notest|f?force)\s*)//) {
80        $pos -= length($1);
81    }
82    my @return;
83    if ($pos == 0 || $line =~ /^(?:h(?:elp)?|\?)\s/) {
84        @return = grep /^\Q$word\E/, @CPAN::Complete::COMMANDS;
85    } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
86        @return = ();
87    } elsif ($line =~ /^a\s/) {
88        @return = cplx('CPAN::Author',uc($word));
89    } elsif ($line =~ /^ls\s/) {
90        my($author,$rest) = $word =~ m|([^/]+)/?(.*)|;
91        @return = $rest ? () : map {"$_/"} cplx('CPAN::Author',uc($author||""));
92        if (0 && 1==@return) { # XXX too slow and even wrong when there is a * already
93            @return = grep /^\Q$word\E/, map {"$author/$_->[2]"} CPAN::Shell->expand("Author",$author)->ls("$rest*","2");
94        }
95    } elsif ($line =~ /^b\s/) {
96        CPAN::Shell->local_bundles;
97        @return = cplx('CPAN::Bundle',$word);
98    } elsif ($line =~ /^d\s/) {
99        @return = cplx('CPAN::Distribution',$word);
100    } elsif ($line =~ m/^(
101                          [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
102                         )\s/x ) {
103        if ($word =~ /^Bundle::/) {
104            CPAN::Shell->local_bundles;
105        }
106        @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
107    } elsif ($line =~ /^i\s/) {
108        @return = cpl_any($word);
109    } elsif ($line =~ /^reload\s/) {
110        @return = cpl_reload($word,$line,$pos);
111    } elsif ($line =~ /^o\s/) {
112        @return = cpl_option($word,$line,$pos);
113    } elsif ($line =~ m/^\S+\s/ ) {
114        # fallback for future commands and what we have forgotten above
115        @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
116    } else {
117        @return = ();
118    }
119    return @return;
120}
121
122#-> sub CPAN::Complete::cplx ;
123sub cplx {
124    my($class, $word) = @_;
125    if (CPAN::_sqlite_running()) {
126        $CPAN::SQLite->search($class, "^\Q$word\E");
127    }
128    my $method = "id";
129    $method = "pretty_id" if $class eq "CPAN::Distribution";
130    sort grep /^\Q$word\E/, map { $_->$method() } $CPAN::META->all_objects($class);
131}
132
133#-> sub CPAN::Complete::cpl_any ;
134sub cpl_any {
135    my($word) = shift;
136    return (
137            cplx('CPAN::Author',$word),
138            cplx('CPAN::Bundle',$word),
139            cplx('CPAN::Distribution',$word),
140            cplx('CPAN::Module',$word),
141           );
142}
143
144#-> sub CPAN::Complete::cpl_reload ;
145sub cpl_reload {
146    my($word,$line,$pos) = @_;
147    $word ||= "";
148    my(@words) = split " ", $line;
149    CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
150    my(@ok) = qw(cpan index);
151    return @ok if @words == 1;
152    return grep /^\Q$word\E/, @ok if @words == 2 && $word;
153}
154
155#-> sub CPAN::Complete::cpl_option ;
156sub cpl_option {
157    my($word,$line,$pos) = @_;
158    $word ||= "";
159    my(@words) = split " ", $line;
160    CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
161    my(@ok) = qw(conf debug);
162    return @ok if @words == 1;
163    return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
164    if (0) {
165    } elsif ($words[1] eq 'index') {
166        return ();
167    } elsif ($words[1] eq 'conf') {
168        return CPAN::HandleConfig::cpl(@_);
169    } elsif ($words[1] eq 'debug') {
170        return sort grep /^\Q$word\E/i,
171            sort keys %CPAN::DEBUG, 'all';
172    }
173}
174
1751;
176