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


line stmt bran cond sub pod time code
1             # Copyright (c) 1999-2004 Graham Barr . 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 Net::LDAP::Control::Sort;
6              
7 1     1   4253 use Net::LDAP::Control;
  1         2  
  1         56  
8              
9             our @ISA = qw(Net::LDAP::Control);
10             our $VERSION = '0.04';
11              
12 1     1   13 use Net::LDAP::ASN qw(SortRequest);
  1         1  
  1         25  
13 1     1   6 use strict;
  1         5  
  1         614  
14              
15             sub init {
16 0     0 1   my($self) = @_;
17              
18 0 0         if (exists $self->{value}) {
    0          
19 0           $self->value($self->{value});
20             }
21             elsif (exists $self->{order}) {
22 0 0         $self->order(ref($self->{order}) ? @{$self->{order}} : $self->{order});
  0            
23             }
24              
25 0           $self;
26             }
27              
28             sub value {
29 0     0 1   my $self = shift;
30              
31 0 0         if (@_) {
32 0           my $value = shift;
33              
34 0           delete $self->{value};
35 0           delete $self->{order};
36 0           delete $self->{error};
37              
38 0           my $asn = $SortRequest->decode($value);
39              
40 0 0         unless ($asn) {
41 0           $self->{error} = $@;
42 0           return undef;
43             }
44              
45             $self->{order} = [ map {
46             ($_->{reverseOrder} ? '-' : '')
47             . $_->{type}
48 0 0         . (defined($_->{orderingRule}) ? ":$_->{orderingRule}" : '')
    0          
49 0           } @{$asn->{order}}];
  0            
50              
51 0           return $self->{value} = $value;
52             }
53              
54 0 0         unless (defined $self->{value}) {
55             $self->{value} = $SortRequest->encode(
56             order => [
57             map {
58 0           /^(-)?([^:]+)(?::(.+))?/;
59             {
60 0 0         type => $2,
    0          
61             (defined $1 ? (reverseOrder => 1) : ()),
62             (defined $3 ? (orderingRule => $3) : ())
63             }
64 0 0         } @{$self->{order} || []}
65             ]
66 0 0         ) or $self->{error} = $@;
67             }
68              
69 0           $self->{value};
70             }
71              
72 0     0 1   sub valid { exists shift->{order} }
73              
74             sub order {
75 0     0 1   my $self = shift;
76              
77 0 0         if (@_) {
78             # @_ can either be a list, or a single item.
79             # if a single item it can be a string, which needs
80             # to be split on spaces, or a reference to a list
81             #
82             # Each element has three parts
83             # leading - (optional)
84             # an attribute name
85             # :match-rule (optional)
86              
87 0 0         my @order = (@_ == 1) ? split(/\s+/, $_[0]) : @_;
88              
89 0           delete $self->{value};
90 0           delete $self->{order};
91 0           delete $self->{error};
92              
93 0           foreach (@order) {
94 0 0         next if /^-?[^:]+(?::.+)?$/;
95              
96 0           $self->{error} = "Bad order argument '$_'";
97 0           return;
98             }
99              
100 0           $self->{order} = \@order;
101             }
102              
103 0           return @{$self->{order}};
  0            
104             }
105              
106             1;
107              
108             __END__