Thread: [LDAPsh-cvs] ldapsh ldapsh,1.20,1.21
Status: Beta
Brought to you by:
rcorvalan
Menu
▾
▴
ldapsh-cvs
|
From: <rco...@us...> - 2003-08-28 23:20:02
|
Update of /cvsroot/ldapsh/ldapsh
In directory sc8-pr-cvs1:/tmp/cvs-serv17309
Modified Files:
ldapsh
Log Message:
Merged patches below into HEAD:
778341
778345
778347
778361
778364
778368
778369
Index: ldapsh
===================================================================
RCS file: /cvsroot/ldapsh/ldapsh/ldapsh,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** ldapsh 27 Jul 2003 07:03:01 -0000 1.20
--- ldapsh 28 Aug 2003 23:19:57 -0000 1.21
***************
*** 18,22 ****
=head1 SYNOPSIS
! ldapsh
=head1 EXAMPLE
--- 18,22 ----
=head1 SYNOPSIS
! ldapsh [expression]
=head1 EXAMPLE
***************
*** 124,133 ****
(composed of B<Net::LDAP::Entry> entries).
! =item 2. E<lt>functionE<gt> ['-r']
This is like the previous usage. The search filter is C<(objectclass=*)>.
! If the C<-r> option is used, the scope is I<sub>.
! Otherwise, the scope is I<one>.
=item 3. E<lt>functionE<gt> $entries
--- 124,135 ----
(composed of B<Net::LDAP::Entry> entries).
! =item 2. E<lt>functionE<gt> ['-r'|.]
This is like the previous usage. The search filter is C<(objectclass=*)>.
! If neither C<-r> nor the dot (a.k.a. "full stop" or "period") is given, the
! scope is I<one>. If C<-r> is given, the scope is I<sub>. If the dot is
! given, the scope is I<base> (this can be used to match the I<current working
! directory> itself).
=item 3. E<lt>functionE<gt> $entries
***************
*** 184,188 ****
use Data::Dumper qw(Dumper);
use Unicode::MapUTF8 qw(to_utf8 from_utf8);
! use subs qw(connect bind dump exit reset);
BEGIN {
--- 186,190 ----
use Data::Dumper qw(Dumper);
use Unicode::MapUTF8 qw(to_utf8 from_utf8);
! use subs qw(connect bind delete dump exit reset);
BEGIN {
***************
*** 219,223 ****
ENTRIES => {VALUE => [], RIGHTS => 'RW'},
PROMPT => {VALUE => '${APP}\[LDAP @ $CONNPARAMS->{SERVER}] $CWD > ', RIGHTS => 'RWL'},
! EDITOR => {VALUE => 'vi', RIGHTS => 'RWL'},
G => {VALUE => undef, RIGHTS => 'RWL'},
_APPENDRESULTS => {VALUE => 0, RIGHTS => ''},
--- 221,225 ----
ENTRIES => {VALUE => [], RIGHTS => 'RW'},
PROMPT => {VALUE => '${APP}\[LDAP @ $CONNPARAMS->{SERVER}] $CWD > ', RIGHTS => 'RWL'},
! EDITOR => {VALUE => $ENV{VISUAL} ? $ENV{VISUAL} : ($ENV{EDITOR} ? $ENV{EDITOR} : 'vi'), RIGHTS => 'RWL'},
G => {VALUE => undef, RIGHTS => 'RWL'},
_APPENDRESULTS => {VALUE => 0, RIGHTS => ''},
***************
*** 463,472 ****
push(@entries, @$spec);
} else {
! my $searchedEntries = _search(
! BaseDN => $Globals->{CWD}{VALUE},
! Scope => $Options->{r} ? 'sub' : 'one',
! Filter => $spec,
! Attribs => []
! );
if (defined($searchedEntries)) {
push(@entries, @$searchedEntries);
--- 465,484 ----
push(@entries, @$spec);
} else {
! my $searchedEntries;
! if ($spec =~ /^\.$/) {
! $searchedEntries = _search(
! BaseDN => $Globals->{CWD}{VALUE},
! Scope => 'base',
! Filter => '(objectclass=*)',
! Attribs => []
! );
! } else {
! $searchedEntries = _search(
! BaseDN => $Globals->{CWD}{VALUE},
! Scope => $Options->{r} ? 'sub' : 'one',
! Filter => $spec,
! Attribs => []
! );
! }
if (defined($searchedEntries)) {
push(@entries, @$searchedEntries);
***************
*** 510,513 ****
--- 522,556 ----
}
+ package PodHeadings;
+
+ use strict;
+ use vars qw(@ISA @EXPORT);
+
+ @ISA = qw(Pod::Select);
+
+ sub verbatim { }
+
+ sub textblock { }
+
+ sub interior_sequence { }
+
+ sub command {
+ my ($self, $cmd, $text, $line_num, $pod_para) = @_;
+ ## Just treat this like a textblock
+ if ($cmd =~ /^head[12]/) {
+ ## Just treat this like a textblock
+ my $out_fh = $self->output_handle();
+ print $out_fh "\n\n";
+ $self->SUPER::textblock($pod_para->raw_text(), $line_num, $pod_para);
+ }
+ elsif ($cmd =~ /^head/) {
+ my $stripped = $pod_para->text();
+ my $out_fh = $self->output_handle();
+ $stripped =~ s/\s+$//;
+ print $out_fh $stripped." ";
+ }
+ }
+
+ package ldapsh;
#############################################################
***************
*** 526,534 ****
### Command completion ###
if (substr($line, 0, $start) =~ /^\s*$/) {
! my $oldvalue = $TermAttribs->{completion_word};
! $TermAttribs->{completion_word} = [_commandListGenerator()];
! my @ret = $Term->completion_matches($text, $TermAttribs->{'list_completion_function'});
! $TermAttribs->{completion_word} = $oldvalue;
! return @ret;
}
--- 569,573 ----
### Command completion ###
if (substr($line, 0, $start) =~ /^\s*$/) {
! return _commandCompletion(@_);
}
***************
*** 594,603 ****
#########################################
! ### DN Completion ###
my $line2 = $line;
$line2 =~ s/^\s+//;
my ($cmd, $rest) = split(/\s+/, $line2, 2);
if ($cmd =~ /^(cd|acd|setdn|pushd|cat|vi|ls|list|dump|ldif|search|cp)$/) {
return _cdCommandCompletion(@_);
} else {
return();
--- 633,649 ----
#########################################
! ### Parameter Completion ###
my $line2 = $line;
$line2 =~ s/^\s+//;
my ($cmd, $rest) = split(/\s+/, $line2, 2);
if ($cmd =~ /^(cd|acd|setdn|pushd|cat|vi|ls|list|dump|ldif|search|cp)$/) {
+ # DN Completion
return _cdCommandCompletion(@_);
+ } elsif ($cmd =~ /^(help|which)$/) {
+ # Command Completion
+ return _commandCompletion(@_);
+ } elsif ($cmd =~ /^(add|replace|delete)$/) {
+ # Attribute Completion
+ return _attributeEditCompletion(@_);
} else {
return();
***************
*** 610,613 ****
--- 656,668 ----
}
+ sub _commandCompletion {
+ my ($text, $line, $start, $end) = @_;
+ my $oldvalue = $TermAttribs->{completion_word};
+ $TermAttribs->{completion_word} = [_commandListGenerator()];
+ my @ret = $Term->completion_matches($text, $TermAttribs->{'list_completion_function'});
+ $TermAttribs->{completion_word} = $oldvalue;
+ return @ret;
+ }
+
sub _cdCommandCompletion {
_bindneeded() or return ();
***************
*** 631,640 ****
return _entryDNCompletion($prefix, $attr, $partToComplete, $BaseDN);
} else {
! return _attributeNamesCompletion($prefix, $partToComplete, $BaseDN);
}
}
! sub _attributeNamesCompletion($$$) {
my ($prefix, $partToComplete, $BaseDN) = @_;
$TermAttribs->{completion_append_character} = "\0";
--- 686,733 ----
return _entryDNCompletion($prefix, $attr, $partToComplete, $BaseDN);
} else {
! return _attributeNamesDNCompletion($prefix, $partToComplete, $BaseDN);
}
}
+ sub _attributeEditCompletion{
+ my ($text, $line, $start, $end) = @_;
+
+ # Put argument delimiter after current comma
+ if ($text =~ /,$/) {
+ $TermAttribs->{completion_append_character} = ' ';
+ return $text;
+ }
+
+ my $entries = $Globals->{ENTRIES}{VALUE};
+
+ unless (defined($entries) && scalar(@{$entries}) > 0) {
+ return undef;
+ }
+
+ $TermAttribs->{completion_append_character} = "\0";
+
+ if (substr($line, 0, $start) =~ /,/) {
+ my ($name) = ($line =~ /^\S+\s+([^,]*)/);
+ return undef unless defined($name);
+ if ($name =~ /^['"]/) {
+ $name = substr($name, 1, length($name)-2);
+ }
+ my @possible_entries = @{$entries}[0]->get_value($name);
+ @possible_entries = grep {/^$text/i} @possible_entries;
+ return undef unless scalar(@possible_entries);
+ # TODO find longest common prefix
+ return $text, @possible_entries;
+ } else {
+ my @possible_entries = @{$entries}[0]->attributes();
+ @possible_entries = grep {/^$text/i} @possible_entries;
+ return undef unless scalar(@possible_entries);
+ # TODO find longest common prefix
+ # TODO use a cache
+ return $text, @possible_entries;
+ }
+ return undef;
+ }
! sub _attributeNamesDNCompletion($$$) {
my ($prefix, $partToComplete, $BaseDN) = @_;
$TermAttribs->{completion_append_character} = "\0";
***************
*** 741,747 ****
=head3 help
! B<Synopsis>: C<help [E<lt>commandE<gt>]>
! Print some help on the given command (or a global help if no command is given).
=cut
--- 834,841 ----
=head3 help
! B<Synopsis>: C<help ['E<lt>commandE<gt>'|'all']>
! Display help about the given command (or global help, if 'all' is given).
! If no parameter is given, a summary of commands will be shown.
=cut
***************
*** 760,764 ****
$parser = new Pod::Text::Termcap;
}
! if (defined($cmd)) {
require Pod::Select;
require File::Temp;
--- 854,861 ----
$parser = new Pod::Text::Termcap;
}
! if (defined($cmd) && $cmd eq "all") {
! $parser->parse_from_file($0, \*STDERR);
! }
! else {
require Pod::Select;
require File::Temp;
***************
*** 769,797 ****
push(@docfiles, $Opts->{RCFile}) if (-r $Opts->{RCFile});
foreach my $file (@docfiles) {
Pod::Select::podselect(
{
! -output => $podfile,
! -sections => [
! "DESCRIPTION/$cmd\\b.*",
! "COMMANDS/${cmd}\\b.*",
! "COMMANDS/.*/${cmd}"
! ]
! },
! $file
! );
! if (-s $podfile) {
! print STDERR "\n------------------------------\n";
! $parser->parse_from_file($podfile, \*STDERR);
! print STDERR "\n------------------------------\n";
! $found = 1;
! last;
}
}
if (! $found) {
! print STDERR "No help found on '$cmd'.\n";
}
unlink $podfile;
- } else {
- $parser->parse_from_file($0, \*STDERR);
}
return 1;
--- 866,902 ----
push(@docfiles, $Opts->{RCFile}) if (-r $Opts->{RCFile});
foreach my $file (@docfiles) {
+ if (defined($cmd)) {
Pod::Select::podselect(
{
! -output => $podfile,
! -sections => [
! "DESCRIPTION/$cmd\\b.*",
! "COMMANDS/${cmd}\\b.*",
! "COMMANDS/.*/${cmd}"
! ]
! }, $file);
! }
! else {
! my $headings = new PodHeadings();
! $headings->select("COMMANDS");
! $headings->parse_from_file($file, $podfile);
! }
! if (-s $podfile) {
! print STDERR "------------------------------\n";
! $parser->parse_from_file($podfile, \*STDERR);
! print STDERR "------------------------------\n";
! $found = 1;
! last;
}
}
if (! $found) {
! if (defined($cmd)) {
! print STDERR "No help found for '$cmd'.\n";
! }
! else {
! print STDERR "No help found.\n";
! }
}
unlink $podfile;
}
return 1;
***************
*** 1117,1123 ****
=head3 cd
! B<Synopsis>: C<cd 'E<lt>RDNE<gt>'>
Change the I<current working directory> to the specified RDN. You can specify multiple RDNs separated by commas (in the reverse order of the DN, to allow completion). You can also specify ".." to go to the parent DN.
See also the L<acd|acd>, L<setdn|setdn>, L<pushd|pushd> and L<popd|popd> commands.
--- 1222,1229 ----
=head3 cd
! B<Synopsis>: C<cd ['E<lt>RDNE<gt>']>
Change the I<current working directory> to the specified RDN. You can specify multiple RDNs separated by commas (in the reverse order of the DN, to allow completion). You can also specify ".." to go to the parent DN.
+ If no RDN is specified, the I<current working directory> is not changed.
See also the L<acd|acd>, L<setdn|setdn>, L<pushd|pushd> and L<popd|popd> commands.
***************
*** 1129,1132 ****
--- 1235,1239 ----
my $SubPath = shift();
+ $SubPath = "" unless defined($SubPath);
$SubPath =~ s/\s*,\s*$//;
$SubPath = join(',', reverse(split(/\s*,\s*/, $SubPath)));
***************
*** 1211,1214 ****
--- 1318,1323 ----
Perform the same action as the L<cd|cd> command. If the action succeeds, the old working directory is stored on a stack (which can be shown using L<dirs|dirs>). It can be restored using L<popd|popd>.
+ If no RDN is given, the I<current working directory> will be pushed onto the stack.
+
=cut
***************
*** 1415,1440 ****
- =head3 vi
-
- B<Synopsis>: C<vi E<lt>expansionE<gt>>
-
- Show the entries returned by the expansion (see L<Expansion|expansion>) in a vi editor, in read-only mode. Any changes made to the file has no effect on LDAP entries.
-
- =cut
-
- sub vi {
- my $entries = _entriesExpander undef, @_;
- return 0 unless defined $entries;
-
- require Net::LDAP::LDIF;
- require File::Temp;
- my (undef, $tempfile) = File::Temp::tempfile('LDAPShell_vi_XXXXXXXXXX', SUFFIX => '.ldif');
- Net::LDAP::LDIF->new($tempfile,"w")->write(@$entries);
- system($Globals->{EDITOR}{VALUE}, $tempfile);
- unlink $tempfile;
- return $entries;
- }
-
-
=head3 dump
--- 1524,1527 ----
***************
*** 1604,1607 ****
--- 1691,1792 ----
=head2 Changing entries
+ =head3 vi
+
+ B<Synopsis>: C<vi E<lt>expansionE<gt>>
+
+ Show the entries matched by the expansion (see L<Expansion|expansion>) in a text editor.
+ Entries are saved to a temporary file for editing in the LDIF format.
+ If the temporary file is modified, it will be re-read as an LDIF file and used to modify
+ the search results. Any changes can be viewed using L<changes|changes> and will need to
+ be committed using L<commit|commit>.
+ BUG (TODO): If you add an attribute to an entry (so, if you add a value to an attribute
+ that hadn't previously a value), it will not be detected. We should do a two-way check.
+
+ =cut
+
+ sub vi {
+ my $entries = _entriesExpander undef, @_;
+ return 0 unless defined $entries;
+
+ require Net::LDAP::LDIF;
+ require File::Temp;
+
+ my (undef, $tempfile) = File::Temp::tempfile('LDAPShell_vi_XXXXXXXXXX', SUFFIX => '.ldif');
+ Net::LDAP::LDIF->new($tempfile,"w")->write(@$entries);
+ my $mtime = (stat($tempfile))[9];
+
+ system($Globals->{EDITOR}{VALUE}, $tempfile);
+
+ # If modified, load as LDIF entry and compare to the same DNs in our directory (if they exist).
+ if ( (stat($tempfile))[9] > $mtime ) {
+ my $ldif = Net::LDAP::LDIF->new($tempfile, "r", onerror => undef);
+ my %hash = map { $_->dn => $_ } @$entries;
+ my $examined = 0;
+ while (not $ldif->eof()) {
+ my $entry = $ldif->read_entry();
+ if ($ldif->error()) {
+ printf STDERR "Encountered error reading LDIF format: [[%s]]\n\n", $ldif->error();
+ last;
+ } elsif (defined($entry)) {
+ $examined++;
+ print STDERR "Comparing " . $entry->dn . "...";
+ if (defined $hash{$entry->dn}) {
+ my $original = $hash{$entry->dn};
+ my %attrs = map { lc $_ => 1 } ($original->attributes(), $entry->attributes()); # unique keys
+ foreach my $attr (sort(keys %attrs)) {
+ my $pre_values = $original->get_value($attr, asref => 1 );
+ my $post_values = $entry->get_value($attr, asref => 1 );
+ if ($pre_values && $post_values) {
+ if (scalar(@$pre_values) != scalar(@$post_values)) {
+ foreach my $value ($post_values) {
+ $original->replace($attr => $value);
+ }
+ }
+ else { # try harder
+ my @a = sort @$pre_values;
+ my @b = sort @$post_values;
+ foreach my $i (0 .. scalar(@a)-1) {
+ if ($a[$i] ne $b[$i]) {
+ foreach my $value ($post_values) {
+ $original->replace($attr => $value);
+ }
+ last;
+ }
+ }
+ }
+ }
+ elsif ($pre_values) {
+ $original->delete($attr);
+ }
+ elsif ($post_values) {
+ foreach my $value ($post_values) {
+ $original->add($attr => $value);
+ }
+ }
+ }
+
+ my $changes = $original->{changes};
+ if (defined($changes) and scalar(@$changes)) {
+ print STDERR "changed\n\n";
+ }
+ else {
+ print STDERR "no modifications.\n\n";
+ }
+ }
+ else {
+ print STDERR "skipped.\n";
+ print STDERR "Warning: cannot change a DN or add an entry using vi.\n\n";
+ }
+ }
+ }
+ unless ($ldif->error() or $examined >= scalar(@$entries)) {
+ print STDERR "Warning: some entries were absent from the edited file.\n\n";
+ }
+ }
+ unlink $tempfile;
+ return $entries;
+ }
+
+
=head3 change
***************
*** 1643,1646 ****
--- 1828,1925 ----
+ =head3 add
+
+ B<Synopsis>: C<add 'E<lt>attributeE<gt>', 'E<lt>valueE<gt>' ...>
+
+ Add one or more new attributes to the entries in the L<$ENTRIES|"$ENTRIES"> global variable.
+
+ The values will be added to the values that already exist for the given attribute.
+
+ The entries are locally modified! You must L<commit|commit>! You can see the changes
+ done using the L<changes|changes> command.
+
+ Example: C<add 'givenName', 'Bob', 'Robert'>
+
+ =cut
+
+ sub add {
+ my $entries = $Globals->{ENTRIES}{VALUE};
+
+ _haveentries() or return 0;
+
+ if (scalar @_ < 2) {
+ print STDERR "You must supply both an attribute and some values.\n";
+ return 0;
+ }
+
+ my $attr = shift;
+
+ map { $_->add($attr, [@_]) } @$entries;
+ return 1;
+ }
+
+
+ =head3 replace
+
+ B<Synopsis>: C<replace 'E<lt>attributeE<gt>', 'E<lt>valueE<gt>' ...>
+
+ Similar to L<add|add>, except that the given values will replace any values that
+ already exist for the given attribute.
+
+ The entries are merely locally modified! You must L<commit|commit>! You can see the changes
+ using the L<changes|changes> command.
+
+ Example: C<replace 'givenName', 'Bill', 'William'>
+
+ =cut
+
+ sub replace {
+ my $entries = $Globals->{ENTRIES}{VALUE};
+
+ _haveentries() or return 0;
+
+ if (scalar @_ < 2) {
+ print STDERR "You must supply both an attribute and some values.\n";
+ return 0;
+ }
+
+ my $attr = shift;
+
+ map { $_->replace($attr, [@_]) } @$entries;
+ return 1;
+ }
+
+
+ =head3 delete
+
+ B<Synopsis>: C<delete 'E<lt>attributeE<gt>'[, 'E<lt>valueE<gt>' ...]>
+
+ Delete the values of given attribute from the the L<$ENTRIES|"$ENTRIES"> global variable.
+ If no values are given, the entire attribute will be deleted.
+
+ The entries are locally modified! You must L<commit|commit>! You can see the changes
+ done using the L<changes|changes> command.
+
+ Example: C<delete 'givenName'>
+
+ =cut
+
+ sub delete {
+ my $entries = $Globals->{ENTRIES}{VALUE};
+
+ _haveentries() or return 0;
+
+ if (scalar @_ < 1) {
+ print STDERR "You must at least supply an attribute name.\n";
+ return 0;
+ }
+
+ my $attr = shift;
+
+ map { $_->delete($attr, [@_]) } @$entries;
+ return 1;
+ }
+
+
=head3 changes
***************
*** 1904,1907 ****
--- 2183,2188 ----
So, in your shell you can type "ads" and get connected to a specific server.
+ Additionally, you could invoke B<ldapsh> as C<ldapsh ads> to call the function
+ straight away.
Remember: you put in this file Perl code. So you can do whatever you want!!!
***************
*** 1972,1976 ****
=head2 $EDITOR
! The default editor used when the L<vi|vi> command is called. By default this is "vi".
=head2 $G
--- 2253,2258 ----
=head2 $EDITOR
! The default editor used when the L<vi|vi> command is called. By default, this is obtained
! from the environment variable $VISUAL (if set) or $EDITOR (if set) or otherwise "vi".
=head2 $G
***************
*** 2059,2067 ****
_Init();
while (1) {
- my $APP = $Globals->{_APPENDRESULTS}{VALUE} ? '** ' : '';
- my $P = eval('return("' . $Globals->{PROMPT}{VALUE} . '")');
- print $@ unless defined $P;
- $_ = $Term->readline($P);
last unless defined($_);
s/^\s+//;
--- 2341,2350 ----
_Init();
+ $_ = "@ARGV";
+
+ # Note: this loop will be executed once before the prompt is shown.
+ # This is to support command-line arguments and will occur whether
+ # or not any were given.
while (1) {
last unless defined($_);
s/^\s+//;
***************
*** 2080,2084 ****
# The line below will quote some barewords such as "-l", "-a" etc...
# It's not perfect, but simple
! while (s/([\s,])(-\w)([\s,]|$)/$1'$2'$3/g) {};
my $redir;
--- 2363,2367 ----
# The line below will quote some barewords such as "-l", "-a" etc...
# It's not perfect, but simple
! while (s/([\s,])(-\w|\.)([\s,]|$)/$1'$2'$3/g) {};
my $redir;
***************
*** 2089,2092 ****
--- 2372,2380 ----
eval() || print STDERR $@;
redir if ($redir);
+
+ my $APP = $Globals->{_APPENDRESULTS}{VALUE} ? '** ' : '';
+ my $P = eval('return("' . $Globals->{PROMPT}{VALUE} . '")');
+ print $@ unless defined $P;
+ $_ = $Term->readline($P);
}
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X