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