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