X-Git-Url: https://git.sur5r.net/?a=blobdiff_plain;f=servers%2Fslapd%2Fback-perl%2FSampleLDAP.pm;h=f1ca8775974ff6cbd79575d00ad89040eb270c47;hb=e0952945d0b6da70703a711c91306be07d31ea1a;hp=4788da3af83f7a5141a1e4a2664bdf661e26b4a8;hpb=dddee8268069ad64cec8515e252ebff1ebf53607;p=openldap

diff --git a/servers/slapd/back-perl/SampleLDAP.pm b/servers/slapd/back-perl/SampleLDAP.pm
index 4788da3af8..f1ca877597 100644
--- a/servers/slapd/back-perl/SampleLDAP.pm
+++ b/servers/slapd/back-perl/SampleLDAP.pm
@@ -2,7 +2,7 @@
 # $OpenLDAP$
 ## This work is part of OpenLDAP Software <http://www.openldap.org/>.
 ##
-## Copyright 1998-2004 The OpenLDAP Foundation.
+## Copyright 1998-2008 The OpenLDAP Foundation.
 ## Portions Copyright 1999 John C. Quillan.
 ## All rights reserved.
 ##
@@ -18,153 +18,151 @@
 #
 #	database	perl
 #	suffix		"o=AnyOrg,c=US"
-#	perlModulePath	/path/to/this/file
+#	perlModulePath	/directory/containing/this/module
 #	perlModule	SampleLDAP
+#
+# See the slapd-perl(5) manual page for details.
 
 package SampleLDAP;
-
+use strict;
+use warnings;
 use POSIX;
 
-sub new
-{
-	my $class = shift;
+$SampleLDAP::VERSION = '1.01';
+
+sub new {
+    my $class = shift;
 
-	my $this = {};
-	bless $this, $class;
-        print STDERR "Here in new\n";
-	print STDERR "Posix Var " . BUFSIZ . " and " . FILENAME_MAX . "\n";
-	return $this;
+    my $this = {};
+    bless $this, $class;
+    print {*STDERR} "Here in new\n";
+    print {*STDERR} 'Posix Var ' . BUFSIZ . ' and ' . FILENAME_MAX . "\n";
+    return $this;
 }
 
-sub init
-{
-	return 0;
+sub init {
+    return 0;
 }
 
-sub search
-{
-	my $this = shift;
-	my($base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly, @attrs ) = @_;
-        print STDERR "====$filterStr====\n";
-	$filterStr =~ s/\(|\)//g;
-	$filterStr =~ s/=/: /;
+sub search {
+    my $this = shift;
+    my ( $base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly,
+        @attrs )
+      = @_;
+    print {*STDERR}, "====$filterStr====\n";
+    $filterStr =~ s/\(|\)//gm;
+    $filterStr =~ s/=/: /m;
 
-	my @match_dn = ();
-	foreach my $dn ( keys %$this ) {
-		if ( $this->{ $dn } =~ /$filterStr/im ) {
-			push @match_dn, $dn;
-			last if ( scalar @match_dn == $sizeLim );
+    my @match_dn = ();
+    for my $dn ( keys %{$this} ) {
+        if ( $this->{$dn} =~ /$filterStr/imx ) {
+            push @match_dn, $dn;
+            last if ( scalar @match_dn == $sizeLim );
 
-		}
-	}
+        }
+    }
 
-	my @match_entries = ();
-	
-	foreach my $dn ( @match_dn )  {
-		push @match_entries, $this->{ $dn };
-	}
+    my @match_entries = ();
 
-	return ( 0 , @match_entries );
+    for my $dn (@match_dn) {
+        push @match_entries, $this->{$dn};
+    }
+
+    return ( 0, @match_entries );
 
 }
 
-sub compare
-{
-	my $this = shift;
-	my ( $dn, $avaStr ) = @_;
-	my $rc = 5; # LDAP_COMPARE_FALSE
+sub compare {
+    my $this = shift;
+    my ( $dn, $avaStr ) = @_;
+    my $rc = 5;    # LDAP_COMPARE_FALSE
 
-	$avaStr =~ s/=/: /;
+    $avaStr =~ s/=/: /m;
 
-	if ( $this->{ $dn } =~ /$avaStr/im ) {
-		$rc = 6; # LDAP_COMPARE_TRUE
-	}
+    if ( $this->{$dn} =~ /$avaStr/im ) {
+        $rc = 6;    # LDAP_COMPARE_TRUE
+    }
 
-	return $rc;
+    return $rc;
 }
 
-sub modify
-{
-	my $this = shift;
+sub modify {
+    my $this = shift;
 
-	my ( $dn, @list ) = @_;
+    my ( $dn, @list ) = @_;
 
-	while ( @list > 0 ) {
-		my $action = shift @list;
-		my $key    = shift @list;
-		my $value  = shift @list;
+    while ( @list > 0 ) {
+        my $action = shift @list;
+        my $key    = shift @list;
+        my $value  = shift @list;
 
-		if( $action eq "ADD" ) {
-			$this->{ $dn } .= "$key: $value\n";
+        if ( $action eq 'ADD' ) {
+            $this->{$dn} .= "$key: $value\n";
 
-		}
-		elsif( $action eq "DELETE" ) {
-			$this->{ $dn } =~ s/^$key:\s*$value\n//mi ;
+        }
+        elsif ( $action eq 'DELETE' ) {
+            $this->{$dn} =~ s/^$key:\s*$value\n//im;
 
-		}
-		elsif( $action eq "REPLACE" ) {
-			$this->{ $dn } =~ s/$key: .*$/$key: $value/im ;
-		}
-	}
+        }
+        elsif ( $action eq 'REPLACE' ) {
+            $this->{$dn} =~ s/$key: .*$/$key: $value/im;
+        }
+    }
 
-	return 0;
+    return 0;
 }
 
-sub add
-{
-	my $this = shift;
-
-	my ( $entryStr ) = @_;
+sub add {
+    my $this = shift;
 
-	my ( $dn ) = ( $entryStr =~ /dn:\s(.*)$/m );
+    my ($entryStr) = @_;
 
-	#
-	# This needs to be here until a normalized dn is
-	# passed to this routine.
-	#
-	$dn = uc( $dn );
-	$dn =~ s/\s*//g;
+    my ($dn) = ( $entryStr =~ /dn:\s(.*)$/m );
 
+    #
+    # This needs to be here until a normalized dn is
+    # passed to this routine.
+    #
+    $dn = uc $dn;
+    $dn =~ s/\s*//gm;
 
-	$this->{$dn} = $entryStr;
+    $this->{$dn} = $entryStr;
 
-	return 0;
+    return 0;
 }
 
-sub modrdn
-{
-	my $this = shift;
+sub modrdn {
+    my $this = shift;
 
-	my ( $dn, $newdn, $delFlag ) = @_;
+    my ( $dn, $newdn, $delFlag ) = @_;
 
-	$this->{ $newdn } = $this->{ $dn };
+    $this->{$newdn} = $this->{$dn};
 
-	if( $delFlag ) {
-		delete $this->{ $dn };
-	}
-	return 0;
+    if ($delFlag) {
+        delete $this->{$dn};
+    }
+    return 0;
 
 }
 
-sub delete
-{
-	my $this = shift;
+sub delete {
+    my $this = shift;
+
+    my ($dn) = @_;
 
-	my ( $dn ) = @_;
-	
-        print STDERR "XXXXXX $dn XXXXXXX\n";
-	delete $this->{$dn};
+    print {*STDERR} "XXXXXX $dn XXXXXXX\n";
+    delete $this->{$dn};
+    return 0;
 }
 
-sub config
-{
-	my $this = shift;
+sub config {
+    my $this = shift;
 
-	my ( @args ) = @_;
-        local $, = " - ";
-        print STDERR @args;
-        print STDERR "\n";
-	return 0;
+    my (@args) = @_;
+    local $, = ' - ';
+    print {*STDERR} @args;
+    print {*STDERR} "\n";
+    return 0;
 }
 
 1;