File Coverage

blib/lib/ResourcePool/Resource/Net/LDAPapi.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             # Original ResourcePool::Resource::Net::LDAP:
2             #*********************************************************************
3             #*** ResourcePool::Resource::Net::LDAP
4             #*** Copyright (c) 2002,2003 by Markus Winand
5             #*********************************************************************
6              
7             =head1 NAME
8              
9             ResourcePool::Resource::Net::LDAPapi - A L wrapper for L
10              
11             =head1 SYNOPSIS
12            
13             use ResourcePool::Resource::Net::LDAPapi;
14            
15             my $resource = ResourcePool::Resource::Net::LDAPapi->new(
16             $factory,
17             [@NamedBindOptions],
18             [@NamedNewOptions]);
19              
20             =head1 DESCRIPTION
21              
22             This class is used by the L internally to create L connections. It's called by the corresponding L object which passes the parameters needed to establish the L connection.
23              
24             The only thing which has to been known by an application developer about this class is the implementation of the L and L methods:
25              
26             =head1 API
27              
28             =over 4
29              
30             =cut
31              
32             package ResourcePool::Resource::Net::LDAPapi;
33              
34 1     1   15356 use vars qw($VERSION @ISA);
  1         2  
  1         58  
35 1     1   5 use strict;
  1         2  
  1         31  
36 1     1   237 use Net::LDAPapi qw(LDAP_SUCCESS);
  0            
  0            
37             use ResourcePool::Resource;
38              
39             $VERSION = "1.00";
40             push @ISA, "ResourcePool::Resource";
41              
42             sub new($$$@) {
43             my $proto = shift;
44             my $class = ref($proto) || $proto;
45             my $self = $class->SUPER::new();
46              
47             $self->{Factory} = shift;
48             $self->{BindOptions} = defined $_[0] ? shift: [];
49             my $NewOptions = defined $_[0] ? shift: [];
50              
51             $self->{ldaph} = Net::LDAPapi->new(@{$NewOptions});
52             if (! defined $self->{ldaph}) {
53             swarn("ResourcePool::Resource::Net::LDAPapi: ".
54             "Connect to '%s' failed: $@\n",
55             $self->{Factory}->info());
56             return undef;
57             }
58            
59             bless($self, $class);
60              
61             # bind returns $self on success
62             return $self->bind($self->{BindOptions});
63             }
64              
65             sub close($) {
66             my ($self) = @_;
67             #$self->{ldaph}->unbind();
68             }
69              
70             sub fail_close($) {
71             my ($self) = @_;
72             swarn("ResourcePool::Resource::Net::LDAPapi: ".
73             "closing failed connection to '%s'.\n",
74             $self->{Factory}->info());
75             }
76              
77             sub get_plain_resource($) {
78             my ($self) = @_;
79             return $self->{ldaph};
80             }
81              
82             sub DESTROY($) {
83             my ($self) = @_;
84             $self->close();
85             }
86              
87             =item S<$resource-Eprecheck>
88              
89             Performs a bind(), either anonymous or with dn and password (depends on the arguments to L).
90              
91             Returns true on success and false if the bind failed (regardless of the reason)
92              
93             =cut
94              
95             sub precheck($) {
96             my ($self) = @_;
97             return $self->bind($self->{BindOptions});
98             }
99              
100             =item S<$resource-Epostcheck>
101              
102             Does not implement any postcheck().
103              
104             Returns always true
105              
106             =cut
107              
108             sub bind($$) {
109             my ($self, $bindopts) = @_;
110             my @BindOptions = @{$bindopts};
111            
112             if ($self->{ldaph}->bind_s(@BindOptions) != LDAP_SUCCESS) {
113             swarn("ResourcePool::Resource::Net::LDAPapi: ".
114             "Bind to '%s' failed: %s\n", $self->{Factory}->info(), $self->{ldaph}->errstring);
115             delete $self->{ldaph};
116             return undef;
117             }
118             return $self;
119             }
120              
121              
122             sub swarn($@) {
123             my $fmt = shift;
124             warn sprintf($fmt, @_);
125             }
126              
127             =back
128              
129             =head1 SEE ALSO
130              
131             L,
132             L,
133             L,
134             L
135              
136             =head1 AUTHOR
137              
138             =head2 ResourcePool::Resource::Net::LDAPapi
139              
140             Copyright (C) 2015 by Phillip O'Donnell
141              
142             This program is free software; you can redistribute it and/or
143             modify it under the same terms as Perl itself.
144              
145             =head2 Portions based on L
146              
147             Copyright (C) 2001-2003 by Markus Winand
148              
149             This program is free software; you can redistribute it and/or
150             modify it under the same terms as Perl itself.
151              
152             =cut
153              
154            
155             1;