lib/CPAN/Complete.pm

   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 = ();
  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 ;
 123 sub 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 ;
 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;