1package Net::LDAP::Shell::Completion; 2 3use Exporter; 4 5use vars qw(@EXPORT %CMDTYPES %TYPEFUNCS $SHELL $VERSION); 6 7$VERSION = 1.00; 8 9@EXPORT = qw( 10 attemptCompletion 11 registerCmd 12); 13 14%CMDTYPES = ( 15 'file' => [ 16 qw(cat cd ls edit clone rm) 17 ], 18); 19 20#--------------------------------------------------------------------------------- 21#--------------------------------------------------------------------------------- 22# completion stuff 23# yay 24#--------------------------------------------------------------------------------- 25#--------------------------------------------------------------------------------- 26 27#--------------------------------------------------------------------------------- 28sub attemptCompletion { 29 exit; 30 unless (defined $Net::LDAP::Shell::SHELL) { 31 die "There must be an instance of an LDAP Shell to use this package.\n"; 32 } 33 $SHELL = $Net::LDAP::Shell::SHELL; 34 35 my ($text, $line, $start, $end) = @_; 36 37# _debug(@_); 38 39 $SHELL->term->Attribs->{attempted_completion_over} = 1; 40 41 ### Command completion ### 42 # XXX no command completion yet... 43 #if (substr($line, 0, $start) =~ /^\s*$/) { 44 # return _commandCompletion(@_); 45 #} 46 47 ### Parameter Completion ### 48 my $line2 = $line; 49 $line2 =~ s/^\s+//; 50 my ($cmd, $rest) = split(/\s+/, $line2, 2); 51 52 if (grep $cmd, @{ $CMDTYPES{'file'} }) { 53 return fileCompletion(@_); 54 } else { 55 return; 56 } 57} 58#--------------------------------------------------------------------------------- 59 60#--------------------------------------------------------------------------------- 61# fileComplete 62sub fileComplete { 63 my ($text, $line, $start, $end) = @_; 64 65 $SHELL->term->Attribs->{completion_append_character} = "\0"; 66 67 # match the 'filtertype' portion of an LDAP filter (RFC 2254 and RFC 2251) 68 69 my ($prefix, $attr, $extra, $partToComplete) = $text =~ m/(^|^.*\()([a-z][a-z0-9-]*)((?:;[a-z0-9-]*)?(?:=|~=|>=|<=))(.*)$/i; 70 return undef unless defined($extra); 71 72 my $result = $SHELL->search( 73 attrs => [$attr], 74 filter => "$attr=$partToComplete*" 75 ); 76 return undef unless defined($result); 77 78 if ($result->code and $result->code == Net::LDAP::Constant::LDAP_NO_SUCH_OBJECT()) { 79 return undef; 80 } 81 82 my @entries = $result->entries; 83 return undef unless scalar(@entries); 84 my @possible_entries = map { 85 $prefix.$attr.$extra.scalar($_->get_value($attr)) 86 } @entries; # Bug: only uses first attribute value. 87 88 my $common = maxCommon(@possible_entries); 89 return $common, @possible_entries; 90} 91# fileComplete 92#--------------------------------------------------------------------------------- 93 94#--------------------------------------------------------------------------------- 95# maxCommon 96sub maxCommon { 97 return '' unless scalar(@_); 98 my $firstElement = shift; 99 my $common = ''; 100 for (my $i = 1; $i <= length($firstElement); $i++) { 101 my $str = substr($firstElement, 0, $i); 102 last if (grep {substr($_, 0, $i) ne $str} @_); 103 $common = $str; 104 } 105} 106 107