Re: canonical_dn

[Graham B. <gb...@po...>]

On Tue, Jan 08, 2002 at 06:19:44PM +0000, Graham Barr wrote:
> On Sun, Jan 06, 2002 at 01:57:37PM +0100, Peter Marschall wrote:
> > Sorry, 
> > 
> > a few small errors in my last mail's listings.
> > Here's the corrected version
> 
> Can you get it so that it will pass the t/01canon.t testcase ? Also can
> explode_dn share the same code ?

I already did :). This is what I got.

Graham.



## split a DN string into its parts
# Synopsis:  @rdns = split_dn($dn, %optionHash)
# allowed options:
#  * lowercase: convert attribute names to lower case
#  * uppercase: convert attribute names to upper case
#  * sort_rdn: sort RDN values
#  * split_rdn: split multi part RDNs into their parts
sub split_dn($%) {
  my $dn = shift;
  my %opt = @_;
  my (@dn, @rdn);

  $dn = $dn->dn if ref($dn);

  while ($dn =~ /\G(?:
                \s*
                ([a-zA-Z][-a-zA-Z0-9]*|(?:[Oo][Ii][Dd]\.)?\d+(?:\.\d+)*)
                \s*
                =
                \s*
                (
                  (?:[^\\",=+<>\#;]*[^\\",=+<>\#;\s]|\\(?:[\\ ",=+<>#;]|[0-9a-fA-F]{2}))*
		  |
                  \#(?:[0-9a-fA-F]{2})+
		  |
                  "(?:[^\\"]+|\\(?:[\\",=+<>#;]|[0-9a-fA-F]{2}))*"
                )
                \s*
                (?:([;,+])\s*(?=\S)|$)
                )\s*/gcx)
  {
    my ($type,$val,$sep) = ($1,$2,$3);

    $type =~ s/^oid\.(\d+(\.\d+)*)$/$1/i;
    $type = lc($type)  if $opt{lowercase};
    $type = uc($type)  if $opt{uppercase};

    if ($val !~ /^#/) {
      $val =~ s/^"(.*)"$/$1/;
      $val =~ s/\\([\\ ",=+<>#;]|[0-9a-fA-F]{2})
               /length($1)==1 ? $1 : chr(hex($1))
               /xeg;
      $val =~ s/([\\",=+<>#;])/\\$1/g;
      $val =~ s/([\x00-\x1F])/sprintf("\\%02x",ord($1))/eg;

      $val =~ s/(^\s+|\s+$)/"\\20" x length $1/ge;
    }

    push @rdn, "$type=$val";

    unless (defined $sep and $sep eq '+') {
      @rdn = sort(@rdn)  if $opt{sort_rdn};
      push @dn, ($opt{split_rdn}) ?
                  ((scalar(@rdn) > 1) ? [ @rdn ] : ($rdn[0] || '')) :
                  join('+', @rdn);
      @rdn = ();
    }
  }
  
  (length($dn) != (pos($dn) || 0))
    ? wantarray ? ()  : undef
    : wantarray ? @dn : \@dn;
}


## join RDNs and RDN parts into a DN string ##
# Synopsis:  $dn = join_dn(@dnpartref, %optionhash)
sub join_dn(\@%) {
  my $dnparts = shift or return undef;
  my %opt = @_;
  my @dn = map {
    ref($_)
      ? join($opt{reversed} ? '\001' : '+', @$_)
      : $_
  } @$dnparts or return undef;

  $opt{reversed}
    ? join('\000', reverse @dn)
    : join(','   , @dn);
}

sub canonical_dn($;$) {
  my ($dn, $rev) = @_;

  $dn = $dn->dn if ref($dn);

  &join_dn(
    scalar split_dn($dn, uppercase => 1, split_rdn => 1, sort_rdn => 1),
    reversed => $rev
  );
}