(* $Id: index.ml,v 3.1 2002/02/12 21:18:21 stolpmann Exp $
 * ----------------------------------------------------------------------
 *
 *)

(* Note: This file must be parsed with camlp4, and the syntax
 * extensions from wdialog-p4.
 *)

open Wd_types

let read_directory path =
  (* Return the file names of the directory "path" as string list *)

  let d = Unix.opendir path in

  let rec readrec () =
    try
      let name = Unix.readdir d in
      name :: readrec()
    with
	End_of_file -> []
  in
  let names = readrec() in
  Unix.closedir d;
  names
;;


let permissions kind perm =
  (* Compute a textual representation of file 'kind' and
   * permission mode 'perm'
   *)
  let first_letter =
    match kind with
	Unix.S_REG -> "-"
      | Unix.S_DIR -> "d"
      | Unix.S_CHR -> "c"
      | Unix.S_BLK -> "b"
      | Unix.S_LNK -> "l"
      | Unix.S_FIFO -> "p"
      | Unix.S_SOCK -> "s"
  in

  let s = ref "" in
  let p = ref perm in

  List.iter
    (fun letter ->
       begin
	 if !p mod 2 = 1 then
	   s := letter ^ !s
	 else
	   s := "-" ^ !s
       end;
       p := !p / 2)
    [ "x"; "w"; "r"; "x"; "w"; "r"; "x"; "w"; "r" ];

  s := first_letter ^ !s;

  if (perm land 0o1000) > 0 then begin
    if !s.[9] = 'x' then
      !s.[9] <- 't'
    else
      !s.[9] <- 'T'
  end;

  if (perm land 0o2000) > 0 then begin
    if !s.[6] = 'x' then
      !s.[6] <- 's'
    else
      !s.[6] <- 'l'
  end;

  if (perm land 0o4000) > 0 then begin
    if !s.[6] = 'x' then
      !s.[6] <- 's'
    else
      !s.[6] <- 'S'
  end;

  !s
;;


let owner uid =
  (* Converts the numerical uid to a string *)
  try
    (Unix.getpwuid uid).Unix.pw_name
  with
      Not_found -> string_of_int uid
;;


let group gid =
  (* Converts the numerical gid to a string *)
  try
    (Unix.getgrgid gid).Unix.gr_name
  with
      Not_found -> string_of_int gid
;;


let timestring t =
  (* Converts the time value t to a string *)
  let tm = Unix.localtime t in
  Printf.sprintf
    "%04d-%02d-%02d %02d:%02d:%02d"
    (tm.Unix.tm_year + 1900)            (* Y2k-compliant *)
    (tm.Unix.tm_mon + 1)
    (tm.Unix.tm_mday)
    (tm.Unix.tm_hour)
    (tm.Unix.tm_min)
    (tm.Unix.tm_sec)
;;


class directory universe name env =
  interactive object (self)

    inherit Wd_dialog.dialog universe name env

    method private prepare_show_listing() =

      let path = _[path:string] in
      let names = Sort.list
		    (fun a b -> a >= b)       (* >=: sic! *)
		    (read_directory path) in             (* file names *)

      (* Get all necessary templates: *)
      let t_directory_row = self # t_get "directory-row" in
      let t_filename      = self # t_get "filename" in
      let t_filename_d    = self # t_get "filename_d" in

      let filename_alist = ref [] in
      let fileperms_alist = ref [] in
      let fileowner_alist = ref [] in
      let filegroup_alist = ref [] in
      let filesize_alist = ref [] in
      let filemtime_alist = ref [] in
      let filesymlink_alist = ref [] in

      List.iter
	(fun name ->
	   let path_name = Filename.concat path name in

	   let s  = Unix.stat path_name in
	   let ls = Unix.lstat path_name in

	   (* If the file is a directory, use t_filename_d instead of
	    * t_filename:
	    *)
	   let t_fname =
	     match s.Unix.st_kind with
		 Unix.S_DIR -> t_filename_d
	       | _          -> t_filename
	   in

	   filename_alist := (name,
			      String_value
				(self # t_to_string
				   (self # t_apply
		                      t_fname
				      [ "value", self # t_text name ])))
	                     :: !filename_alist;

	   fileperms_alist := (name,
			       String_value
				 (permissions
				    s.Unix.st_kind
				    s.Unix.st_perm)) :: !fileperms_alist;

	   fileowner_alist := (name,
			       String_value(owner s.Unix.st_uid))
                              :: !fileowner_alist;

	   filegroup_alist := (name,
			       String_value (group s.Unix.st_uid))
	                      :: !filegroup_alist;

	   filesize_alist := (name,
			      String_value (string_of_int s.Unix.st_size))
                             :: !filesize_alist;

	   filemtime_alist := (name,
			       String_value (timestring s.Unix.st_mtime))
                              :: !filemtime_alist;

	   filesymlink_alist := (name,
				 let t =
				   match ls.Unix.st_kind with
				       Unix.S_LNK ->
					 self # t_apply_byname "symlink"
					   [ "value",
					     self # t_text
					       (Unix.readlink path_name) ]
				     | _ -> self # t_empty
				 in
				 String_value (self # t_to_string t)
				)
	                        :: !filesymlink_alist;
	)
	names;

      _[filename:alist] <-    !filename_alist;
      _[fileperms:alist] <-   !fileperms_alist;
      _[fileowner:alist] <-   !fileowner_alist;
      _[filegroup:alist] <-   !filegroup_alist;
      _[filesize:alist] <-    !filesize_alist;
      _[filemtime:alist] <-   !filemtime_alist;
      _[filesymlink:alist] <- !filesymlink_alist;


    method private handle_show_listing() =
      match self # event with
	  Indexed_button ("goto_dir", dirname) ->
	    begin match dirname with
		"." -> ()
	      | ".." ->
		  let p = Filename.dirname _[path:string] in
		  _[path:string] <- p
	      | _ ->
		  _[path:string] <-
		    (Filename.concat
		       _[path:string]
		       dirname)
	    end
	| _ -> ()
  end
;;


Wd_run_cgi.run
  ~reg:(fun universe ->
          universe # register "directory" (new directory)
       )
  ()
;;


(* ======================================================================
 * History:
 *
 * $Log: index.ml,v $
 * Revision 3.1  2002/02/12 21:18:21  stolpmann
 * 	Initial revision at sourceforge
 *
 * Revision 1.2  2002/01/14 15:06:49  gerd
 * 	Updated to recent wd version.
 *
 * Revision 1.1  2000/04/13 17:43:05  gerd
 * 	Initial revision.
 *
 *
 *)