lib/A3C/LDAP.pm

package A3C::LDAP;

use strict;
use warnings;

use Net::LDAP;
use Data::Dump qw/dump/;
use base qw(Jifty::Object Class::Accessor::Fast);
our @config_fields = qw( server dn password base );
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;
                }
        }

        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 as_collection_of

  my $connection = $ldap->collection(
        # name of model to use
        '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;

        # 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;
                #warn dump( $model_obj );
                my $additional;
                $self->ldap2model( $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_to_entry

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

=cut

sub ldap2model {
        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 ) {
                        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;
1	dpavlin	36	package A3C::LDAP;
2
3			use strict;
4			use warnings;
5
6			use Net::LDAP;
7			use Data::Dump qw/dump/;
8	dpavlin	40	use base qw(Jifty::Object Class::Accessor::Fast);
9	dpavlin	42	our @config_fields = qw( server dn password base );
10			Jifty->log->debug("using fields from configuration: ",dump( @config_fields ));
11			__PACKAGE__->mk_accessors( qw(ldap current_search), @config_fields );
12	dpavlin	36
13
14	dpavlin	40	=head1 NAME
15	dpavlin	36
16	dpavlin	40	A3C::LDAP
17	dpavlin	36
18	dpavlin	40	=head1 DESCRIPTION
19	dpavlin	36
20	dpavlin	40	This object turn L<Net::LDAP> into something with looks like
21			L<Jifty::Collection>
22	dpavlin	36
23	dpavlin	40	=head1 METHODS
24
25			=head2 new
26
27			my $ldap = A3C::LDAP->new;
28
29			=cut
30
31			sub new {
32			my $class = shift;
33
34			my $args = { @_ };
35
36			my $ldap_config = Jifty->config->app('LDAP');
37			Jifty->log->debug( "config->app(LDAP) = ",dump( $ldap_config ) );
38
39	dpavlin	42	foreach my $f ( @config_fields ) {
40			if ( my $v = $ldap_config->{$f} ) {
41			$args->{$f} = $v;
42			}
43			}
44	dpavlin	40
45			my $ldap = Net::LDAP->new( $args->{server} ) or die "$@";
46
47			# an anonymous bind
48			#$ldap->bind;
49			$ldap->bind( $args->{dn}, password => $args->{password} );
50
51			Jifty->log->info("Connected to ", $args->{server}, " with DN ", $args->{dn});
52
53			$args->{ldap} = $ldap;
54
55			$class->SUPER::new( $args );
56			}
57
58			=head2 search
59
60			my $msg = A3C::LDAP->search(
61	dpavlin	42	base => 'dc=skole,dc=hr',
62			filter => '(objectClass=hrEduOrg)',
63			sizelimit => 10,
64	dpavlin	40	);
65
66			=cut
67
68	dpavlin	36	sub search {
69			my $self = shift;
70
71	dpavlin	40	my $search = $self->ldap->search( @_ );
72			if ( $search->code != 0 ) {
73	dpavlin	42	Jifty->log->error( $search->error, ' for ', dump( @_ ) );
74	dpavlin	40	}
75			return $self->current_search( $search );
76	dpavlin	36	}
77
78	dpavlin	40	=head2 next
79
80			Syntaxtic shugar to look more like L<Jifty::DBI::Collection>
81
82			my $entry = ldap->next;
83
84			=cut
85
86			sub next {
87			my $self = shift;
88
89			die "no current LDAP search" unless $self->current_search;
90
91			return $self->current_search->shift_entry;
92			}
93
94			=head2 count
95
96			my $search_results = $ldap->count;
97
98			=cut
99
100			sub count {
101			my $self = shift;
102			$self->current_search->count;
103			}
104
105	dpavlin	42	=head2 as_collection_of
106
107	dpavlin	47	my $connection = $ldap->collection(
108			# name of model to use
109			'Organization',
110			# optional params
111			limit => $limit,
112	dpavlin	53	filter => '(uid=foobar)',
113	dpavlin	47	);
114	dpavlin	42
115			=cut
116
117			my $collection2filter = {
118	dpavlin	66	'Person' => '(objectClass=hrEduPerson)',
119	dpavlin	42	'Organization' => '(objectClass=hrEduOrg)',
120			};
121
122			sub collection {
123	dpavlin	47	my $self = shift;
124			my $model = shift or die "no model?";
125			my $args = {@_};
126	dpavlin	42
127	dpavlin	47	$args->{limit} \|\|= 0; # unlimited by default
128	dpavlin	42
129			my $filter = $collection2filter->{$model};
130			die "unknown model $model" unless $filter;
131
132	dpavlin	53	# add user filter
133			$filter = '(&' . $filter . $args->{filter} . ')' if $args->{filter};
134
135	dpavlin	42	$self->search(
136			base => $self->base,
137			filter => $filter,
138	dpavlin	47	sizelimit => $args->{limit},
139	dpavlin	42	);
140
141	dpavlin	47	Jifty->log->info(
142	dpavlin	59	"Searching LDAP for $model with $filter ",
143			$args->{limit} ? 'limit ' . $args->{limit} . ' ' : '',
144	dpavlin	47	'returned ', $self->count, ' results'
145			);
146	dpavlin	42
147			my $class = Jifty->app_class('Model', $model . 'Collection' ) or die "can't create ${model}Collection";
148			my $collection = $class->new() or die "can't $class->new";
149
150			while ( my $entry = $self->next ) {
151			my $model_obj = Jifty->app_class('Model',$model)->new;
152			#warn dump( $model_obj );
153			my $additional;
154			$self->ldap2model( $model_obj, $entry, %$additional );
155			$collection->add_record( $model_obj );
156			}
157
158			return $collection;
159			}
160
161	dpavlin	41	=head1 INTERNAL METHODS
162
163			Following methods map directly into L<Net::LDAP>
164
165			=head2 current_search
166
167			Result of last C<< $ldap->search >> request
168
169	dpavlin	42	=head2 model_to_entry
170
171			$ldap->model_to_entry( $model, $entry, $additional );
172
173	dpavlin	41	=cut
174
175	dpavlin	42	sub ldap2model {
176			my ( $self, $model, $entry, $additional ) = @_;
177			my $data;
178
179			my @columns = map { $_->name } $model->columns;
180			#warn "# columns = ",dump( @columns );
181
182			foreach my $attr ( $entry->attributes ) {
183			if ( grep(/^\Q$attr\E$/, @columns ) ) {
184			$data->{$attr} = $entry->get_value( $attr );
185			} elsif ( $attr !~ m/^(objectClass)$/i ) {
186	dpavlin	44	Jifty->log->warn(ref($model)," doesn't have $attr");
187	dpavlin	42	}
188			}
189
190			Jifty->log->debug( ref($model), ' = ', dump( $data ) );
191
192			my ( $id, $message ) = $model->load_or_create( %$data, %$additional );
193
194			if ( $id ) {
195	dpavlin	45	Jifty->log->info( $message \|\| 'Added', ' ', ref($model), ' ', $model->id, ' ', $model->name );
196	dpavlin	42	} else {
197			Jifty->log->error( ref($model), " ", $message );
198			}
199			}
200
201
202
203	dpavlin	36	1;