File Coverage

blib/lib/CPAN/Complete.pm
Criterion Covered Total %
statement 9 79 11.3
branch 0 58 0.0
condition 0 24 0.0
subroutine 3 9 33.3
pod 0 6 0.0
total 12 176 6.8


line stmt bran cond sub pod time code
1             # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2             # vim: ts=4 sts=4 sw=4:
3             package CPAN::Complete;
4 12     12   53 use strict;
  12         17  
  12         970  
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              
42 12         519 use vars qw(
43             $VERSION
44 12     12   47 );
  12         13  
45             $VERSION = "5.5001";
46              
47             package CPAN::Complete;
48 12     12   47 use strict;
  12         13  
  12         13273  
49              
50             sub gnu_cpl {
51 0     0 0   my($text, $line, $start, $end) = @_;
52 0           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 0 0         return () unless @perlret;
56 0           my($newtext) = $text;
57 0           for (my $i = length($text)+1;;$i++) {
58 0 0 0       last unless length($perlret[0]) && length($perlret[0]) >= $i;
59 0           my $try = substr($perlret[0],0,$i);
60 0           my @tries = grep {substr($_,0,$i) eq $try} @perlret;
  0            
61             # warn "try[$try]tries[@tries]";
62 0 0         if (@tries == @perlret) {
63 0           $newtext = $try;
64             } else {
65 0           last;
66             }
67             }
68 0           ($newtext,@perlret);
69             }
70              
71             #-> sub CPAN::Complete::cpl ;
72             sub cpl {
73 0     0 0   my($word,$line,$pos) = @_;
74 0   0       $word ||= "";
75 0   0       $line ||= "";
76 0   0       $pos ||= 0;
77 0 0         CPAN->debug("word [$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
78 0           $line =~ s/^\s*//;
79 0 0         if ($line =~ s/^((?:notest|f?force)\s*)//) {
80 0           $pos -= length($1);
81             }
82 0           my @return;
83 0 0 0       if ($pos == 0 || $line =~ /^(?:h(?:elp)?|\?)\s/) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
84 0           @return = grep /^\Q$word\E/, @CPAN::Complete::COMMANDS;
85             } elsif ( $line !~ /^[\!abcdghimorutl]/ ) {
86 0           @return = ();
87             } elsif ($line =~ /^a\s/) {
88 0           @return = cplx('CPAN::Author',uc($word));
89             } elsif ($line =~ /^ls\s/) {
90 0           my($author,$rest) = $word =~ m|([^/]+)/?(.*)|;
91 0 0 0       @return = $rest ? () : map {"$_/"} cplx('CPAN::Author',uc($author||""));
  0            
92 0           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 0           CPAN::Shell->local_bundles;
97 0           @return = cplx('CPAN::Bundle',$word);
98             } elsif ($line =~ /^d\s/) {
99 0           @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 0 0         if ($word =~ /^Bundle::/) {
104 0           CPAN::Shell->local_bundles;
105             }
106 0           @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
107             } elsif ($line =~ /^i\s/) {
108 0           @return = cpl_any($word);
109             } elsif ($line =~ /^reload\s/) {
110 0           @return = cpl_reload($word,$line,$pos);
111             } elsif ($line =~ /^o\s/) {
112 0           @return = cpl_option($word,$line,$pos);
113             } elsif ($line =~ m/^\S+\s/ ) {
114             # fallback for future commands and what we have forgotten above
115 0           @return = (cplx('CPAN::Module',$word),cplx('CPAN::Bundle',$word));
116             } else {
117 0           @return = ();
118             }
119 0           return @return;
120             }
121              
122             #-> sub CPAN::Complete::cplx ;
123             sub cplx {
124 0     0 0   my($class, $word) = @_;
125 0 0         if (CPAN::_sqlite_running()) {
126 0           $CPAN::SQLite->search($class, "^\Q$word\E");
127             }
128 0           my $method = "id";
129 0 0         $method = "pretty_id" if $class eq "CPAN::Distribution";
130 0           sort grep /^\Q$word\E/, map { $_->$method() } $CPAN::META->all_objects($class);
  0            
131             }
132              
133             #-> sub CPAN::Complete::cpl_any ;
134             sub cpl_any {
135 0     0 0   my($word) = shift;
136             return (
137 0           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 0     0 0   my($word,$line,$pos) = @_;
147 0   0       $word ||= "";
148 0           my(@words) = split " ", $line;
149 0 0         CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
150 0           my(@ok) = qw(cpan index);
151 0 0         return @ok if @words == 1;
152 0 0 0       return grep /^\Q$word\E/, @ok if @words == 2 && $word;
153             }
154              
155             #-> sub CPAN::Complete::cpl_option ;
156             sub cpl_option {
157 0     0 0   my($word,$line,$pos) = @_;
158 0   0       $word ||= "";
159 0           my(@words) = split " ", $line;
160 0 0         CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
161 0           my(@ok) = qw(conf debug);
162 0 0         return @ok if @words == 1;
163 0 0 0       return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
164 0 0         if (0) {
    0          
    0          
165 0           } elsif ($words[1] eq 'index') {
166 0           return ();
167             } elsif ($words[1] eq 'conf') {
168 0           return CPAN::HandleConfig::cpl(@_);
169             } elsif ($words[1] eq 'debug') {
170 0           return sort grep /^\Q$word\E/i,
171             sort keys %CPAN::DEBUG, 'all';
172             }
173             }
174              
175             1;