DN Comparison function

[Christophe Wolfhugel]

Good day everyone.

I was wondering if it would make sense to have a DN comparison function
part of Net::LDAP? Whilst in most cases a simple string comparison could
make it, there are always cases where this is not so easy, particularly
when comparison functions are not identical.

See code below for a proposal on how to do this (this does not integrate
yet "as is" in perl-ldap). One design question I would have is: should
this be part of Net::LDAP::Schema as a metho or Net::LDAP::Util, with the
schema as a provided parameter?

I welcome any thoughts on this and anyone feel free to use the code if
it helps you.

-- 
Christophe Wolfhugel -+- ch...@wolfhugel.eu

## $SCHEMA is a global to the selected schema we use.

## Compares 2 DNs for either equality or the first being
## part (or equal to) of a subtree represented by the
## second argument. Third argument if set tells a subtree
## comparison should be done. Returns true if identical or
## in the tree, 0 otherwise, undef if not enough arguments.
sub compare_dn { 
   return unless (@_ >= 2);
   return 1 if ($_[0] eq $_[1]);
   my $a = ldap_explode_dn($_[0]);
   my $b = ldap_explode_dn($_[1]);
   my $s = @_ == 3 ? $_[2] : 0;

   if ($s) {
      return 0 if ($#{$a} < $#${b});
      splice(@{$a}, 0, $#{$a} -  $#${b});
   } elsif ($#{$a} != $#${b}) {
      return 0;
   }
   foreach my $rdn_a (@{$a}) {
      my $rdn_b = shift(@{$b});
      return 0 if (join(',', sort keys %{$rdn_a}) ne join(',', sort keys 
%{$rdn_b}));
      while (my($attr, $v_a) = each %{$rdn_a}) {
         if (defined(my $v_b = delete($rdn_b->{$attr}))) {
            ## LDAPmatchingrule_for_attribute is my wrapper around 
matchingrule_for_attribute.
            my $mr = defined($SCHEMA) ? LDAPmatchingrule_for_attribute($SCHEMA, 
$attr, 'equality') : undef;
            $mr = defined($mr) && exists($cmpsubs{$mr}) ? $cmpsubs{$mr} : 
$cmpsubs{'*'};
            return 0 unless (&{$mr}($v_a, $v_b));
         } else {
            return 0;
         }
      }
   }
   return 1;
}

my %cmpsubs = (
   '*'                  =>      sub { return $_[0] eq $_[1]; },
   'integerMatch'       =>      sub { return $_[0] == $_[1]; },
   'caseIgnoreIA5Match' =>      sub { return lc($_[0]) eq lc($_[1]); },
   'caseIgnoreMatch'    =>      sub {
                                        my @a = @_;
                                        utf8::decode($a[0]) if 
(utf8::valid($a[0]) && utf8::is_utf8($a[0]) == 0);
                                        utf8::decode($a[1]) if 
(utf8::valid($a[1]) && utf8::is_utf8($a[1]) == 0);
                                        return lc($a[0]) eq lc($a[1]);
                                }
);