summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/URI/_ldap.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/URI/_ldap.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/URI/_ldap.pm140
1 files changed, 0 insertions, 140 deletions
diff --git a/Master/tlpkg/tlperl/lib/URI/_ldap.pm b/Master/tlpkg/tlperl/lib/URI/_ldap.pm
deleted file mode 100755
index 608dbd339a3..00000000000
--- a/Master/tlpkg/tlperl/lib/URI/_ldap.pm
+++ /dev/null
@@ -1,140 +0,0 @@
-# Copyright (c) 1998 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 URI::_ldap;
-
-use strict;
-
-use vars qw($VERSION);
-$VERSION = "1.10";
-
-use URI::Escape qw(uri_unescape);
-
-sub _ldap_elem {
- my $self = shift;
- my $elem = shift;
- my $query = $self->query;
- my @bits = (split(/\?/,defined($query) ? $query : ""),("")x4);
- my $old = $bits[$elem];
-
- if (@_) {
- my $new = shift;
- $new =~ s/\?/%3F/g;
- $bits[$elem] = $new;
- $query = join("?",@bits);
- $query =~ s/\?+$//;
- $query = undef unless length($query);
- $self->query($query);
- }
-
- $old;
-}
-
-sub dn {
- my $old = shift->path(@_);
- $old =~ s:^/::;
- uri_unescape($old);
-}
-
-sub attributes {
- my $self = shift;
- my $old = _ldap_elem($self,0, @_ ? join(",", map { my $tmp = $_; $tmp =~ s/,/%2C/g; $tmp } @_) : ());
- return $old unless wantarray;
- map { uri_unescape($_) } split(/,/,$old);
-}
-
-sub _scope {
- my $self = shift;
- my $old = _ldap_elem($self,1, @_);
- return unless defined wantarray && defined $old;
- uri_unescape($old);
-}
-
-sub scope {
- my $old = &_scope;
- $old = "base" unless length $old;
- $old;
-}
-
-sub _filter {
- my $self = shift;
- my $old = _ldap_elem($self,2, @_);
- return unless defined wantarray && defined $old;
- uri_unescape($old); # || "(objectClass=*)";
-}
-
-sub filter {
- my $old = &_filter;
- $old = "(objectClass=*)" unless length $old;
- $old;
-}
-
-sub extensions {
- my $self = shift;
- my @ext;
- while (@_) {
- my $key = shift;
- my $value = shift;
- push(@ext, join("=", map { $_="" unless defined; s/,/%2C/g; $_ } $key, $value));
- }
- @ext = join(",", @ext) if @ext;
- my $old = _ldap_elem($self,3, @ext);
- return $old unless wantarray;
- map { uri_unescape($_) } map { /^([^=]+)=(.*)$/ } split(/,/,$old);
-}
-
-sub canonical
-{
- my $self = shift;
- my $other = $self->_nonldap_canonical;
-
- # The stuff below is not as efficient as one might hope...
-
- $other = $other->clone if $other == $self;
-
- $other->dn(_normalize_dn($other->dn));
-
- # Should really know about mixed case "postalAddress", etc...
- $other->attributes(map lc, $other->attributes);
-
- # Lowecase scope, remove default
- my $old_scope = $other->scope;
- my $new_scope = lc($old_scope);
- $new_scope = "" if $new_scope eq "base";
- $other->scope($new_scope) if $new_scope ne $old_scope;
-
- # Remove filter if default
- my $old_filter = $other->filter;
- $other->filter("") if lc($old_filter) eq "(objectclass=*)" ||
- lc($old_filter) eq "objectclass=*";
-
- # Lowercase extensions types and deal with known extension values
- my @ext = $other->extensions;
- for (my $i = 0; $i < @ext; $i += 2) {
- my $etype = $ext[$i] = lc($ext[$i]);
- if ($etype =~ /^!?bindname$/) {
- $ext[$i+1] = _normalize_dn($ext[$i+1]);
- }
- }
- $other->extensions(@ext) if @ext;
-
- $other;
-}
-
-sub _normalize_dn # RFC 2253
-{
- my $dn = shift;
-
- return $dn;
- # The code below will fail if the "+" or "," is embedding in a quoted
- # string or simply escaped...
-
- my @dn = split(/([+,])/, $dn);
- for (@dn) {
- s/^([a-zA-Z]+=)/lc($1)/e;
- }
- join("", @dn);
-}
-
-1;