(************************************************************
   web_pwd.ml		Created      : Sun Feb 16 09:31:06 2003
  			Last modified: Sun Feb 16 10:34:36 2003
  Compile: ocamlc.opt unix.cma str.cma web_pwd.ml -o web_pwd #
  FTP Directory: sources/ocaml #
************************************************************)
(**

   pwd_filename で示されるファイルにURLのベースが書いてあると
する。そのファイルを level の数だけ親ディレクトリに登って探す。
あればそれを開いて、登った分の相対パスをそのファイルの内容に
加える。

  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>

*)

let pwd_filename = "WEBPATH"

let tail_regexp = Str.regexp "^\\(.*/\\)\\([^/]+\\)/?$"

(** path はディレクトリをさしていると仮定 *)
let get_tail_dir path = 
  if Str.string_match tail_regexp path 0 then
    (Str.matched_group 1 path, Str.matched_group 2 path)
  else
    begin prerr_endline ("not matched: "^path) ; exit 1 end

let wpwd pwd_filename level path =
  let rec iter cwd tail l =
    if l = 0 then
      begin 
	prerr_endline ("Not found: " ^ pwd_filename);
	prerr_endline cwd;
	exit 1 end
    else
      begin
	try 
	  let input = open_in pwd_filename in
	  let base = input_line input in
	  close_in input; 
	  Filename.concat base tail
	with
	  Sys_error _ ->
	    begin
	      let (next_cwd, path_tail) = get_tail_dir cwd in
	      let next_tail = Filename.concat path_tail tail in
	      Unix.chdir "..";
	      iter next_cwd next_tail (l-1)
	    end
      end in
  iter path "" level

let _ =
  let level = ref 5 in
  let specs = 
    [ ("-l", Arg.Int(fun x -> level := x), "level to go up (count cwd as 1)") ] in
  let usage_line = 
    Sys.argv.(0)^"\n  base path is written in file named \""^ pwd_filename ^ "\"" in
  let _ = Arg.parse specs ignore usage_line in
  let result = wpwd pwd_filename !level (Unix.getcwd ()) in
  print_endline result;