File Coverage

blib/lib/Net/DSML/Filter.pm

Criterion	Covered	Total	%
statement	144	223	64.5
branch	62	130	47.6
condition	7	21	33.3
subroutine	18	28	64.2
pod	19	19	100.0
total	250	421	59.3

package Net::DSML::Filter;

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

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

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

{

BEGIN
{
  use Exporter ();

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

}


#
# The class filter provides methods for building ldap dsml search filters.
#
my %sfilter;
my %debug;
my %errMsg;
my %msg;

#
#  initialize the new object.
#
# Method new
#
# The new method initializes a new filter object.
#
# This method has 1 valid option; debug; value of 1 or 0.  This will enable
# debug messages to standard out.
#

sub new
{
  my ($class, $opt) = @_;
  my $self = bless anon_scalar(), $class;

  $sfilter{ident $self} = ""; # Search filter
  $debug{ident $self} = $opt->{debug} ? 1 : 0; # debug flag
  $errMsg{ident $self} = ""; #  error messages, no error this will be a null string.
  $msg{ident $self} = ""; # general messages
  return $self;
}

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

  delete $sfilter{$id};
  delete $debug{$id};
  delete $errMsg{$id};
  delete $msg{$id};
  return;
}

# 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;
  $debug{ident $dsml} = shift if ( @_ >= 1 );
  return $debug{ident $dsml};
}


#  Method error
#
# The error method returns error message that is stored in the
# object.  Any error message will be associated with the last
# filter module operation.
#
# No input options.
#
# Example:  $filter->error;
#

sub error
{
  my ($dsml) = @_;
  return $errMsg{ident $dsml};
}


#  Method getFilter
#
# The getFilter method returns the last filter string that was
# created.
#
# No input options.
#
# Example:  $filter->getFilter;
#

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

  if ( !($sfilter{$id} =~ //) )
  {
     $sfilter{$id} = "" . $sfilter{$id} . "";
  }
  return $sfilter{$id};
}


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

}

#  Method setFilter
#
# The setFilter method sets the objects filter string.  This
# could be used as a base to continue building the filter string.
#
# Example:  $filter->setFilter($value);
#
# There is 1 input option ($value):  filter string.
#

sub setFilter
{
  my ($dsml, $value) = @_;
  my $refvalue;
  $refvalue = (ref($value) ? ${$value} : $value);
  if ( length($refvalue) > 0 )
  {
     _specialChar(\$refvalue) if ( $refvalue =~ /(&||<||>||"||')/);
     $sfilter{ident $dsml} = $refvalue;
     return 1;
  }

  $errMsg{ident $dsml} = "Method setFilter filter value is not defined.";
  return 0;

}


#  Method reset
#
# The reset method will reset the filter string to a null, or blank,
# value.
#
# No input options.
#
# Example:  $filter->reset;
#

sub reset
{
  my ($dsml) = @_;
  $sfilter{ident $dsml} = "";
  return 1;
}

# Method subString
#
# The method subString sets up a LDAP substring filter.
#
# There are 3 required input options.
#
# $return = $filter->subString( type => "initial,
#                               attribute => "cn",
#                               value => "Bugs Bunny" );
#
# Input option "type":  String that contains the type of substring
# search that is being preformed; final, any, initial.
#
# Input option "attribute": String that contains the attribute name
# that controls the search.
#
# Input option  "value": String that contains the value of the
# attribute.
#
# Method output;  Returns true on success; false on error, error message
# can be gotten with error property.
#

sub subString
{
  my ($dsml, $opt) = @_;
  my $id = ident($dsml);
  my $attribute;
  my $value;
  my $type;
  $errMsg{$id} = "";

  $attribute = (ref($opt->{attribute}) ? ${$opt->{attribute}} : $opt->{attribute});
  $value = (ref($opt->{value}) ? ${$opt->{value}} : $opt->{value});
  $type = (ref($opt->{type}) ? ${$opt->{type}} : $opt->{type});

  if ( defined($opt->{attribute}) &&
       defined($opt->{value}) &&
       defined($opt->{type}) )
  {
      _specialChar(\$value) if ( $value =~ /(&||<||>||"||')/);
      $_ = lc($type);
      if ( /^(final||initial||any)$/ )
      {
          $sfilter{$id} .= "<" . $1 . ">" . $value . "";
          return 1;
      }

      $errMsg{$id} = "Requested substring type does not match final, any or initial.";
      return 0;

  }
  else
  {
  #
  #  Substring error conditions
  #
      if ( (@_) < 6 )
      {
          $errMsg{$id} = "Subroutine subString did not have enough parameters defined.";
      }
      elsif ( !defined($opt->{attribute}) )
      {
          $errMsg{$id} = "Subroutine subString attribute string is not defined.";
      }
      elsif ( !defined($opt->{value}) )
      {
          $errMsg{$id} = "Subroutine subString value string is not defined.";
      }
      elsif ( !defined($opt->{type}) )
      {
          $errMsg{$id} = "Subroutine subString type string is not defined.";
      }
      return 0;
  }

}


# Method present
#
# The method present sets up a LDAP present filter.
#
# There is 1 required input option.
#
# $return = $filter->present(  { attribute => "cn" } );
#
# Input option "attribute": String that contains the attribute name
# that controls the search.
#
# Method output;  Returns true on success; false on error, error message
# can be gotten with error property.
#

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

  $errMsg{$id} = "";
  $refvalue = (ref($opt->{attribute}) ? ${$opt->{attribute}} : $opt->{attribute});
  if ( !defined($opt->{attribute}) )
  {
     $errMsg{$id} = "Subroutine present attribute string is not defined.";
     return 0;
  }
  $sfilter{$id} .= "";
  return 1;
}


# Method equalityMatch
#
# The method equalityMatch sets up a LDAP equality match filter.
#
# There are 2 required input options.
#
# $return = $filter->equalityMatch( { attribute => "sn", value => "Bunny"  } );
#
# Input option "attribute": String that contains the attribute name
# that controls the search.
#
# Input option  "value": String that contains the attribute value.
#
# Method output;  Returns true on success; false on error, error message
# can be gotten with error property.
#

sub equalityMatch
{
  my ($dsml, $opt) = @_;
  my $id = ident($dsml);
  my $attribute;
  my $value;
  $errMsg{$id} = "";
  $attribute = (ref($opt->{attribute}) ? ${$opt->{attribute}} : $opt->{attribute});
  $value = (ref($opt->{value}) ? ${$opt->{value}} : $opt->{value});

  if ( defined($opt->{attribute}) && defined($opt->{value}) )
  {
      _specialChar(\$value) if ( $value =~ /(&||<||>||"||')/);
      $sfilter{$id} .= "" . $value . "";

      #print $sfilter{$id}, "\n"; # if ( $debug{$id} );
      return 1;
  }
  else
  {

    if ( (@_) < 2 )
    {
        $errMsg{$id} = "Subroutine equalityMatch did not have enough parameters defined.";
    }
    elsif ( !defined($opt->{attribute}) )
    {
       $errMsg{$id} = "Subroutine equalityMatch attribute string is not defined.";
    }
    elsif ( !defined($opt->{value}) )
    {
       $errMsg{$id} = "Subroutine equalityMatch value string is not defined.";
    }
    return 0;
  }
}


# Method greaterOrEqual
#
# The method greaterOrEqual sets up a LDAP greater or equal filter.
#
# There are 2 required input options.
#
# $return = $filter->greaterOrEqual( { attribute => "uid", value => "bugs" } );
#
# Input option "attribute": String that contains the attribute name
# that controls the search.
#
# Input option  "value": String that contains the value of the
# attribute.
#
# Method output;  Returns true on success; false on error, error message
# can be gotten with error property.
#

sub greaterOrEqual
{
  my ($dsml, $opt) = @_;
  my $id = ident($dsml);
  my $attribute;
  my $value;

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

  if ( defined($opt->{attribute}) && defined($opt->{value}) )
  {
      _specialChar(\$value) if ( $value =~ /(&||<||>||"||')/);
      $sfilter{$id} .= "" . $value . "";
      return 1;
  }
  else
  {
    if ( (@_) < 4 )
    {
        $errMsg{$id} = "Subroutine greaterOrEqual did not have enough parameters defined.";
    }
    elsif ( !defined($opt->{attribute}) )
    {
        $errMsg{$id} = "Subroutine greaterOrEqual attribute string is not defined.";
    }
    elsif ( !defined($opt->{value}) )
    {
        $errMsg{$id} = "Subroutine greaterOrEqual value string is not defined.";
    }
    return 0;
  }
}



# Method lessOrEqual
#
# The method lessOrEqual sets up a LDAP less or equal filter.
#
# There are 2 required input options.
#
# $return = $filter->lessOrEqual( { attribute => "uid", value => "turkey" } );
#
# Input option "attribute": String that contains the attribute name
# that controls the search.
#
# Input option  "value": String that contains the value of the
# attribute.
#
# Method output;  Returns true on success; false on error, error message
# can be gotten with error property.
#

sub lessOrEqual
{
  my ($dsml, $opt) = @_;
  my $id = ident($dsml);
  my $attribute;
  my $value;
  $errMsg{$id} = "";

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

  if ( defined($opt->{attribute}) && defined($opt->{value}) )
  {
      _specialChar(\$value) if ( $value =~ /(&||<||>||"||')/);
      $sfilter{$id} .= "" . $value . "";
      return 1;
  }
  else
  {
    if ( (@_) < 4 )
    {
        $errMsg{$id} = "Subroutine lessOrEqual did not have enough parameters defined.";
    }
    elsif ( !defined($opt->{attribute}) )
    {
        $errMsg{$id} = "Subroutine lessOrEqual attribute string is not defined.";
    }
    elsif ( !defined($opt->{value}) )
    {
        $errMsg{$id} = "Subroutine lessOrEqual value string is not defined.";
    }
    return 0;
  }
}


# Method approxMatch
#
# The method approxMatch sets up a LDAP approximate match filter.
#
# There are 2 required input options.
#
# $return = $filter->approxMatch( { attribute => "uid", value => "bird" } );
#
# Input option "attribute": String that contains the attribute name
# that controls the search.
#
# Input option  "value": String that contains the value of the
# attribute.
#
# Method output;  Returns true on success; false on error, error message
# can be gotten with error property.
#

sub approxMatch
{
  my ($dsml, $opt) = @_;
  my $id = ident($dsml);
  my $attribute;
  my $value;
  $errMsg{$id} = "";

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

  if ( defined($opt->{attribute}) && defined($opt->{value}) )
  {
      _specialChar(\$value) if ( $value =~ /(&||<||>||"||')/);
      $sfilter{$id} .= "" . $value . "";
      return 1;
  }
  else
  {
    if ( (@_) < 4 )
    {
        $errMsg{$id} = "Subroutine approxMatch did not have enough parameters defined.";
    }
    elsif ( !defined($opt->{attribute}) )
    {
        $errMsg{$id} = "Subroutine approxMatch attribute string is not defined.";
    }
    elsif ( !defined($opt->{value}) )
    {
        $errMsg{$id} = "Subroutine approxMatch value string is not defined.";
    }
    return 0;
  }
}


# Method extensibleMatch
#
# The method extensibleMatch sets up a LDAP extensibleMatch filter.
#
# There is 1 required input options.
# Input option  "value": String that contains the value of the
# attribute.
# There are 3 optional options.
# Input option  "matchingRule": String that contains the value of the
# matchingRule.
# Input option  "dnAttributes": String that contains the boolean value
# of true or false
# Input option  "name": String that contains the name string.
#
#
# $return = $filter->extensibleMatch( { value =>" ",
#                                       name => " ",
#                                       matchingRule => " ",
#                                       dnAttributes => " " } );
#
# Method output;  Returns true on success; false on error, error message
# can be gotten with error property.
#

sub extensibleMatch
{
  my ($dsml, $opt) = @_;
  my $id = ident($dsml);
  my $name;
  my $value;
  my $mrule;
  my $dnAttributes;
  $errMsg{$id} = "";

  $value = (ref($opt->{value}) ? ${$opt->{value}} : $opt->{value});
  $name = (ref($opt->{name}) ? ${$opt->{name}} : $opt->{name}) if ( $opt->{name});
  $mrule = (ref($opt->{matchingRule}) ? ${$opt->{matchingRule}} : $opt->{matchingRule}) if ( $opt->{matchingRule});
  $dnAttributes = (ref($opt->{dnAttributes}) ? ${$opt->{dnAttributes}} : $opt->{dnAttributes}) if ( defined($opt->{dnAttributes}) );

    if ( $opt )
    {
       if ( !$opt->{value} )
       {
           $errMsg{$id} = "Subroutine extensibleMatch value string is not defined.";
           return 0;
       }

       $_ = lc($dnAttributes) if ( defined($opt->{dnAttributes}) );

       if ( defined($_) && !(/^(true)||(false)$/) )
       {
          $errMsg{$id} = "Subroutine extensibleMatch dnAttributes string is not properly defined.";
          return 0;
       }

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

        if ( $opt->{name})
        {
          _specialChar(\$name) if ( $name =~ /(&||<||>||"||')/);
        }

        if ( $opt->{matchingRule})
        {
          _specialChar(\$mrule) if ( $mrule =~ /(&||<||>||"||')/);
        }

         $sfilter{$id} .= "
         $sfilter{$id} .= " name=\"" . $name . "\"" if ($name);
         $sfilter{$id} .= " dnAttributes=\"" . $dnAttributes . "\"" if ($opt->{dnAttributes});
         $sfilter{$id} .= " matchingRule=\"" . $mrule . "\"" if ($opt->{matchingRule});
         $sfilter{$id} .= ">" . $value . "";
         return 1;
      }
      else
      {
        $errMsg{$id} = "Subroutine extensibleMatch had no input options defined.";
        return 0;
      }
}

# Method or
#
# The method or sets up a beginning or element of a LDAP or filter.
#
# There are no required input options.
#
# $return = $filter->or();
#
# Method output;  Always returns true for success.
#

sub or
{
  my ($dsml) = @_;
  $sfilter{ident $dsml} .= "";
  return 1;
}

# Method endor
#
# The method endor sets up a ending or element of a LDAP or filter.
#
# There are no required input options.
#
# $return = $filter->or();
#
# Method output;  Always returns true for success.
#

sub endor
{
  my ($dsml) = @_;
  $sfilter{ident $dsml} .= "";
  return 1;
}


# Method and
#
# The method and sets up a beginning and element of a LDAP and filter.
#
# There are no required input options.
#
# $return = $filter->and();
#
# Method output;  Always return true for success.
#

sub and
{
  my ($dsml) = @_;
  $sfilter{ident $dsml} .= "";
  return 1;
}

# Method endand
#
# The method endand sets up a ending and element of a LDAP and filter.
#
# There are no required input options.
#
# $return = $filter->endand();
#
# Method output;  Always returns true for success.
#

sub endand
{
  my ($dsml) = @_;
  $sfilter{ident $dsml} .= "";
  return 1;
}

# Method not
#
# The method not sets up a beginning not element of a LDAP not filter.
#
# There are no required input options.
#
# $return = $filter->not();
#
# Method output;  Always return true for success.
#

sub not
{
  my ($dsml) = @_;
  $sfilter{ident $dsml} .= "";
  return 1;
}

# Method endnot
#
# The method endnot sets up the ending not element of a LDAP not filter.
#
# There are no required input options.
#
# $return = $filter->endnot();
#
# Method output;  Always returns true for success.
#

sub endnot
{
  my ($dsml) = @_;
  $sfilter{ident $dsml} .= "";
  return 1;
}

}


1; # Magic true value required at end of module

__END__