3 |
# $Id$ |
# $Id$ |
4 |
# |
# |
5 |
# Copyright (C) 2003 FireEgl (Philip Moore) <FireEgl@Tcldrop.Tk> |
# Copyright (C) 2003 FireEgl (Philip Moore) <FireEgl@Tcldrop.Tk> |
6 |
# |
# |
7 |
# This program is free software; you can redistribute it and/or |
# This program is free software; you can redistribute it and/or |
8 |
# modify it under the terms of the GNU General Public License |
# modify it under the terms of the GNU General Public License |
9 |
# as published by the Free Software Foundation; either version 2 |
# as published by the Free Software Foundation; either version 2 |
10 |
# of the License, or (at your option) any later version. |
# of the License, or (at your option) any later version. |
11 |
# |
# |
12 |
# This program is distributed in the hope that it will be useful, |
# This program is distributed in the hope that it will be useful, |
13 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
14 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
15 |
# GNU General Public License for more details. |
# GNU General Public License for more details. |
16 |
# |
# |
17 |
# You should have received a copy of the GNU General Public License |
# You should have received a copy of the GNU General Public License |
18 |
# along with this program (see gpl.txt); if not, write to the |
# along with this program (see gpl.txt); if not, write to the |
19 |
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
20 |
# Or visit http://www.GNU.Org/licenses/gpl.html |
# Or visit http://www.GNU.Org/licenses/gpl.html |
21 |
# |
# |
22 |
# The author of this project can be reached at FireEgl@Tcldrop.Tk |
# The author of this project can be reached at FireEgl@Tcldrop.Tk |
23 |
# Or can be found on IRC (EFNet or FreeNode) as FireEgl. |
# Or can be found on IRC (EFNet or FreeNode) as FireEgl. |
24 |
# |
# |
94 |
# Searches the user database for the handle that most closely matches $nuhost. |
# Searches the user database for the handle that most closely matches $nuhost. |
95 |
# Returns the matching handle, or "*" if none found. |
# Returns the matching handle, or "*" if none found. |
96 |
proc ::tcldrop::users::finduser {nuhost} { |
proc ::tcldrop::users::finduser {nuhost} { |
97 |
|
if {![string match {*!*} $nuhost]} { set nuhost "*!$nuhost" } |
98 |
foreach a [binds finduser] { |
foreach a [binds finduser] { |
99 |
foreach {type flags mask count proc} $a {} |
foreach {type flags mask count proc} $a {} |
100 |
if {[catch { $proc $nuhost } val]} { |
if {[catch { $proc $nuhost } val]} { |
156 |
# Gets user related info: |
# Gets user related info: |
157 |
proc ::tcldrop::users::getuser {handle {type {}} {xtra {}}} { |
proc ::tcldrop::users::getuser {handle {type {}} {xtra {}}} { |
158 |
foreach a [binds getuser] { |
foreach a [binds getuser] { |
159 |
foreach {type flags mask count proc} $a {} |
foreach {bindtype flags mask count proc} $a {} |
160 |
if {[catch { $proc $handle $type $xtra } val]} { |
if {[catch { uplevel \#0 $proc $handle $type $xtra } val]} { |
161 |
putlog "Error in script: $proc: $val" |
putlog "Error in script: $proc: $val" |
162 |
puterrlog "$::errorInfo" |
puterrlog "$::errorInfo" |
163 |
return -code error $val |
return -code error $val |
164 |
|
} else { |
165 |
|
return $val |
166 |
} |
} |
|
return $val |
|
167 |
} |
} |
168 |
return -code error {No user database module has been loaded.} |
return -code error {No user database module has been loaded.} |
169 |
} |
} |
179 |
# It returns the new setting. |
# It returns the new setting. |
180 |
proc ::tcldrop::users::setuser {handle {type {}} {setting {}} {xtra {}}} { |
proc ::tcldrop::users::setuser {handle {type {}} {setting {}} {xtra {}}} { |
181 |
foreach a [binds setuser] { |
foreach a [binds setuser] { |
182 |
foreach {type flags mask count proc} $a {} |
foreach {bindtype flags mask count proc} $a {} |
183 |
if {[set lev [catch { $proc $handle $type $setting $xtra } val]]} { |
if {[set lev [catch { $proc $handle $type $setting $xtra } val]]} { |
184 |
putlog "Error in script: $proc: $val" |
putlog "Error in script: $proc: $val" |
185 |
puterrlog "$::errorInfo" |
puterrlog "$::errorInfo" |
186 |
} |
} |
187 |
|
putlog "lev: $lev" |
188 |
|
putlog "val: $val" |
189 |
if {![info exists retval]} { |
if {![info exists retval]} { |
190 |
set retlev $lev |
set retlev $lev |
191 |
set retval $val |
set retval $val |