package SPOPS::LDAP::MultiDatasource;
# $Id: MultiDatasource.pm,v 3.3 2004/06/02 00:48:23 lachoy Exp $
use strict;
use base qw( SPOPS::LDAP );
use Log::Log4perl qw( get_logger );
use SPOPS;
use SPOPS::Exception::LDAP;
$SPOPS::LDAP::MultiDatasource::VERSION = sprintf("%d.%02d", q$Revision: 3.3 $ =~ /(\d+)\.(\d+)/);
use constant DEFAULT_CONNECT_KEY => 'main';
my $log = get_logger();
sub base_dn {
my ( $class, $connect_key ) = @_;
my $partial_dn = $class->get_partial_dn( $connect_key );
unless ( $partial_dn ) {
SPOPS::Exception->throw( "No Base DN defined in configuration key 'ldap_base_dn'" );
}
my $connect_info = $class->connection_info( $connect_key );
return join( ',', $partial_dn, $connect_info->{base_dn} );
}
# Retrieves the 'partial dn', or the section that's prepended to the
# server's 'base DN' to identify the branch on which these objects
# live
sub get_partial_dn {
my ( $class, $connect_key ) = @_;
my $base_dn_info = $class->CONFIG->{ldap_base_dn};
return $base_dn_info unless ( ref $base_dn_info eq 'HASH' );
$connect_key ||= $class->get_connect_key;
return $base_dn_info->{ $connect_key };
}
sub get_connect_key {
my ( $class ) = @_;
return $class->CONFIG->{default_datasource} || DEFAULT_CONNECT_KEY;
}
sub fetch {
my ( $class, $id, $p ) = @_;
# If passed in a handle, we will always use only that
if ( $p->{ldap} ) {
return $class->SUPER::fetch( $id, $p );
}
my @ds_list = $class->_get_datasource_list( 'fetch', $id, $p );
# Step through the datasource listing and try to retrieve each one
# in turn
foreach my $ds ( @ds_list ) {
$log->is_info &&
$log->info( "(fetch) Trying to use datasource ($ds) for class ($class)" );
$p->{connect_key} = $ds;
my $object = eval { $class->SUPER::fetch( $id, $p ) };
if ( $object ) {
$object->{_datasource} = $ds;
return $object;
}
}
return undef;
}
sub fetch_by_dn {
my ( $class, $dn, $p ) = @_;
if ( $p->{ldap} ) {
return $class->SUPER::fetch_by_dn( $dn, $p );
}
my @ds_list = $class->_get_datasource_list( 'fetch_by_dn', $dn, $p );
# Step through the datasource listing and try to retrieve each one
# in turn
foreach my $ds ( @ds_list ) {
$log->is_info &&
$log->info( "(fetch_by_dn) Trying to use datasource ($ds) for class ($class)" );
$p->{connect_key} = $ds;
my $object = eval { $class->SUPER::fetch_by_dn( $dn, $p ) };
if ( $object ) {
$object->{_datasource} = $ds;
return $object
}
}
}
sub fetch_group_all {
my ( $class, $p ) = @_;
if ( $p->{ldap} ) {
return $class->SUPER::fetch_group( $p );
}
my @ds_list = $class->_get_datasource_list( 'fetch_group', $p );
my @all_objects = ();
foreach my $ds ( @ds_list ) {
$p->{connect_key} = $ds;
$log->is_info &&
$log->info( "Trying to fetch from datasource ($ds)" );
my $object_list = $class->SUPER::fetch_group( $p );
if ( $object_list and ref $object_list eq 'ARRAY' ) {
foreach my $object ( @{ $object_list } ) {
$object->{_datasource} = $ds;
push @all_objects, $object;
}
}
}
return \@all_objects;
}
# Just be sure we grab the right LDAP handle before saving or removing
# -- if people pass in a handle, we'll defer to their judgement that
# they know what they're doing
sub save {
my ( $self, $p ) = @_;
$p->{ldap} ||= $self->global_datasource_handle( $self->{_datasource} );
return $self->SUPER::save( $p );
}
sub remove {
my ( $self, $p ) = @_;
$p->{ldap} ||= $self->global_datasource_handle( $self->{_datasource} );
return $self->SUPER::remove( $p );
}
# Retrieve a datasource list from the class configuration. If it
# doesn't work (no list or the list is empty), run a specified method
# in the parent class.
sub _get_datasource_list {
my ( $class, $method, @args ) = @_;
my $ds_list = $class->CONFIG->{datasource};
# If there are not multiple datasources specified, then bounce
# back to the SPOPS::LDAP-version of th method we were trying to
# call in the first place.
unless ( ref $ds_list eq 'ARRAY' and scalar @{ $ds_list } ) {
$log->is_info &&
$log->info( "No datasources in configuration for ($class).",
"Using SPOPS::LDAP->$method()" );
my $full_method = "SUPER::$method";
return $class->$full_method( @args );
}
return @{ $ds_list };
}
1;
__END__
=pod
=head1 NAME
SPOPS::LDAP::MultiDatasource -- SPOPS::LDAP functionality but fetching objects from multiple datasources
=head1 SYNOPSIS
# In your configuration
my $config = {
class => 'My::LDAPThings',
datasource => [ 'main', 'secondary', 'tertiary' ],
isa => [ ... 'SPOPS::LDAP::MultiDatasource' ],
...,
};
# Fetch an object and see where it came from
my $object = My::LDAPThings->fetch( 'superuser' );
print "My DN is ", $object->dn, " and I came from $object->{_datasource}";
=head1 DESCRIPTION
This class extends L<SPOPS::LDAP|SPOPS::LDAP> with one purpose: be
able to fetch objects from multiple datasources. This can happen when
you have got objects dispersed among multiple directories -- for
instance, your 'Accounting' department is on one LDAP server and your
'Development' department on another. One class can (more or less --
see below) link the two LDAP servers.
Every object is tagged with the datasource it came from (in the
C<_datasource> property, if you ever need it), and any calls to
C<save()> or C<remove()> will use this datasource to retrieve the
proper connection for the object.
=head2 Caveats
The C<fetch()> method is the only functional method overridden from
L<SPOPS::LDAP|SPOPS::LDAP>. The C<fetch_group()> or
C<fetch_iterator()> methods will only use the first datasource in the
listing, whatever datasource you pass in with the parameter
'connect_key' or whatever LDAP connection handle you pass in with the
parameter 'ldap'. If you want to retrieve objects from multiple
datasources using the same filter, use the C<fetch_group_all()>
method.
The C<fetch_iterator()> method is not supported at all for multiple
datasources -- use C<fetch_group_all()> in conjunction with
L<SPOPS::Iterator::WrapList|SPOPS::Iterator::WrapList> if your
implementation expects an L<SPOPS::Iterator|SPOPS::Iterator> object.
=head1 SETUP
There are a number of items to configure and setup to use this
class. Please see
L<SPOPS::Manual::Configuration|SPOPS::Manual::Configuration> for the
configuration keys used by this module.
=head2 Methods You Must Implement
B<connection_info( $connect_key )>
This method should look at the C<$connect_key> and return a hashref of
information used to connect to the LDAP directory. Keys (hopefully
self-explanatory) should be:
=over 4
=item *
B<host> ($)
=item *
B<base_dn> ($)
=back
Other keys are optional and can be used in conjunction with a
connection/resource manager (example below).
=over 4
=item *
B<port> ($) (optional, default is '389')
=item *
B<bind_dn> ($) (optional, will use anonymous bind without)
=item *
B<bind_password> ($) (optional, only used if 'bind_dn' specified)
=back
For example:
package My::ConnectionManage;
use strict;
my $connections = {
main => { host => 'localhost',
base_dn => 'dc=MyCompanyEast,dc=com' },
accounting => { host => 'accounting.mycompany.com',
base_dn => 'dc=MyCompanyWest,dc=com' },
development => { host => 'dev.mycompany.com',
base_dn => 'dc=MyCompanyNorth,dc=com' },
etc => { host => 'etc.mycompany.com',
base_dn => 'dc=MyCompanyBranch,dc=com' },
};
sub connection_info {
my ( $class, $connect_key ) = @_;
return \%{ $connections->{ $connect_key } };
}
Then put this class into the 'isa' for your SPOPS class:
my $spops = {
class => 'My::Person',
isa => [ 'My::ConnectionManage', 'SPOPS::LDAP::MultiDatasource' ],
};
B<global_datasource_handle( $connect_key )>
You will need an implementation that deals with multiple
configurations. For example:
package My::DSManage;
use strict;
use Net::LDAP;
my %DS = ();
sub global_datasource_handle {
my ( $class, $connect_key ) = @_;
unless ( $connect_key ) {
SPOPS::Exception->throw( "Cannot retrieve handle without connect key" );
}
unless ( $DS{ $connect_key } ) {
my $ldap_info = $class->connection_info( $connect_key );
$ldap_info->{port} ||= 389;
my $ldap = Net::LDAP->new( $ldap_info->{host},
port => $ldap_info->{port} );
unless ( $ldap ) {
SPOPS::Exception->throw( "Cannot create LDAP connection: $@" );
}
my ( %bind_params );
if ( $ldap_info->{bind_dn} ) {
$bind_params{dn} = $ldap_info->{bind_dn};
$bind_params{password} = $ldap_info->{bind_password};
}
my $bind_msg = $ldap->bind( %bind_params );
if ( $bind_msg->code ) {
SPOPS::Exception::LDAP->throw( "Cannot bind to directory: " . $bind_msg->error,
{ code => $bind_msg->code,
action => 'global_datasource_handle' } );
$DS{ $connect_key } = $ldap;
}
return $DS{ $connect_key };
}
Then put this class into the 'isa' for your SPOPS class:
my $spops = {
class => 'My::Person',
isa => [ 'My::DSManage', 'SPOPS::LDAP::MultiDatasource' ],
};
Someone with a thinking cap on might put the previous two items in the
same class :-)
=head1 METHODS
B<fetch( $id, \%params )>
Given the normal parameters for C<fetch()>, tries to retrieve an
object matching either the C<$id> or the 'filter' specified in
C<\%params> from one of the datasources. When it finds an object it is
immediately returned.
If you pass in the key 'ldap' in \%params, this functions as the
C<fetch()> does in L<SPOPS::LDAP|SPOPS::LDAP> and multiple datasources are not
used.
Returns: SPOPS object (if found), or undef.
B<fetch_group_all( \%params )>
Given the normal parameters for C<fetch_group()>, retrieves B<all>
objects matching the parameters from B<all> datasources. Use with
caution.
Returns: Arrayref of SPOPS objects.
B<save( \%params )>
Just pass along the right handle to the actual C<save()> method in
L<SPOPS::LDAP|SPOPS::LDAP>.
B<remove( \%params )>
Just pass along the right handle to the actual C<remove()> method in
L<SPOPS::LDAP|SPOPS::LDAP>.
B<base_dn( $connect_key )>
Returns the B<full> base DN associated with C<$connect_key>.
B<get_partial_dn( $connect_key )>
Retrieves the B<partial> base DN associated with C<$connect_key>.
B<get_connect_key()>
If called, returns either the value of the config key
'default_datasource' or the value of the class constant
'DEFAULT_CONNECT_KEY', which is normally 'main'.
=head1 BUGS
None known.
=head1 TO DO
Test some more.
=head1 SEE ALSO
L<SPOPS::LDAP|SPOPS::LDAP>
Example in SPOPS distribution: eg/ldap_multidatasource.pl
=head1 COPYRIGHT
Copyright (c) 2001-2004 MSN Marketing Service Nordwest, GmbH. All rights
reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHORS
Chris Winters E<lt>chris@cwinters.comE<gt>
=cut