(* * <COPYRIGHT> * Copyright 2003 Gerd Stolpmann * * <GPL> * This file is part of WTimer. * * WTimer is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * WTimer is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with WDialog; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * </> *) (* $Id: selectuser.ml,v 1.5 2003/03/23 11:59:14 gerd Exp $ * ---------------------------------------------------------------------- * *) open Wd_dialog open Wd_run_cgi open Wd_types open Db.Types open Definitions class selectuser db universe name env = object (self) inherit dialog universe name env inherit error_behaviour method private check_auth () = check_auth db (self # dialog_variable "session") method private try_prepare_page() = let login = User (self # string_variable "session.login-user") in let inst_list = Db_ac.Instance.list db login in let inst_list' = List.filter (fun inst -> Db.Permission.check db inst.i_name login `Read) inst_list in self # set_variable "sheetlist" (Dyn_enum_value (List.map (fun inst -> let wr = Db.Permission.check db inst.i_name login `Write in let name = match inst.i_name with Instance n -> n in let ext_name = " (" ^ inst.i_description ^ ")" in let ro_text = if wr then "" else " (read-only)" in (name, name ^ ext_name ^ ro_text) ) inst_list' ) ) method private try_handle() = try raise(Change_dialog(Filemenu.handle (self :> dialog_type) db self#event)) with Filemenu.Not_competent -> ( match self # event with | Button "cont-error" -> self # set_next_page "selector" | _ -> () ) end ;; Registry.new_selectuser := fun universe env opt_session -> let dlg = universe # create env "selectuser" in dlg # set_variable "session" (Dialog_value opt_session); dlg ;; (* ====================================================================== * History: * * $Log: selectuser.ml,v $ * Revision 1.5 2003/03/23 11:59:14 gerd * GPL * * Revision 1.4 2003/02/03 01:28:59 gerd * Continued. * * Revision 1.3 2003/01/26 23:45:16 gerd * Improved error behaviour. * * Revision 1.2 2003/01/16 00:39:25 gerd * Continued. * * Revision 1.1 2002/11/16 12:34:51 gerd * Initial revision * * *)