package LDAPShell;

use 5.006;
use strict;
#use warnings;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use LDAPShell ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( '_funcs' => [ qw(
				      _ls
				      _mv
				      _add
				      _modify
				      _delete
				      _cat
				      _login
				      _auth
				      _logout
				      _pwd
				      _cd
) ],
		     'all' => [ qw(

) ]
);

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);
our $VERSION = '1.00';

use Term::ReadLine;
use Term::ReadLine::Gnu;
use Term::ANSIColor;
use Getopt::Long;
use URI;
use Text::FormatTable;
use Unicode::String qw(utf8 latin1);
use vars qw(%Attribs @EXPORT @ISA);
use Net::LDAP qw(LDAP_NO_SUCH_OBJECT);
use ResourcePool;
use ResourcePool::Factory::Net::LDAP;

use LDAPShell::Callbacks;

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

sub toutf8
  {
    latin1($_[1]||'')->utf8;
  }

sub tolatin1
  {
    utf8($_[1]||'')->latin1;
  }

sub new
  {
    my $self = shift;
    my $class = ref $self || $self;
    my $this = bless {},$class;

    $this->{_term} = Term::ReadLine::Gnu->new('LDAP Shell');
    my $attribs = $this->{_term}->Attribs;
    $attribs->{completion_entry_function} = \&rdn_completion_function;
    $attribs->{basic_word_break_characters} = "\t\n\ ";
    $attribs->{completer_word_break_characters} = $attribs->{basic_word_break_characters};
    $attribs->{filename_quote_characters} = "\ ";
    $attribs->{completion_append_character} = '/';
    $attribs->{filename_completion_desired} = 1;
    $this->{_base} = '';
    $this->{_callbacks} = LDAPShell::Callbacks->new();
    my $uri = $this->getenv('AUTOCONNECT');
    if ($uri)
      {
	my $u = URI->new($uri) or die "Malformed uri: $uri\n";
	my ($host,$port,$path) = $u->opaque =~ /\/\/([^\/:]+):?([0-9]*)\/?(.*)/;
	$this->{_server} = $host;
	$this->{_port} = $port if $port;
	$this->{_base} = $path if $path;
	$this->reconnect();
      }
    $this;
  }

sub init
  {
    my $self = shift;
    my $ini = shift;

  }

sub callbacks { $_[0]->{_callbacks} }

my $_i;
sub rdn_completion_function ( $$ ) {
    my($text, $state) = @_;

    $_i = $state ? $_i + 1 : 0; # clear counter at the first call
    *Attribs = \%Term::ReadLine::Gnu::Attribs;
    my $cw = $Attribs{completion_word};
    for (; $_i <= $#{$cw}; $_i++) {
      #warn "\"$cw->[$_i]\"\n";
      return $cw->[$_i] if (substr($cw->[$_i],0,length($text)) eq $text);
    }
    return undef;
}

sub getenv
  {
    $ENV{"DSH_".$_[1]};
  }

sub setenv
  {
    $ENV{"DSH_".$_[1]} = $_[2];
  }

sub unset
  {
    delete $ENV{"DSH_".$_[1]};
  }

sub _escapespace
  {
    local $_ = shift;
    s/ /\\\ /og;
    $_;
  }

sub _unescapespace
  {
    local $_ = shift;
    s/\\\ / /og;
    $_;
  }

sub setup_autocompletion
  {
    my $self = shift;

    my $c = $self->connection;
    my $dn = $self->{_base};
    my $res = $c->search(base=>$dn,
			 scope=>'one',
			 filter=>$self->getenv('filter') || 'objectClass=*',
			 attr=>['objectClass']);

    $res->code && die "LDAP Error: ".$res->error."\n";
    my @rdns;
    foreach my $e ($res->all_entries)
      {
	push(@rdns,_escapespace($self->tolatin1($self->rdn($e->dn()))));
      }
    $self->{_term}->Attribs->{completion_word} = \@rdns;
  }

sub reconnect
  {
    my $self = shift;

    delete $self->{_ssl};
    delete $self->{_authenticated};
    if (ref $self->{_ldap})
      {
	$self->{_ldap}->unbind();
      }

    if ($self->getenv('USESSL'))
      {
	my $port = $self->{_port} || 636;
	my @ca;
	push(@ca,cafile=>$self->getenv('CAFILE')) if $self->getenv('CAFILE');
	push(@ca,cadir=>$self->getenv('CADIR')) if $self->getenv('CADIR');
	$self->{_ldap} = Net::LDAP->new($self->{_server},
					version=>3,
					port=>$port,
					verify=>'require',@ca);
	$self->{_ssl}++;
      }
    else
      {
	$self->{_ldap} = Net::LDAP->new($self->{_server},version=>3,port=>$self->{_port}||389);
	my $starttls = $self->getenv('STARTTLS');
	if ($starttls)
	  {
	    my @ca;
	    push(@ca,cafile=>$self->getenv('CAFILE')) if $self->getenv('CAFILE');
	    push(@ca,cadir=>$self->getenv('CADIR')) if $self->getenv('CADIR');
	    my $res = $self->{_ldap}->start_tls(verify=>'require',@ca);
	    if ($res->code)
	      {
		if ($starttls =~ /require/i)
		  {
		    die "START_TLS: ".$res->error."\n";
		  }
		else
		  {
		    warn "START_TLS: ".$res->error."\n";
		  }
	      }
	    else
	      {
		$self->{_ssl}++;
	      }
	  }
      }
    $self->setup_autocompletion();
    die "Unable to connect" unless $self->{_ldap};
  }

sub yesno
  {
    my $self = shift;
    my $prompt = shift;

    'yes' eq $self->askfor("$prompt [yes|no] ",0,'\s*(yes|no)\s*');
  }

sub askfor
  {
    my $self = shift;
    my $prompt = shift;
    my $noecho = shift;
    my $regexp = shift || '\s*(\S+)\s*';

    my $value;
    while (! defined $value)
      {
	system "stty -echo" if $noecho;
	print $prompt;
	$value = <STDIN>;
	chomp($value);
	if ($noecho)
	  {
	    system "stty echo";
	    print "\n";
	  }
	next unless ($value) = $value =~ /$regexp/;
      }
    $value;
  }

sub getUser
  {
    my $self = shift;
    my $uid = shift;
    my $attrs = shift;

    my $c = $self->connection;
    my $res = $c->search(base=>$self->getenv('BASE'),filter=>"uid=$uid",attrs=>$attrs || ['objectClass','uid']);
    $res = $c->search(base=>$self->getenv('BASE'),filter=>"sAMAccountName=$uid",attrs=>$attrs || ['objectClass','sAMAccountName']) if $res->code;
    $res->code && die $res->error;
    return $res->pop_entry();
  }

sub dologin
  {
    my $self = shift;
    my $user = shift;

    unless ($user)
      {
	$user = $self->askfor("Username: ");
      }
    my $ue = $self->getUser($user);
    die "No such user $user\n" unless $ue;
    $self->authenticate($ue->dn(),@_);
  }

sub authenticate
  {
    my $self = shift;
    my $dn = shift;

    if (!$self->getenv('AUTH') || $self->getenv('AUTH') =~ /plain/is)
      {
	if ($self->getenv('NOCLUE'))
	  {
	    warn "*** You have set DSH_NOCLUE=1. I will send passwords in the clear.\n" unless $self->{_ssl};
	  }
	else
	  {
	    die "I refuse to send passwords in the clear. Enable ssl/start_tls\n" unless $self->{_ssl};
	  }
	my $pass = $self->askfor("Password for $dn: ",1);
	my $res = $self->{_ldap}->bind($dn,password=>$pass,version=>3);
	$res->code && die $res->error;
	$self->{_authenticated} = $dn;
      }
    elsif ($self->getenv('AUTH') =~ /sasl/is)
      {
	use Authen::SASL;
	my $sasl = Authen::SASL->new(mechanism=>$self->getenv('SASL_MECH') || 'GSSAPI');
	my $res = $self->{_ldap}->bind($dn,sasl=>$sasl,version=>3);
	$res->code && die $res->error;
	$self->{_authenticated} = $dn;
      }
    else
      {
	die "Unknown authentication method \"".$self->getenv('AUTH')."\"";
      }
  }


sub getDN
  {
    my $self = shift;
    my $ustr = shift;

    my $path;
    my @paths;
    if ($ustr =~ /^ldap:/)
      {
	my $uri = URI->new($ustr);

	$path = $uri->path;
	my ($host,$port) = $uri->opaque =~ /\/\/([^\/:]+):?([0-9]+)*$path$/;
	$path =~ s/^\///o;
	if ($host || $port)
	  {
	    if ($self->{_server} ne $host || $self->{_port} ne $port)
	      {
		$self->{_server} = $host;
		$self->{_port} = $port;
		$self->reconnect();
	      }
	  }
	push(@paths,$path);
      }
    elsif ($ustr =~ /^~(.+)/)
      {
        my $e = $self->getUser($1);
        die "No such user $1\n" unless ref $e;
	push(@paths,$e->dn());
      }
    elsif ($ustr =~ /^\*(.+)/)
      {
	my $res = $self->connection->search(filter=>'objectClass=*',
					    base=>$self->{_base},
					    scope=>'base');
	$res->code && die $res->error;
	my $e = $res->pop_entry();
	die "No such entry: ".$self->{_base}."\n" unless $e;
	my @v = $e->get_value($1);
	die "No such attribute \'$1\'\n" unless @v;
	push(@paths,@v);
      }
    elsif ($ustr =~ /^(\/?)\?(.+)/)
      {
	my $base = $1 ? '' : $self->{_base};
	my $res =
	  $self->connection->search(base=>$base,
				    filter=>$2,
				    scope=>'sub',
				    attrs=>['objectClass']);
	$res->code && die "LDAP Error: ".$res->error."\n";
	foreach my $e ($res->all_entries)
	  {
	    push(@paths,$e->dn());
	  }
	die "No entry matching search for $2 below $base\n" unless @paths;
      }
    elsif ($ustr =~ /([a-zA-Z0-9-]\.)+/s)
      {
	my @dc = split /\./,$ustr;
	push(@paths,join(',',map { "dc=$_" } @dc));
      }
    else
      {
	$ustr =~ s/\/$//o;
	my $abs;
	$abs++ if $ustr =~ s/^\///;
	$ustr = join(',',reverse(split(/\//,$ustr)));
	push(@paths,$ustr.($self->{_base} && !$abs ? ','.$self->{_base} : ''));
      }

    map
      {
	my $mod = 1;
	while ($mod)
	  {
	    $mod = 0;
	    $mod++ if s/\.\.,([^,]+)//o;
	    $mod++ if s/\.,([^,]+)/$1/g;
	    $mod++ if s/^\.$//o;
	    $mod++ if s/^\.\.$//o;
	    $mod++ if s/^,//o;
	    $mod++ if s/,$//o;
	    $mod++ if s/^,//o;
	    $mod++ if s/,,/,/o;
	  }
      } @paths;

    wantarray ? @paths : $paths[0];
  }

sub dequote
  {
    shift;
    local $_ = shift;

    s/^\"//og;
    s/\"$//og;
    s/^\'//og;
    s/\'$//og;
    $_;
  }

sub url
  {
    my $self = shift;

    return "not connected" unless $self->{_server};

    if (!$self->{_port} || $self->{_port} == 389)
      {
	sprintf "ldap://%s/%s",$self->{_server},$self->{_base}
      }
    else
      {
	sprintf "ldap://%s:%d/%s",$self->{_server},$self->{_port},$self->{_base}
      }
  }

sub displayUrl
  {
    $_[0]->tolatin1($_[0]->url);
  }

sub prompt
  {
    my $self = shift;

    my $auth = $self->{_authenticated};
    my $durl = $self->displayUrl();
    my $len = length($durl);
    sprintf "[%s%s]>",defined $auth ? '*' : '',($len > 37 ? substr($durl,0,37)." ..." : $durl);
  }

sub connection
  {
    $_[0]->{_ldap};
  }

sub get
  {
    die "Not connected\n" unless $_[0]->{_server};

    $_[0]->{_rp}->get();
  }

sub free
  {
    $_[0]->{_rp}->free($_[1]);
  }

sub print
  {
    my $self = shift;

    print @_;
  }

sub printf
  {
    my $self = shift;

    printf @_;
  }

sub rdn
  {
    my @rdns = split /\s*,\s*/,$_[1];
    $rdns[0];
  }

sub write
  {
    my $self = shift;
    my $e = shift;

    $self->printf("\n%s:\n\n",$self->tolatin1($e->dn()));
    my $len = 0;
    foreach my $attr ($e->attributes)
      {
        my $alen = length($attr);
        $len = $len > $alen ? $len : $alen;
      }
    $len+=2;
    foreach my $attr ($e->attributes)
      {
        foreach my $value ($e->get_value($attr))
          {
            $self->printf("%${len}s: %s\n",$attr,$self->tolatin1($value));
          }
      }
    $self->print("\n");
  }

sub split
  {
    $_[1] =~ s/\\\ /%20;/og;
    my @parts = split /\s+/,$_[1];
    map { s/%20;/\\\ /og; $_ } @parts;
  }

sub loop
  {
    my $self = shift;

    foreach my $cmd (keys %LDAPShell::Builtins::builtins)
      {
	no warnings;
	eval "sub $cmd { \$self->_$cmd(\@_); }";
	die $@ if $@;
      }

    while (defined ($_ = $self->{_term}->readline($self->prompt())) )
      {
	my @parts = $self->split($_);
	if (ref $LDAPShell::Builtins::builtins{$parts[0]})
	  {
	    my $cmd = shift @parts;
	    my $spec = $LDAPShell::Builtins::builtins{$cmd};
	    eval
	      {
		my %args;
		my @opts = @{$spec->[1]};
		local @ARGV = @parts;
		if (@opts && @ARGV)
		  {
		    GetOptions(\%args,@opts)
		      or die "Usage: $spec->[2]\n";
		  }
		&{$spec->[0]}($self,\%args,@ARGV)
	      };
	  }
	else
	  {
	    eval;
	  }
	print "** $@\n" if $@;
      }
  }

package LDAPShell::Builtins;
@LDAPShell::Builtins::ISA = qw(LDAPShell);
use Net::LDAP qw(LDAP_NO_SUCH_OBJECT);

use vars qw(%builtins);

%builtins = (
	     ls => [\&_ls,['filter:s'],"ls [--filter=<ldap filter>] <what>"],
	     cat => [\&_cat,['format=s','attributes=s'],"cat [--format=<ldif|dsml|dump*>] [--attributes=<attr list>] <object>?"],
	     cd => [\&_cd,[],"cd <object>"],
	     pwd => [\&_pwd,[],"pwd"],
	     add => [\&_add,['interactive!'],"add [--interactive] -- {<attribute>=<value>}+"],
	     modify => [\&_modify,['interactive!'],"modify [--interactive] [<what>] -- {[+|-|&|!]<attribute>=<value>}+"],
	     delete => [\&_delete,['interactive!'],"delete [--interactive] [<object>]"],
	     mv => [\&_mv,['interactive!'],"mv [--interactive] <object>+"],
	     logout => [\&_logout,[],"logout"],
	     login => [\&_login,[],["login [<user>]"]],
	     auth => [\&_auth,[],["auth [<dn>]"]],
	     whoami => [\&_whoami,[],["whoami"]],
	    );

sub _def
  {
    my $self = shift;
    my $args = shift;
    my $name = shift;
    my $block = shift;

    $builtins{$name} = eval "sub _$name { my \$self = shift; my \$args = shift; eval \"$block\" }";
  }

sub _whoami
  {
    my $self = shift;
    my $args = shift;

    $self->print($self->{_authenticated} ? "$self->{_authenticated}\n" : "anonymous\n");
  }

sub _ls
  {
    my $self = shift;
    my $args = shift;
    my $c = $self->connection;
    # The semantics of ls forbids us to ls multiple directories so we
    # don't want an array here.
    my $dn = $self->getDN($self->toutf8($_[0]));
    my $res = $c->search(base=>$dn,
			 scope=>'one',
			 filter=>$args->{'filter'} || 'objectClass=*',
			 attr=>['objectClass']);
    $res->code && die "ls $dn:".$res->error."\n";
    my $line;
    my @rdns;
    foreach my $e ($res->all_entries)
      {
	push(@rdns,$self->tolatin1($self->rdn($e->dn())));
      }
    my $tab = Text::FormatTable->new('l l l l l');
    my @row; my $nc = 0;
    foreach my $rdn (sort @rdns)
      {
	push(@row,$rdn);
	$nc++;
	if ($nc == 5)
	  {
	    $tab->row(@row);
	    $nc = 0;
	    @row = ();
	  }
      }
    foreach (my $i = $nc; $i < 5; $i++)
      {
	push(@row,'');
      }
    $tab->row(@row);
    $self->print($tab->render);
  }

sub _cat
  {
    my $self = shift;
    my $args = shift;

    my @dn = $self->getDN($self->toutf8($_[0]));
    my @attrs = split(',',$args->{attributes}) if $args->{attributes};

    my $writer;
    my $format = $args->{format} || 'dump';
    if ($format eq 'ldif')
      {
        use Net::LDAP::LDIF;
	$writer = Net::LDAP::LDIF->new(\*STDOUT,"w");
      }
    elsif ($format eq 'dsml')
      {
	use Net::LDAP::DSML;
	$writer = Net::LDAP::DSML->new();
	$writer->open(\*STDOUT);
      }
    else
      {
	$writer = $self;
      }

    foreach my $dn (@dn)
      {
	my $res = $self->connection->search(scope=>'base',
					    base=>$dn,
					    attrs=>\@attrs,
					    filter=>'objectClass=*');
	$res->code && die "cat $dn: ".$res->error."\n";
	my $e = $res->pop_entry();
	die "No such entry: $dn\n"
	  unless UNIVERSAL::isa($e,'Net::LDAP::Entry');

	$args->{diff} ? $writer->write_cmd($e) : $writer->write($e);
      }

    $writer->finish() if $format eq 'dsml';
  }

sub _login
  {
    my $self = shift;
    my $args = shift;

    $self->dologin($_[0] || $self->getenv('USER'));
  }

sub _auth
  {
    my $self = shift;
    my $args = shift;

    $self->authenticate($_[0] || $self->getenv('USER') || $self->getenv('AUTHDN'));
  }

sub _logout
  {
    my $self = shift;
    my $args = shift;

    $self->reconnect();
  }

sub _pwd
  {
    my $self = shift;
    my $args = shift;

    $self->print($self->displayUrl(),"\n");
  }

sub _cd
  {
    my $self = shift;
    my $args = shift;

    my $dir = $self->toutf8($_[0]);
    $dir = ($self->getenv('HOME') || $self->{_authenticated} || '/') unless $dir;
    my $dn = $self->getDN($dir);
    my $res = $self->connection->search(base=>$dn,
					filter=>'objectClass=*',
					scope=>'base',
					attrs=>['objectClass']);
    $res->code && $res->code != LDAP_NO_SUCH_OBJECT && die "cd $dn: ".$res->error."\n";
    $res->code == LDAP_NO_SUCH_OBJECT && do {
      $self->printf("cd: %s: %s\n",$dn,$res->error);
      $dn = $res->dn();
    };
    $self->{_base} = $dn;
    $self->setup_autocompletion();
  }

sub __moddn
  {
    my $self = shift;
    my $e = shift;
    my @newdn = @_;

    my $newrdn = shift @newdn;

    $e->replace(newrdn => $newrdn,
		newsuperior => join(',',@newdn),
		deleteoldrdn => 1);

    $e->changetype('moddn');
  }

sub _mv
  {
    my $self = shift;
    my $args = shift;

    my @dn;
    foreach my $expr (@_)
      {
	push(@dn,$self->getDN($self->toutf8($expr)));
      }
    my $target_dn = pop @dn;
    my $res = $self->connection->search(filter=>'objectClass=*',
					scope=>'base',
					base=>$target_dn);
    $res->code && die "mv $target_dn: ".$res->error."\n";
    my $target_entry = $res->pop_entry();
    my @target_rdns = split(',',$target_dn);
    if (ref $target_entry)
      {
	foreach my $dn (@dn)
	  {
	    my $nres = $self->connection->search(filter=>'objectClass=*',
				 		scope=>'base',
						base=>$dn);
	    $nres->code && die "mv $dn: ".$nres->error."\n";
	    my $e = $nres->pop_entry();
	    next unless ref $e;
	    my @rdns = split(',',$dn);
	    my $rdn = shift @rdns;
	    &__moddn($self,$e,$rdn,@target_rdns);
	    if ($args->{interactive})
	      {
		$self->write($e);
		$self->print("\n");
		die "Cancelled\n" unless $self->yesno("++ Really complete this move/rename?");
	      }
	    my $res = $e->update($self->connection);
	    $res->code && die "mv $dn: ".$res->error."\n";
	    $self->setup_autocompletion();
	  }
      }
    else
      {
	die "Last argument must be a container when moving multiple targets\n"
	  unless 1 == @dn;
	my $nres = $self->connection->search(filter=>'objectClass=*',
					    scope=>'base',
					    base=>$dn[0]);
	$nres->code && die "mv $dn[0]: ".$nres->error."\n";
	my $e = $nres->pop_entry();
	die "No such entry: $dn[0]\n" unless ref $e;
	&__moddn($self,$e,@target_rdns);
	if ($args->{interactive})
	  {
	    $self->write($e);
	    $self->print("\n");
	    die "Cancelled\n" unless $self->yesno("++ Really complete this move/rename?");
	  }
	my $res = $e->update($self->connection);
	$res->code && die "mv $dn[0]: ".$res->error."\n";
	$self->setup_autocompletion();
      }
  }

sub _utf_eq
  {
    my ($self,$a,$b,$caseexact) = @_;

    if ($caseexact)
      {
	return $a eq $b;
      }
    else
      {
	my $ua = $self->tolatin1($a);
	my $ub = $self->tolatin1($b);
	return uc($ua) eq uc($ub);
      }
  }

sub _add
  {
    my $self = shift;
    my $args = shift;

    my $dn = $self->getDN();
    my $c = $self->connection;
    my $res = $c->search(filter=>'objectClass=*',
			 base=>$dn,
			 scope=>'base');
    $res->code && die "add $dn: ".$res->error."\n";
    my $pe = $res->pop_entry();
    die "No such entry \'$dn\'\n"
      unless $pe;
    my $e = Net::LDAP::Entry->new();
    my $rdn;
    foreach my $av (@_)
      {
	my ($c,$a,$v) = $av =~ /([+-]?)([^+-=]+)\s*=?\s*(.*)/;
	die "Improperly formatted add request: \'$av\'\n"
	  unless $a && $v;
	$rdn = "$a=$v" unless $rdn;
	$e->add($a => $v);
      }
    die "Must specify an RDN\n" unless $rdn;
    my @dn = ($rdn);
    push(@dn,$dn) if $dn;
    $e->dn(join(',',@dn));
    $self->callbacks->add_callbacks($e,$self->connection);
    if ($args->{interactive})
      {
	$self->write($e);
	$self->print("\n");
	die "Cancelled\n" unless $self->yesno("++ Really ADD this entry?");
      }
    $res = $e->update($c);
    $res->code && die "add ".$e->dn().": ".$res->error."\n";
    $self->setup_autocompletion();
  }

sub _modify
  {
    my $self = shift;
    my $args = shift;

    my $dir = shift;
    foreach my $dn ($self->getDN($self->toutf8($dir)))
      {
	my $res = $self->connection->search(filter=>'objectClass=*',
					    base=>$dn,
					    scope=>'base');
	$res->code && die "modify $dn: ".$res->error."\n";
	my $e = $res->pop_entry();
	die "No such entry $dn\n" unless $e;

	my $mod = 0;
	my @ma;
	foreach my $av (@_)
	  {
	    my $avc = $av;
	    my ($c,$a,$eq,$v);
	    $avc =~ s/^([\+\-\&]?)([^\&\+\-=]+)\s*//o;
	    $c = $1;
	    $a = $2;
	    if ($avc)
	      {
		$avc =~ s/(==|=)\s*(.*)//o;
		$eq = $1;
		$v = LDAPShell::_unescapespace($2);
	      }
	    if ($c eq '&')
	      {
		die "Improperly formatted value append request: \'$av\'\n"
		  unless $a && $v;
		$e->add($a => $v),$mod++,push(@ma,$a) unless
		  grep { _utf_eq($self,$_,$v,$eq eq '='); } $e->get_value($a);
	      }
	    elsif ($c eq '+')
	      {
		die "Improperly formatted add request: \'$av\'\n"
		  unless $a && $v;
		$e->add($a => $v),$mod++,push(@ma,$a);
	      }
	    elsif ($c eq '-')
	      {
		die "Improperly formatted remove request: \'$av\'\n"
		  unless $a;
		unless ($v)
		  {
		    $e->delete($a),$mod++,push(@ma,$a);
		  }
		else
		  {
		    my @v = $e->get_value($a);
		    my @nv = grep { !_utf_eq($self,$v,$_,$eq eq '='); } @v;
		    $e->replace($a => \@nv),$mod++,push(@ma,$a) if scalar @nv != scalar @v;
		  }
	      }
	    else
	      {
		die "Improperly formatted replace request: \'$av\'\n"
		  unless $a && $v;
		$e->replace($a => $v),$mod++,push(@ma,$a);
	      }
	  }
	$self->print("No modifications required\n"),next unless $mod;
	$self->callbacks->modify_callbacks($e,$self->connection,\@ma);

	if ($args->{interactive})
	  {
	    $self->write($e);
	    $self->print("\n");
	    die "Cancelled\n" unless $self->yesno("++ Really save these MODIFIED attributes?");
	  }
	
	$res = $e->update($self->connection);
	$res->code && die "mv ".$e->dn().": ".$res->error."\n";
      }
    $self->setup_autocompletion();
  }

sub _delete
  {
    my $self = shift;
    my $args = shift;

    foreach my $dn ($self->getDN($self->toutf8($_[0])))
      {
	my $res = $self->connection->search(filter=>'objectClass=*',
					    base=>$dn,
					    scope=>'base');
	$res->code && $res->error;
	my $e = $res->pop_entry();
	die "No such entry $dn\n" unless $e;
	$e->delete();
	if ($args->{interactive})
	  {
	    $self->write($e);
	    $self->print("\n");
	    die "Cancelled\n" unless $self->yesno("++ Really DELETE this entry?");
	  }
	$res = $e->update($self->connection);
	$res->code && die "delete ".$e->dn().": ".$res->error."\n";
      }
    $self->setup_autocompletion();
  }


package LDAPShell;

1;
__END__
# Below is stub documentation for your module. You better edit it!

=head1 NAME

LDAPShell - Perl extension for blah blah blah

=head1 SYNOPSIS

  use LDAPShell;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for LDAPShell, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.

Blah blah blah.

=head2 EXPORT

None by default.


=head1 AUTHOR

A. U. Thor, E<lt>a.u.thor@a.galaxy.far.far.awayE<gt>

=head1 SEE ALSO

L<perl>.

=cut