Re: Re: LDAP Search Script runs slow

Replies are listed 'Best First'.

Re^3: LDAP Search Script runs slow
by atcroft (Abbot) on Dec 07, 2003 at 05:06 UTC

Here was an attempt at blending some of the aspects of your script with the code I offered above. Untested, but at least it may give you the ideas you need. I did leave out some of the functions from your original code, so you would have to integrate them in.

I wasn't actually using the LDIF format in my test script, so I appologize for any confusion that may have caused.

#!/usr/bin/perl -w

use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use Net::LDAP qw(:all);
use Net::LDAP::Entry;
use Net::LDAP::Util qw(ldap_error_text);
use strict;
use vars qw($attributes $returnedcount);

$| = 1;
{
    my $attributelist = qw(cn uid l departmentnumber title mail);
    $attributes = join('|', @attributelist);
}

$returnedcount = 0;

my $cgi = new CGI;

print $cgi->header();
print <<HTML_HEADER;
<html>
  <head>
HTML_HEADER

my $flag = $cgi->param('looking');

if (!flag) {
    lookUp();
} else {

    print <<HEADER;
    <title>LDAP Results</title>
  </head>
  <body>
    <div align="center">
      <table>
HEADER

    my $ldap_server = "your.ldap.server.here";
    my $basedn      = "your.base.dn.here";
    my $binddn      = "your.bind.dn.here";
    my $password    = "your.ldap.password.here";

    my $ldap = Net::LDAP->new($ldap_server) or die ( $@ . "\n" );
    my $result = $ldap->bind( $binddn, password => $password ) 
      or die($result->error());
    my $scope = "sub";

    my $count = 0;
    my $searchstory = '';
    {
        my %searchparams = ( 'first' => 'givenname', 
                             'last' => 'sn', 
                             'dept' => 'departmentnumber' );
        foreach my $p (keys(%searchparams))
            if (defined($cgi->param($p))) {
                $count++;
                $searchstory .= '(' . 
                                $p . 
                                '=*' . 
                                $cgi->param($searchparams{$p}) . 
                                '*)';
            }
        }
        $searchstory = '(&' . $searchstory . ')' if ($count > 1);
    }

    # UNTESTED 
    # - Supposed to send something to the browser periodically -
    $SIG{ALRM} = sub { print ' '; alarm(5); }
    # UNTESTED

    my $searchobj = $ldap->search(
        base     => $basedn,
        filter   => $searchstory,
        callback => \&process
    );
        print( '<tr>',
               '<td colspan="2">Bad search</td>', 
               '<td>', 
               ldap_error_text( $searchobj->code() ), 
               '</td>',
               "</tr>\n" )
          if ( $searchobj->code() );
        print( '<tr>',
               '<td colspan="2">Returned entries: ', 
               $returnedcount, 
               '</td>', 
               "</tr>\n" );
    }
    $ldap->unbind();
}

print <<HTML_FOOTER;
      </table>
    </div>
  </body>
</html>
HTML_FOOTER

sub process {
    local $SIG{ALRM} = 'IGNORE';

    my $mesg = shift;
    my $obj  = shift;
    if ( !$obj ) {
        # Search complete
    }
    else {
        my $dn = $obj->dn();
        {
            my @parts = ();
            my $resultstring = '|';
            print( '<tr><td>dn: ', $dn, "</td>\n" );
            foreach my $attr ( sort( { lc($a) cmp lc($b) } 
              $obj->attributes ) ) {
                next unless ($attr =~ m/^($attributes)$/);
                $resultstring .= join ( ': ', 
                                        $attr, 
                                        $obj->get_value($attr) ), 
                  "|" );
            }
            print( "<td>$resultstring</td></tr>\n" );
            $returnedcount++;
        }
        $mesg->pop_entry();
    }
}
[download]

Updated: 06 Dec 2003 - Added *untested* SIGALRM to try to send something to the browser periodically.

[reply]
[d/l]


Your skill will accomplish what the force of many cannot
	PerlMonks