Commit | Line | Data |
f9916dde |
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 |
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 |
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 |
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 |
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; |