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|ls)\s/) {
  88         @return = cplx('CPAN::Author',uc($word));
  89     } elsif ($line =~ /^b\s/) {
  90         CPAN::Shell->local_bundles;
  91         @return = cplx('CPAN::Bundle',$word);
  92     } elsif ($line =~ /^d\s/) {
  93         @return = cplx('CPAN::Distribution',$word);
  94     } elsif ($line =~ m/^(
  95                           [mru]|make|clean|dump|get|test|install|readme|look|cvs_import|perldoc|recent
  96                          )\s/x ) {
  97         if ($word =~ /^Bundle::/) {
  98             CPAN::Shell->local_bundles;
  99         }
 100         @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
 101     } elsif ($line =~ /^i\s/) {
 102         @return = cpl_any($word);
 103     } elsif ($line =~ /^reload\s/) {
 104         @return = cpl_reload($word,$line,$pos);
 105     } elsif ($line =~ /^o\s/) {
 106         @return = cpl_option($word,$line,$pos);
 107     } elsif ($line =~ m/^\S+\s/ ) {
 108         # fallback for future commands and what we have forgotten above
 109         @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
 110     } else {
 111         @return = ();
 112     }
 113     return @return;
 114 }
 115
 116 #-> sub CPAN::Complete::cplx ;
 117 sub cplx {
 118     my($class, $word) = @_;
 119     if (CPAN::_sqlite_running()) {
 120         $CPAN::SQLite->search($class, "^\Q$word\E");
 121     }
 122     sort grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
 123 }
 124
 125 #-> sub CPAN::Complete::cpl_any ;
 126 sub cpl_any {
 127     my($word) = shift;
 128     return (
 129             cplx('CPAN::Author',$word),
 130             cplx('CPAN::Bundle',$word),
 131             cplx('CPAN::Distribution',$word),
 132             cplx('CPAN::Module',$word),
 133            );
 134 }
 135
 136 #-> sub CPAN::Complete::cpl_reload ;
 137 sub cpl_reload {
 138     my($word,$line,$pos) = @_;
 139     $word ||= "";
 140     my(@words) = split " ", $line;
 141     CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
 142     my(@ok) = qw(cpan index);
 143     return @ok if @words == 1;
 144     return grep /^\Q$word\E/, @ok if @words == 2 && $word;
 145 }
 146
 147 #-> sub CPAN::Complete::cpl_option ;
 148 sub cpl_option {
 149     my($word,$line,$pos) = @_;
 150     $word ||= "";
 151     my(@words) = split " ", $line;
 152     CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
 153     my(@ok) = qw(conf debug);
 154     return @ok if @words == 1;
 155     return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
 156     if (0) {
 157     } elsif ($words[1] eq 'index') {
 158         return ();
 159     } elsif ($words[1] eq 'conf') {
 160         return CPAN::HandleConfig::cpl(@_);
 161     } elsif ($words[1] eq 'debug') {
 162         return sort grep /^\Q$word\E/i,
 163             sort keys %CPAN::DEBUG, 'all';
 164     }
 165 }
 166
 167 1;