File Coverage

blib/lib/Net/LDAP/Control/Sort.pm

Criterion	Covered	Total	%
statement	9	49	18.3
branch	0	30	0.0
condition			n/a
subroutine	3	7	42.8
pod	4	4	100.0
total	16	90	17.7

# Copyright (c) 1999-2004 Graham Barr . All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Net::LDAP::Control::Sort;

use Net::LDAP::Control;

our @ISA = qw(Net::LDAP::Control);
our $VERSION = '0.04';

use Net::LDAP::ASN qw(SortRequest);
use strict;

sub init {
  my($self) = @_;

  if (exists $self->{value}) {
    $self->value($self->{value});
  }
  elsif (exists $self->{order}) {
    $self->order(ref($self->{order}) ? @{$self->{order}} : $self->{order});
  }

  $self;
}

sub value {
  my $self = shift;

  if (@_) {
    my $value = shift;

    delete $self->{value};
    delete $self->{order};
    delete $self->{error};

    my $asn = $SortRequest->decode($value);

    unless ($asn) {
      $self->{error} = $@;
      return undef;
    }

    $self->{order} = [ map {
      ($_->{reverseOrder} ? '-' : '')
      . $_->{type}
      . (defined($_->{orderingRule}) ? ":$_->{orderingRule}" : '')
    } @{$asn->{order}}];

    return $self->{value} = $value;
  }

  unless (defined $self->{value}) {
    $self->{value} = $SortRequest->encode(
      order => [
	map {
	  /^(-)?([^:]+)(?::(.+))?/;
	  {
	    type => $2,
	    (defined $1 ? (reverseOrder => 1)  : ()),
	    (defined $3 ? (orderingRule => $3) : ())
	  }
	} @{$self->{order} || []}
      ]
    ) or $self->{error} = $@;
  }

  $self->{value};
}

sub valid { exists shift->{order} }

sub order {
  my $self = shift;

  if (@_) {
    # @_ can either be a list, or a single item.
    # if a single item it can be a string, which needs
    # to be split on spaces, or a reference to a list
    #
    # Each element has three parts
    #  leading - (optional)
    #  an attribute name
    #  :match-rule (optional)

    my @order = (@_ == 1) ? split(/\s+/, $_[0]) : @_;

    delete $self->{value};
    delete $self->{order};
    delete $self->{error};

    foreach (@order) {
      next  if /^-?[^:]+(?::.+)?$/;

      $self->{error} = "Bad order argument '$_'";
      return;
    }

    $self->{order} = \@order;
  }

  return @{$self->{order}};
}

1;

__END__