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 = 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;
                #warn dump( $model_obj );
                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 );

=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;
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	106	our @config_fields = keys %{ Jifty->config->app('LDAP') };
10	dpavlin	42	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	dpavlin	106	# configuration sanity testing
46			foreach ( qw/server dn password base objectClass link/ ) {
47			die "missing required field $_ in LDAP from etc/config.yaml" unless $args->{$_};
48			}
49			foreach ( qw/person organization/ ) {
50			die "missing required field $_ in LDAP.objectClass.$_ from etc/config.yaml" unless $args->{objectClass}->{$_};
51			}
52			foreach ( qw/person_filter display_from value_from/ ) {
53			die "missing required field $_ in LDAP.link.$_ from etc/config.yaml" unless $args->{link}->{$_};
54			}
55
56	dpavlin	40	my $ldap = Net::LDAP->new( $args->{server} ) or die "$@";
57
58			# an anonymous bind
59			#$ldap->bind;
60			$ldap->bind( $args->{dn}, password => $args->{password} );
61
62			Jifty->log->info("Connected to ", $args->{server}, " with DN ", $args->{dn});
63
64			$args->{ldap} = $ldap;
65
66			$class->SUPER::new( $args );
67			}
68
69			=head2 search
70
71			my $msg = A3C::LDAP->search(
72	dpavlin	42	base => 'dc=skole,dc=hr',
73			filter => '(objectClass=hrEduOrg)',
74			sizelimit => 10,
75	dpavlin	40	);
76
77			=cut
78
79	dpavlin	36	sub search {
80			my $self = shift;
81
82	dpavlin	40	my $search = $self->ldap->search( @_ );
83			if ( $search->code != 0 ) {
84	dpavlin	42	Jifty->log->error( $search->error, ' for ', dump( @_ ) );
85	dpavlin	40	}
86			return $self->current_search( $search );
87	dpavlin	36	}
88
89	dpavlin	40	=head2 next
90
91			Syntaxtic shugar to look more like L<Jifty::DBI::Collection>
92
93			my $entry = ldap->next;
94
95			=cut
96
97			sub next {
98			my $self = shift;
99
100			die "no current LDAP search" unless $self->current_search;
101
102			return $self->current_search->shift_entry;
103			}
104
105			=head2 count
106
107			my $search_results = $ldap->count;
108
109			=cut
110
111			sub count {
112			my $self = shift;
113			$self->current_search->count;
114			}
115
116	dpavlin	106	=head2 collection
117	dpavlin	42
118	dpavlin	47	my $connection = $ldap->collection(
119			# name of model to use
120	dpavlin	106	$ldap->objectClass->{organization},
121	dpavlin	47	# optional params
122			limit => $limit,
123	dpavlin	53	filter => '(uid=foobar)',
124	dpavlin	47	);
125	dpavlin	42
126			=cut
127
128			my $collection2filter = {
129	dpavlin	66	'Person' => '(objectClass=hrEduPerson)',
130	dpavlin	42	'Organization' => '(objectClass=hrEduOrg)',
131			};
132
133			sub collection {
134	dpavlin	47	my $self = shift;
135			my $model = shift or die "no model?";
136			my $args = {@_};
137	dpavlin	42
138	dpavlin	47	$args->{limit} \|\|= 0; # unlimited by default
139	dpavlin	42
140			my $filter = $collection2filter->{$model};
141	dpavlin	101	# die "unknown model $model" unless $filter;
142			# fallback to model named as objectClass
143			$filter \|\|= "(objectClass=$model)";
144	dpavlin	42
145	dpavlin	53	# add user filter
146			$filter = '(&' . $filter . $args->{filter} . ')' if $args->{filter};
147
148	dpavlin	42	$self->search(
149			base => $self->base,
150			filter => $filter,
151	dpavlin	47	sizelimit => $args->{limit},
152	dpavlin	42	);
153
154	dpavlin	47	Jifty->log->info(
155	dpavlin	59	"Searching LDAP for $model with $filter ",
156			$args->{limit} ? 'limit ' . $args->{limit} . ' ' : '',
157	dpavlin	47	'returned ', $self->count, ' results'
158			);
159	dpavlin	42
160			my $class = Jifty->app_class('Model', $model . 'Collection' ) or die "can't create ${model}Collection";
161			my $collection = $class->new() or die "can't $class->new";
162
163			while ( my $entry = $self->next ) {
164			my $model_obj = Jifty->app_class('Model',$model)->new;
165			#warn dump( $model_obj );
166			my $additional;
167	dpavlin	104	$self->model_from_entry( $model_obj, $entry, %$additional );
168	dpavlin	42	$collection->add_record( $model_obj );
169			}
170
171			return $collection;
172			}
173
174	dpavlin	41	=head1 INTERNAL METHODS
175
176			Following methods map directly into L<Net::LDAP>
177
178			=head2 current_search
179
180			Result of last C<< $ldap->search >> request
181
182	dpavlin	104	=head2 model_from_entry
183	dpavlin	42
184	dpavlin	104	$ldap->model_from_entry( $model, $entry, $additional );
185	dpavlin	42
186	dpavlin	41	=cut
187
188	dpavlin	104	sub model_from_entry {
189	dpavlin	42	my ( $self, $model, $entry, $additional ) = @_;
190			my $data;
191
192			my @columns = map { $_->name } $model->columns;
193			#warn "# columns = ",dump( @columns );
194
195			foreach my $attr ( $entry->attributes ) {
196			if ( grep(/^\Q$attr\E$/, @columns ) ) {
197			$data->{$attr} = $entry->get_value( $attr );
198	dpavlin	104	# } elsif ( $attr !~ m/^(objectClass)$/i ) {
199	dpavlin	106	} else {
200			Jifty->log->warn(ref($model)," doesn't have $attr");
201	dpavlin	42	}
202			}
203
204			Jifty->log->debug( ref($model), ' = ', dump( $data ) );
205
206			my ( $id, $message ) = $model->load_or_create( %$data, %$additional );
207
208			if ( $id ) {
209	dpavlin	45	Jifty->log->info( $message \|\| 'Added', ' ', ref($model), ' ', $model->id, ' ', $model->name );
210	dpavlin	42	} else {
211			Jifty->log->error( ref($model), " ", $message );
212			}
213			}
214
215
216
217	dpavlin	36	1;