File Coverage

blib/lib/Catalyst/Model/LDAP/Entry.pm
Criterion Covered Total %
statement 28 35 80.0
branch 6 14 42.8
condition 0 3 0.0
subroutine 8 9 88.8
pod 3 3 100.0
total 45 64 70.3


line stmt bran cond sub pod time code
1             package Catalyst::Model::LDAP::Entry;
2             # ABSTRACT: Convenience methods for Net::LDAP::Entry
3              
4 2     2   1787 use strict;
  2         8  
  2         62  
5 2     2   14 use warnings;
  2         14  
  2         66  
6 2     2   15 use base qw/Net::LDAP::Entry Class::Accessor::Fast/;
  2         7  
  2         1153  
7 2     2   369447 use Carp qw/croak/;
  2         7  
  2         118  
8 2     2   361 use MRO::Compat;
  2         2126  
  2         799  
9              
10             __PACKAGE__->mk_accessors(qw/_ldap_client/);
11              
12              
13             sub new {
14 1     1 1 420 my ( $class, $dn, %attributes ) = @_;
15              
16 1         3 my $client = delete $attributes{_ldap_client};
17              
18 1         7 my $self = $class->next::method( $dn, %attributes );
19              
20 1 50       110 if ($client) {
21 0         0 $self->_ldap_client($client);
22             }
23              
24 1         4 return $self;
25             }
26              
27              
28             sub update {
29 0     0 1 0 my $self = shift;
30 0   0     0 my $client = shift || $self->_ldap_client;
31 0 0       0 croak 'No LDAP client provided to update' unless $client;
32              
33 0         0 return $self->next::method( $client, @_ );
34             }
35              
36              
37             sub can {
38 2     2 1 190998 my ( $self, $method ) = @_;
39 2 50       18 return 0 unless ref($self);
40 0 0       0 $self->exists($method) || $self->SUPER::can($method);
41             }
42              
43             sub AUTOLOAD {
44 3     3   3123 my ( $self, @args ) = @_;
45              
46 3         21 my ($attribute) = ( our $AUTOLOAD =~ /([^:]+)$/ );
47 3 100       37 return if $attribute eq 'DESTROY';
48              
49 2 50       9 croak qq[Can't locate object method "$attribute" via package "]
50             . ref($self) . qq["]
51             unless $self->exists($attribute);
52              
53 2 50       22 if ( scalar @args ) {
54 0         0 $self->replace( $attribute, @args );
55             }
56              
57 2         5 return $self->get_value($attribute);
58             }
59              
60              
61             1;
62              
63             __END__
64              
65             =pod
66              
67             =encoding UTF-8
68              
69             =head1 NAME
70              
71             Catalyst::Model::LDAP::Entry - Convenience methods for Net::LDAP::Entry
72              
73             =head1 VERSION
74              
75             version 0.19
76              
77             =head1 SYNOPSIS
78              
79             # In your controller
80             my $mesg = $c->model('Person')->search('(cn=Lou Rhodes)');
81             my $entry = $mesg->shift_entry;
82             print $entry->title;
83              
84             =head1 DESCRIPTION
85              
86             This module simplifies use of L<Net::LDAP::Entry> objects in your
87             application. It makes accessors and mutators for all attributes on an
88             entry. For example:
89              
90             print $entry->cn;
91              
92             It also stores a reference to the parent LDAP connection, simplifying
93             updates to the entry:
94              
95             $entry->title('Folk singer');
96             $entry->update;
97              
98             =head1 ADDING ENTRY METHODS
99              
100             If you want to provide your own methods on an LDAP entry, you can use
101             the C<entry_class> configuration variable. For example:
102              
103             # In lib/MyApp/Model/LDAP.pm
104             package MyApp::Model::LDAP;
105             use base qw/Catalyst::Model::LDAP/;
106              
107             __PACKAGE__->config(
108             # ...
109             entry_class => 'MyApp::LDAP::Entry',
110             );
111              
112             1;
113              
114             # In lib/MyApp/LDAP/Entry.pm
115             package MyApp::LDAP::Entry;
116             use base qw/Catalyst::Model::LDAP::Entry/;
117             use DateTime::Format::Strptime;
118              
119             sub get_date {
120             my ($self, $attribute) = @_;
121              
122             my ($datetime) = ($self->get_value($attribute) =~ /^(\d{14})/);
123              
124             my $parser = DateTime::Format::Strptime->new(
125             pattern => '%Y%m%d%H%M%S',
126             locale => 'en_US',
127             time_zone => 'UTC'
128             );
129              
130             return $parser->parse_datetime($datetime);
131             }
132              
133             1;
134              
135             =head1 METHODS
136              
137             =head2 new
138              
139             Override the L<Net::LDAP::Entry> object constructor to take an
140             optional LDAP handle. If provided this will be used automatically on
141             L</update>.
142              
143             =head2 update
144              
145             Override C<update> to default to the optional LDAP handle provided to
146             the constructor.
147              
148             =head2 can
149              
150             Override C<can> to declare existence of the LDAP entry attribute
151             methods from C<AUTOLOAD>.
152              
153             =head1 SEE ALSO
154              
155             =over 4
156              
157             =item * L<Catalyst::Model::LDAP>
158              
159             =item * L<Catalyst::Model::LDAP::Search>
160              
161             =back
162              
163             =head1 AUTHORS
164              
165             =over 4
166              
167             =item * Marcus Ramberg
168              
169             =back
170              
171             =head1 LICENSE
172              
173             This library is free software; you can redistribute it and/or modify
174             it under the same terms as Perl itself.
175              
176             =head1 AUTHOR
177              
178             Gavin Henry <ghenry@surevoip.co.uk>
179              
180             =head1 COPYRIGHT AND LICENSE
181              
182             This software is copyright (c) 2017 by Gavin Henry.
183              
184             This is free software; you can redistribute it and/or modify it under
185             the same terms as the Perl 5 programming language system itself.
186              
187             =cut