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;
        # 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 ) {
#                       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	dpavlin	101	# die "unknown model $model" unless $filter;
131			# fallback to model named as objectClass
132			$filter \|\|= "(objectClass=$model)";
133	dpavlin	42
134	dpavlin	53	# add user filter
135			$filter = '(&' . $filter . $args->{filter} . ')' if $args->{filter};
136
137	dpavlin	42	$self->search(
138			base => $self->base,
139			filter => $filter,
140	dpavlin	47	sizelimit => $args->{limit},
141	dpavlin	42	);
142
143	dpavlin	47	Jifty->log->info(
144	dpavlin	59	"Searching LDAP for $model with $filter ",
145			$args->{limit} ? 'limit ' . $args->{limit} . ' ' : '',
146	dpavlin	47	'returned ', $self->count, ' results'
147			);
148	dpavlin	42
149			my $class = Jifty->app_class('Model', $model . 'Collection' ) or die "can't create ${model}Collection";
150			my $collection = $class->new() or die "can't $class->new";
151
152			while ( my $entry = $self->next ) {
153			my $model_obj = Jifty->app_class('Model',$model)->new;
154			#warn dump( $model_obj );
155			my $additional;
156	dpavlin	104	$self->model_from_entry( $model_obj, $entry, %$additional );
157	dpavlin	42	$collection->add_record( $model_obj );
158			}
159
160			return $collection;
161			}
162
163	dpavlin	41	=head1 INTERNAL METHODS
164
165			Following methods map directly into L<Net::LDAP>
166
167			=head2 current_search
168
169			Result of last C<< $ldap->search >> request
170
171	dpavlin	104	=head2 model_from_entry
172	dpavlin	42
173	dpavlin	104	$ldap->model_from_entry( $model, $entry, $additional );
174	dpavlin	42
175	dpavlin	41	=cut
176
177	dpavlin	104	sub model_from_entry {
178	dpavlin	42	my ( $self, $model, $entry, $additional ) = @_;
179			my $data;
180
181			my @columns = map { $_->name } $model->columns;
182			#warn "# columns = ",dump( @columns );
183
184			foreach my $attr ( $entry->attributes ) {
185			if ( grep(/^\Q$attr\E$/, @columns ) ) {
186			$data->{$attr} = $entry->get_value( $attr );
187	dpavlin	104	# } elsif ( $attr !~ m/^(objectClass)$/i ) {
188			# Jifty->log->warn(ref($model)," doesn't have $attr");
189	dpavlin	42	}
190			}
191
192			Jifty->log->debug( ref($model), ' = ', dump( $data ) );
193
194			my ( $id, $message ) = $model->load_or_create( %$data, %$additional );
195
196			if ( $id ) {
197	dpavlin	45	Jifty->log->info( $message \|\| 'Added', ' ', ref($model), ' ', $model->id, ' ', $model->name );
198	dpavlin	42	} else {
199			Jifty->log->error( ref($model), " ", $message );
200			}
201			}
202
203
204
205	dpavlin	36	1;