[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 # Copyright (c) 1997-2004 Graham Barr <gbarr@pobox.com>. All rights reserved. 2 # This program is free software; you can redistribute it and/or 3 # modify it under the same terms as Perl itself. 4 5 package Net::LDAP::Entry; 6 7 use strict; 8 use Net::LDAP::ASN qw(LDAPEntry); 9 use Net::LDAP::Constant qw(LDAP_LOCAL_ERROR); 10 use vars qw($VERSION); 11 12 use constant CHECK_UTF8 => $] > 5.007; 13 14 BEGIN { 15 require Encode 16 if (CHECK_UTF8); 17 } 18 19 20 $VERSION = "0.24"; 21 22 sub new { 23 my $self = shift; 24 my $type = ref($self) || $self; 25 26 my $entry = bless { 'changetype' => 'add', changes => [] }, $type; 27 28 @_ and $entry->dn( shift ); 29 @_ and $entry->add( @_ ); 30 31 return $entry; 32 } 33 34 sub clone { 35 my $self = shift; 36 my $clone = $self->new(); 37 38 $clone->dn($self->dn()); 39 foreach ($self->attributes()) { 40 $clone->add($_ => [$self->get_value($_)]); 41 } 42 43 $clone->{changetype} = $self->{changetype}; 44 my @changes = @{$self->{changes}}; 45 while (my($action, $cmd) = splice(@changes,0,2)) { 46 my @new_cmd; 47 my @cmd = @$cmd; 48 while (my($type, $val) = splice(@cmd,0,2)) { 49 push @new_cmd, $type, [ @$val ]; 50 } 51 push @{$clone->{changes}}, $action, \@new_cmd; 52 } 53 54 $clone; 55 } 56 57 # Build attrs cache, created when needed 58 59 sub _build_attrs { 60 +{ map { (lc($_->{type}),$_->{vals}) } @{$_[0]->{asn}{attributes}} }; 61 } 62 63 # If we are passed an ASN structure we really do nothing 64 65 sub decode { 66 my $self = shift; 67 my $result = ref($_[0]) ? shift : $LDAPEntry->decode(shift) 68 or return; 69 my %arg = @_; 70 71 %{$self} = ( asn => $result, changetype => 'modify', changes => []); 72 73 if (CHECK_UTF8 && $arg{raw}) { 74 $result->{objectName} = Encode::decode_utf8($result->{objectName}) 75 if ('dn' !~ /$arg{raw}/); 76 77 foreach my $elem (@{$self->{asn}{attributes}}) { 78 map { $_ = Encode::decode_utf8($_) } @{$elem->{vals}} 79 if ($elem->{type} !~ /$arg{raw}/); 80 } 81 } 82 83 $self; 84 } 85 86 87 88 sub encode { 89 $LDAPEntry->encode( shift->{asn} ); 90 } 91 92 93 sub dn { 94 my $self = shift; 95 @_ ? ($self->{asn}{objectName} = shift) : $self->{asn}{objectName}; 96 } 97 98 sub get_attribute { 99 require Carp; 100 Carp::carp("->get_attribute deprecated, use ->get_value") if $^W; 101 shift->get_value(@_, asref => !wantarray); 102 } 103 104 sub get { 105 require Carp; 106 Carp::carp("->get deprecated, use ->get_value") if $^W; 107 shift->get_value(@_, asref => !wantarray); 108 } 109 110 111 sub exists { 112 my $self = shift; 113 my $type = lc(shift); 114 my $attrs = $self->{attrs} ||= _build_attrs($self); 115 116 exists $attrs->{$type}; 117 } 118 119 sub get_value { 120 my $self = shift; 121 my $type = lc(shift); 122 my %opt = @_; 123 124 if ($opt{alloptions}) { 125 my %ret = map { 126 $_->{type} =~ /^\Q$type\E((?:;.*)?)$/i ? (lc($1), $_->{vals}) : () 127 } @{$self->{asn}{attributes}}; 128 return %ret ? \%ret : undef; 129 } 130 131 my $attrs = $self->{attrs} ||= _build_attrs($self); 132 my $attr = $attrs->{$type} or return; 133 134 return $opt{asref} 135 ? $attr 136 : wantarray 137 ? @{$attr} 138 : $attr->[0]; 139 } 140 141 142 sub changetype { 143 144 my $self = shift; 145 return $self->{'changetype'} unless @_; 146 $self->{'changes'} = []; 147 $self->{'changetype'} = shift; 148 return $self; 149 } 150 151 152 153 sub add { 154 my $self = shift; 155 my $cmd = $self->{'changetype'} eq 'modify' ? [] : undef; 156 my $attrs = $self->{attrs} ||= _build_attrs($self); 157 158 while (my($type,$val) = splice(@_,0,2)) { 159 my $lc_type = lc $type; 160 161 push @{$self->{asn}{attributes}}, { type => $type, vals => ($attrs->{$lc_type}=[])} 162 unless exists $attrs->{$lc_type}; 163 164 push @{$attrs->{$lc_type}}, ref($val) ? @$val : $val; 165 166 push @$cmd, $type, [ ref($val) ? @$val : $val ] 167 if $cmd; 168 169 } 170 171 push(@{$self->{'changes'}}, 'add', $cmd) if $cmd; 172 173 return $self; 174 } 175 176 177 sub replace { 178 my $self = shift; 179 my $cmd = $self->{'changetype'} eq 'modify' ? [] : undef; 180 my $attrs = $self->{attrs} ||= _build_attrs($self); 181 182 while(my($type, $val) = splice(@_,0,2)) { 183 my $lc_type = lc $type; 184 185 if (defined($val) and (!ref($val) or @$val)) { 186 187 push @{$self->{asn}{attributes}}, { type => $type, vals => ($attrs->{$lc_type}=[])} 188 unless exists $attrs->{$lc_type}; 189 190 @{$attrs->{$lc_type}} = ref($val) ? @$val : ($val); 191 192 push @$cmd, $type, [ ref($val) ? @$val : $val ] 193 if $cmd; 194 195 } 196 else { 197 delete $attrs->{$lc_type}; 198 199 @{$self->{asn}{attributes}} 200 = grep { $lc_type ne lc($_->{type}) } @{$self->{asn}{attributes}}; 201 202 push @$cmd, $type, [] 203 if $cmd; 204 205 } 206 } 207 208 push(@{$self->{'changes'}}, 'replace', $cmd) if $cmd; 209 210 return $self; 211 } 212 213 214 sub delete { 215 my $self = shift; 216 217 unless (@_) { 218 $self->changetype('delete'); 219 return; 220 } 221 222 my $cmd = $self->{'changetype'} eq 'modify' ? [] : undef; 223 my $attrs = $self->{attrs} ||= _build_attrs($self); 224 225 while(my($type,$val) = splice(@_,0,2)) { 226 my $lc_type = lc $type; 227 228 if (defined($val) and (!ref($val) or @$val)) { 229 my %values; 230 @values{(ref($val) ? @$val : $val)} = (); 231 232 unless( @{$attrs->{$lc_type}} 233 = grep { !exists $values{$_} } @{$attrs->{$lc_type}}) 234 { 235 delete $attrs->{$lc_type}; 236 @{$self->{asn}{attributes}} 237 = grep { $lc_type ne lc($_->{type}) } @{$self->{asn}{attributes}}; 238 } 239 240 push @$cmd, $type, [ ref($val) ? @$val : $val ] 241 if $cmd; 242 } 243 else { 244 delete $attrs->{$lc_type}; 245 246 @{$self->{asn}{attributes}} 247 = grep { $lc_type ne lc($_->{type}) } @{$self->{asn}{attributes}}; 248 249 push @$cmd, $type, [] if $cmd; 250 } 251 } 252 253 push(@{$self->{'changes'}}, 'delete', $cmd) if $cmd; 254 255 return $self; 256 } 257 258 259 sub update { 260 my $self = shift; 261 my $ldap = shift; 262 my %opt = @_; 263 my $mesg; 264 my $user_cb = delete $opt{callback}; 265 my $cb = sub { $self->changetype('modify') unless $_[0]->code; 266 $user_cb->(@_) if $user_cb }; 267 268 if ($self->{'changetype'} eq 'add') { 269 $mesg = $ldap->add($self, 'callback' => $cb, %opt); 270 } 271 elsif ($self->{'changetype'} eq 'delete') { 272 $mesg = $ldap->delete($self, 'callback' => $cb, %opt); 273 } 274 elsif ($self->{'changetype'} =~ /modr?dn/o) { 275 my @args = (newrdn => $self->get_value('newrdn') || undef, 276 deleteoldrdn => $self->get_value('deleteoldrdn') || undef); 277 my $newsuperior = $self->get_value('newsuperior'); 278 push(@args, newsuperior => $newsuperior) if $newsuperior; 279 $mesg = $ldap->moddn($self, @args, 'callback' => $cb, %opt); 280 } 281 elsif (@{$self->{'changes'}}) { 282 $mesg = $ldap->modify($self, 'changes' => $self->{'changes'}, 'callback' => $cb, %opt); 283 } 284 else { 285 require Net::LDAP::Message; 286 $mesg = Net::LDAP::Message->new( $ldap ); 287 $mesg->set_error(LDAP_LOCAL_ERROR,"No attributes to update"); 288 } 289 290 return $mesg; 291 } 292 293 294 # Just for debugging 295 296 sub dump { 297 my $self = shift; 298 no strict 'refs'; # select may return a GLOB name 299 my $fh = @_ ? shift : select; 300 301 my $asn = $self->{asn}; 302 print $fh "-" x 72,"\n"; 303 print $fh "dn:",$asn->{objectName},"\n\n" if $asn->{objectName}; 304 305 my($attr,$val); 306 my $l = 0; 307 308 for (keys %{ $self->{attrs} ||= _build_attrs($self) }) { 309 $l = length if length > $l; 310 } 311 312 my $spc = "\n " . " " x $l; 313 314 foreach $attr (@{$asn->{attributes}}) { 315 $val = $attr->{vals}; 316 printf $fh "%$l}s: ", $attr->{type}; 317 my($i,$v); 318 $i = 0; 319 foreach $v (@$val) { 320 print $fh $spc if $i++; 321 print $fh $v; 322 } 323 print $fh "\n"; 324 } 325 } 326 327 sub attributes { 328 my $self = shift; 329 my %opt = @_; 330 331 if ($opt{nooptions}) { 332 my %done; 333 return map { 334 $_->{type} =~ /^([^;]+)/; 335 $done{lc $1}++ ? () : ($1); 336 } @{$self->{asn}{attributes}}; 337 } 338 else { 339 return map { $_->{type} } @{$self->{asn}{attributes}}; 340 } 341 } 342 343 sub asn { 344 shift->{asn} 345 } 346 347 sub changes { 348 my $ref = shift->{'changes'}; 349 $ref ? @$ref : (); 350 } 351 352 1;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |