Commit | Line | Data |
---|---|---|
f9916dde A |
1 | # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*- |
2 | # vim: ts=4 sts=4 sw=4: | |
3 | package CPAN::Complete; | |
4 | use strict; | |
5 | @CPAN::Complete::ISA = qw(CPAN::Debug); | |
6 | # Q: where is the "How do I add a new command" HOWTO? | |
7 | # A: svn diff -r 1048:1049 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 | ||
42 | use vars qw( | |
43 | $VERSION | |
44 | ); | |
45 | $VERSION = "5.5"; | |
46 | ||
47 | package CPAN::Complete; | |
48 | use strict; | |
49 | ||
50 | sub 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 ; | |
72 | sub 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 = (); | |
2f2071b1 | 87 | } elsif ($line =~ /^a\s/) { |
f9916dde | 88 | @return = cplx('CPAN::Author',uc($word)); |
2f2071b1 A |
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 | } | |
f9916dde A |
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 ; | |
123 | sub cplx { | |
124 | my($class, $word) = @_; | |
125 | if (CPAN::_sqlite_running()) { | |
126 | $CPAN::SQLite->search($class, "^\Q$word\E"); | |
127 | } | |
2f2071b1 A |
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); | |
f9916dde A |
131 | } |
132 | ||
133 | #-> sub CPAN::Complete::cpl_any ; | |
134 | sub 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 ; | |
145 | sub 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 ; | |
156 | sub 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 | ||
175 | 1; |