← Back to branch summary

~ubuntu-branches/debian/squeeze/movabletype-opensource/squeeze

« back to all changes in this revision

Viewing changes to extlib/URI/_ldap.pm

  • Committer: Bazaar Package Importer
  • Author(s): Dominic Hargreaves
  • Date: 2008-06-13 23:28:40 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20080613232840-ya4jfxv1jgl45a3d
Tags: 4.2~rc2-1
* New upstream release candidate
* Update Standards-Version (no changes)
* Ensure that schema upgrade message is always seen

Show diffs side-by-side

added added

removed removed

Lines of Context:
extlib/URI/_ldap.pm
 
1
# Copyright (c) 1998 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 URI::_ldap;
 
6
 
 
7
use strict;
 
8
 
 
9
use vars qw($VERSION);
 
10
$VERSION = "1.10";
 
11
 
 
12
use URI::Escape qw(uri_unescape);
 
13
 
 
14
sub _ldap_elem {
 
15
  my $self  = shift;
 
16
  my $elem  = shift;
 
17
  my $query = $self->query;
 
18
  my @bits  = (split(/\?/,defined($query) ? $query : ""),("")x4);
 
19
  my $old   = $bits[$elem];
 
20
 
 
21
  if (@_) {
 
22
    my $new = shift;
 
23
    $new =~ s/\?/%3F/g;
 
24
    $bits[$elem] = $new;
 
25
    $query = join("?",@bits);
 
26
    $query =~ s/\?+$//;
 
27
    $query = undef unless length($query);
 
28
    $self->query($query);
 
29
  }
 
30
 
 
31
  $old;
 
32
}
 
33
 
 
34
sub dn {
 
35
  my $old = shift->path(@_);
 
36
  $old =~ s:^/::;
 
37
  uri_unescape($old);
 
38
}
 
39
 
 
40
sub attributes {
 
41
  my $self = shift;
 
42
  my $old = _ldap_elem($self,0, @_ ? join(",", map { my $tmp = $_; $tmp =~ s/,/%2C/g; $tmp } @_) : ());
 
43
  return $old unless wantarray;
 
44
  map { uri_unescape($_) } split(/,/,$old);
 
45
}
 
46
 
 
47
sub _scope {
 
48
  my $self = shift;
 
49
  my $old = _ldap_elem($self,1, @_);
 
50
  return unless defined wantarray && defined $old;
 
51
  uri_unescape($old);
 
52
}
 
53
 
 
54
sub scope {
 
55
  my $old = &_scope;
 
56
  $old = "base" unless length $old;
 
57
  $old;
 
58
}
 
59
 
 
60
sub _filter {
 
61
  my $self = shift;
 
62
  my $old = _ldap_elem($self,2, @_);
 
63
  return unless defined wantarray && defined $old;
 
64
  uri_unescape($old); # || "(objectClass=*)";
 
65
}
 
66
 
 
67
sub filter {
 
68
  my $old = &_filter;
 
69
  $old = "(objectClass=*)" unless length $old;
 
70
  $old;
 
71
}
 
72
 
 
73
sub extensions {
 
74
  my $self = shift;
 
75
  my @ext;
 
76
  while (@_) {
 
77
    my $key = shift;
 
78
    my $value = shift;
 
79
    push(@ext, join("=", map { $_="" unless defined; s/,/%2C/g; $_ } $key, $value));
 
80
  }
 
81
  @ext = join(",", @ext) if @ext;
 
82
  my $old = _ldap_elem($self,3, @ext);
 
83
  return $old unless wantarray;
 
84
  map { uri_unescape($_) } map { /^([^=]+)=(.*)$/ } split(/,/,$old);
 
85
}
 
86
 
 
87
sub canonical
 
88
{
 
89
    my $self = shift;
 
90
    my $other = $self->_nonldap_canonical;
 
91
 
 
92
    # The stuff below is not as efficient as one might hope...
 
93
 
 
94
    $other = $other->clone if $other == $self;
 
95
 
 
96
    $other->dn(_normalize_dn($other->dn));
 
97
 
 
98
    # Should really know about mixed case "postalAddress", etc...
 
99
    $other->attributes(map lc, $other->attributes);
 
100
 
 
101
    # Lowecase scope, remove default
 
102
    my $old_scope = $other->scope;
 
103
    my $new_scope = lc($old_scope);
 
104
    $new_scope = "" if $new_scope eq "base";
 
105
    $other->scope($new_scope) if $new_scope ne $old_scope;
 
106
 
 
107
    # Remove filter if default
 
108
    my $old_filter = $other->filter;
 
109
    $other->filter("") if lc($old_filter) eq "(objectclass=*)" ||
 
110
                          lc($old_filter) eq "objectclass=*";
 
111
 
 
112
    # Lowercase extensions types and deal with known extension values
 
113
    my @ext = $other->extensions;
 
114
    for (my $i = 0; $i < @ext; $i += 2) {
 
115
        my $etype = $ext[$i] = lc($ext[$i]);
 
116
        if ($etype =~ /^!?bindname$/) {
 
117
            $ext[$i+1] = _normalize_dn($ext[$i+1]);
 
118
        }
 
119
    }
 
120
    $other->extensions(@ext) if @ext;
 
121
    
 
122
    $other;
 
123
}
 
124
 
 
125
sub _normalize_dn  # RFC 2253
 
126
{
 
127
    my $dn = shift;
 
128
 
 
129
    return $dn;
 
130
    # The code below will fail if the "+" or "," is embedding in a quoted
 
131
    # string or simply escaped...
 
132
 
 
133
    my @dn = split(/([+,])/, $dn);
 
134
    for (@dn) {
 
135
        s/^([a-zA-Z]+=)/lc($1)/e;
 
136
    }
 
137
    join("", @dn);
 
138
}
 
139
 
 
140
1;