Net::LDAP::Class::Loader - interrogate an LDAP schema

Net-LDAP-Class documentation

Contained in the Net-LDAP-Class distribution.

Index

NAME
SYNOPSIS
DESCRIPTION
METHODS
- init
- interrogate
- base_dn
- ldap
- object_classes
AUTHOR
BUGS
SUPPORT
ACKNOWLEDGEMENTS
COPYRIGHT
SEE ALSO

Code Index:

package Net::LDAP::Class::Loader
- init
- interrogate
__END__
EOF

NAME

Net::LDAP::Class::Loader - interrogate an LDAP schema

SYNOPSIS

 package MyLDAPClass;
 use strict;
 use base qw( Net::LDAP::Class );

 __PACKAGE__->metadata->setup(
    use_loader      => 1,
    ldap            => $ldap,
    object_classes  => [qw( posixAccount )],    # optional
 );

 1;

DESCRIPTION

Net::LDAP::Class:Loader inspects a Net::LDAP::Schema object and determines which attributes are available and which are unique.

METHODS

init

Checks that ldap() and object_classes() are defined.

interrogate

Inspects the Net::LDAP::Schema object and returns hashref of attributes and unique_attributes.

base_dn

Get/set the base DN used by interrogate().

ldap

Get/set the Net::LDAP object.

object_classes

Get/set the array ref of object classes to be used by interrogate().

AUTHOR

Peter Karman, <karman at cpan.org>

BUGS

Please report any bugs or feature requests to bug-net-ldap-class at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-LDAP-Class. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::LDAP::Class

You can also look for information at:

* AnnoCPAN: Annotated CPAN documentation: http://annocpan.org/dist/Net-LDAP-Class
* CPAN Ratings: http://cpanratings.perl.org/d/Net-LDAP-Class
* RT: CPAN's request tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-LDAP-Class
* Search CPAN: http://search.cpan.org/dist/Net-LDAP-Class

ACKNOWLEDGEMENTS

The Minnesota Supercomputing Institute http://www.msi.umn.edu/ sponsored the development of this software.

COPYRIGHT

Copyright 2008 by the Regents of the University of Minnesota. All rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

SEE ALSO

Net::LDAP

Net-LDAP-Class documentation

Contained in the Net-LDAP-Class distribution.

package Net::LDAP::Class::Loader;
use strict;
use warnings;
use Carp;
use Data::Dump qw( dump );
use base qw( Rose::Object );
use Net::LDAP::Class::MethodMaker (
    scalar => [qw( base_dn ldap object_classes )], );

our $VERSION = '0.26';

sub init {
    my $self = shift;
    $self->SUPER::init(@_);

    if ( !$self->ldap ) {
        croak "must set a Net::LDAP object";
    }

    if ( !$self->object_classes or ref( $self->object_classes ) ne 'ARRAY' ) {
        croak "must set an ARRAY ref of object_classes";
    }

    return $self;
}

sub interrogate {
    my $self = shift;

    if ( $self->ldap->version < 3 ) {
        croak "LDAP v3 required in order to interrogate the LDAP server";
    }

    #dump $self;

    my %OC;
    my $schema = $self->ldap->schema;
    for my $oc ( @{ $self->object_classes } ) {

        #warn "interrogating $oc";

        my ( @attributes, @unique );

        for my $may ( $schema->may($oc) ) {

            #warn "may: " . dump($may);
            push( @attributes, $may->{name} );

        }
    MUST: for my $must ( $schema->must($oc) ) {

            #warn "must: " . dump($must);
            my $name = $must->{name};
            next MUST if $name eq 'objectClass';

            push( @attributes, $name );

            # TODO how to speed up fetching only one search result?
            # or better, how to determine which attributes must be unique.
            if ( !@unique ) {
                my $filter = "(&($name=*) (objectClass=$oc))";
                my $res    = $self->ldap->search(
                    base      => $self->base_dn,
                    scope     => 'sub',
                    filter    => $filter,
                    sizelimit => 1,
                );

                if ( !$res->count ) {
                    #warn "no match for $filter";
                    next MUST;
                }

                my $entry = $res->pop_entry;
                if ($entry) {

                    my $dn = $entry->dn;
                    my @rdn = split( m/,/, $dn );
                    my ( $attr, $val ) = split( m/=/, $rdn[0] );
                    push( @unique, $attr );

                }
                $res->abandon;

            }

        }

        $OC{$oc}
            = { attributes => \@attributes, unique_attributes => \@unique };
    }

    return \%OC;

}

1;

__END__