File Coverage

blib/lib/Net/DSML.pm

Criterion	Covered	Total	%
statement	399	613	65.0
branch	151	288	52.4
condition	1	3	33.3
subroutine	32	42	76.1
pod	30	30	100.0
total	613	976	62.8

package Net::DSML;


use warnings;
use strict;
#use Carp;
use Class::Std::Utils;
use LWP::UserAgent;

# Copyright (c) 2007 Clif Harden . All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use version; $VERSION = version->new('0.003');

{

BEGIN
{
  use Exporter ();

  @ISA = qw(Exporter);
  @EXPORT = qw();
  %EXPORT_TAGS = ();
  @EXPORT_OK  = ();
}

my %ops;           # items container
my %pid;           # process id container
my %content;       # Returned ldap data
my %prepostData;   # Returned ldap data
my %errMsg;        # no error this will be a null string.
my %psize;         # Size of xml string.
my %postData;      # Actual xml data string.
my %operations;    # operations container
my %authentication;    # authentication container

#
# Method new
#
# The method new creates a new DSML oject.
#
# There are two possible input options.
#
# $dsml = Net::DSML->new( debug => 1, url => "http://system.company.com:8080/dsml" );
#
# Input option "debug":  Sets the debug variable to the input value.
# Input option "url":    Sets the host variable to the input value.
#
#
# Input option "process":  String that contains the LDAP process value;
# sequential or parallel.  Default is sequential.
# Input option "type":  String that contains the LDAP scope value;
# true or false.  Default is false.
# Input option "referral":  String that contains the referral control value;
# neverDerefAliases, derefInSearching, derefFindingBaseObj or derefAlways.
# Default is neverDerefAliases.
# Input option "scope":  String that contains the LDAP scope value;
# singleLevel, baseObject or wholeSubtree.  Default is singleLevel.
# Input option "order":  String that contains the LDAP order value;
# sequential or unordered.  Default is sequential.
# Input option "error":  String that contains the LDAP onError value;
# exit or resume.  Default is exit.
# Input option "time":  String that contains the time limit of the
# LDAP search.  Default is "0".
# Input option "size":  String that contains the size limit of the
# LDAP search.  Default is "0".
# Input option "base":  String that contains the LDAP search base.
# Input option "bid":   String that contains the batch request ID
#
#
# Method output;  Returns a new DSML object.
#

sub new
{
my ($class, $opt) = @_;
my $self = bless anon_scalar(),$class;
my $id = ident($self);
my $initerror = "";
my $pnumber = 0;
my $result;
#
# Initailize the data to a default value.
#
$content{$id}    = ""; # Returned ldap data
$psize{$id}      = ""; # Size of xml string.
$postData{$id}   = ""; # Actual xml data string.
$prepostData{$id} = ""; # Actual xml data string.
$errMsg{$id}     = ""; #  error messages, no error this will be a null string.

$ops{$id}->{processing} = " processing=\"sequential\""; # Processing type
$ops{$id}->{sbase}      = ""; # search base
$ops{$id}->{sizelimit}  = " sizeLimit=\"0\"";     # search size limit
$ops{$id}->{timelimit}  = " timeLimit=\"0\"";     # search time limit
$ops{$id}->{onerror}    = " onError=\"exit\"";    # search time limit
$ops{$id}->{responseOrder} = " responseOrder=\"sequential\""; # search time limit
$ops{$id}->{scope}      = " scope=\"singleLevel\"";  # search scope
$ops{$id}->{derefAliases} = " derefAliases=\"neverDerefAliases\"";
$ops{$id}->{typesOnly}  = " typesOnly=\"false\">"; #
$ops{$id}->{auth}       = "";                     # authRequest data

$ops{$id}->{control}    = "";                     # Control data

$ops{$id}->{reqid} = " requestID=\"batch request\"";  # request ID
$ops{$id}->{host}  = (ref($opt->{url}) ? ${$opt->{url}} : $opt->{url}) if ( $opt->{url} ); # ldap host
$ops{$id}->{debug} = $opt->{debug} ? 1 : 0;  # debug flage
$ops{$id}->{pid} = "";  # initial process id.
$pid{$id}->{pid} = 1;  # initial process id.

$operations{$id} = [];
$result = 1;

$result = $self->setProcess({ process => (ref($opt->{process}) ? ${$opt->{process}} : $opt->{process}) }) if ( $opt->{process});
$initerror .= $errMsg{$id} if (!$result);

$result = $self->setType( { type => (ref($opt->{type}) ? ${$opt->{type}} : $opt->{type}) } ) if ( $opt->{type} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$result = $self->setReferral( { referral => (ref($opt->{referral}) ? ${$opt->{referral}} : $opt->{referral}) } ) if ( $opt->{referral} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$result = $self->setScope( { scope => (ref($opt->{scope}) ? ${$opt->{scope}} : $opt->{scope}) } ) if ( $opt->{scope} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$result = $self->setOrder( { order => (ref($opt->{order}) ? ${$opt->{order}} : $opt->{order}) } ) if ( $opt->{order} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$result = $self->setOnError( { error => (ref($opt->{error}) ? ${$opt->{error}} : $opt->{error})} ) if ( $opt->{error} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$result = $self->setTime( { time => (ref($opt->{time}) ? ${$opt->{time}} : $opt->{time}) } ) if ( $opt->{time} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$result = $self->setSize( { size => (ref($opt->{size}) ? ${$opt->{size}} : $opt->{size}) } ) if ( $opt->{size} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$result = $self->setBase( { base => (ref($opt->{base}) ? ${$opt->{base}} : $opt->{base}) } ) if ( $opt->{base} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$result = $self->setProxy( { dn => (ref($opt->{proxyid}) ? ${$opt->{proxyid}} : $opt->{proxyid}) } ) if ( $opt->{proxyid} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$result = $self->setBatchId( { id => (ref($opt->{bid}) ? ${$opt->{bid}} : $opt->{bid}) } ) if ( $opt->{bid} );
$initerror .= "\t" . $errMsg{$id} if (!$result);

$errMsg{$id} = $initerror;


if ( $opt->{dn} && $opt->{password} )
{
  $authentication{$id}->{dn} = (ref($opt->{dn}) ? ${$opt->{dn}} : $opt->{dn});
  $authentication{$id}->{password} = (ref($opt->{password}) ? ${$opt->{password}} : $opt->{password});
}

return $self;
}

#
# inside-out classes have to have a DESTROY subrountine.
#
sub DESTROY
{
  my ($dsml) = @_;
  my $id = ident($dsml);

  delete $ops{$id};           # items container
  delete $content{$id};       # Returned ldap data
  delete $psize{$id};         # Size of xml string.
  delete $postData{$id};      # Actual xml data string.
  delete $prepostData{$id};   # Copy of actual xml data string.
  delete $errMsg{$id};        # no error this will be a null string.
  delete $operations{$id};    # operations container
  delete $authentication{$id};    # authentication container
  delete $pid{$id};               # initial process id.
  return;
}

#   1.  & - &
#   2. < - <
#   3. > - >
#   4. " - "
#   5. ' - '
#
#   Convert special characters to xml standards.
#
sub _specialChar
{
  my ($char) = @_;

  $$char =~ s/&/&/g;
  $$char =~ s/
  $$char =~ s/>/>/g;
  $$char =~ s/"/"/g;
  $$char =~ s/'/'/g;
  return;
}

#
# Constant values
#
# The string postHead provides the xml "Header" string.
# This "Header" string is standard with all DSML XML strings.
#
my $postHead = "";

# The string postTail provides the xml "Tail" string.
# This "Tail" string is standard with all DSML XML strings.
#
my $postTail = "";

# The string postPing provides the xml "Body" string for a DSML ping request.
# The DSML ping request is used to tell if the DSML functions are provided.
#
my $postPing = "";

# The string postDSE provides the ending xml "Body" string for a DSML
# rootDSE request.  The DSML rootDSE request is used to get the directory
# rootDSE information.
#
my $postDSE = "";

# The string preBatch provides the initial batchRequest xml "Body" string
# for a DSML request.
#
my $preBatch = "

# The string postBatch provides the ending batchRequest xml "Body"
# string for a DSML request.
#
my $postBatch = "";

# The string preAuth provides the authorization xml "Body" string for a DSML
# authRequest.
#
my $preAuth = "

# The string postAuth provides the ending authorization xml "Body" string for a
# DSML authRequest.
#
my $postAuth = "\"/>";

# The string postSearch provides the ending xml "Body" string for a
# DSML search request.
#
my $postSearch = "";

# The string postCompare provides the ending xml "Body" string for a
# DSML search request.
#
my $postCompare = "";

# The string reqID provides the initial part of the scope attribute of
# the batchRequest element.
#
my $reqID = " requestID=\"";

my $prescope = " scope=\"";

# The string deref provides the initial part of the derefAliases attribute
# of the batchRequest element.
#
my $deref = " derefAliases=\"";

# The string types provides the initial part of the typesOnly attribute
# of the batchRequest element.
#
my $types = " typesOnly=\"";
my $sizel = " sizeLimit=\"";
my $timel = " timeLimit=\"";
my $orders = " responseOrder=\"";
my $proc = " processing=\"";
my $onE = " onError=\"";

#
# End of constant values.
#

#
# Method setScope
#
# The method setScope sets the LDAP search scope.
#
# There is one required input option.
#
# $return = $dsml->setScope( { scope => "singleLevel" } );
#
# Input option "scope":  String that contains the LDAP scope value;
# singleLevel, baseObject or wholeSubtree.  Default is singleLevel.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setScope
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;

  $errMsg{$id} = "";

  if ((ref($opt->{scope}) ? ${$opt->{scope}} : $opt->{scope}) =~ /^(singleLevel||baseObject||wholeSubtree)$/)
  {
    $ops{$id}->{scope} = $prescope . $1 . "\"";
    return 1;
  }

  $errMsg{$id} = "Requested scope value does not match singleLevel, baseObject or wholeSubtree";
  return 0;
}

#
# Method setReferral
#
# The method setReferral sets the LDAP referral status.
#
# There is one required input option.
#
# $return = $dsml->setReferral( { referral => "neverDerefAliases" } );
#
# Input option "referral":  String that contains the referral control value;
# neverDerefAliases, derefInSearching, derefFindingBaseObj or derefAlways.
# Default is neverDerefAliases.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setReferral
{
  my ($dsml,$opt) = @_;
  my $id = ident $dsml;

  $errMsg{$id} = "";

  if ((ref($opt->{referral}) ? ${$opt->{referral}} : $opt->{referral}) =~ /^(neverDerefAliases||derefInSearching||derefFindingBaseObj||derefalways)$/)
  {
    $ops{$id}->{derefAliases} = $deref . $1 . "\"";
    return 1;
  }

  $errMsg{$id} = "Requested setReferral derefAliases value does not match neverDerefAliases, derefInSearching, derefFindingBaseObj or derefAlways.";
  return 0;
}

# Method setType
#
# The method setType sets the LDAP search scope.
#
# There is one required input option.
#
# $return = $dsml->setType( { type => "false" } );
#
# Input option "type":  String that contains the LDAP scope value;
# true or false.  Default is false.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setType
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;

  $errMsg{$id} = "";

  if (lc((ref($opt->{type}) ? ${$opt->{type}} : $opt->{type})) =~ /^(false||true)$/ )
  {
    $ops{$id}->{typesOnly} = $types . $1 . "\">";  # The > ends an xml element.
    return 1;
  }

  $errMsg{$id} = "Requested setType value does not match true or false.";
  return 0;
}


# Method setSize
#
# The method setSize sets the size limit of the LDAP search.
#
# There is one required input option.
#
# $return = $dsml->setSize( { size => "0" } );
#
# Input option "size":  String that contains the size limit of the
# LDAP search.  Default is "0".
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setSize
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $refvalue;

  $errMsg{$id} = "";
  $refvalue = (ref($opt->{size}) ? ${$opt->{size}} : $opt->{size});

  if (!(length($refvalue)) )
  {
    $errMsg{$id} = "Subroutine setSize size value is not defined.";
    return 0;
  }

  $ops{$id}->{sizelimit} = $sizel . $refvalue ."\"";  # The > ends an xml element.
  return 1;
}


# Method setTime
#
# The method setTime sets the time limit of the LDAP search.
#
# There is one required input option.
#
# $return = $dsml->setTime( { time => "0" } );
#
# Input option "time":  String that contains the time limit of the
# LDAP search.  Default is "0".
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setTime
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $refvalue;
  $errMsg{$id} = "";

  $refvalue = (ref($opt->{time}) ? ${$opt->{time}} : $opt->{time});

  if ( !(length($refvalue)) )
  {
    $errMsg{$id} = "Subroutine setTime time value is not defined.";
    return 0;
  }

  $ops{$id}->{timelimit} = $timel . $refvalue . "\"";
  return 1;
}


# Method setOrder
#
# The method setOrder sets the order of the returned  LDAP data.
#
# There is one required input option.
#
# $return = $dsml->setOrder( { order => "sequential" } );
#
# Input option "order":  String that contains the LDAP order value;
# sequential or unordered.  Default is sequential.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setOrder
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;

  $errMsg{$id} = "";

  if (lc((ref($opt->{order}) ? ${$opt->{order}} : $opt->{order})) =~ /^(sequential||unordered)$/ )
  {
    $ops{$id}->{responseOrder} = $orders . $1 . "\"";
    return 1;
  }

  $errMsg{$id} = "Requested responseOrder value does not match sequential or unordered.";
  return 0;
}


# Method setProcess
#
# The method setProcess sets the LDAP DSML processing mode; sequential
# or parallel.  If you use parallel you must set up a seperate unique
# requestId for each requested chunk of data.
#
# There is one required input option.
#
# $return = $dsml->setProcess( { process => "sequential" } );
#
# Input option "process":  String that contains the LDAP process value;
# sequential or parallel.  Default is sequential.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setProcess
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;

  $errMsg{$id} = "";

  if (lc((ref($opt->{process}) ? ${$opt->{process}} : $opt->{process})) =~ /^(sequential||parallel)$/)
  {
    $ops{$id}->{processing} = $proc . $1 . "\""; # Processing type
    return 1;
  }

  $errMsg{$id} = "Requested process value does not match sequential or parallel.";
  return 0;
}


# Method setOnError
#
# The method setOnError sets the LDAP DSML processing mode for errors; exit
# or resume.
#
# There is one required input option.
#
# $return = $dsml->setOnError( { error => "exit" } );
#
# Input option "error":  String that contains the LDAP onError value;
# exit or resume.  Default is exit.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setOnError
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;

  $errMsg{ident $dsml} = "";
  if ( !(length($opt->{error})) )
  {
    $errMsg{$id} = "Subroutine setOnError required attribute is not defined.";
    return 0;
  }

  if ( lc((ref($opt->{error}) ? ${$opt->{error}} : $opt->{error})) =~ /^(exit||resume)$/ )
  {
    $ops{$id}->{onerror} = $onE . $1 . "\""; # On error action to take
    return 1;
  }

  $errMsg{$id} = "Requested onError value does not match exit or resume.";
  return 0;
}

# Method setBatchId
#
# The method setBatchId sets the batch operation request id.
#
# There is one required input option.
#
# $return = $dsml->setBatchId(  { id => "batch request id" });
#
# Input option "id":  String that contains the batch operation request id.
# Default is "search request".
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setBatchId
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $refvalue;

  $errMsg{$id} = "";
  $refvalue = (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id});

  if ( !(length($refvalue)) )
  {
    $errMsg{$id} = "Subroutine setBatchId id string is not defined.";
    return 0;
  }

  $ops{$id}->{reqid} = $reqID . $refvalue . "\"";
  return 1;
}


# Method setProcessId
#
# The method setProcessId sets the LDAP process operation request id.
# Very important method if parallel processing is enabled because each
# parallel operation must have a unique request id.
#
# There is one required input option.
#
# $return = $dsml->setProcessId(  { id => "request id" });
#
# Input option "id":  String that contains the LDAP operation request id.
# Default value: 1, incremented after each process.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setProcessId
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $refvalue;
  $errMsg{$id} = "";
  $refvalue = (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id});
  if ( !(length($refvalue)) )
  {
    $errMsg{$id} = "Subroutine setProcessId id value is not defined.";
    return 0;
  }

  $ops{$id}->{pid} = $reqID . $refvalue . "\"";
  return 1;
}

# Method setBase
#
# The method setBase sets the LDAP search base.
# This is a required method, program must set it.
#
# There is one required input option.
#
# $return = $dsml->setBase( { base => "dc=company,dc=com" } );
#
# Input option "base":  String that contains the LDAP search base.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#

sub setBase
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $refvalue;
  $errMsg{$id} = "";
  $refvalue = (ref($opt->{base}) ? ${$opt->{base}} : $opt->{base});

  if ( !(length($refvalue)) )
  {
    $errMsg{$id} = "Subroutine setBase base value is not defined.";
    return 0;
  }
  _specialChar(\$refvalue) if ( $refvalue =~ /(&||<||>||"||')/);
  $ops{$id}->{sbase} = "\"" . $refvalue . "\"";
  return 1;
}


# Method debug
#
# The method debug sets or returns the object debug flag.
#
# If there is one required input option.
#
# $return = $dsml->debug( 1 );
#
# Input option:  Debug value; 1 or 0.  Default is 0.
#
# Method output; Returns debug value.
#

sub debug
{
  my $dsml = shift;
  $ops{ident $dsml}->{debug} = shift if ( @_ >= 1 );
  return $ops{ident $dsml}->{debug};
}


# Method url
#
# The method url sets or returns the object url value.
#
# If there is one required input option.
#
# $return = $dsml->url( "http://xyz.company.com:8080/dsml" );
#
# Input option:  Host system name.
#
# Method output; Returns host value.
#

sub url
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $refvalue;
  $refvalue = (ref($opt) ? ${$opt} : $opt);
  $ops{$id}->{host} = $refvalue;
  return $ops{$id}->{host};
}


#
# Method error
#
# The method error returns the error message for the object.
# $message = $dsml->error();
#

sub error
{
  my $dsml = shift;
  return $errMsg{ident $dsml};
}


# Method size
#
# The method size returns the size of the last dsml message sent to the dsml
# server.
#
# $size = $dsml->size();
#

sub size
{
   my $dsml = shift;
   return $psize{ident $dsml};
}


# Method content
#
# The method content returns the last dsml message received from the
# dsml server.
# Once the user has the content he or she can use whatever XML parser they
# choose.
#
# $returnXmlMessage = $dsml->content();
#

sub content
{
  my $dsml = shift;
  return $content{ident $dsml};
}


# Method Ping
#
# The method Ping builds a Ping batch request to be sent to the dsml server.
# A Ping requests is used to confirm the existance of a dsml server on a
# directory server system.
#
#
# $return = $dsml->Ping();
# $return = $dsml->send();    # Post the xml message to the DSML server
# $return = $dsml->content(); # Get the data returned from the DSML server.
#
# There are no inputs options for this method.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#
# The user must call the send method to actually send the ping request and
# parse the returned xml message to determine if the dsml server responded.
#

sub Ping
{
  my $dsml = shift;
  my $id = ident $dsml;
  my $result;
  $dsml->setBatchId({id => "Ping!"});
  $result = "";
  push(@{$operations{$id}},$result);
  return 1;
}


# Method rootDSE
#
# The method DSE the searchs the root, or dse, of the dsml server.
#
# There is one required input option.
# Input option "attributes":  Array of attributes to get information on.
#
# There is one optional input option.
# Input option "id":  The request ID for this operation.
#
# $return = $dsml->rootDSE( { attributes => \@attributes } );
# $return = $dsml->send();  # Post the xml message to the DSML server
# $return = $dsml->content(); # Get the data returned from the DSML server.
#
#
# The scope will automatically be set to the correct value for the user.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#
# The user must parse the returned xml message to determine what the
# dsml server responded with.
#

sub rootDSE
{
  my ($dsml,$opt) = @_;
  my $size;
  my $count;
  my $oldscope;
  my $id = ident $dsml;
  my $result;

  $oldscope = $ops{$id}->{scope};

  $count = @{$opt->{attributes}};

  $result = "

  # Load Process ID

  if ( $opt->{id} )
  {
     $result .= $reqID . (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id}) . "\"";
  }
  elsif ( $ops{$id}->{pid} )
  {
     $result .= $ops{$id}->{pid};
     delete($ops{$id}->{pid});
  }
  else
  {
     $result .= $reqID . $pid{$id}->{pid} . "\"";
     ++$pid{$id}->{pid};
  }

  $result .= " dn=\"\"" . " scope=\"baseObject\"" . $ops{$id}->{derefAliases} . $ops{$id}->{timelimit} . $ops{$id}->{sizelimit} . $ops{$id}->{typesOnly} . "";

  for (my $i = 0; $i < $count; $i++)
  {
    $result .= "
    $result .= ${$opt->{attributes}}[$i];
    $result .= "\"/>";
  }

  $result .= $postDSE;
  $result .= $opt->{control} if ( defined($opt->{control}));
  $result .= "";
  push(@{$operations{$id}},$result);
  return 1;

}

#
# Method setProxy
#
# The method setProxy sets the LDAP authenication dn.
#
# There is one required input option.
#
# $return = $dsml->setProxy( { dn => "cn=directory manager" } );
#
# Input option "dn":  String that contains the LDAP authenication dn .
#

sub setProxy
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $refvalue;

  $errMsg{$id} = "";
  $refvalue = (ref($opt->{dn}) ? ${$opt->{dn}} : $opt->{dn});
  if ( !(length($refvalue)) )
  {
    $errMsg{$id} = "Subroutine setProxy dn value is not defined.";
    return 0;
  }

  $ops{$id}->{auth} = $preAuth . $refvalue . $postAuth;
  return 1;
}

# Method search
#
# The method search searchs the dsml server for the requested information.
#
# If there are two required input options.
# Input option "sfilter":  The filter object that contains the filter string.
# Input option "attributes":  Array reference of attributes to get
# information on.
#
# There are 3 optional input options.
# Input option "id":  The request ID for this operation.
# Input option "control":  The Control object that contains the control string.
# Input option "base":  The search base dn.
#
# $return = $dsml->search( { sfilter => $dsml->getFilter(),
#                            attributes => \@attributes },
#                             control => $control->getControl() );
# $return = $dsml->send();  # Post the xml message to the DSML server
# $content = $dsml->content(); # Get the data returned from the DSML server.
#
# Method output;  Returns true on success;  false on error, error message
# can be gotten with error method.
#
# The user must parse the returned xml message to determine what the
# dsml server responded with.
#

sub search
{
  my ($dsml, $opt) = @_;
  my $count;
  my $id = ident $dsml;
  my $result;
  $count = @{$opt->{attributes}};
  $errMsg{$id} = "";

  if ( !$count )
  {
    $errMsg{$id} = "Subroutine search attributes are not defined.";
    return 0;
  }

  if ( !(length($opt->{sfilter})) )
  {
    $errMsg{$id} = "Subroutine search search filter is not defined.";
    return 0;
  }

  if ( $opt->{base} )
  {
    if (!$dsml->setBase( {base => (ref($opt->{base}) ? ${$opt->{base}} : $opt->{base}) }))
    {
      return 0;
    }
  }

  #
  # build search xml message
  #

  $result =  "

  # Load Process ID
  if ( $opt->{id} )
  {
     $result .= $reqID . (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id}) . "\"";
  }
  elsif ( $ops{$id}->{pid} )
  {
     $result .= $ops{$id}->{pid};
     delete($ops{$id}->{pid});
  }
  else
  {
     $result .= $reqID . $pid{$id}->{pid} . "\"";
     ++$pid{$id}->{pid};
  }

  $result .= " dn=" . $ops{$id}->{sbase} . $ops{$id}->{scope} . $ops{$id}->{derefAliases} . $ops{$id}->{timelimit} . $ops{$id}->{sizelimit} . $ops{$id}->{typesOnly};
  #
  # Now add the filter xml string
  #
  $result .= $opt->{sfilter};

  #
  # Now add the attribute list as a xml string.
  #
  $result .= "";

  for (my $i = 0; $i < $count; $i++)
  {
    $result .= "
    $result .= ${$opt->{attributes}}[$i];
    $result .= "\"/>";
  }

  $result .= "";
  $result .= $opt->{control} if ( defined($opt->{control}));
  $result .= $postSearch;
  push(@{$operations{$id}},$result);
  return 1;
}

# Method compare
#
# The method compare compares  the dsml server for the requested information.
#
# There are three required input options.
# Input option "dn": The dn of the object that you wish to do the comparsion on
# Input option "attribute":  attributes to compare the value of.
# Input option "value":  value to compare against.
#
# There are two option input options.
# Input option "id":  The request ID for this operation.
# Input option "control":  A Net::DSML::Control object.
#
# $return = $dsml->compare( { dn => "cn=Super Man,ou=People,dc=xyz,dc=com", attibute => "sn", value => "manager" } );
# $return = $dsml->send();  # Post the xml message to the DSML server
# $content = $dsml->content(); # Get the data returned from the DSML server.
#
# Method output;  Returns 1 (true) on success;  0 (false) on error, error
# message can be gotten with error method.
#
# The user must parse the returned xml content message to determine what the
# dsml server responded with.
#

sub compare
{
  my ($dsml, $opt) = @_;
  my $size;
  my $count;
  my $id = ident $dsml;
  my $result;
  my $dn;
  my $attribute;
  my $value;

  $dn = (ref($opt->{dn}) ? ${$opt->{dn}} : $opt->{dn});
  $attribute = (ref($opt->{attribute}) ? ${$opt->{attribute}} : $opt->{attribute});
  $value = (ref($opt->{value}) ? ${$opt->{value}} : $opt->{value});
  if ( !(length($dn)) )
  {
    $errMsg{$id} = "Subroutine compare dn value is not defined.";
    return 0;
  }

  if ( !(length($attribute)) )
  {
    $errMsg{$id} = "Subroutine compare attribute is not defined.";
    return 0;
  }

  if ( !(length($value)) )
  {
    $errMsg{$id} = "Subroutine compare attribute value is not defined.";
    return 0;
  }

  _specialChar(\$value) if ( $value =~ /(&||<||>||"||')/);

  $result =  "

  # Load Process ID

  if ( $opt->{id} )
  {
     $result .= $reqID . (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id}) . "\"";
  }
  elsif ( $ops{$id}->{pid} )
  {
     $result .= $ops{$id}->{pid};
     delete($ops{$id}->{pid});
  }
  else
  {
     $result .= $reqID . $pid{$id}->{pid} . "\"";
     ++$pid{$id}->{pid};
  }

  $result .= " dn=\"" . $dn . "\">" . $value;

  $result .= $postCompare;
  $result .= $opt->{control} if ( defined($opt->{control}));
  $result .= "";
  push(@{$operations{$id}},$result);
  return 1;
}


# Method delete
#
# The method delete deletes an entry from the directory server.
#
# There is one required input option.
# Input option "dn": The dn of the entry that you wish to delete.
# There are two optional input options.
# Input option "control": The control object to be used with the delete
# operation.
# Input option "id":  The request ID for this operation.
#
# $return = $dsml->delete( { dn => "cn=Super Man,ou=People,dc=xyz,dc=com" } );
# $return = $dsml->send();  # Post the xml message to the DSML server
# $content = $dsml->content(); # Get the data returned from the DSML server.
#
# Method output;  Returns 1 (true) on success;  0 (false) on error, error
# message can be gotten with error method.
#
# The user must parse the returned xml content message to determine what the
# dsml server responded with.
#

sub delete
{
  my ($dsml, $opt) = @_;
  my $size;
  my $count;
  my $id = ident $dsml;
  my $result;
  my $refvalue;
  $errMsg{$id} ="";
  $refvalue = (ref($opt->{dn}) ? ${$opt->{dn}} : $opt->{dn});
  if ( !(length($refvalue)) )
  {
    $errMsg{$id} = "Subroutine delete dn value is not defined.";
    return 0;
  }

  if (defined($opt->{control}))
  {
     $result  = "

     # Load Process ID

     if ( $ops{$id}->{pid} )
     {
        $result .= $ops{$id}->{pid};
        delete($ops{$id}->{pid});
     }
     else
     {
        $result .= $reqID . $pid{$id}->{pid} . "\"";
        ++$pid{$id}->{pid};
     }

     $result .= " dn=\"" . $refvalue . "\" >";
     $result .= $opt->{control};
     $result .= "";
  }
  else
  {
     $result = "

     # Load Process ID

     if ( $opt->{id} )
     {
        $result .= $reqID . (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id}) . "\"";
     }
     elsif ( $ops{$id}->{pid} )
     {
        $result .= $ops{$id}->{pid};
        delete($ops{$id}->{pid});
     }
     else
     {
        $result .= $reqID . $pid{$id}->{pid} . "\"";
        ++$pid{$id}->{pid};
     }

     $result .= " dn=\"" . $refvalue . "\" />";
  }

  push(@{$operations{$id}},$result);
  return 1;
}


# Method modrdn
#
# The method modrdn renames an entry in the directory server.
#
# There are three required input options.
# Input option "dn": The dn of the entry that you wish to delete.
# Input option "newsuperior": The base dn of the entry that you wish to rename.
# Input option "newrdn": The rdn of the new entry that you wish to create.
# There are three optional input options.
# Input option "deleteoldrdn": The flag that controls the deleting of the
# entry:  true -> delete entry, false -> keep entry.
# Input option "id":  The request ID for this operation.
# Input option "control": A Net::DSML::Control object output.
#
# $return = $dsml->modrdn( { dn => "cn=Super Man,ou=People,dc=xyz,dc=com",
#                            newrdn => "cn=Bad Boy",
#                            deleteoldrdn => "true",
#                            newsuperior => "ou=People,dc=xyz,dc=com" } );
# $return = $dsml->send();  # Post the xml message to the DSML server
# $content = $dsml->content(); # Get the data returned from the DSML server.
#
# Method output;  Returns 1 (true) on success;  0 (false) on error, error
# message can be gotten with error method.
#
# The user must parse the returned xml content message to determine what the
# dsml server responded with.
#

sub modrdn
{
  my ($dsml, $opt) = @_;
  my $size;
  my $count;
  my $id = ident $dsml;
  my $result;
  my $dn;
  my $newrdn;
  my $newsuperior;
  my $refvalue;

  $errMsg{$id} ="";

  $dn = (ref($opt->{dn}) ? ${$opt->{dn}} : $opt->{dn});
  $newrdn = (ref($opt->{newrdn}) ? ${$opt->{newrdn}} : $opt->{newrdn});
  $newsuperior = (ref($opt->{newsuperior}) ? ${$opt->{newsuperior}} : $opt->{newsuperior});
  $refvalue = (ref($opt->{deleteoldrdn}) ? ${$opt->{deleteoldrdn}} : $opt->{deleteoldrdn}) if ( $opt->{deleteoldrdn} );

  if ( !(length($dn)) )
  {
    $errMsg{$id} = "Subroutine modrdn dn value is not defined.";
    return 0;
  }

  if ( !(length($newrdn)) )
  {
    $errMsg{$id} = "Subroutine modrdn newrdn value is not defined.";
    return 0;
  }

  if ( !(length($newsuperior)) )
  {
    $errMsg{$id} = "Subroutine modrdn newsuperior value is not defined.";
    return 0;
  }

  $result  = "

  # Load Process ID

  if ( $opt->{id} )
  {
     $result .= $reqID . (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id}) . "\"";
  }
  elsif ( $ops{$id}->{pid} )
  {
     $result .= $ops{$id}->{pid};
     delete($ops{$id}->{pid});
  }
  else
  {
     $result .= $reqID . $pid{$id}->{pid} . "\"";
     ++$pid{$id}->{pid};
  }

  $result .= " dn=\"" . $dn . "\" ";
  $result .= "newrdn=\"" . $newrdn . "\" ";
  $result .= "newSuperior=\"" . $newsuperior . "\" ";
  $result .= "deleteoldrdn=\"" . $refvalue . "\"" if ( $opt->{deleteoldrdn} );
  $result .= ">";
  $result .= $opt->{control} if ( defined($opt->{control}));
  $result .= "";

  push(@{$operations{$id}},$result);
  return 1;
}

#
# Method add
#
# The method add adds an entry into the directory server.
#
# There are 2 required input options.
# Input option "dn": The dn of the entry that you wish to add.
# Input option "attr": A hash of the attributes and their values that are
#                      that are to be in the entry.
#
# There are two optional input options.
# Input option "control": A Net::DSML::Control object output.
# Input option "id":  The request ID for this operation.
#
#
# $result = $dsml->add( { dn => 'cn=Barbara Jensen, o=University of Michigan, c=US',
#                         attr => {
#                                 'cn'   => ['Barbara Jensen', 'Barbs Jensen'],
#                                 'sn'   => 'Jensen',
#                                 'mail' => '[e-mail]',
#                                 'objectclass' => ['top', 'person',
#                                                   'organizationalPerson',
#                                                   'inetOrgPerson' ],
#                                 }
#                        }
#                        );
#
# $return = $dsml->send();  # Post the xml message to the DSML server
# $content = $dsml->content(); # Get the data returned from the DSML server.
#
# Method output;  Returns 1 (true) on success;  0 (false) on error, error
# message can be gotten with error method.
#
# The user must parse the returned xml content message to determine what the
# dsml server responded with.
#

sub add
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $result;
  my @attributes;
  my $dn;
  $errMsg{$id} = "";

  $dn = (ref($opt->{dn}) ? ${$opt->{dn}} : $opt->{dn});

  if ( !(length($dn)) )
  {
    $errMsg{$id} = "Subroutine add dn value is not defined.";
    return 0;
  }

  @attributes = sort(keys(%{$opt->{attr}}));

  #
  # build search xml message
  #

  $result =  "

  # Load Process ID

  if ( $opt->{id} )
  {
     $result .= $reqID . (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id}) . "\"";
  }
  elsif ( $ops{$id}->{pid} )
  {
     $result .= $ops{$id}->{pid};
     delete($ops{$id}->{pid});
  }
  else
  {
     $result .= $reqID . $pid{$id}->{pid} . "\"";
     ++$pid{$id}->{pid};
  }

  $result .= " dn=\"" . $dn . "\">";

  #
  # Now add the attribute list as a xml string.
  #

  foreach my $i (@attributes)
  {
    if ( ref($opt->{attr}{$i}))
    {
       if (ref($opt->{attr}{$i}) eq 'SCALAR')
       {
         $result .= "${$opt->{attr}{$i}}";
       }
       elsif (ref($opt->{attr}{$i}) eq 'ARRAY')
       {
         foreach my $val ( @{$opt->{attr}{$i}})
         {
         $result .= "$val";
         }

       }
       else
       {
          $errMsg{$id} = "Invalid object in add subroutine attr hash.";
          return 0;
       }
    }
    else
    {
       $result .= "$opt->{attr}{$i}";
    }
  }

  $result .= $opt->{control} if ( defined($opt->{control}));
  $result .= "";
  push(@{$operations{$id}},$result);
  return 1;
}


#
# Method modify
#
# The method modify modifies attributes in an entry.
#
# There are 2 required input options.
# Input option "dn": The dn of the entry that you wish to add.
# Input option "attr": A hash of the attributes and their values that are
#                      that are to be in the entry.
#
# There are two optional input option.
# Input option "control": A Net::DSML::Control object output.
# Input option "id":  The request ID for this operation.
#
#
# $result = $dsml->modify( {
#            dn => 'cn=Barbara Jensen, o=University of Michigan, c=US',
#            modify => {
#                       add => {
#                       'telephoneNumber' => ['214-972-1212','972-123-0987'],
#                              },
#                       replace => {
#                                 'mail' => '[e-mail]',
#                                  },
#                       delete => {
#                                 'cn'   => 'Barbs Jensen',
#                                 'title'   => '',
#                                  }
#                        } } );
#
# $return = $dsml->send();  # Post the xml message to the DSML server
# $content = $dsml->content(); # Get the data returned from the DSML server.
#
# Method output;  Returns 1 (true) on success;  0 (false) on error, error
# message can be gotten with error method.
#
# The user must parse the returned xml content message to determine what the
# dsml server responded with.
#

sub modify
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $result;
  my @changes;
  my @action;
  my @attributes;
  my $dn;
  $errMsg{$id} = "";

  $dn = (ref($opt->{dn}) ? ${$opt->{dn}} : $opt->{dn});
  if ( !(length($dn)) )
  {
    $errMsg{$id} = "Subroutine modify dn value is not defined.";
    return 0;
  }


  @changes = sort(keys(%{$opt->{modify}}));

  #
  # build search xml message
  #

  $result =  "

  # Load Process ID

  if ( $opt->{id} )
  {
     $result .= $reqID . (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id}) . "\"";
  }
  elsif ( $ops{$id}->{pid} )
  {
     $result .= $ops{$id}->{pid};
     delete($ops{$id}->{pid});
  }
  else
  {
     $result .= $reqID . $pid{$id}->{pid} . "\"";
     ++$pid{$id}->{pid};
  }

  $result .= " dn=\"" . $dn . "\">";

  #
  # Now add the attribute list as a xml string.
  #

  foreach my $action (@changes)
  {

    @action = sort(keys(%{$opt->{modify}{$action}}));
    foreach my $i ( @action)
    {

      if ( ref($opt->{modify}{$action}{$i}))
      {
         if (ref($opt->{modify}{$action}{$i}) eq 'SCALAR')
         {
           if ( !(length(${$opt->{modify}{$action}{$i}})))
           {
              $result .= "";
           }
           else
           {
              $result .= "${$opt->{modify}{$action}{$i}}";
           }
         }
         elsif (ref($opt->{modify}{$action}{$i}) eq 'ARRAY')
         {
           $result .= "";
           foreach my $val ( @{$opt->{modify}{$action}{$i}})
           {
             if ( length($val))
             {
                $result .= "$val";
             }
           }
           $result .= "";

         }
         else
         {
            $errMsg{$id} = "Invalid object in add subroutine modify hash.";
            return 0;
         }
      }
      else
      {
         $result .= "";
         if ( length($opt->{modify}{$action}{$i}))
         {
           $result .= "$opt->{modify}{$action}{$i}";
         }
         $result .= "";
      }

    }
  }

  $result .= $opt->{control} if ( defined($opt->{control}));
  $result .= "";
  push(@{$operations{$id}},$result);
  return 1;

}

#
# Method abandon
#
# The method abandon request that the DSML server abandon the
# batch request with the given ID.
#
# There is 1 required input option.
# Input option "id": The id of the batch request to abandon.
#                    This id may be referenced.
#
#
# $result = $dsml->abandon( { id => $id } );
#
# $return = $dsml->send();  # Post the xml message to the DSML server
# $content = $dsml->content(); # Get the data returned from the DSML server.
#
# Method output;  Returns 1 (true) on success;  0 (false) on error, error
# message can be gotten with error method.
#
# The user must parse the returned xml content message to determine what the
# dsml server responded with.
#

sub abandon
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $result;
  my $aid;
  $errMsg{$id} = "";

  $aid = (ref($opt->{id}) ? ${$opt->{id}} : $opt->{id});
  if ( !$id )
  {
    $errMsg{$id} = "Method abandon id value is not defined.";
    return 0;
  }

  $result = "";
  $result .= "";
  push(@{$operations{$id}},$result);
  return 1;

}

#
#  This method is used mainly for debugging purposes.
#

sub getOperations
{
  my ($dsml) = @_;
  my $id = ident $dsml;
  my $data;

  $data = "";
  #
  # load each operation into the xml string in order.
  #
  foreach my $str (@{$operations{$id}})
  {
      $data .= $str;
  }

  return $data;
}

# Method getPostData
#
# The method getPostData the xml data string that was posted to the
# DSML server.   It is used mainly for debugging problems.
#
# There are no required input options.
#
# $content = $dsml->getPostData();
#
# Method output;  Always returns 1 (true).
#
# The user must parse the returned xml content message to determine what
# was posted to the dsml server.
#

sub getPostData
{
  my ($dsml) = @_;
  my $id = ident $dsml;

  return $postData{$id};
}

# Method send
#
# The method send sends the xml data string that was created to the
# DSML server.
#
# There are no required input options.
#
# $result = $dsml->send();
# $content = $dsml->content(); # Get the data returned from the DSML server.
#
# Method output;  Returns 1 (true) on success;  0 (false) on error, error
# message can be gotten with error method.  This error code is from the
# http process and NOT the DSML process
#
# The user must parse the returned xml content message to determine what
# was recieved from the dsml server.
#

sub send
{
  my ($dsml, $opt) = @_;
  my $id = ident $dsml;
  my $size;

  $size = @{$operations{$id}};
  if ( !$size )
  {
    $errMsg{$id} = "No XML query data string present.";
    return 0;
  }

  # start xml string
  $postData{$id} = $postHead . $preBatch . $ops{$id}->{reqid} . $ops{$id}->{onerror} . $ops{$id}->{responseOrder} . $ops{$id}->{processing} . ">";

  $postData{$id} .= $ops{$id}->{auth} if ( length($ops{$id}->{auth}));

  #
  # load each operation into the xml string in order.
  #
  foreach my $str (@{$operations{$id}})
  {
      $postData{$id} .= $str;
  }

  # terminate the xml string.
  $postData{$id} .= $postBatch .  $postTail;
  if ( !defined($opt->{debug}))
  {
    return $dsml->_post();   # Send the data to the dsml server.
  }
  else
  {
    return 1;
  }
}

#
#  This version of the method post uses a XML string
#  that has been built prior to calling this method.
#
# true on success, false on error.
# Use errMsg method to get error message.
#
sub _post
{
  my $dsml = shift;
  my $id = ident $dsml;

  if (length($postData{$id}) == 0 )
  {
    $errMsg{$id} = "No XML query data string present.";
    return 0;
  }

  return $dsml->_postit();
}

#
#
#  The private method postit executes the HTTP DSML request.
#
# true on success, false on error.
# Use errMsg method to get error message.
#
sub _postit
{
  my $dsml = shift;
  my $ua;
  my $headers;
  my $req;
  my $res;
  my $psize;
  my $host;
  my $dsmlinfo;
  my $postData;
  my $uriString;
  my $code;

  my $id = ident $dsml;

  $psize{$id} = length($postData{$id});
  $psize = length($postData{$id});
  $uriString = $ops{$id}->{host};
  $postData = $postData{$id};
  $prepostData{$id} = $postData;  # Copy of actual postData

  $ua = new LWP::UserAgent;
  $ua->agent('DSML HTTP/1.1');
  print $postData if ( $ops{$id}->{debug} );

  $headers = HTTP::Headers->new( 'content-length' => $psize,
                                 'HOST'  => $uriString,
                                 'SOAPAction'  => "",
                                 'Content-Type'  => "text/xml",
                                 'Connection'  => "close");

  $headers->authorization_basic($authentication{$id}->{dn}, $authentication{$id}->{password} ) if ( $authentication{$id} );
  #
  # Create the request
  #
  $req =  new HTTP::Request ('POST',$uriString, $headers);
  $req->content($postData);
  $res = $ua->request($req);


  #
  # Check the outcome of the response
  #
  if ($res->is_success)
  {
    print "Success\n" if ( $ops{$id}->{debug});
    $content{$id} =  $res->content;
  }
  else
  {
    print "No Success\n" if ( $ops{$id}->{debug});
    $code = $res->status_line;
    $errMsg{$id} = "$code";
    return 0;
  }

  if (length($content{$id}) == 0  )
  {
#       print "No Success return\n";
    $errMsg{$id} = "Error, no response data received from " . $uriString . ".";
    return 0;
  }
  $errMsg{$id} = "";   # Clear the error message string.
  return 1;   # Exit the method with no errors, does not mean we got data!
}

}

1; # Magic true value required at end of module

__END__