gustafn
committed
on 05 Nov 16
- use acs::tcllib if available
openacs-4/.../auth-ldap/lib/search.tcl (+93 -64)
1 1 # creation-date 2007-01-21
2 2 # author Dave Bauer (dave@solutiongrove.com)
3 3 # includable search form
4 4 # results should be appended to multirow called users
5 5 # ADP level
6 6 # should get authority_id, return_url passed in.
7 7
8 8 ad_form -name user-search -export {authority_id object_id} -html {id "user-search"} -has_submit 1 -form {
9 9     {search_text:text(text),optional
10 10         {label "Search"}
11 11     }
12 12     {search_btn:text(button) {label ""} {value "Search"} {html {onclick {document.getElementById('searchform').style.display='';document.getElementById('user-search').submit()}}}}
13 13 }
14 14 if {![info exists orderby]} {
15 15     set orderby ""
16 16 }
17   set auth_search_impl_id [auth::authority::get_element -authority_id $authority_id -element "search_impl_id"]
  17 set auth_search_impl_id [auth::authority::get_element \
  18                              -authority_id $authority_id \
  19                              -element "search_impl_id"]
18 20
19   set auth_search_parameters [auth::driver::get_parameter_values -authority_id $authority_id -impl_id $auth_search_impl_id]
  21 set auth_search_parameters [auth::driver::get_parameter_values \
  22                                 -authority_id $authority_id \
  23                                 -impl_id $auth_search_impl_id]
20 24
21 25 array set auth_search_parameters_arr $auth_search_parameters
22 26 set search_attribs [list]
23 27 # foreach attribute_mapping [split $auth_search_parameters_arr(InfoAttributeMap) ";"] {
24 28 #     set attr [lindex [split $attribute_mapping "="] 1]
25 29 #     set pretty_name [lindex [split $attribute_mapping "="] 0]
26 30 #     lappend search_attribs $attr
27 31 #     ad_form -extend -name user-search -form \
28 32 #       [list [list $attr:text,optional [list label $pretty_name]]]
29 33 #     }
30 34
31 35
32 36 ad_form -extend -name user-search -on_request {
33 37 #    element set_value user-search search_text $search_text
34 38 } -on_submit {
35 39
36 40 } -validate {
37 41     {search_text
38           {[string length $search_text] >= 3 || [string length $search_text] <3 || [string length $department] >= 3}
  42         {[string length $search_text] >= 3
  43             || [string length $search_text] <3
  44             || [string length $department] >= 3}
39 45         "\"search_text\" must be a string containing three or more characters"
40 46     }
41 47 }
42 48
43 49 set search_terms [list]
44 50 foreach attr [concat search_text $search_attribs] {
45 51     if {[info exists $attr] && [set $attr] ne ""} {
46 52         lappend search_terms $attr [set $attr]
47 53     }
48 54 }
49 55 if {[llength $search_terms]} {
50 56     set matches [auth::ldap::search::Search $search_terms $auth_search_parameters]
51 57
52 58      set user_info_impl_id [auth::authority::get_element -authority_id $authority_id -element "user_info_impl_id"]
53        set user_info_parameters [auth::driver::get_parameter_values -authority_id $authority_id -impl_id $user_info_impl_id]
  59     set user_info_parameters [auth::driver::get_parameter_values \
  60                                   -authority_id $authority_id \
  61                                   -impl_id $user_info_impl_id]
54 62
55 63     # matches will contain a list of either usernames or user_ids
56 64     foreach user $matches {
57 65         # user info is an array - info_status, user_info, info_message
58 66         set user_info_raw [auth::ldap::user_info::GetUserInfo $user $user_info_parameters]
59 67 #       ns_log notice "user info is $user_info_raw"
60 68         # some objects (like resources in LDAP for example), may not return any information so we check first
61 69         if { [lindex $user_info_raw 3] ne "" } {
62 70             array set user_info [lindex $user_info_raw 3]
63 71         } else {
64 72             array set user_info [list first_names "" last_name "" email ""]
65 73         }
66 74
67 75         # unpack user_info
68 76         set extra_attributes ""
69 77         foreach name [array names user_info] {
70 78             if {[lsearch {first_names last_name username email} $name] < 0} {
71 79                 append extra_attributes "$name $user_info($name) "
72 80             }
73 81             set $name $user_info($name)
74 82         }
75 83         if { ![info exists email] } { set email "" }
76 84
77 85         if { [auth::UseEmailForLoginP] } {
78 86             set username $email
79 87         } else {
80 88             set username $user
81 89         }
82 90
83 91         # does the user have a local account?
84 92         set local_account_p 0
85 93         set user_id ""
86 94         set status [list]
87           db_0or1row user_exists_p "select user_id from cc_users where upper(username) = upper(:user) and upper(email) = upper(:email)"
  95         db_0or1row user_exists_p {
  96             select user_id
  97             from cc_users
  98             where upper(username) = upper(:user) and upper(email) = upper(:email)
  99         }
88 100         if {$user_id eq ""} {
89 101             set group_member_p 0
90 102         } else {
91 103             set group_member_p [group::member_p -group_id $group_id -user_id $user_id -cascade]
92 104         }
93 105         set group_name [group::get_element -element group_name -group_id $group_id]
94 106         if {$group_member_p} {
95               lappend status "[_ acs-authentication.Member_of_group_name]"
  107             lappend status [_ acs-authentication.Member_of_group_name]
96 108         } else {
97               lappend status "[_ acs-authentication.Not_a_member_of_group_name]"
  109             lappend status [_ acs-authentication.Not_a_member_of_group_name]
98 110         }
99 111         if {[info exists object_id]} {
100               set group_member_p [permission::permission_p -object_id $object_id -party_id $user_id -privilege $privilege]
  112             set group_member_p [permission::permission_p \
  113                                     -object_id $object_id \
  114                                     -party_id $user_id \
  115                                     -privilege $privilege]
101 116         }
102           set create_account_url [export_vars -base create-local-account {username first_names last_name email authority_id}]
103           # we could go on to retrieve member information here if there is a local account (for instance to allow member_state change, etc)
  117         set create_account_url [export_vars -base create-local-account {
  118             username first_names last_name email authority_id
  119         }]
  120         #
  121         # We could go on to retrieve member information here if there
  122         # is a local account (for instance to allow member_state
  123         # change, etc).
  124         #
104 125
105 126         set ldap_status [lindex $user_info_raw 5]
106 127         set system_name [ad_system_name]
107           set status "[join $status "<br>"]"
108           template::multirow -ulevel 2 -local append users $first_names $last_name $username $email $status $group_member_p $create_account_url "" $extra_attributes $user_id $authority_id
  128         set status "[join $status <br>]"
  129         template::multirow -ulevel 2 -local append users \
  130             $first_names $last_name $username $email $status $group_member_p \
  131             $create_account_url "" $extra_attributes $user_id $authority_id
109 132         unset user_info email
110 133
111 134     }
112 135 }
113 136
114 137
115 138 set orderby_list [split $orderby ,]
116 139 set orderby_column [lindex $orderby_list 0]
117 140 set direction [lindex $orderby_list 1]
118 141 set direction [string map {asc -increasing desc -decreasing} $direction]
119 142 if {$orderby_column ne ""} {
120 143     eval "template::multirow -ulevel 2 -local sort users $direction $orderby_column"
121 144 }
  145
  146 # Local variables:
  147 #    mode: tcl
  148 #    tcl-indent-level: 4
  149 #    indent-tabs-mode: nil
  150 # End: