File Coverage

blib/lib/Net/LDAP/Class/Metadata.pm
Criterion Covered Total %
statement 53 74 71.6
branch 11 20 55.0
condition 3 11 27.2
subroutine 12 14 85.7
pod 5 5 100.0
total 84 124 67.7


line stmt bran cond sub pod time code
1             package Net::LDAP::Class::Metadata;
2 10     10   86 use strict;
  10         27  
  10         686  
3 10     10   65 use warnings;
  10         23  
  10         342  
4 10     10   56 use Carp;
  10         18  
  10         1033  
5 10     10   82 use base qw( Rose::Object );
  10         16  
  10         1141  
6 10     10   23538 use Clone ();
  10         250490  
  10         366  
7 10     10   10606 use Net::LDAP::Class::Loader;
  10         34  
  10         10708  
8              
9             our $VERSION = '0.26';
10              
11             #
12             # much of this stolen verbatim from RDBO::Metadata
13             #
14              
15             use Net::LDAP::Class::MethodMaker (
16 10         119 scalar => [
17             qw(
18             attributes
19             unique_attributes
20             base_dn
21             ldap
22             class
23             object_classes
24             error
25             )
26             ],
27             boolean => [
28             'is_initialized' => { default => 0 },
29             'use_loader' => { default => 0 },
30             ],
31 10     10   116 );
  10         19  
32              
33             our %Objects;
34              
35             =head1 NAME
36              
37             Net::LDAP::Class::Metadata - LDAP class metadata
38              
39             =head1 SYNOPSIS
40              
41             package MyLDAPClass;
42             use strict;
43             use base qw( Net::LDAP::Class );
44            
45             __PACKAGE__->metadata->setup(
46             base_dn => 'dc=mycompany,dc=local',
47             attributes => [qw( name phone email )],
48             unique_attributes => [qw( email )],
49             );
50            
51             1;
52              
53             =head1 DESCRIPTION
54              
55             Instances of this class hold all the attribute information
56             for a Net::LDAP::Class-derived object.
57              
58             =head1 METHODS
59              
60             =head2 new( class => 'NetLDAPClassName' )
61              
62             Returns a new instance. The C argument is required.
63              
64             =cut
65            
66             sub new {
67 8     8 1 124 my ( $this_class, %args ) = @_;
68 8 50       52 my $class = $args{'class'}
69             or croak "Missing required 'class' parameter";
70 8   33     429 return $Objects{$class} ||= shift->SUPER::new(@_);
71             }
72              
73             =head2 loader_class
74              
75             Returns 'Net::LDAP::Class::Loader' by default.
76              
77             =cut
78              
79 0     0 1 0 sub loader_class {'Net::LDAP::Class::Loader'}
80              
81             =head2 setup( I )
82              
83             Initialize the Metadata object.
84              
85             I must be key/value pairs. The keys should be the names
86             of methods, and the values will be set on those method names
87             in the order given.
88              
89             setup() will call the Net::LDAP::Class::MethodMaker make_methods()
90             method to create accessor methods for all the attributes()
91             on the class indicated in new().
92              
93             =cut
94              
95             sub setup {
96 8     8 1 20 my $self = shift;
97 8         181 my @args = @_;
98 8 50       50 if ( @args % 2 ) {
99 0         0 croak "setup() arguments must be key/value pairs";
100             }
101 8         38 while ( scalar @args ) {
102 24         52 my $method = shift @args;
103 24         49 my $value = shift @args;
104 24         419 $self->$method($value);
105             }
106              
107 8 50       115 if ( !$self->base_dn ) {
108 0         0 croak "base_dn required in Metadata";
109             }
110              
111 8 50       43 if ( $self->use_loader ) {
112              
113 0 0       0 unless ( $self->ldap ) {
114 0         0 croak "must define ldap() in order to use_loader";
115             }
116              
117             my $loader = $self->loader_class->new(
118             ldap => $self->ldap,
119             object_classes => $self->object_classes
120 0   0     0 || [ map { $_->{name} }
121             $self->ldap->schema->all_objectclasses ],
122             base_dn => $self->base_dn,
123             );
124              
125 0         0 my $info = $loader->interrogate;
126              
127 0         0 $self->unique_attributes(
128 0         0 [ map { @{ $info->{$_}->{unique_attributes} } } keys %$info ] );
  0         0  
129 0         0 $self->attributes(
130 0         0 [ map { @{ $info->{$_}->{attributes} } } keys %$info ] );
  0         0  
131              
132             }
133              
134 8 50 33     234 if ( !defined $self->unique_attributes
135             or ref( $self->unique_attributes ) ne 'ARRAY' )
136             {
137 0         0 croak "unique_attributes() must be set to an ARRAY ref";
138             }
139 8 50 33     237 if ( !defined $self->attributes or ref( $self->attributes ) ne 'ARRAY' ) {
140 0         0 croak "attributes() must be set to an ARRAY ref";
141             }
142              
143             Net::LDAP::Class::MethodMaker->make_methods(
144 8         319 { target_class => $self->class,
145             preserve_existing => 1,
146             },
147 8         141 'ldap_entry' => [ @{ $self->attributes } ],
148             );
149              
150 8         272 $self->is_initialized(1);
151              
152 8         76 return $self;
153             }
154              
155             =head2 clone
156              
157             Returns a clone of the Metadata object. Uses Clone::clone().
158              
159             =cut
160              
161             sub clone {
162 0     0 1 0 my $self = shift;
163 0         0 return Clone::clone($self);
164             }
165              
166             =head2 for_class( I )
167              
168             Returns a Metadata object for I. Used primarily
169             by the metadata() method in Net::LDAP::Class.
170              
171             =cut
172              
173             sub for_class {
174 480     480 1 1216 my ( $meta_class, $class ) = ( shift, shift );
175 480 100       12925 return $Objects{$class} if ( $Objects{$class} );
176              
177             # Clone an ancestor meta object
178 8         60 foreach my $parent_class ( __get_parents($class) ) {
179 32 50       148 if ( my $parent_meta = $Objects{$parent_class} ) {
180 0         0 my $meta = $parent_meta->clone;
181              
182 0         0 $meta->is_initialized(0);
183 0         0 $meta->class($class);
184              
185 0         0 return $Objects{$class} = $meta;
186             }
187             }
188              
189 8         124 return $Objects{$class} = $meta_class->new( class => $class );
190             }
191              
192             sub __get_parents {
193 32     32   168 my ($class) = shift;
194 32         46 my @parents;
195              
196 10     10   35659 no strict 'refs';
  10         28  
  10         1510  
197 32         54 foreach my $sub_class ( @{"${class}::ISA"} ) {
  32         332  
198 32 100       1068 push( @parents, __get_parents($sub_class) )
199             if ( $sub_class->isa('Net::LDAP::Class') );
200             }
201              
202 32         209 return $class, @parents;
203             }
204              
205             =head2 attributes
206              
207             Get/set the array ref of attributes for the class.
208              
209             =head2 base_dn
210              
211             Get/set the base DN for the class.
212              
213             =head2 error
214              
215             Get/set the current error message.
216              
217             =head2 ldap
218              
219             Get/set the internal Net::LDAP object.
220              
221             =head2 object_classes
222              
223             Get/set the object_classes to be used by the Loader. Ignored if
224             you are not using Net::LDAP::Class::Loader.
225              
226             =head2 unique_attributes
227              
228             Get/set the array ref of unique attributes for the class.
229             These are attributes which may be used to uniquely identify
230             a LDAP entry.
231              
232             =cut
233              
234             1;
235              
236             __END__