File Coverage

blib/lib/Net/LDAP/Control.pm

Criterion	Covered	Total	%
statement	21	46	45.6
branch	6	26	23.0
condition	3	29	10.3
subroutine	5	12	41.6
pod	10	10	100.0
total	45	123	36.5

# 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;

use strict;

use Net::LDAP::Constant qw(
  LDAP_CONTROL_SORTREQUEST
  LDAP_CONTROL_SORTRESULT
  LDAP_CONTROL_VLVREQUEST
  LDAP_CONTROL_VLVRESPONSE
  LDAP_CONTROL_PAGED
  LDAP_CONTROL_PROXYAUTHORIZATION
  LDAP_CONTROL_MANAGEDSAIT
  LDAP_CONTROL_PERSISTENTSEARCH
  LDAP_CONTROL_ENTRYCHANGE
  LDAP_CONTROL_MATCHEDVALUES
  LDAP_CONTROL_PASSWORDPOLICY
  LDAP_CONTROL_PREREAD
  LDAP_CONTROL_POSTREAD
  LDAP_CONTROL_SYNC
  LDAP_CONTROL_SYNC_STATE
  LDAP_CONTROL_SYNC_DONE
  LDAP_CONTROL_ASSERTION
  LDAP_CONTROL_RELAX
  LDAP_CONTROL_DONTUSECOPY
  LDAP_CONTROL_TREE_DELETE
  LDAP_CONTROL_SUBENTRIES
  LDAP_CONTROL_NOOP
);

our $VERSION = '0.20';

my %Pkg2Type = (

  'Net::LDAP::Control::Sort'		=> LDAP_CONTROL_SORTREQUEST,
  'Net::LDAP::Control::SortResult' 	=> LDAP_CONTROL_SORTRESULT,

  'Net::LDAP::Control::VLV'		=> LDAP_CONTROL_VLVREQUEST,
  'Net::LDAP::Control::VLVResponse'	=> LDAP_CONTROL_VLVRESPONSE,

  'Net::LDAP::Control::Paged'		=> LDAP_CONTROL_PAGED,

  'Net::LDAP::Control::ProxyAuth'	=> LDAP_CONTROL_PROXYAUTHORIZATION,

  'Net::LDAP::Control::ManageDsaIT'	=> LDAP_CONTROL_MANAGEDSAIT,

  'Net::LDAP::Control::PersistentSearch'	=> LDAP_CONTROL_PERSISTENTSEARCH,
  'Net::LDAP::Control::EntryChange'	=> LDAP_CONTROL_ENTRYCHANGE,

  'Net::LDAP::Control::MatchedValues'	=> LDAP_CONTROL_MATCHEDVALUES,

  'Net::LDAP::Control::PasswordPolicy'	=> LDAP_CONTROL_PASSWORDPOLICY,

  'Net::LDAP::Control::PreRead'		=> LDAP_CONTROL_PREREAD,

  'Net::LDAP::Control::PostRead'	=> LDAP_CONTROL_POSTREAD,

  'Net::LDAP::Control::SyncRequest'	=> LDAP_CONTROL_SYNC,
  'Net::LDAP::Control::SyncState'	=> LDAP_CONTROL_SYNC_STATE,
  'Net::LDAP::Control::SyncDone'	=> LDAP_CONTROL_SYNC_DONE,
  'Net::LDAP::Control::Assertion'	=> LDAP_CONTROL_ASSERTION,
  'Net::LDAP::Control::Relax'		=> LDAP_CONTROL_RELAX,
  'Net::LDAP::Control::DontUseCopy'	=> LDAP_CONTROL_DONTUSECOPY,
  'Net::LDAP::Control::TreeDelete'	=> LDAP_CONTROL_TREE_DELETE,
  'Net::LDAP::Control::Subentries'	=> LDAP_CONTROL_SUBENTRIES,
  'Net::LDAP::Control::NoOp'		=> LDAP_CONTROL_NOOP,
  #
  #LDAP_CONTROL_PWEXPIRED
  #LDAP_CONTROL_PWEXPIRING
  #
  #LDAP_CONTROL_REFERRALS
);

my %Type2Pkg = reverse %Pkg2Type;

sub register {
  my($class, $oid) = @_;

  require Carp and Carp::croak("$oid is already registered to $Type2Pkg{$oid}")
    if exists $Type2Pkg{$oid} and $Type2Pkg{$oid} ne $class;

  require Carp and Carp::croak("$class is already registered to $Pkg2Type{$class}")
    if exists $Pkg2Type{$class} and $Pkg2Type{$class} ne $oid;

  $Type2Pkg{$oid} = $class;
  $Pkg2Type{$class} = $oid;
}

sub new {
  my $self = shift;
  my $pkg  = ref($self) || $self;
  my $oid  = (@_ & 1) ? shift : undef;
  my %args = @_;

  $args{type} ||= $oid || $Pkg2Type{$pkg} || '';

  unless ($args{type} =~ /^\d+(?:\.\d+)+$/) {
    $args{error} = 'Invalid OID';
    return bless \%args;
  }

  if ($pkg eq __PACKAGE__ and exists $Type2Pkg{$args{type}}) {
    $pkg = $Type2Pkg{$args{type}};
    eval "require $pkg"  or die $@;
  }

  delete $args{error};

  bless(\%args, $pkg)->init;
}


sub from_asn {
  my $self = shift;
  my $asn = shift;
  my $class = ref($self) || $self;

  if ($class eq __PACKAGE__ and exists $Type2Pkg{$asn->{type}}) {
    $class = $Type2Pkg{$asn->{type}};
    eval "require $class"  or die $@;
  }

  delete $asn->{error};

  bless($asn, $class)->init;
}

sub to_asn {
  my $self = shift;
  $self->value; # Ensure value is there
  delete $self->{critical}  unless $self->{critical};
  $self;
}

sub critical {
  my $self = shift;
  $self->{critical} = shift  if @_;
  $self->{critical} || 0;
}

sub value    {
  my $self = shift;
  $self->{value} = shift  if @_;
  $self->{value} || undef
}

sub type  { shift->{type} }
sub valid { ! exists shift->{error} }
sub error { shift->{error} }
sub init  { shift }

1;

__END__