Re: Net::LDAP::FilterMatch

[Mike Jackson]

[EMAIL PROTECTED] wrote:

Hi,

attached is Net::LDAP::FilterMatch, a module to match Net::LDAP::Entry objects against a Net::LDAP::Filter filter. It can be used to filter out entries from an LDIF, but also as a simple solution for searching while using Net::LDAP::Server.

Comments are welcome.

Kind regards,

Hans

Cool. Where do I find Net::LDAP::Server?

Not here:

http://svn.mutatus.co.uk/wsvn/perl-ldap/trunk/lib/Net/LDAP/?rev=0&sc=0


--
mike

------------------------------------------------------------------------

# ===========================================================================
# Net::LDAP::FilterMatch

# # LDAP entry matching # # Hans Klunder <[EMAIL PROTECTED]>

# Copyright (c) 2005.

# # See below for documentation. #

package Net::LDAP::FilterMatch;

require Exporter;
@ISA        = qw(Exporter);
@EXPORT_OK  = qw(filterMatch);
$VERSION    = '0.1';


sub filterMatch{
  my $filter=shift;
  my $entry=shift;

  keys(%{$filter}); #this one is to ensure the next each works out fine
  my ($op, $args)=each(%{$filter});

  return (filterMatch(@{$args}[0],$entry) and filterMatch(@{$args}[1],$entry)) 
if ($op eq 'and');
  return (filterMatch(@{$args}[0],$entry) or filterMatch(@{$args}[1],$entry))if 
($op eq 'or');
  return (not(filterMatch($args,$entry))) if ($op eq 'not');
  return ($entry->exists($args)) if ($op eq 'present');

  if ($op=~ /^(equalityMatch|greaterOrEqual|lessOrEqual|approxMatch)/){
      my @values=$entry->get_value($args->{'attributeDesc'});
      my $type='string'; # should be derived from schema
      my $match= $type.'_'.$op;
      my $filter=$args->{'assertionValue'};
      foreach my $value(@values){
          return  1 if eval( "$match".'($filter,$value)');
      }
      return 0;
  }
  if ($op eq 'substrings'){
      my @values=$entry->get_value($args->{'type'});
      my $type='string'; # should be derived from schema
      my $match= $type.'_'.$op;
      my $regexp = join('.*', "",map { $_ } map { values %$_ } 
@{$args->{'substrings'}});
      $regexp =~ s/^..// if exists $args->{'substrings'}[0]{initial};
      $regexp .= '.*' unless exists $args->{'substrings'}[-1]{final};
      foreach my $value(@values){
          return 1 if eval( "$match".'($regexp,$value)' );
      }
      return 0;
  }
}

sub string_equalityMatch{
    return (@_[0] eq @_[1]);
}

sub string_greaterOrEqual{
    return (@_[0] ge @_[1]);
}

sub string_lessOrEqual{
    return (@_[0] le @_[1]);
}

sub string_approxMatch{
    return (@_[0] eq @_[1]);    #this needs fixing by using String::Approx
}

sub string_substrings{
    return ($_[1]=~/$_[0]/);
}

1;

__END__

=head1 NAME

Net::LDAP::FilterMatch - LDAP entry matching

=head1 SYNOPSIS

  use Net::LDAP::Entry;
  use Net::LDAP::Filter;
  use Net::LDAP::FilterMatch qw/filterMatch/;

  my $entry=new Net::LDAP::Entry;
  $entry->dn("cn=dummy entry");
  $entry->add (
   'cn' => 'dummy entry',
   'street' => [ '1 some road','nowhere' ] );

my @filters=(qw/(cn=dummy*)

                (ou=*)
                (&(cn=dummy*)(street=*road))
                (&(cn=dummy*)(!(street=nowhere)))/);


  for (@filters){
    my $filter=new Net::LDAP::Filter;
    $filter->parse($_);
    print $_,' : ',filterMatch($filter,$entry) ? 'match' : 'no match' ,"\n";
  }

=head1 ABSTRACT

This class provides ldap entry matching functionality which can be used on its own or as part of a Net::LDAP::Server based LDAP server.

Given an entry and a filter it will tell you if the filter matches the entry.

=head1 SEE ALSO

L<Net::LDAP::Server>

=head1 COPYRIGHT

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Hans Klunder E<lt>[EMAIL PROTECTED]<gt>

=cut