Revision 208 (by dpavlin, 2008/06/19 21:24:26) another round of re-factoring

- re-organize LDAP-related pages under /ldap with new view A3C::View::LDAP
- move record multi-value support into A3C::Record
- document multi-value solution which started it all
package A3C::LDAP;

use strict;
use warnings;

use Net::LDAP;
use Data::Dump qw/dump/;
use base qw(Jifty::Object Class::Accessor::Fast);
use Jifty;
our @config_fields = keys %{ Jifty->config->app('LDAP') };
Jifty->log->debug("using fields from configuration: ",dump( @config_fields ));
__PACKAGE__->mk_accessors( qw(ldap current_search), @config_fields );


=head1 NAME

A3C::LDAP

=head1 DESCRIPTION

This object turn L<Net::LDAP> into something with looks like
L<Jifty::Collection>

=head1 METHODS

=head2 new

  my $ldap = A3C::LDAP->new;

=cut

sub new {
	my $class = shift;

	my $args = { @_ };

	my $ldap_config = Jifty->config->app('LDAP');
	Jifty->log->debug( "config->app(LDAP) = ",dump( $ldap_config ) );

	foreach my $f ( @config_fields ) {
		if ( my $v = $ldap_config->{$f} ) {
			$args->{$f} = $v;
		}
	}

	# configuration sanity testing
	foreach ( qw/server dn password base objectClass link/ ) {
		die "missing required field $_ in LDAP from etc/config.yaml" unless $args->{$_};
	}
	foreach ( qw/person organization/ ) {
		die "missing required field $_ in LDAP.objectClass.$_ from etc/config.yaml" unless $args->{objectClass}->{$_};
	}
	foreach ( qw/person_filter display_from value_from/ ) {
		die "missing required field $_ in LDAP.link.$_ from etc/config.yaml" unless $args->{link}->{$_};
	}

	my $ldap = Net::LDAP->new( $args->{server} ) or die "$@";

	# an anonymous bind
	#$ldap->bind;
	$ldap->bind( $args->{dn}, password => $args->{password} );

	Jifty->log->info("Connected to ", $args->{server}, " with DN ", $args->{dn});

	$args->{ldap} = $ldap;

	$class->SUPER::new( $args );
}

=head2 search

  my $msg = A3C::LDAP->search(
	base	=> 'dc=skole,dc=hr',
	filter	=> '(objectClass=hrEduOrg)',
	sizelimit => 10,
  );

=cut

sub search {
	my $self = shift;

	my $search = $self->ldap->search( @_ );
	if ( $search->code != 0 ) {
		Jifty->log->error( $search->error, ' for ', dump( @_ ) );
	}
	return $self->current_search( $search );
}

=head2 next

Syntaxtic shugar to look more like L<Jifty::DBI::Collection>

  my $entry = ldap->next;

=cut

sub next {
	my $self = shift;

	die "no current LDAP search" unless $self->current_search;

	return $self->current_search->shift_entry;
}

=head2 count

  my $search_results = $ldap->count;

=cut

sub count {
	my $self = shift;
	$self->current_search->count;
}

=head2 collection

  my $connection = $ldap->collection(
	# name of model to use
  	$ldap->objectClass->{organization},
	# optional params
	limit => $limit,
	filter => '(uid=foobar)',
  );

=cut

my $collection2filter = {
	'Person'		=> '(objectClass=hrEduPerson)',
	'Organization'	=> '(objectClass=hrEduOrg)',
};

sub collection {
	my $self = shift;
	my $model = shift or die "no model?";
	my $args = {@_};

	$args->{limit} ||= 0;	# unlimited by default

	my $filter = $collection2filter->{$model};
#	die "unknown model $model" unless $filter;
	# fallback to model named as objectClass
	$filter ||= "(objectClass=$model)";

	# add user filter
	$filter = '(&' . $filter . $args->{filter} . ')' if $args->{filter};

	$self->search(
		base => $self->base,
		filter => $filter,
		sizelimit => $args->{limit},
	);

	Jifty->log->info(
		"Searching LDAP for $model with $filter ",
		$args->{limit} ? 'limit ' . $args->{limit} . ' ' : '',
		'returned ', $self->count, ' results'
	);

	my $class = Jifty->app_class('Model', $model . 'Collection' ) or die "can't create ${model}Collection";
	my $collection = $class->new() or die "can't $class->new";

	while ( my $entry = $self->next ) {
		my $model_obj = Jifty->app_class('Model',$model)->new;
		my $additional;
		$self->model_from_entry( $model_obj, $entry, %$additional );
		$collection->add_record( $model_obj );
	}

	return $collection;
}

=head1 INTERNAL METHODS

Following methods map directly into L<Net::LDAP>

=head2 current_search

Result of last C<< $ldap->search >> request

=head2 model_from_entry

  $ldap->model_from_entry( $model, $entry, $additional );

This method will join repeatable attributes by magic marker,
see C<XXX> in code!

=cut

sub model_from_entry {
	my ( $self, $model, $entry, $additional ) = @_;
	my $data;

	my @columns = map { $_->name } $model->columns;
	#warn "# columns = ",dump( @columns );

	foreach my $attr ( $entry->attributes ) {
		if ( grep(/^\Q$attr\E$/, @columns ) ) {
			$data->{$attr} = $entry->get_value( $attr );
#		} elsif ( $attr !~ m/^(objectClass)$/i ) {
		} else {
			Jifty->log->warn(ref($model)," doesn't have $attr");
		}
	}

	Jifty->log->debug( ref($model), ' = ', dump( $data ) );

	my ( $id, $message ) = $model->load_or_create( %$data, %$additional );

	if ( $id ) {
		Jifty->log->info( $message || 'Added', ' ', ref($model), ' ', $model->id, ' ', $model->name );
	} else {
		Jifty->log->error( ref($model), " ", $message );
	}
}



1;