Skip to main content

Perl

Perl Access

Stanford writes and maintains the Stanford::Directory Perl module. This module will maintain ticket files if you are using a keytab for access in addition to connecting to the directory service.

Full documentation of the Stanford::Directory module can be obtained by reading perldoc Stanford::Directory after installing the module  The module is available on the timeshare cluster (cardinal.stanford.edu), and for use on the central web service.  The module is also available as a debian package from the stanford repository.

Perl CGI script example

##############################################################################
# Stanford::Directory CGI Example
##############################################################################

use strict;
use vars qw($DIR);

use CGI qw(:standard);
use Stanford::Directory;

$DIR = new Stanford::Directory;
$DIR->set (ldap_server => "ldap-prod.stanford.edu",
           mechanism   => "GSSAPI",
           basedn      => "cn=people,dc=stanford,dc=edu");

##############################################################################
# Main routine
##############################################################################

print header, start_html;

my %userinfo;
my $person=$ENV{WEBAUTH_USER};
my @entries = $DIR->ldap_query ("(susearchid=$person)");
foreach my $entry (@entries) {
    foreach my $attr (keys (%{$entry})) {
        push @{$userinfo{$attr}}, @{$entry->{$attr}};
    }
}

foreach my $attr (sort keys %userinfo) {
    print strong($attr), ": ", join (", ", @{$userinfo{$attr}}), br;
}

print end_html;

Interactive Perl Example

#!/usr/bin/perl
##############################################################################
# Stanford Directory Example
##############################################################################

use Stanford::Directory;

use Getopt::Long;
use Pod::Usage;
use strict;

our $opt_base;
our $opt_debug;
our $opt_help;
our $opt_host;
our $opt_manual;

# Get options
GetOptions('debug'  => \$opt_debug,
           'help'   => \$opt_help,
           'host=s' => \$opt_host,
           'manual' => \$opt_manual);

# Provide help
pod2usage(-verbose => 0) unless $ARGV[0];
pod2usage(-verbose => 0) if $opt_help   || $ARGV[0] eq 'help';
pod2usage(-verbose => 2) if $opt_manual || $ARGV[0] eq 'manual';

# Provide some defaults
$opt_host = 'ldap-prod.stanford.edu' unless $opt_host;
$opt_base = 'cn=people,dc=stanford,dc=edu' unless $opt_base;

my $in = $ARGV[0];

my $dir = new Stanford::Directory;
$dir->set(ldap_server    => $opt_host,
          mechanism      => "GSSAPI",
          basedn         => $opt_base);

my @filter = ("sn=$in", "cn=$in");
my @attrs = ('displayName');

if ($opt_debug) {
    print "Search parameters\n";
    print "-----------------\n";
    print "host: $opt_host\n";
    print "base dn: $opt_base\n";
    print "filters: ".join(', ', @filter)."\n";
    print "attributes:".join(', ', @attrs)."\n";
}

my %entries = $dir->ldap_query(\@filter, @attrs);
if (!%entries) {
    if ($dir->error) {
        print "\n" . $dir->error_type .
            " Error:\n\n   " . $dir->error . "\n\n";
    } else {
        print "No match.\n";
    }
    exit;
}

print "\n";
print "People with last names like '$in':\n";
foreach my $key (keys %entries) {
    foreach my $entry (@{$entries{$key}}) {
        print " ", $entry->displayname;
        print " (Key: $key)" if $opt_debug;
        print "\n";
    }
}

exit;

__END__

=head1 NAME

stanford-directory-example

=head1 SYNOPSIS

stanford-directory-example name-fragment [--host=ldaphost] [--base=dn]
[--help] [--manual] [--debug]

=head1 DESCRIPTION

This script accepts a name fragment and queries an ldap directory 
for matches to the commonName and surName attributes.

=head1 OPTIONS AND ARGUMENTS

=over 4

=item --host=hostname

The name of an LDAP server.

=item --base=dn

The base distinguished name to use as a starting point for a subtree 
search of the directory.

=item --debug

Generate debugging messages.

=item --help

A short help message.

=item --manual 

The complete documentation.

=back

=cut
Last modified