File Coverage

blib/lib/Gtk2/Net/LDAP/Widgets/LdapTreeView.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package Gtk2::Net::LDAP::Widgets::LdapTreeView;
2             #---[ pod head ]---{{{
3              
4             =head1 NAME
5              
6             Gtk2::Net::LDAP::Widgets::LdapEntryView - LDAP entry viewport
7              
8             =head1 SYNOPSIS
9              
10             use Gtk2::Net::LDAP::Widgets;
11              
12             $treeView = Gtk2::Net::LDAP::Widgets::LdapTreeView->new($ldap_source, 'ou=OrgStructure,dc=example,dc=com', 'objectClass=top');
13             # expand entries two tree levels below:
14             $treeView->expand_row(Gtk2::TreePath->new_from_string('0'), 0);
15             $treeView->expand_row(Gtk2::TreePath->new_from_string('0:0'), 0);
16             # ... later ...
17             print join(", ", $treeView->get_dn);
18             =head1 ABSTRACT
19              
20             Gtk2::Net::LDAP::Widgets::LdapEntryView is a child class to L
21             and is used to create a Gtk2 component which lets the user select LDAP entry/entries
22             displayed in a tree-like structure.
23              
24             Note: there might be problems with displaying the tree when an interactive
25             filter is set since there may be problems building the tree if all ancestors
26             for an entry aren't included in the search result.
27              
28             So it's advised to carefully control the filters that are fed to this component.
29              
30             =cut
31              
32             #---}}}
33 1     1   28161 use utf8;
  1         11  
  1         6  
34 1     1   31 use strict;
  1         2  
  1         41  
35 1     1   6 use vars qw(@ISA $VERSION);
  1         2  
  1         63  
36              
37 1     1   1029 use Net::LDAP;
  1         218117  
  1         9  
38 1     1   4362 use Net::LDAP::Util;
  1         89  
  1         65  
39 1     1   566 use Gtk2 -init;
  0            
  0            
40             use Data::Dumper;
41             use Gtk2::Net::LDAP::Widgets::DistinguishedName;
42             use Gtk2::Net::LDAP::Widgets::Util;
43              
44             @ISA = qw(Gtk2::TreeView);
45              
46             our $VERSION = "2.0.1";
47              
48             our $rdn_column = 0;
49             our $bool_column = 1;
50             our $dn_column = 2;
51              
52              
53             use overload
54             q{""} => 'to_string';
55              
56             #---[ sub new ]---{{{
57              
58             =head1 CONSTRUCTOR
59              
60             =over 4
61              
62             =item new ( ldap_source, base_dn, static_filter, interative_filter, single_selection)
63              
64             Creates a new Gtk2::Net::LDAP::Widgets::LdapTreeView object.
65              
66             C the L object which is an active connection to an LDAP server
67              
68             C the base DN of LDAP search operations
69              
70             C the static filter that will be logically AND-ed with all filters executed by this selector
71              
72             C the additional filter that usually comes from filter box components
73              
74             C whether to use single selection mode (otherwise multiple selection is posible)
75              
76             =back
77              
78             =cut
79             sub new {
80             my $class = shift;
81             my $self = $class->SUPER::new;
82             $self->{ldap_source} = shift;
83             $self->{base_dn} = shift;
84             $self->{static_filter} = shift;
85             defined($self->{static_filter}) or $self->{static_filter} = '';
86             $self->{interactive_filter} = shift;
87             defined($self->{interactive_filter}) or $self->{interactive_filter} = '';
88             $self->{single_selection} = shift;
89              
90             $self->{selectedDN} = undef;
91              
92              
93              
94             bless $self, $class;
95             $self->set_rules_hint (1);
96             $self->get_selection->set_mode ('multiple');
97             ###
98             # 1st column
99             my $renderer = Gtk2::CellRendererText->new;
100             my $col_offset = $self->insert_column_with_attributes
101             (-1, "Entry", $renderer,
102             text => 0);
103             my $column = $self->get_column ($col_offset - 1);
104             $column->set_clickable (1);
105              
106             ###
107             # 2nd column
108             $renderer = Gtk2::CellRendererToggle->new;
109             $renderer->set (xalign => 0.0);
110             $renderer->set_data (column => 1);
111             if ($self->{single_selection}) {
112             $renderer->set_radio (1);
113             }
114             $renderer->signal_connect (toggled => \&LdapTreeView_item_toggled, $self);
115             $col_offset = $self->insert_column_with_attributes
116             (-1, "Y/N", $renderer,
117             active => 1
118             );
119             $column = $self->get_column ($col_offset - 1);
120             $column->set_clickable (1);
121             #$column->set_sizing ('fixed');
122             #$column->set_fixed_width (50);
123              
124             $self->refresh_model;
125             bless $self, $class;
126             }
127             #---}}}
128              
129             #---[ sub refresh_model ]---{{{
130             =head2 refresh_model
131              
132             Refresh the data model - re-execute the search with the current filters
133              
134             =cut
135             sub refresh_model {
136             my $self = shift;
137             my $static_filter = $self->{static_filter};
138             my $interactive_filter = $self->{interactive_filter};
139             # Remove superfluous pairs of parentheses:
140             $interactive_filter = filter_trim_outer_parens($interactive_filter);
141             $static_filter = filter_trim_outer_parens($static_filter);
142              
143             my $compositeFilter;
144             if (length($interactive_filter) > 3) {
145             $compositeFilter = '(&('.$static_filter.')('.$interactive_filter.'))';
146             } else {
147             $compositeFilter = '('.$static_filter.')';
148             }
149             #print "LdapTreeView composite filter: $compositeFilter\n";
150              
151             my $result = $self->{ldap_source}->search(filter => $compositeFilter, base => $self->{base_dn}, attrs => ['dn']);
152             my @entries = $result->sorted;
153             my $tree_model = Gtk2::TreeStore->new(qw/Glib::String Glib::Boolean Glib::String/);
154             my $prev_dn = undef;
155             my $child;
156             my $entry;
157             my @ancestors_stack = ();
158             my %dn_iters;
159             #push @parents, $toplevel;
160             foreach $entry (@entries) {
161             my $dn = Gtk2::Net::LDAP::Widgets::DistinguishedName->new($entry->dn);
162             my $rdn;
163             my $parent = $ancestors_stack[$#ancestors_stack];
164             if (defined($prev_dn) && $dn->isDescendant($prev_dn)) {
165             # it's a child of the previous dn
166             # print "$dn is a child of $prev_dn\n";
167             # TODO: assert length($entry->dn) =okolo (rindex($entry->dn, $prev_dn) + length($prev_dn))
168             # TODO: push the previous DN onto a stack
169              
170             # Push the parent to stack:
171             push(@ancestors_stack, $prev_dn);
172             $parent = $ancestors_stack[$#ancestors_stack];
173            
174             } else {
175             # it might not be a descendant of the parent anymore. Search for the youngest ancestor:
176             while(scalar(@ancestors_stack)) {
177             $parent = pop(@ancestors_stack);
178             if ($dn->isDescendant($parent)) {
179             push(@ancestors_stack, $parent);
180             last;
181             }
182             }
183             #$rdn = $dn->getRdn($parent);
184             }
185             # determine the RDN:
186             $rdn = $dn->getRdn($parent);
187             #print " ...so its RDN is $rdn\n";
188             #print "number of components:".$dn->getLength."\n";
189              
190             # Determine the Iter-a of the super element in the tree model (if there's
191             # no parent, then iter is undefined and tree's top level is created):
192             my $iter = undef;
193             if (defined($parent)) {
194             $iter = $dn_iters{$parent->{dn}};
195             }
196              
197             $child = $tree_model->append($iter);
198              
199             $tree_model->set($child,
200             0 => $rdn,
201             1 => 0,
202             2 => ($dn->{dntext})
203             );
204             $dn_iters{$dn->{dn}} = $child;
205             $prev_dn = $dn;
206             }
207              
208             $self->set_model($tree_model);
209              
210             }
211             #---}}}
212              
213             # by OLO
214             # czw mar 17 17:51:20 CET 2005
215             # Conversion of self to string:
216             sub to_string {
217             my $self = shift;
218             return $self->{class}.' "'.\$self.'"';
219             }
220              
221             #---[ sub get_dn ]---{{{
222              
223             =head2 get_dn
224              
225             Return the list of selected entries' Distinguished Names.
226              
227             The list has at most one entry if single_selection is set to 1.
228              
229             =cut
230             sub get_dn {
231             my $self = shift;
232             my @dn_list;
233            
234             if ($self->{single_selection}) {
235             push @dn_list, $self->{selectedDN};
236             } else {
237             my $model = $self->get_model;
238             $model->foreach( sub {
239             my $model = shift;
240             my $path = shift;
241             my $iter = shift;
242             if ($model->get ($iter, $bool_column) > 0) {
243             # The entry is selected:
244             push(@dn_list, $model->get ($iter, $dn_column));
245             }
246             return 0;
247             });
248             }
249            
250             #print "Selected:\n";
251             #print Dumper(\@dn_list);
252             #print "\n";
253             return @dn_list;
254             }
255             #---}}}
256              
257             #---[ sub set_dn ]---{{{
258              
259             =head2 set_dn
260              
261             =over 4
262              
263             =item set_dn( dn_list )
264              
265             Sets the state of entries specified by DNs in dn_list to "selected" and unselects all other entries.
266              
267             C list of Distinguished Names of entries to select
268              
269             =back
270              
271             =cut
272             sub set_dn(@) {
273             my $self = shift;
274             my @dn_list = @_;
275              
276             # Build a hash map to speed up lookups:
277             my %dn_hash = map { my $DN = new Gtk2::Net::LDAP::Widgets::DistinguishedName($_); ($DN->{dn}) => 1; } @dn_list;
278              
279             my $model = $self->get_model;
280             $model->foreach( sub {
281             my $model = shift;
282             my $path = shift;
283             my $iter = shift;
284             my $row_dn = $model->get ($iter, $dn_column);
285             my $row_DistinguishedName = new Gtk2::Net::LDAP::Widgets::DistinguishedName($row_dn);
286             if ($dn_hash{$row_DistinguishedName->{dn}}) {
287             # DN is on the supplied list, select the row:
288             $model->set ($iter, $bool_column, 1);
289             } else {
290             # DN is not on the supplied list, deselect the row:
291             $model->set ($iter, $bool_column, 0);
292             }
293             return 0;
294             });
295             }
296             #---}}}
297              
298             sub LdapTreeView_item_toggled {
299             #my $self = shift;
300             my ($cell, $path_str, $self) = @_;
301             my $model = $self->get_model;
302             my $path = Gtk2::TreePath->new_from_string ($path_str);
303             #print "$path_str\n$path\n";
304             my $column = $cell->get_data ("column");
305             # get toggled iter
306             my $iter = $model->get_iter ($path);
307             #print Dumper($iter);
308             my ($toggle_item) = $model->get ($iter, $column);
309              
310             # do something with the value
311             my $selectedDN = $model->get($iter, $dn_column);
312             #print "Row: ".$model->get($iter, 0)."\n";
313             #print "DN: ".$model->get($iter, 2)."\n";
314             #print "toggle_item before: $toggle_item\n";
315              
316             if ($self->{single_selection}) {
317             $model->foreach( sub { my $model = shift; my $path = shift; my $iter = shift; $model->set ($iter, $column, 0); return 0; } );
318             $model->set ($iter, $column, 1);
319             $self->{selectedDN} = $selectedDN;
320             } else {
321             $toggle_item ^= 1;
322             $model->set ($iter, $column, $toggle_item);
323             }
324              
325             }
326              
327             #---[ sub set_interactive_filter ]---{{{
328              
329             =head2 set_interactive_filter
330              
331             =over 4
332              
333             =item set_interactive_filter ( interactive_filter )
334              
335             Sets the interactive filter which is an additional filter applied to LDAP
336             searches, usually provided by interactive components like a search/filter box
337             and refreshes the data model, re-executing LDAP search and building a new data
338             tree.
339              
340             C a string representation of an LDAP filter
341              
342             =back
343              
344             =cut
345             sub set_interactive_filter($) {
346             my $self = shift;
347             $self->{interactive_filter} = shift;
348             $self->refresh_model;
349             }
350             #---}}}
351              
352             1;
353             __END__