|
Peter, I've created a 0.14 (see attached patch ;-)) which contains more matching rules and some other small fixes. However to post patches, it would be very convenient to have *readonly* svn access. I tried using tortoise SVN but I get a forbidden. Am I doing something wrong ? Using the web interface is rather cumbersome if I want to keep up with the patches as I seem to be unable to get the files apart from copy/paste from the webpage. Any hints would be appreciated ;-) I removed the "use Net::LDAP::Filter" & "use Net::LDAP::Schema" as it does not seem to harm code execution. The module seems to be strict, however the &$match is not allowed when strict is active (thats why my initial version used the eval ) Regarding the approx, we could use Text::Soundex or String::Approx and conditionally load that if present on the system, "just" a regexp would be perfect, but I haven't come across one yet ;-) Cheers, Hans Peter Marschall schreef: Hi Hans, On Saturday, 14. January 2006 21:00, [EMAIL PROTECTED] wrote: |
*** /trunk/lib/Net/LDAP/FilterMatch.pm 2006-01-15 20:27:05.787625600 +0100
--- FilterMatch.pm 2006-01-15 21:34:40.457955200 +0100
***************
*** 10,37 ****
# See below for documentation.
#
- use Net::LDAP::Filter;
- use Net::LDAP::Schema;
-
package Net::LDAP::Filter;
! use strict;
! use vars qw(@ISA @EXPORT_OK);
!
! require Exporter;
! @ISA = qw(Exporter);
! @EXPORT_OK = qw(filterMatch);
! $VERSION = '0.13';
sub filterMatch($@);
sub _cis_equalityMatch($@);
sub _cis_greaterOrEqual($@);
sub _cis_lessOrEqual($@);
sub _cis_approxMatch($@);
! sub _cis_substrings;
! sub _caseIgnoreMatch { return _cis_equalityMatch(@_)};
! sub _caseIgnoreSubstringsMatch { return _cis_substrings(@_) };
sub match
{
--- 10,66 ----
# See below for documentation.
#
package Net::LDAP::Filter;
! $VERSION = '0.14';
sub filterMatch($@);
+
sub _cis_equalityMatch($@);
+ sub _exact_equalityMatch($@);
+ sub _numeric_equalityMatch($@);
+ sub _cis_orderingMatch($@);
+ sub _numeric_orderingMatch($@);
sub _cis_greaterOrEqual($@);
sub _cis_lessOrEqual($@);
sub _cis_approxMatch($@);
! sub _cis_substrings($@);
! sub _exact_substrings($@);
! # all known matches from the OL 2.2 schema,
! *_bitStringMatch = \&_exact_equalityMatch;
! *_booleanMatch = \&_cis_equalityMatch; # this might need to be
reworked
! *_caseExactIA5Match = \&_exact_equalityMatch;
! *_caseExactIA5SubstringsMatch = \&_exact_substrings;
! *_caseExactMatch = \&_exact_equalityMatch;
! *_caseExactOrderingMatch = \&_exact_orderingMatch;
! *_caseExactSubstringsMatch = \&_exact_substrings;
! *_caseIgnoreIA5Match = \&_cis_equalityMatch;
! *_caseIgnoreIA5SubstringsMatch = \&_cis_substrings;
! *_caseIgnoreMatch = \&_cis_equalityMatch;
! *_caseIgnoreOrderingMatch = \&_cis_orderingMatch;
! *_caseIgnoreSubstringsMatch = \&_cis_substrings;
! *_certificateExactMatch = \&_exact_equalityMatch;
! *_certificateMatch = \&_exact_equalityMatch;
! *_distinguishedNameMatch = \&_exact_equalityMatch;
! *_generalizedTimeMatch = \&_exact_equalityMatch;
! *_generalizedTimeOrderingMatch = \&_exact_orderingMatch;
! *_integerBitAndMatch = \&_exact_equalityMatch; # this needs to be
reworked
! *_integerBitOrMatch = \&_exact_equalityMatch; # this needs to be
reworked
! *_integerFirstComponentMatch = \&_exact_equalityMatch;
! *_integerMatch = \&_numeric_equalityMatch;
! *_integerOrderingMatch = \&_numeric_orderingMatch;
! *_numericStringMatch = \&_numeric_equalityMatch;
! *_numericStringOrderingMatch = \&_numeric_orderingMatch;
! *_numericStringSubstringsMatch = \&_numeric_substrings;
! *_objectIdentifierFirstComponentMatch = \&_exact_equalityMatch; # this needs
to be reworked
! *_objectIdentifierMatch = \&_exact_equalityMatch;
! *_octetStringMatch = \&_exact_equalityMatch;
! *_octetStringOrderingMatch = \&_exact_orderingMatch;
! *_octetStringSubstringsMatch = \&_exact_substrings;
! *_telephoneNumberMatch = \&_exact_equalityMatch;
! *_telephoneNumberSubstringsMatch = \&_exact_substrings;
! *_uniqueMemberMatch = \&_cis_equalityMatch; # this needs to be
reworked
sub match
{
*************** sub match
*** 41,54 ****
return filterMatch($self, $entry, $schema);
}
-
# map Ops to schema matches
my %op2schema = qw(
! equalityMatch equality
! greaterOrEqual equality
! lessOrEqual ordering
! approxMatch ordering
! substrings substr
);
sub filterMatch($@)
--- 70,82 ----
return filterMatch($self, $entry, $schema);
}
# map Ops to schema matches
my %op2schema = qw(
! equalityMatch equality
! greaterOrEqual ordering
! lessOrEqual ordering
! approxMatch approx
! substrings substr
);
sub filterMatch($@)
*************** sub filterMatch($@)
*** 57,62 ****
--- 85,91 ----
my $entry = shift;
my $schema = shift;
+
keys(%{$filter}); # re-initialize each() operator
my ($op, $args) = each(%{$filter});
*************** sub filterMatch($@)
*** 83,103 ****
# handle basic filters
if ($op =~
/^(equalityMatch|greaterOrEqual|lessOrEqual|approxMatch|substrings)/o) {
! my $attr=($op eq 'substrings') ? $args->{'type'} :
$args->{'attributeDesc'} ;
! my @values = $entry->get_value($attr);
my $match;
# approx match is not standardized in schema
if ($schema and ($op ne 'approxMatch') ){
! # get matchingrule from schema, be sure that matching subs exist
for every MR in your schema
! $match='_' . $schema->matchingrule_for_attribute( $attr,
$op2schema{$op}) or return undef;
}
else{
# fall back on build-in logic
$match='_cis_' . $op;
}
!
! return &$match($args, @values);
}
return undef; # all other filters => fail with error
--- 112,147 ----
# handle basic filters
if ($op =~
/^(equalityMatch|greaterOrEqual|lessOrEqual|approxMatch|substrings)/o) {
! my $attr;
! my $assertion;
my $match;
+ if ($op eq 'substrings'){
+ $attr = $args->{'type'};
+ # build a regexp as assertion value
+ $assertion = join('.*', map { "\Q$_\E" } map { values %$_ }
@{$args->{'substrings'}});
+ $assertion = '^'. $assertion if (exists
$args->{'substrings'}[0]{'initial'});
+ $assertion .= '$' if (exists $args->{'substrings'}[-1]{'final'});
+ }
+ else{
+ $attr = $args->{'attributeDesc'};
+ $assertion = $args->{'assertionValue'}
+ }
+
+
+ my @values = $entry->get_value($attr);
+
# approx match is not standardized in schema
if ($schema and ($op ne 'approxMatch') ){
! # get matchingrule from schema, be sure that matching subs exist
for every MR in your schema
! $match='_' . $schema->matchingrule_for_attribute( $attr,
$op2schema{$op}) or return undef;
}
else{
# fall back on build-in logic
$match='_cis_' . $op;
}
! print $attr,'##',$assertion, '##', $op,'##',
$op2schema{$op},'##',$match,'##';
! return &$match($assertion,$op,@values);
}
return undef; # all other filters => fail with error
*************** sub filterMatch($@)
*** 105,149 ****
sub _cis_equalityMatch($@)
{
! my $args=shift;
! my $assertion = $args->{'assertionValue'};
return grep(/^\Q$assertion\E$/i, @_) ? 1 : 0;
}
! sub _cis_greaterOrEqual($@)
{
! my $args=shift;
! my $assertion = $args->{'assertionValue'};
! if (grep(!/^-?\d+$/o, $assertion, @_)) { # numerical values only =>
compare numerically
return (grep { $_ ge $assertion } @_) ? 1 : 0;
}
else {
! return (grep { lc($_) >= lc($assertion) } @_) ? 1 : 0;
! }
}
! sub _cis_lessOrEqual($@)
{
! my $args=shift;
! my $assertion = $args->{'assertionValue'};
if (grep(!/^-?\d+$/o, $assertion, @_)) { # numerical values only =>
compare numerically
! return (grep { $_ le $assertion } @_) ? 1 : 0;
}
else {
! return (grep { lc($_) <= lc($assertion) } @_) ? 1 : 0;
}
}
sub _cis_approxMatch($@)
{
! my $args=shift;
! my $assertion = $args->{'assertionValue'};
# kludge: treat assertion as regex
$assertion =~ s/\./\\./go;
--- 149,257 ----
sub _cis_equalityMatch($@)
{
! my $assertion = shift;
! my $op = shift;
return grep(/^\Q$assertion\E$/i, @_) ? 1 : 0;
}
+ sub _exact_equalityMatch($@)
+ {
+ my $assertion = shift;
+ my $op = shift;
! return grep(/^\Q$assertion\E$/, @_) ? 1 : 0;
! }
!
! sub _numeric_equalityMatch($@)
{
! my $assertion = shift;
! my $op = shift;
! return grep(/^\Q$assertion\E$/, @_) ? 1 : 0;
! }
!
! sub _cis_orderingMatch($@)
! {
! my $assertion = shift;
! my $op = shift;
!
! if ($op eq 'greaterOrEqual') {
! return (grep { lc($_) ge lc($assertion) } @_) ? 1 : 0;
! }
! elsif ($op eq 'lessOrEqual') {
! return (grep { lc($_) le lc($assertion) } @_) ? 1 : 0;
! }
! else {
! return undef; #something went wrong
! };
! }
!
! sub _exact_orderingMatch($@)
! {
! my $assertion = shift;
! my $op = shift;
!
! if ($op eq 'greaterOrEqual') {
return (grep { $_ ge $assertion } @_) ? 1 : 0;
}
+ elsif ($op eq 'lessOrEqual') {
+ return (grep { $_ le $assertion } @_) ? 1 : 0;
+ }
else {
! return undef; #something went wrong
! };
! }
!
! sub _numeric_orderingMatch($@)
! {
! my $assertion = shift;
! my $op = shift;
!
! if ($op eq 'greaterOrEqual') {
! return (grep { $_ >= $assertion } @_) ? 1 : 0;
! }
! elsif ($op eq 'lessOrEqual') {
! return (grep { $_ <= $assertion } @_) ? 1 : 0;
! }
! else {
! return undef; #something went wrong
! };
! }
!
! sub _cis_substrings($@)
! {
! my $regex=shift;
! return grep(/$regex/i, @_) ? 1 : 0;
}
+ sub _exact_substrings($@)
+ {
+ my $regex=shift;
+ return grep(/$regex/, @_) ? 1 : 0;
+ }
! # this one is here in case we don't use schema
!
! sub _cis_greaterOrEqual($@)
{
! my $assertion=shift;
! my $op=shift;
if (grep(!/^-?\d+$/o, $assertion, @_)) { # numerical values only =>
compare numerically
! return _cis_orderingMatch($assertion,$op,@_);
}
else {
! return _numeric_orderingMatch($assertion,$op,@_);
}
}
+ *_cis_lessOrEqual = \&_cis_greaterOrEqual;
sub _cis_approxMatch($@)
{
! my $assertion=shift;
! my $op=shift;
# kludge: treat assertion as regex
$assertion =~ s/\./\\./go;
*************** my $assertion = $args->{'assertionValue'
*** 154,173 ****
# better: by use String::Approx or similar
}
-
- sub _cis_substrings
- {
- my $args=shift;
- my $regex = join('.*', map { "\Q$_\E" } map { values %$_ }
@{$args->{'substrings'}});
-
- $regex = '^'.$regex if (exists $args->{'substrings'}[0]{initial});
- $regex .= '$' if (exists $args->{'substrings'}[-1]{final});
-
- #print "RegEx: ".$regex."\n";
-
- return grep(/$regex/i, @_) ? 1 : 0;
- }
-
1;
--- 262,267 ----
*************** Peter Marschall E<lt>[EMAIL PROTECTED]<gt>
*** 239,242 ****
=cut
! # EOF
\ No newline at end of file
--- 333,336 ----
=cut
! # EOF
