(* Copyright (C) 2000, HELM Team.
 * 
 * This file is part of HELM, an Hypertextual, Electronic
 * Library of Mathematics, developed at the Computer Science
 * Department, University of Bologna, Italy.
 * 
 * HELM 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.
 * 
 * HELM 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 HELM; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 * MA  02111-1307, USA.
 * 
 * For details, see the HELM World-Wide-Web page,
 * http://cs.unibo.it/helm/.
 *)

(******************************************************************************)
(*                                                                            *)
(*                               PROJECT HELM                                 *)
(*                                                                            *)
(*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>               *)
(*                                 11/10/2000                                 *)
(*                                                                            *)
(*                                                                            *)
(******************************************************************************)

let resolve s =
 let starts_with s s' =
  if String.length s < String.length s' then
   false
  else
   (String.sub s 0 (String.length s')) = s'
 in
  if starts_with s "http:" then
   ClientHTTP.get_and_save_to_tmp s
  else
   s
;;

(*PXP 1.0
let url_syntax =
    let enable_if =
      function
	  `Not_recognized  -> Neturl.Url_part_not_recognized
	| `Allowed         -> Neturl.Url_part_allowed
	| `Required        -> Neturl.Url_part_required
    in
    { Neturl.null_url_syntax with
	Neturl.url_enable_scheme = enable_if `Allowed;
	Neturl.url_enable_host   = enable_if `Allowed;
	Neturl.url_enable_path   = Neturl.Url_part_required;
	Neturl.url_accepts_8bits = true;
    } 
;;

exception Unexpected;; (* Added when porting the file to PXP 1.1 *)

let file_url_of_id xid =
  let file_url_of_sysname sysname =
    (* By convention, we can assume that sysname is a URL conforming
     * to RFC 1738 with the exception that it may contain non-ASCII
     * UTF-8 characters. 
     *)
    try
     Neturl.url_of_string url_syntax sysname 
        (* may raise Malformed_URL *)
    with
     Neturl.Malformed_URL -> raise Pxp_reader.Not_competent
  in
  let url =
    match xid with
       Pxp_types.Anonymous          -> raise Pxp_reader.Not_competent
     | Pxp_types.Public (_,sysname) ->
        let sysname = resolve sysname in
         if sysname <> "" then file_url_of_sysname sysname
                          else raise Pxp_reader.Not_competent
     | Pxp_types.System sysname     ->
        let sysname = resolve sysname in
         file_url_of_sysname sysname
     | Pxp_types.Private pid -> raise Unexpected
  in
  let scheme =
    try Neturl.url_scheme url with Not_found -> "file" in
  let host =
    try Neturl.url_host url with Not_found -> "" in
    
  if scheme <> "file" then raise Pxp_reader.Not_competent;
  if host <> "" && host <> "localhost" then raise Pxp_reader.Not_competent;
    
  url
;;

let from_file ?system_encoding utf8_filename =
  
  let r =
    new Pxp_reader.resolve_as_file 
      ?system_encoding:system_encoding
      ~url_of_id:file_url_of_id
      ()
  in

  let utf8_abs_filename =
    if utf8_filename <> "" && utf8_filename.[0] = '/' then
      utf8_filename
    else
      Sys.getcwd() ^ "/" ^ utf8_filename
  in

  let syntax = { Neturl.ip_url_syntax with Neturl.url_accepts_8bits = true } in
  let url = Neturl.make_url 
	      ~scheme:"file" 
	      ~host:"localhost" 
	      ~path:(Neturl.split_path utf8_abs_filename) 
	      syntax
  in

  let xid = Pxp_types.System (Neturl.string_of_url url) in
    

  Pxp_yacc.ExtID(xid, r)
;;
*)

(*PXP 1.1*)
(* csc_pxp_reader.ml is an exact copy of PXP pxp_reader.ml *)
(* The only reason is to loosen the interface              *)

class resolve_as_file
  ?(file_prefix = (`Allowed :> Csc_pxp_reader.spec))
  ?(host_prefix = (`Allowed :> Csc_pxp_reader.spec))
  ?(system_encoding = `Enc_utf8)
  ?(map_private_id = (fun _ -> raise Csc_pxp_reader.Not_competent))
  ?(open_private_id = (fun _ -> raise Csc_pxp_reader.Not_competent))
  ()
  =

  let url_syntax =
    let enable_if =
      function
          `Not_recognized  -> Neturl.Url_part_not_recognized
        | `Allowed         -> Neturl.Url_part_allowed
        | `Required        -> Neturl.Url_part_required
    in
    { Neturl.null_url_syntax with
        Neturl.url_enable_scheme = enable_if file_prefix;
        Neturl.url_enable_host   = enable_if host_prefix;
        Neturl.url_enable_path   = Neturl.Url_part_required;
        Neturl.url_accepts_8bits = true;
    }
  in

  let base_url_syntax =
    { Neturl.null_url_syntax with
        Neturl.url_enable_scheme = Neturl.Url_part_required;
        Neturl.url_enable_host   = Neturl.Url_part_allowed;
        Neturl.url_enable_path   = Neturl.Url_part_required;
        Neturl.url_accepts_8bits = true;
    }
  in

  let default_base_url =
    Neturl.make_url
      ~scheme: "file"
      ~host:   ""
      ~path:   (Neturl.split_path (Sys.getcwd() ^ "/"))
      base_url_syntax
  in

  let file_url_of_id xid =
   let module P = Csc_pxp_reader in
   let module T = Pxp_types in
    let file_url_of_sysname sysname =
      (* By convention, we can assume that sysname is a URL conforming
       * to RFC 1738 with the exception that it may contain non-ASCII
       * UTF-8 characters.
       *)
      try
        Neturl.url_of_string url_syntax sysname
          (* may raise Malformed_URL *)
      with
          Neturl.Malformed_URL -> raise P.Not_competent
    in
    let url =
      match xid with
          T.Anonymous          -> raise P.Not_competent
        | T.Public (_,sysname) -> let sysname = resolve sysname in
                                  if sysname <> "" then file_url_of_sysname sysname
                                                 else raise P.Not_competent
        | T.System sysname     -> let sysname = resolve sysname in
                                  file_url_of_sysname sysname
        | T.Private pid        -> map_private_id pid
    in
    let scheme =
      try Neturl.url_scheme url with Not_found -> "file" in
    let host =
      try Neturl.url_host url with Not_found -> "" in

    if scheme <> "file" then raise P.Not_competent;
    if host <> "" && host <> "localhost" then raise P.Not_competent;

    url
  in

  let channel_of_file_url xid url =
   let module P = Csc_pxp_reader in
   let module T = Pxp_types in
    match xid with
        T.Private pid -> open_private_id pid
      | _ ->
          ( try
              let path_utf8 =
                try Neturl.join_path (Neturl.url_path ~encoded:false url)
                with Not_found -> raise P.Not_competent
              in

              let path =
                Netconversion.recode_string
                  ~in_enc:  `Enc_utf8
                  ~out_enc: system_encoding
                  path_utf8 in
              (* May raise Malformed_code *)

              open_in_bin path, None
                (* May raise Sys_error *)

            with
              | Netconversion.Malformed_code -> assert false
                (* should not happen *)
              | Sys_error _ as e ->
                  raise (P.Not_resolvable e)
          )
  in

  Csc_pxp_reader.resolve_read_url_channel
    ~base_url:       default_base_url
    ~url_of_id:      file_url_of_id
    ~channel_of_url: channel_of_file_url
    ()
;;

let from_file ?(alt = []) ?system_encoding ?enc utf8_filename =
  let r =
    new resolve_as_file
    ?system_encoding:system_encoding
      ()
  in
                  
  let url = Csc_pxp_reader.make_file_url
              ?system_encoding
              ?enc
              utf8_filename in
    
  let xid = Pxp_types.System (Neturl.string_of_url url) in

  Pxp_yacc.ExtID(xid, new Csc_pxp_reader.combine (r :: alt))
;;