package LDAPShell::Callbacks;

use Net::LDAP;

@LDAPShell::Callbacks::ISA = qw(Exporter);
@LDAPShell::Callbacks::EXPORT = qw(check_global_uid_uniqueness
				   check_global_group_gid_uniqueness
				   check_global_group_cn_uniqueness
				   track_cn_and_displayname
				   track_mail
				   add_top_unless_present);

sub new
  {
    my $self = shift;
    my $class = ref $self || $self;

    bless {},$class;
  }

sub add_callbacks
  {
    my $self = shift;
    my $entry = shift;
    my $ldap = shift;
    my @attrs = @{shift} || $entry->attributes;

    foreach my $attr (@attrs)
      {
	foreach my $cb (@{$self->{add}->{$attr}})
	  {
	    &$cb($ldap,$attr,$entry,\@attrs);
	  }
	foreach my $cb (@{$self->{any}->{$attr}})
	  {
	    &$cb($ldap,$attr,$entry,\@attrs);
	  }
      }
  }

sub modify_callbacks
  {
    my $self = shift;
    my $entry = shift;
    my $ldap = shift;
    my @attrs = @{shift} || $entry->attributes;

    foreach my $attr (@attrs)
      {
	foreach my $cb (@{$self->{modify}->{$attr}})
	  {
	    &$cb($ldap,$attr,$entry,\@attrs);
	  }
	foreach my $cb (@{$self->{any}->{$attr}})
	  {
	    &$cb($ldap,$attr,$entry,\@attrs);
	  }
      }
  }

sub callback
  {
    my $self = shift;
    my $attr = shift;
    my $type = shift;
    my $code = shift;

    die "Must be a CODE reference\n" unless ref $code eq 'CODE';

    push(@{$self->{lc($type)}->{lc($attr)}},$code);
  }

sub check_global_uid_uniqueness
  {
    my $c = shift;
    my $attr = shift;
    my $entry = shift;
    my $attrs = shift;

    return unless grep /(uid|userid)/is,@{$attrs};
    my $uid = $entry->get_value('uid');
    $uid = $entry->get_value('userid') unless $uid;
    return unless $uid;

    my $res = $c->search(filter=>"uid=$uid",base=>'',attrs=>['uid']);
    return if $res->code == LDAP_NO_SUCH_OBJECT;
    $res->code && die "LDAP Error: ".$res->error."\n";
    my $e = $res->pop_entry;
    return unless $e;
    $e->dump();
    my $dn = $e->dn();
    die "The username \'$uid\' already exists: \"$dn\"\n";
  }

sub check_global_group_cn_uniqueness
  {
    my $c = shift;
    my $attr = shift;
    my $entry = shift;
    my $attrs = shift;

    return unless $c->isA($entry,'posixGroup');
    my $cn = $entry->get_value('cn');
    return unless $cn;

    my $res = $c->search(filter=>"(&(cn=$cn)(posixGroup))",base=>'',scope=>'sub',attrs=>['cn']);
    return if $res->code == LDAP_NO_SUCH_OBJECT;
    $res->code && die "LDAP Error: ".$res->error."\n";
    my $e = $res->pop_entry;
    return unless $e;
    my $dn = $e->dn();
    die "The group \'$cn\' already exists: \"$dn\"\n";
  }

sub check_global_group_gid_uniqueness
  {
    my $c = shift;
    my $attr = shift;
    my $entry = shift;
    my $attrs = shift;

    return unless $c->isA($e,'posixGroup');
    my $gidNumber = $entry->get_value('gidNumber');
    return unless $gidNumber;

    my $res = $c->search(filter=>"(&(gidNumber=$gidNumber)(posixGroup))",base=>'',scope=>'sub',attrs=>['cn']);
    return if $res->code == LDAP_NO_SUCH_OBJECT;
    $res->code && die "LDAP Error: ".$res->error."\n";
    my $e = $res->pop_entry;
    return unless $e;
    my $dn = $e->dn();
    die "The group with GID \'$gidNumber\' already exists: \"$dn\"\n";
  }

sub track_cn_and_displayname
  {
    my $c = shift;
    my $attr = shift;
    my $entry = shift;
    my $attrs = shift;

    return unless $c->isA($entry,'inetOrgPerson');
    return unless grep /sn/is,@{$attrs};
    return unless grep /givenName/is,@{$attrs};

    my $sn = $entry->get_value('sn');
    my $givenName = $entry->get_value('givenName');
    return unless $sn && $givenName;

    my $cn = "$givenName $sn";
    $entry->replace(cn=>$cn);
    $entry->replace(displayName=>$cn);
  }

sub track_mail
  {
    my $c = shift;
    my $attr = shift;
    my $entry = shift;
    my $attrs = shift;

    return unless $c->isA($entry,'inetOrgPerson');
    my $uid = $entry->get_value('uid');
    my $domain = $c->domainOf($entry);
    return unless $uid && $domain;
    $entry->add(mail=>"$uid\@$domain") 
      unless grep /$uid\@$domain/is,$entry->get_value('mail');
  }

sub add_top_unless_present
  {
    my $c = shift;
    my $attr = shift;
    my $entry = shift;
    my $attrs = shift;

    my @oc = $entry->get_value('objectClass');
    push(@oc,'top') unless grep /top/is,@oc;
    $entry->replace(objectClass=>\@oc);
  }