upstream/openldap
1
0
Fork 0
mirror of https://git.openldap.org/openldap/openldap.git synced 2026-01-20 05:43:01 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Running 'perlcritic -1 SampleLDAP.pm' and tidying up.

Browse source
This commit is contained in:
Gavin Henry 2007-06-15 16:28:33 +00:00
parent 53fcfd93a3
commit d6444a108d
1 changed files with 97 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

198
servers/slapd/back-perl/SampleLDAP.pm
View file

@ -1,3 +1,8 @@
package SampleLDAP;
use strict;
use warnings;
use POSIX;
# This is a sample Perl module for the OpenLDAP server slapd.
# $OpenLDAP$
## This work is part of OpenLDAP Software <http://www.openldap.org/>.
@ -23,150 +28,141 @@
#
# See the slapd-perl(5) manual page for details.
package SampleLDAP;
our $VERSION = '1.00';
use POSIX;
sub new {
my $class = shift;
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;
sub add {
my $this = shift;
my ( $entryStr ) = @_;
my ($entryStr) = @_;
my ( $dn ) = ( $entryStr =~ /dn:\s(.*)$/m );
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*//g;
#
# 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 ) = @_;
print STDERR "XXXXXX $dn XXXXXXX\n";
delete $this->{$dn};
my ($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;