Added Net::LDAP to the distribution for easier installs.
This commit is contained in:
JT Smith
parent
f51b335d74
commit
223c014813
47 changed files with 15060 additions and 2 deletions
293
lib/Net/LDAP/Entry.pm
Normal file
293
lib/Net/LDAP/Entry.pm
Normal file
|
|
@ -0,0 +1,293 @@
|
|||
# Copyright (c) 1997-2000 Graham Barr <gbarr@pobox.com>. All rights reserved.
|
||||
# This program is free software; you can redistribute it and/or
|
||||
# modify it under the same terms as Perl itself.
|
||||
|
||||
package Net::LDAP::Entry;
|
||||
|
||||
use strict;
|
||||
use Net::LDAP::ASN qw(LDAPEntry);
|
||||
use Net::LDAP::Constant qw(LDAP_LOCAL_ERROR);
|
||||
use vars qw($VERSION);
|
||||
|
||||
$VERSION = "0.15";
|
||||
|
||||
sub new {
|
||||
my $self = shift;
|
||||
my $type = ref($self) || $self;
|
||||
|
||||
my $entry = bless { 'changetype' => 'add', changes => [] }, $type;
|
||||
|
||||
$entry;
|
||||
}
|
||||
|
||||
# Build attrs cache, created when needed
|
||||
|
||||
sub _build_attrs {
|
||||
+{ map { (lc($_->{type}),$_->{vals}) } @{$_[0]->{asn}{attributes}} };
|
||||
}
|
||||
|
||||
# If we are passed an ASN structure we really do nothing
|
||||
|
||||
sub decode {
|
||||
my $self = shift;
|
||||
my $result = ref($_[0]) ? shift : $LDAPEntry->decode(shift)
|
||||
or return;
|
||||
|
||||
%{$self} = ( asn => $result, changetype => 'modify', changes => []);
|
||||
|
||||
$self;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub encode {
|
||||
$LDAPEntry->encode( shift->{asn} );
|
||||
}
|
||||
|
||||
|
||||
sub dn {
|
||||
my $self = shift;
|
||||
@_ ? ($self->{asn}{objectName} = shift) : $self->{asn}{objectName};
|
||||
}
|
||||
|
||||
sub get_attribute {
|
||||
require Carp;
|
||||
Carp::carp("->get_attribute deprecated, use ->get_value") if $^W;
|
||||
shift->get_value(@_, asref => !wantarray);
|
||||
}
|
||||
|
||||
sub get {
|
||||
require Carp;
|
||||
Carp::carp("->get deprecated, use ->get_value") if $^W;
|
||||
shift->get_value(@_, asref => !wantarray);
|
||||
}
|
||||
|
||||
|
||||
sub exists {
|
||||
my $self = shift;
|
||||
my $type = lc(shift);
|
||||
my $attrs = $self->{attrs} ||= _build_attrs($self);
|
||||
|
||||
exists $attrs->{$type};
|
||||
}
|
||||
|
||||
sub get_value {
|
||||
my $self = shift;
|
||||
my $type = lc(shift);
|
||||
my %opt = @_;
|
||||
|
||||
if ($opt{alloptions}) {
|
||||
my %ret = map {
|
||||
$_->{type} =~ /^\Q$type\E(.*)/ ? (lc($1), $_->{vals}) : ()
|
||||
} @{$self->{asn}{attributes}};
|
||||
return %ret ? \%ret : undef;
|
||||
}
|
||||
|
||||
my $attrs = $self->{attrs} ||= _build_attrs($self);
|
||||
my $attr = $attrs->{$type} or return;
|
||||
|
||||
return $opt{asref}
|
||||
? $attr
|
||||
: wantarray
|
||||
? @{$attr}
|
||||
: $attr->[0];
|
||||
}
|
||||
|
||||
|
||||
sub changetype {
|
||||
my $self = shift;
|
||||
return $self->{'changetype'} unless @_;
|
||||
$self->{'changes'} = [];
|
||||
$self->{'changetype'} = shift;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub add {
|
||||
my $self = shift;
|
||||
my $cmd = $self->{'changetype'} eq 'modify' ? [] : undef;
|
||||
my $attrs = $self->{attrs} ||= _build_attrs($self);
|
||||
|
||||
while (my($type,$val) = splice(@_,0,2)) {
|
||||
$type = lc $type;
|
||||
|
||||
push @{$self->{asn}{attributes}}, { type => $type, vals => ($attrs->{$type}=[])}
|
||||
unless exists $attrs->{$type};
|
||||
|
||||
push @{$attrs->{$type}}, ref($val) ? @$val : $val;
|
||||
|
||||
push @$cmd, $type, [ ref($val) ? @$val : $val ]
|
||||
if $cmd;
|
||||
|
||||
}
|
||||
|
||||
push(@{$self->{'changes'}}, 'add', $cmd) if $cmd;
|
||||
}
|
||||
|
||||
|
||||
sub replace {
|
||||
my $self = shift;
|
||||
my $cmd = $self->{'changetype'} eq 'modify' ? [] : undef;
|
||||
my $attrs = $self->{attrs} ||= _build_attrs($self);
|
||||
|
||||
while(my($type, $val) = splice(@_,0,2)) {
|
||||
$type = lc $type;
|
||||
|
||||
if (defined($val) and (!ref($val) or @$val)) {
|
||||
|
||||
push @{$self->{asn}{attributes}}, { type => $type, vals => ($attrs->{$type}=[])}
|
||||
unless exists $attrs->{$type};
|
||||
|
||||
@{$attrs->{$type}} = ref($val) ? @$val : ($val);
|
||||
|
||||
push @$cmd, $type, [ ref($val) ? @$val : $val ]
|
||||
if $cmd;
|
||||
|
||||
}
|
||||
else {
|
||||
delete $attrs->{$type};
|
||||
|
||||
@{$self->{asn}{attributes}}
|
||||
= grep { $type ne lc($_->{type}) } @{$self->{asn}{attributes}};
|
||||
|
||||
push @$cmd, $type, []
|
||||
if $cmd;
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
push(@{$self->{'changes'}}, 'replace', $cmd) if $cmd;
|
||||
}
|
||||
|
||||
|
||||
sub delete {
|
||||
my $self = shift;
|
||||
|
||||
unless (@_) {
|
||||
$self->changetype('delete');
|
||||
return;
|
||||
}
|
||||
|
||||
my $cmd = $self->{'changetype'} eq 'modify' ? [] : undef;
|
||||
my $attrs = $self->{attrs} ||= _build_attrs($self);
|
||||
|
||||
while(my($type,$val) = splice(@_,0,2)) {
|
||||
$type = lc $type;
|
||||
|
||||
if (defined($val) and (!ref($val) or @$val)) {
|
||||
my %values;
|
||||
@values{@$val} = ();
|
||||
|
||||
unless( @{$attrs->{$type}}
|
||||
= grep { !exists $values{$_} } @{$attrs->{$type}})
|
||||
{
|
||||
delete $attrs->{$type};
|
||||
@{$self->{asn}{attributes}}
|
||||
= grep { $type ne lc($_->{type}) } @{$self->{asn}{attributes}};
|
||||
}
|
||||
|
||||
push @$cmd, $type, [ ref($val) ? @$val : $val ]
|
||||
if $cmd;
|
||||
}
|
||||
else {
|
||||
delete $attrs->{$type};
|
||||
|
||||
@{$self->{asn}{attributes}}
|
||||
= grep { $type ne lc($_->{type}) } @{$self->{asn}{attributes}};
|
||||
|
||||
push @$cmd, $type, [] if $cmd;
|
||||
}
|
||||
}
|
||||
|
||||
push(@{$self->{'changes'}}, 'delete', $cmd) if $cmd;
|
||||
}
|
||||
|
||||
|
||||
sub update {
|
||||
my $self = shift;
|
||||
my $ldap = shift;
|
||||
my $mesg;
|
||||
my $cb = sub { $self->changetype('modify') unless $_[0]->code };
|
||||
|
||||
if ($self->{'changetype'} eq 'add') {
|
||||
$mesg = $ldap->add($self, 'callback' => $cb);
|
||||
}
|
||||
elsif ($self->{'changetype'} eq 'delete') {
|
||||
$mesg = $ldap->delete($self, 'callback' => $cb);
|
||||
}
|
||||
elsif ($self->{'changetype'} =~ /modr?dn/) {
|
||||
my @args = (newrdn => $self->get_value('newrdn'),
|
||||
deleteoldrdn => $self->get_value('deleteoldrdn'));
|
||||
my $newsuperior = $self->get_value('newsuperior');
|
||||
push(@args, newsuperior => $newsuperior) if $newsuperior;
|
||||
$mesg = $ldap->moddn($self, @args, 'callback' => $cb);
|
||||
}
|
||||
elsif (@{$self->{'changes'}}) {
|
||||
$mesg = $ldap->modify($self, 'changes' => $self->{'changes'}, 'callback' => $cb);
|
||||
}
|
||||
else {
|
||||
require Net::LDAP::Message;
|
||||
$mesg = Net::LDAP::Message->new( {} );
|
||||
$mesg->set_error(LDAP_LOCAL_ERROR,"No attributes to update");
|
||||
}
|
||||
|
||||
return $mesg;
|
||||
}
|
||||
|
||||
|
||||
# Just for debugging
|
||||
|
||||
sub dump {
|
||||
my $self = shift;
|
||||
|
||||
my $asn = $self->{asn};
|
||||
print "-" x 72,"\n";
|
||||
print "dn:",$asn->{objectName},"\n\n";
|
||||
|
||||
my($attr,$val);
|
||||
my $l = 0;
|
||||
|
||||
for (keys %{ $self->{attrs} ||= _build_attrs($self) }) {
|
||||
$l = length if length > $l;
|
||||
}
|
||||
|
||||
my $spc = "\n " . " " x $l;
|
||||
|
||||
foreach $attr (@{$asn->{attributes}}) {
|
||||
$val = $attr->{vals};
|
||||
printf "%${l}s: ", $attr->{type};
|
||||
my($i,$v);
|
||||
$i = 0;
|
||||
foreach $v (@$val) {
|
||||
print $spc if $i++;
|
||||
print $v;
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub attributes {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
|
||||
if ($opt{nooptions}) {
|
||||
my %done;
|
||||
return map {
|
||||
$_->{type} =~ /^([^;]+)/;
|
||||
$done{lc $1}++ ? () : ($1);
|
||||
} @{$self->{asn}{attributes}};
|
||||
}
|
||||
else {
|
||||
return map { $_->{type} } @{$self->{asn}{attributes}};
|
||||
}
|
||||
}
|
||||
|
||||
sub asn {
|
||||
shift->{asn}
|
||||
}
|
||||
|
||||
sub changes {
|
||||
@{shift->{'changes'}}
|
||||
}
|
||||
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue